Skip to content

Instantly share code, notes, and snippets.

@parsonsmatt

parsonsmatt/dont-use-hkd.md

Last active August 3, 2023 01:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save parsonsmatt/c6827d09a4ddec6581a401626e72ac3f to your computer and use it in GitHub Desktop.
Save parsonsmatt/c6827d09a4ddec6581a401626e72ac3f to your computer and use it in GitHub Desktop.
Download ZIP
Another Failed HKD Attempt
Raw
dont-use-hkd.md

Why not use HKD for the Esqueleto Records?

The most recent patch to esqueleto creates another datatype for esqueleto records: a Maybe variant, used when the table is introduced in a left join. This brings the record count up to three:

data Dog = Dog
    { name      :: String
    , age       :: Maybe Int
    , person    :: Maybe (Entity Person)
    }

data SqlDog = SqlDog
    { name      :: SqlExpr (Value String)
    , age       :: SqlExpr (Value (Maybe Int))
    , person    :: SqlExpr (Maybe (Entity Person))
    }

data SqlMaybeDog = SqlMaybeDog
    { name      :: SqlExpr (Value (Maybe String))
    , age       :: SqlExpr (Value (Maybe (Maybe Int)))
    , person    :: SqlExpr (Maybe (Maybe (Entity Person)))
    }

Here we have three records, all with the same basic shape, and even the same "core type" - why not use HKD? Isn't that what HKD is really good for?

The HKD pattern would have you write this:

data DogF f = Dog
    { name :: f String
    , age :: f (Maybe Int)
    , person :: f (Maybe (Entity Person))
    }

type Dog = DogF Identity
type SqlDog = DogF ???
type SqlMaybeDog = DogF ???

Unfortunately, we can't directly use this, because the type of SqlDog is the composition of two type constructors - and we can't provide a placeholder for it. We'd need to write a newtype.

newtype SqlValue a = SqlValue (SqlExpr (Value a))

newtype SqlEntity a = SqlEntity (SqlExpr (Entity a))

newtype SqlMaybeValue a = SqlMaybeValue (SqlExpr (Value (Maybe a)))

newtype SqlMaybeEntity a = SqlMaybeEntity (SqlExpr (Maybe (Entity a)))

type SqlDog = DogF SqlValue

Except - this doesn't work either. DogF SqlValue is going to give us the wrong thing for the Entity field.

data DogF f = Dog
    { ...
    , person :: f (Maybe (Entity Person))
    }

-- f ~ SqlValue
   , person :: SqlValue (Maybe (Entity Person))

-- unwrap newtype
   , person :: SqlExpr (Value (Maybe (Entity Person)))

That SqlExpr . Value . Maybe . Entity is wrong. It needs to be SqlExpr . Maybe . Entity. So we're not uniformly wrapping the constructors.

This is where you can safely stop considering the HKD technique. When you don't have a uniform f that you want to apply over every field, then you're in the badlands.

But Matt! I know you just hate HKD. Can't we work around these problems?

Unfortunately, yes, you can, but down that way lies pain.

Can you just show us? We're not convinced.

Sure. Instead of having f be the precise type constructor, we're going to make it a context parameter. We'll define a sum type that lists our contexts, and then we'll use a type family to dispatch on that to determine exactly how we wrap the payload field.

data RecordContext
    = RecordHaskell
    | RecordSql
    | RecordSqlMaybe

data DogF (f :: RecordContext) =
    Dog
        { name :: Pick f String
        , age :: Pick f (Maybe Int)
        , person :: Pick f (Maybe (Entity Person))
        }

type family Pick (ctx :: RecordContext) (a :: Type) :: Type where
    Pick RecordHaskell a    = a
    Pick RecordSql a        = SqlExpr (Value a)
    Pick RecordSqlMaybe a   = SqlExpr (Value (Maybe a))

    -- ahahaha, gotta think about entity
    Pick RecordSql (Entity a)       = SqlExpr (Entity a)
    Pick RecordSqlMaybe (Entity a)  = SqlExpr (Maybe (Entity a))

    {- are there other cases we forgot to consider? -}

type Dog = DogF 'RecordHaskell
type SqlDog = DogF 'RecordSql
type SqlMaybeDog = DogF 'RecordSqlMaybe

Now, this gets you kinda close. But we run into another issue. What about nested records??

data Cat = Cat
    { primaryEnemy :: Maybe (DogF Identity)
    }

The naive approach here does this conversion:

data CatF (f :: RecordContext) = Cat
    { primaryEnemy :: Pick f (Maybe (DogF f))
    }

But now our Pick is going to do the wrong thing - it'll match on Maybe a (since DogF is not Entity) and do SqlExpr (Value (Maybe (DogF RecordSql))) - and, dang, now that's wrong. The DogF isn't supposed to be in a Value. It's not even supposed to be in a SqlExpr. The concrete version of what we need to generate is this:

data SqlCat = SqlCat
    { primaryEnemy :: DogF 'RecordSqlMaybe
    }

and not this:

data SqlCat = SqlCat
    { primaryEnemy :: SqlExpr (Value (Maybe (DogF Identity)))
    }

So, we need t make Pick an open type family. Let's make an attached class, just for fun.

class SqlSelectRecord a where
    type SqlSelectRecordSqlRepresentation a

instance {-# OVERLAPPABLE #-} SqlSelectRecord (a :: Type) where
    type SqlSelectRecordSqlRepresentation a =
        SqlExpr (Value a)

instance SqlSelectRecord (Entity a) where
    type SqlSelectRecordSqlRepresentation (Entity a) =
        SqlExpr (Entity a)

instance SqlSelectRecord (Maybe (Entity a)) where
    type SqlSelectRecordSqlRepresentation (Maybe (Entity a)) =
        SqlExpr (Maybe (Entity a))

-- ah, some magic, i guess
instance SqlSelectRecord (DogF f) where
    type SqlSelectRecordSqlRepresentation (DogF f) =
        SqlExpr (DogF RecordSql)

instance SqlSelectRecord (Maybe (DogF f)) where
    type SqlSelectRecordSqlRepresentation (Maybe (DogF f)) =
        SqlExpr (DogF RecordSqlMaybe)

Unfortunately, this won't work. We can't mix type families and overlapping instances.

/home/matt/sqlhkd.hs:30:10: error:
    Conflicting family instance declarations:
      SqlSelectRecordSqlRepresentation a = SqlExpr (Value a)
        -- Defined at /home/matt/sqlhkd.hs:30:10
      SqlSelectRecordSqlRepresentation (Maybe (Entity a)) = SqlExpr
                                                              (Maybe (Entity a))
        -- Defined at /home/matt/sqlhkd.hs:38:10
   |
30 |     type SqlSelectRecordSqlRepresentation a =
   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

And we also can't have functional dependencies that'll give us the type inference we want. We're doing a type-level computation, and GHC ain't happy about nondeterminism like that.

This is a problem because we're trying to reason from the Haskell definition (ie the plain type) to determine what the SQL representation should be. And then, from there, ensuring that we Maybe-ify it correctly.

Well, you could require that your user do the Value stuff for you.

data RecordContext = HSRec | SqlRec | SqlNullRec

data DogF (f :: RecordContext)  = DogF
    { name :: PickC f (Value String)
    , age :: PickC f (Value (Maybe Int))
    , person :: PickC f (Maybe (Entity Person))
    }

type family PickC (f :: RecordContext) a :: *

type instance PickC HSRec (Value a) = a
type instance PickC SqlRec (Value a) = SqlExpr (Value a)
type instance PickC SqlNullRec (Value a) = SqlExpr (Value (Maybe a))

type instance PickC HSRec (Entity a) = Entity a
type instance PickC SqlRec (Entity a) = SqlExpr (Entity a)
type instance PickC SqlNullRec (Entity a) = SqlExpr (Maybe (Entity a))

type instance PickC HSRec (Maybe (Entity a)) = Maybe (Entity a)
type instance PickC SqlRec (Maybe (Entity a)) = SqlExpr (Maybe (Entity a))
type instance PickC SqlNullRec (Maybe (Entity a)) = SqlExpr (Maybe (Entity a))

type instance PickC HSRec (DogF a) = DogF a
type instance PickC SqlRec (DogF HSRec) = TypeError ('Text "no")
type instance PickC SqlRec (DogF SqlRec) = DogF SqlRec
type instance PickC SqlRec (DogF SqlNullRec) = DogF SqlRec
type instance PickC SqlNullRec (DogF rec) = DogF SqlNullRec

dogHs :: DogF HSRec
dogHs = DogF
    { name = "hello"
    , age = Just 10
    , person = Just (Entity Person)
    }

And that works kinda okay, but now you're asking users to manually determine what needs a Value and what doesn't - which users may get wrong. You're also asking them to write all those PickC family instances, including a pair of nominally illegal ones. You could fold that into the TemplateHaskell code that generates the SqlSelect and ToMaybe stuff, I guess.

On another aside, when I find that a technique is getting worse the more I try to use it, that strongly indicates that it's a bad fit. Rarely, rarely, you'll bash your head against something for long enough, and then it'll be great. But more often, it just never gets any better. This is a great point to recognize that HKD is a bad solution for this problem, and stop trying to use it.

But, since this is a demonstration as much as anything else, let's forge ahead.

Reasoning Backwards?

Let's think about our information flow here. The API looks like this:

data Dog = Dog { ... }

deriveEsqueletoRecord ''Dog

We don't really want to make end users change how they're using this code. So we're stuck with a plain ol' Haskell record and some TemplateHaskell to do the rest of the magic for us.

Can we use HKD just for the SQL side of the equation, and share a type for Sql and SqlMaybe?

-- library code
data SqlRecordContext
    = SqlPresent
    | SqlNullable

type family Pick (f :: SqlRecordContext) a 

type instance Pick SqlPresent (Value a) = Value a
type instance Pick SqlNullable (Value a) = Value (Maybe a)

type instance Pick SqlPresent (Entity a) = Entity a
type instance Pick SqlNullable (Entity a) = Maybe (Entity a)

-- generated,

data SqlDog f = SqlDog
    { name      :: Pick f (Value String)
    , age       :: Pick f (Maybe Int)
    , person    :: Pick f (Maybe (Entity Person))
    }

type instance Pick SqlPresent (SqlDog f) = SqlDog f
type instance Pick SqlNullable (SqlDog f) = SqlDog SqlNullable

This looks OK so far. So let's go get Cat into the picture and see what stuff looks like.

data Cat = Cat
    { parent :: Entity Person
    , primaryEnemy :: Maybe Dog
    }

I've introduced another field Person which isn't null, because I need to sanity check these types. Let's skip the type family for now and just inline our knowledge about the nullability of the parent and dog.

data SqlCat f = SqlCat
    { parent       :: Pick f (Entity Person)
    , primaryEnemy :: SqlDog SqlNullable
    }

enemyPresent :: SqlCat SqlPresent -> SqlDog SqlNullable
enemyPresent cat = cat.primaryEnemy

parentPresent :: SqlCat SqlPresent -> SqlExpr (Entity Person)
parentPresent cat = cat.parent

enemyNullable :: SqlCat SqlNullable -> SqlDog SqlNullable
enemyNullable cat = cat.primaryEnemy

parentNullable :: SqlCat SqlNullable -> SqlExpr (Maybe (Entity Person))
parentNullable cat = cat.parent

Well, I suppose we can pass the f along in the present cases, and force SqlNullable in the Maybe cases.

data Cat = Cat
    { parent :: Person
    , primaryEnemy :: Maybe Dog
    }

data SqlCat f = SqlCat
    { parent       :: Pick f (Entity Person)
    , primaryEnemy :: SqlDog SqlNullable
    }

enemyPresent :: SqlCat SqlPresent -> SqlDog SqlNullable
enemyPresent cat = cat.primaryEnemy

parentPresent :: SqlCat SqlPresent -> SqlExpr (Entity Person)
parentPresent cat = cat.parent

enemyNullable :: SqlCat SqlNullable -> SqlDog SqlNullable
enemyNullable cat = cat.primaryEnemy

parentNullable :: SqlCat SqlNullable -> SqlExpr (Maybe (Entity Person))
parentNullable cat = cat.parent

This works out.

Now, we do still need the type family machinery to be there so that we can just uniformly apply Pick - so what type family equations work?

data SqlDog f = SqlDog
    { name      :: SqlExpr (Pick f (Value String))
    , age       :: SqlExpr (Pick f (Maybe Int))
    , person    :: SqlExpr (Pick f (Maybe (Entity Person)))
    }

type instance Pick SqlPresent (SqlDog f) = SqlDog f
type instance Pick SqlNullable (SqlDog f) = SqlDog SqlNullable

data SqlCat f = SqlCat
    { parent       :: SqlExpr (Pick f (Entity Person))
    , primaryEnemy :: SqlExpr (Pick SqlNullable (SqlDog SqlNullable))
    }

type instance Pick SqlPresent (SqlCat f) = SqlCat f
type instance Pick SqlNulalble (SqlCat f) = SqlCat SqlNullable

Actually, wait, uh oh. This isn't ok. Our primaryEnemy field is returning a SqlExpr (SqlDog SqlNullable). But these records have SqlExpr baked into the fields. They're not properly SqlExpr, but a collection of SqlExpr.

There's another problem - I made a mistake in my "generated" code earlier.

data SqlDog f = SqlDog
    { name      :: SqlExpr (Pick f (Value String))
    , age       :: SqlExpr (Pick f (Maybe Int))
    , person    :: SqlExpr (Pick f (Maybe (Entity Person)))
    }

The age field should have a Value in it.

 data SqlDog f = SqlDog
     { name      :: SqlExpr (Pick f (Value String))
-    , age       :: SqlExpr (Pick f (Maybe Int))
+    , age       :: SqlExpr (Pick f (Value (Maybe Int)))
     , person    :: SqlExpr (Pick f (Maybe (Entity Person)))
     }

OK, so we need to go back a few steps. Pick needs to be able to determine if we need a SqlExpr or not. So let's go back to Dog.

data SqlDog f = SqlDog
    { name   :: Pick f (Value String)
    , age    :: Pick f (Value (Maybe Int))
    , person :: Pick f (Maybe (Entity Person))
    }

type instance Pick SqlPresent (SqlDog f) = SqlDog f
type instance Pick SqlNullable (SqlDog f) = SqlDog SqlNullable

dogName :: SqlDog SqlPresent -> SqlExpr (Value String)
dogName dog = dog.name

dogNameNull :: SqlDog SqlNullable -> SqlExpr (Value (Maybe String))
dogNameNull dog = dog.name

dogAge :: SqlDog SqlPresent -> SqlExpr (Value (Maybe Int))
dogAge dog = dog.age

dogAgeNull :: SqlDog SqlNullable -> SqlExpr (Value (Maybe (Maybe Int)))
dogAgeNull dog = dog.age

dogPerson :: SqlDog SqlPresent -> SqlExpr (Maybe (Entity Person))
dogPerson dog = dog.person

dogPersonNull :: SqlDog SqlNullable -> SqlExpr (Maybe (Maybe (Entity Person)))
dogPersonNull dog = dog.person

OK. This is our SqlDog definition that we want, and some reasonable test cases. I'm OK with the Maybe collapsing or not.

The existing record code already does a reification of the SqlSelect instance for a type. So let's define our Pick instances:

newtype Entity a = Entity a

type instance ToMaybeT (Entity a) = Maybe (Entity a)

type instance Pick SqlNullable (Entity a) = SqlExpr (ToMaybeT (Entity a))
type instance Pick SqlPresent (Entity a) = SqlExpr (Entity a)

type instance Pick f (Maybe (Entity a)) = SqlExpr (ToMaybeT (Entity a))

newtype Value a = Value a

type instance ToMaybeT (Value a) = Value (Maybe a)

type instance Pick SqlNullable (Value a) = SqlExpr (ToMaybeT (Value a))
type instance Pick SqlPresent (Value a) = SqlExpr (Value a)

This appears to work alright. I've copied the ToMaybeT type family from esqueleto here, which makes some of this a bit less verbose. Indeed, the Pick family seems to be a way of either applying ToMaybeT or not - given a better type programming system, we'd probably write pick f = if f == SqlNullable then toMaybeT else id.

OK, let's extend to Cat and figure out how to make that work.

type instance ToMaybeT (SqlDog f) = SqlDog SqlNullable

type instance Pick SqlPresent (SqlDog f) = SqlDog f
type instance Pick SqlNullable (SqlDog f) = SqlDog SqlNullable

data Cat = Cat
    { parent :: Person
    , primaryEnemy :: Maybe Dog
    }

data SqlCat f = SqlCat
    { parent       :: Pick f (SqlPerson f)
    , primaryEnemy :: Pick f (SqlDog SqlNullable)
    }

enemyPresent :: SqlCat SqlPresent -> SqlDog SqlNullable
enemyPresent cat = cat.primaryEnemy

parentPresent :: SqlCat SqlPresent -> SqlExpr (Entity Person)
parentPresent cat = cat.parent

enemyNullable :: SqlCat SqlNullable -> SqlDog SqlNullable
enemyNullable cat = cat.primaryEnemy

parentNullable :: SqlCat SqlNullable -> SqlExpr (Maybe (Entity Person))
parentNullable cat = cat.parent

This all works out alright.

OK, so that's the HKD solution

Let's recap:

-- library code
data SqlNullable = SqlPresent | SqlNullable

type family Pick (f :: SqlNullable a)

type instance Pick SqlNullable (Entity a) = SqlExpr (ToMaybeT (Entity a))
type instance Pick SqlPresent (Entity a) = SqlExpr (Entity a)
type instance Pick f (Maybe (Entity a)) = SqlExpr (ToMaybeT (Entity a))

type instance Pick SqlNullable (Value a) = SqlExpr (ToMaybeT (Value a))
type instance Pick SqlPresent (Value a) = SqlExpr (Value a)

-- user code

data Dog = Dog
    { name :: String
    , age :: Maybe Int
    , owner :: Maybe (Entity Person)
    }

deriveEsqueletoRecord ''Dog

data Cat = Cat
    { parent :: Person
    , parentEntity :: Entity Person
    , primaryEnemy :: Maybe Dog
    }

deriveEsqueletoRecord ''Cat

-- generated code

data SqlDog f = SqlDog
    { name   :: Pick f (Value String)
    , age    :: Pick f (Value (Maybe Int))
    , person :: Pick f (Maybe (Entity Person))
    }

type instance ToMaybeT (SqlDog f) = SqlDog SqlNullable

type instance Pick SqlPresent (SqlDog f) = SqlDog f
type instance Pick SqlNullable (SqlDog f) = SqlDog SqlNullable

data SqlCat f = SqlCat
    { parent       :: Pick f (SqlPerson f)
    , parentEntity :: Pick f (Entity Person)
    , primaryEnemy :: Pick f (SqlDog SqlNullable)
    }

type instance ToMaybeT (SqlCat f) = SqlCat SqlNullable

type instance Pick SqlPresent (SqlCat f) = SqlCat f
type instance Pick SqlNullable (SqlCat f) = SqlCat SqlNullable

Now, there's an extra complication - the SqlSelect type class. This is the thing that says "here's how to get a Haskell X out of a SqlExpr X" and is used while parsing. Let's define instances of that class for everything:

-- in esqueleto-next, we lose a fundep
class SqlSelect a r | a -> r

instance SqlSelect (SqlExpr (Entity a)) (Entity a)
instance SqlSelect (SqlExpr (Value a)) (Value a)

instance SqlSelect (SqlDog SqlPresent) Dog
instance SqlSelect (SqlDog SqlNullable) (Maybe Dog)

instance SqlSelect (SqlCat SqlPresent) Cat
instance SqlSelect (SqlCat SqlNullable) (Maybe Cat)

select :: SqlSelect a r => a -> r
select = undefined

And now, let's try to use it!

foo :: Cat
foo = do
    select $
        SqlCat
            { parent = SqlPerson
            , parentEntity = SqlExpr $ Entity Person
            , primaryEnemy =
                SqlDog
                    { name = SqlExpr $ Value "dog"
                    , age = SqlExpr $ Value (Just 5)
                    , person = SqlExpr Nothing
                    }
            }

Unfortunately, we get mad errors.

[1 of 1] Compiling SqlHkd           ( /home/matt/sqlhkd.hs, interpreted )

/home/matt/sqlhkd.hs:166:24: error:
    • Couldn't match expected type: Pick f2 (SqlPerson f2)
                  with actual type: SqlPerson f0
      The type variable ‘f2’ is ambiguous
    • In the ‘parent’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                              person = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = SqlDog
                                {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                 person = SqlExpr Nothing}}
    |
166 |             { parent = SqlPerson
    |                        ^^^^^^^^^

/home/matt/sqlhkd.hs:167:30: error:
    • Couldn't match expected type: Pick f2 (Entity Person)
                  with actual type: SqlExpr (Entity Person)
      The type variable ‘f2’ is ambiguous
    • In the ‘parentEntity’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                              person = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = SqlDog
                                {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                 person = SqlExpr Nothing}}
    |
167 |             , parentEntity = SqlExpr $ Entity Person
    |                              ^^^^^^^^^^^^^^^^^^^^^^^

/home/matt/sqlhkd.hs:169:17: error:
    • Couldn't match expected type: Pick f2 (SqlDog 'SqlNullable)
                  with actual type: SqlDog f1
      The type variable ‘f2’ is ambiguous
    • In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                              person = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = SqlDog
                                {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                 person = SqlExpr Nothing}}
    |
169 |                 SqlDog
    |                 ^^^^^^...

/home/matt/sqlhkd.hs:170:30: error:
    • Couldn't match expected type: Pick f1 (Value String)
                  with actual type: SqlExpr (Value String)
      The type variable ‘f1’ is ambiguous
    • In the ‘name’ field of a record
      In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                              person = SqlExpr Nothing}}’
    |
170 |                     { name = SqlExpr $ Value "dog"
    |                              ^^^^^^^^^^^^^^^^^^^^^

/home/matt/sqlhkd.hs:171:29: error:
    • Couldn't match expected type: Pick f1 (Value (Maybe Int))
                  with actual type: SqlExpr (Value (Maybe a0))
      The type variable ‘f1’ is ambiguous
    • In the ‘age’ field of a record
      In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                              person = SqlExpr Nothing}}’
    |
171 |                     , age = SqlExpr $ Value (Just 5)
    |                             ^^^^^^^^^^^^^^^^^^^^^^^^
Failed, no modules loaded.

The type of every field is ambiguous because we don't know what f is supposed to be, so we can't solve Pick f typ. If we restore the bidirectional functional dependency, then this works out okay - we get a much Better error message.

/home/matt/sqlhkd.hs:167:30: error:
    • Couldn't match type: Maybe [Char]
                     with: [Char]
      Expected: Pick 'SqlNullable (Value String)
        Actual: SqlExpr (Value String)
    • In the ‘name’ field of a record
      In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value $ "dog",
                              age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}’
    |
167 |                     { name = SqlExpr $ Value $ "dog"
    |                              ^^^^^^^^^^^^^^^^^^^^^^^

We have to manually "promote" every field to a Just. Well, let's go ahead and make that part of the toMaybe class so we can lift it: And, while we're at it, let's rewrite the instances and Pick code to follow the shape of the actual library one - which operates on SqlExpr of things, and not just things.

-- library code:
class ToMaybe a where
    type ToMaybeT a
    toMaybe :: a -> ToMaybeT a

instance ToMaybe (SqlExpr (Maybe a)) where
    type ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a)

    toMaybe = id

instance ToMaybe (SqlExpr (Entity a)) where
    type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))

    toMaybe (SqlExpr ea) = SqlExpr (Just ea)

instance ToMaybe (SqlExpr (Value a)) where
    type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe a))

    toMaybe (SqlExpr (Value a)) = SqlExpr (Value (Just a))

-- generated code:
instance ToMaybe (SqlDog f) where
    type ToMaybeT (SqlDog f) = SqlDog SqlNullable

    toMaybe SqlDog { .. } = SqlDog
        { name = toMaybe name
        , age = toMaybe age
        , person = toMaybe person
        }

This error fails with a confusing message -

/home/matt/sqlhkd.hs:117:18: error:
    • Couldn't match type: ToMaybeT (Pick f (Value String))
                     with: SqlExpr (Value (Maybe [Char]))
      Expected: Pick 'SqlNullable (Value String)
        Actual: ToMaybeT (Pick f (Value String))
    • In the ‘name’ field of a record
      In the expression:
        SqlDog
          {name = toMaybe name, age = toMaybe age, person = toMaybe person}
      In an equation for ‘toMaybe’:
          toMaybe SqlDog {..}
            = SqlDog
                {name = toMaybe name, age = toMaybe age, person = toMaybe person}
    • Relevant bindings include
        person :: Pick f (Maybe (Entity Person))
          (bound at /home/matt/sqlhkd.hs:116:22)
        age :: Pick f (Value (Maybe Int))
          (bound at /home/matt/sqlhkd.hs:116:22)
        name :: Pick f (Value String)
          (bound at /home/matt/sqlhkd.hs:116:22)
        toMaybe :: SqlDog f -> ToMaybeT (SqlDog f)
          (bound at /home/matt/sqlhkd.hs:116:5)
    |
117 |         { name = toMaybe name
    |                  ^^^^^^^^^^^^

/home/matt/sqlhkd.hs:118:17: error:
    • Couldn't match type: ToMaybeT (Pick f (Value (Maybe Int)))
                     with: SqlExpr (Value (Maybe (Maybe Int)))
      Expected: Pick 'SqlNullable (Value (Maybe Int))
        Actual: ToMaybeT (Pick f (Value (Maybe Int)))
    • In the ‘age’ field of a record
      In the expression:
        SqlDog
          {name = toMaybe name, age = toMaybe age, person = toMaybe person}
      In an equation for ‘toMaybe’:
          toMaybe SqlDog {..}
            = SqlDog
                {name = toMaybe name, age = toMaybe age, person = toMaybe person}
    • Relevant bindings include
        person :: Pick f (Maybe (Entity Person))
          (bound at /home/matt/sqlhkd.hs:116:22)
        age :: Pick f (Value (Maybe Int))
          (bound at /home/matt/sqlhkd.hs:116:22)
        name :: Pick f (Value String)
          (bound at /home/matt/sqlhkd.hs:116:22)
        toMaybe :: SqlDog f -> ToMaybeT (SqlDog f)
          (bound at /home/matt/sqlhkd.hs:116:5)
    |
118 |         , age = toMaybe age
    |                 ^^^^^^^^^^^

Ah, the problem is that we're defining this in terms of all SqlDog f, so we don't know if it's a SqlDog SqlPresent or a SqlDog SqlNullable. We need two instances, even though they both do pretty much the same thing.

instance ToMaybe (SqlDog SqlNullable) where
    type ToMaybeT (SqlDog _) = SqlDog SqlNullable

    toMaybe = id

instance ToMaybe (SqlDog SqlPresent) where
    type ToMaybeT (SqlDog _) = SqlDog SqlNullable

    toMaybe SqlDog { .. } = SqlDog
        { name = toMaybe name
        , age = toMaybe age
        , person = toMaybe person
        }

OK, now everything compiles.

Unfortunately, we do need to delete that bidirectional functional dependency, as new features require the flexibility. Now we still have an error:

foo :: Cat
foo = do
    select $
        SqlCat
            { parent = SqlPerson
            , parentEntity = SqlExpr $ Entity Person
            , primaryEnemy =
                SqlDog
                    { name = SqlExpr $ Value $ Just "dog"
                    , age = SqlExpr $ Value (Just (Just 5))
                    , person = SqlExpr Nothing
                    }
            }
[1 of 1] Compiling SqlHkd           ( /home/matt/sqlhkd.hs, interpreted ) [Source file changed]

/home/matt/sqlhkd.hs:188:24: error:
    • Couldn't match expected type: Pick f2 (SqlPerson f2)
                  with actual type: SqlPerson f0
      The type variable ‘f2’ is ambiguous
    • In the ‘parent’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value $ Just "dog",
                              age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = SqlDog
                                {name = SqlExpr $ Value $ Just "dog",
                                 age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}
    |
188 |             { parent = SqlPerson
    |                        ^^^^^^^^^

/home/matt/sqlhkd.hs:189:30: error:
    • Couldn't match expected type: Pick f2 (Entity Person)
                  with actual type: SqlExpr (Entity Person)
      The type variable ‘f2’ is ambiguous
    • In the ‘parentEntity’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value $ Just "dog",
                              age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = SqlDog
                                {name = SqlExpr $ Value $ Just "dog",
                                 age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}
    |
189 |             , parentEntity = SqlExpr $ Entity Person
    |                              ^^^^^^^^^^^^^^^^^^^^^^^

/home/matt/sqlhkd.hs:191:17: error:
    • Couldn't match expected type: Pick f2 (SqlDog 'SqlNullable)
                  with actual type: SqlDog f1
      The type variable ‘f2’ is ambiguous
    • In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value $ Just "dog",
                              age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = SqlDog
                                {name = SqlExpr $ Value $ Just "dog",
                                 age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}
    |
191 |                 SqlDog
    |                 ^^^^^^...

/home/matt/sqlhkd.hs:192:30: error:
    • Couldn't match expected type: Pick f1 (Value String)
                  with actual type: SqlExpr (Value (Maybe String))
      The type variable ‘f1’ is ambiguous
    • In the ‘name’ field of a record
      In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value $ Just "dog",
                              age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}’
    |
192 |                     { name = SqlExpr $ Value $ Just "dog"
    |                              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^

/home/matt/sqlhkd.hs:193:29: error:
    • Couldn't match expected type: Pick f1 (Value (Maybe Int))
                  with actual type: SqlExpr (Value (Maybe (Maybe a0)))
      The type variable ‘f1’ is ambiguous
    • In the ‘age’ field of a record
      In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value $ Just "dog",
                              age = SqlExpr $ Value (Just (Just 5)), person = SqlExpr Nothing}}’
    |
193 |                     , age = SqlExpr $ Value (Just (Just 5))
    |                             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Well, OK, it gives a shitload of errors. We need a type annotation on SqlCat to tell us what the actual f is. It can't infer it. We have to provide a type annotation.

foo :: Cat
foo = do
    select $
        (SqlCat
            { parent = SqlPerson
            , parentEntity = SqlExpr $ Entity Person
            , primaryEnemy =
                SqlDog
                    { name = SqlExpr $ Value $ Just "dog"
                    , age = SqlExpr $ Value (Just (Just 5))
                    , person = SqlExpr Nothing
                    }
            } :: SqlCat SqlPresent)

Well, that is annoying. But, hey, we have that toMaybe stuff now, let's untangle the SqlDog.

foo :: Cat
foo = do
    select $
        (SqlCat
            { parent = SqlPerson
            , parentEntity = SqlExpr $ Entity Person
            , primaryEnemy =
                toMaybe SqlDog
                    { name = SqlExpr $ Value "dog"
                    , age = SqlExpr $ Value (Just 5)
                    , person = SqlExpr Nothing
                    }
            } :: SqlCat SqlPresent)

Unfortunately, this also gives errors.

[1 of 1] Compiling SqlHkd           ( /home/matt/sqlhkd.hs, interpreted ) [Source file changed]

/home/matt/sqlhkd.hs:191:17: error:
    • Couldn't match type: ToMaybeT (SqlDog f0)
                     with: SqlDog 'SqlNullable
      Expected: Pick 'SqlPresent (SqlDog 'SqlNullable)
        Actual: ToMaybeT (SqlDog f0)
      The type variable ‘f0’ is ambiguous
    • In the ‘primaryEnemy’ field of a record
      In the expression:
          SqlCat
            {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
             primaryEnemy = toMaybe
                              SqlDog
                                {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                 person = SqlExpr Nothing}} ::
            SqlCat SqlPresent
      In the second argument of ‘($)’, namely
        ‘(SqlCat
            {parent = SqlPerson, parentEntity = SqlExpr $ Entity Person,
             primaryEnemy = toMaybe
                              SqlDog
                                {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                 person = SqlExpr Nothing}} ::
            SqlCat SqlPresent)’
    |
191 |                 toMaybe SqlDog
    |                 ^^^^^^^^^^^^^^...

/home/matt/sqlhkd.hs:192:30: error:
    • Couldn't match expected type: Pick f0 (Value String)
                  with actual type: SqlExpr (Value String)
      The type variable ‘f0’ is ambiguous
    • In the ‘name’ field of a record
      In the first argument of ‘toMaybe’, namely
        ‘SqlDog
           {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
            person = SqlExpr Nothing}’
      In the ‘primaryEnemy’ field of a record
    |
192 |                     { name = SqlExpr $ Value "dog"
    |                              ^^^^^^^^^^^^^^^^^^^^^

/home/matt/sqlhkd.hs:193:29: error:
    • Couldn't match expected type: Pick f0 (Value (Maybe Int))
                  with actual type: SqlExpr (Value (Maybe a0))
      The type variable ‘f0’ is ambiguous
    • In the ‘age’ field of a record
      In the first argument of ‘toMaybe’, namely
        ‘SqlDog
           {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
            person = SqlExpr Nothing}’
      In the ‘primaryEnemy’ field of a record
    |
193 |                     , age = SqlExpr $ Value (Just 5)
    |                             ^^^^^^^^^^^^^^^^^^^^^^^^

Ah, more ambiguity. Now we don't know what our input is - it's a SqlDog f. We need a type annotation, again.

OK, let's recap, again. The machinery for an HKD solution to the "esqueleto maybe record" problem:

{-# language GHC2021, DataKinds, NoFieldSelectors, RecordWildCards, FunctionalDependencies, DuplicateRecordFields, OverloadedRecordDot, TypeFamilies, UndecidableInstances #-}

module SqlHkd where

-- Mimic of esqueleto existing library code
class SqlSelect sql haskell | sql -> haskell

class ToMaybe a where
    type ToMaybeT a
    toMaybe :: a -> ToMaybeT a

newtype Entity a = Entity a

instance SqlSelect (SqlExpr (Entity a)) (Entity a)

instance ToMaybe (SqlExpr (Maybe a)) where
    type ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a)

    toMaybe = id

instance ToMaybe (SqlExpr (Entity a)) where
    type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))

    toMaybe (SqlExpr ea) = SqlExpr (Just ea)

newtype Value a = Value a

instance SqlSelect (SqlExpr (Value a)) (Value a)

instance ToMaybe (SqlExpr (Value a)) where
    type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe a))

    toMaybe (SqlExpr (Value a)) = SqlExpr (Value (Just a))

newtype SqlExpr a = SqlExpr a


-- Novel library code
data SqlRecordContext
    = SqlPresent
    | SqlNullable

type family Pick (f :: SqlRecordContext) a

type instance Pick SqlNullable (Entity a) = ToMaybeT (SqlExpr (Entity a))
type instance Pick SqlPresent (Entity a) = SqlExpr (Entity a)

type instance Pick f (Maybe (Entity a)) = ToMaybeT (SqlExpr (Entity a))

type instance Pick SqlNullable (Value a) = ToMaybeT (SqlExpr (Value a))
type instance Pick SqlPresent (Value a) = SqlExpr (Value a)

-- User defined code

-- | This is a database table - intended for use with `Entity Person`
data Person = Person

-- | This is a Haskell record, that we want to use in esqueleto context.
data Dog = Dog
    { name :: String
    , age :: Maybe Int
    , owner :: Maybe (Entity Person)
    }

-- BEGIN: deriveEsqueletoRecord ''Dog
data SqlDog f = SqlDog
    { name   :: Pick f (Value String)
    , age    :: Pick f (Value (Maybe Int))
    , person :: Pick f (Maybe (Entity Person))
    }

instance SqlSelect (SqlDog SqlPresent) Dog
instance SqlSelect (SqlDog SqlNullable) (Maybe Dog)

instance ToMaybe (SqlDog SqlNullable) where
    type ToMaybeT (SqlDog _) = SqlDog SqlNullable

    toMaybe = id

instance ToMaybe (SqlDog SqlPresent) where
    type ToMaybeT (SqlDog _) = SqlDog SqlNullable

    toMaybe SqlDog { .. } = SqlDog
        { name = toMaybe name
        , age = toMaybe age
        , person = toMaybe person
        }

type instance Pick SqlPresent (SqlDog f) = SqlDog f
type instance Pick SqlNullable (SqlDog f) = SqlDog SqlNullable

instance SqlSelect (SqlDog SqlPresent) Dog
instance SqlSelect (SqlDog SqlNullable) (Maybe Dog)
-- END: deriveEsqueletoRecord ''Dog

-- | Another Haskell record that we want to use in esqueleto.
data Cat = Cat
    { parent :: Person
    , parentEntity :: Entity Person
    , primaryEnemy :: Maybe Dog
    }

-- BEGIN: deriveEsqueletoRecord ''Cat
data SqlCat f = SqlCat
    { parentEntity :: Pick f (Entity Person)
    , primaryEnemy :: Pick f (SqlDog SqlNullable)
    }

instance SqlSelect (SqlCat SqlPresent) Cat
instance SqlSelect (SqlCat SqlNullable) (Maybe Cat)

type instance Pick SqlPresent (SqlCat f) = SqlCat f
type instance Pick SqlNullable (SqlCat f) = SqlCat SqlNullable
-- END: deriveEsqueletoRecord ''Cat

select :: SqlSelect a r => a -> r
select = undefined

foo :: Cat
foo = do
    select $
        (SqlCat
            { parentEntity = SqlExpr $ Entity Person
            , primaryEnemy =
                toMaybe (SqlDog
                    { name = SqlExpr $ Value "dog"
                    , age = SqlExpr $ Value (Just 5)
                    , person = SqlExpr Nothing
                    } :: SqlDog SqlPresent)
            } :: SqlCat SqlPresent)

That's a lot of boilerplate (though, mostly generated), and the end result is kind of awful to use. Furthermore, we don't really derive any value from this - you can't meaningfully write a function like forall f. SqlDog f -> r, since you actually doneed to know which f you're dealing with to get past the Pick type family.

Let's not go to HKD, 'tis a silly place

This is a huge amount of hoop jumping and rigamarole, all so that we can avoid having two similarly named datatypes:

data Dog = Dog
    { name :: String
    , age :: Maybe Int
    , owner :: Maybe (Entity Person)
    }

data SqlDog = SqlDog
    { name :: SqlExpr (Value String)
    , age :: SqlExpr (Value (Maybe Int)
    , owner :: SqlExpr (Maybe (Entity Person))
    }

data SqlMaybeDog = SqlMaybeDog
    { name :: SqlExpr (Value (Maybe String))
    , age :: SqlExpr (Value (Maybe Int)
    , owner :: SqlExpr (Maybe (Entity Person))
    }

So how does our solution change, without HKD?

Well, we don't need Pick anymore, or SqlRecordContext. That's a bunch of deleted lines right there. Our generated datatype SqlDog f now turns into two datatypes, SqlDog and SqlDogMaybe.

-instance SqlSelect (SqlDog SqlPresent) Dog
+instance SqlSelect SqlDog Dog
-instance SqlSelect (SqlDog SqlNullable) (Maybe Dog)
+instance SqlSelect SqlMaybeDog (Maybe Dog)

The SqlSelect instances have fewer parentheses, which is an incredible victory over LISP nerds.

- instance ToMaybe (SqlDog SqlNullable) where
+ instance ToMaybe SqlMaybeDog where
-     type ToMaybeT (SqlDog _) = SqlDog SqlNullable
+     type ToMaybeT _ = SqlMaybeDog
  
      toMaybe = id
  
- instance ToMaybe (SqlDog SqlPresent) where
+ instance ToMaybe SqlDog where
-     type ToMaybeT (SqlDog _) = SqlDog SqlNullable
+     type ToMaybeT SqlDog = SqlMaybeDog
 
-     toMaybe SqlDog { .. } = SqlDog
+     toMaybe SqlDog { .. } = SqlMaybeDog
          { name = toMaybe name
          , age = toMaybe age
          , person = toMaybe person
          }

The ToMaybe instances are barely different - the name of the constructor changes, and some type mentions change.

That's pretty much it. We can omit the type signatures on our select work now:

foo :: Cat
foo = do
    select $
        SqlCat
            { parentEntity = SqlExpr $ Entity Person
            , primaryEnemy =
                toMaybe SqlDog
                    { name = SqlExpr $ Value "dog"
                    , age = SqlExpr $ Value (Just 5)
                    , owner = SqlExpr Nothing
                    }
            }

The sqlnohkd.hs file is 6 lines shorter (142 lines vs 148 lines for HKD). There are no type families. Type inference is great. The errors are pretty easy, too - consider what happens if we forget that toMaybe -

[1 of 1] Compiling SqlHkd           ( sqlnohkd.hs, interpreted ) [Source file changed]

sqlnohkd.hs:137:17: error: [GHC-83865]
    • Couldn't match expected type ‘SqlMaybeDog’
                  with actual type ‘SqlDog’
    • In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = SqlDog
                             {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                              owner = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = SqlDog
                                {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                 owner = SqlExpr Nothing}}
    |
137 |                 SqlDog
    |                 ^^^^^^...

No ambiguous type variable nonsense, no leaky type family abstractions, just a clear simple message - "Couldn't match expected type A with actual type B." You can even use a type hole!

sqlnohkd.hs:137:17: error: [GHC-88464]
    • Found hole: _f :: SqlDog -> SqlMaybeDog
      Or perhaps ‘_f’ is mis-spelled, or not in scope
    • In the ‘primaryEnemy’ field of a record
      In the second argument of ‘($)’, namely
        ‘SqlCat
           {parentEntity = SqlExpr $ Entity Person,
            primaryEnemy = _f
                             SqlDog
                               {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                owner = SqlExpr Nothing}}’
      In a stmt of a 'do' block:
        select
          $ SqlCat
              {parentEntity = SqlExpr $ Entity Person,
               primaryEnemy = _f
                                SqlDog
                                  {name = SqlExpr $ Value "dog", age = SqlExpr $ Value (Just 5),
                                   owner = SqlExpr Nothing}}
    • Relevant bindings include foo :: Cat (bound at sqlnohkd.hs:132:1)
      Valid hole fits include
        toMaybe :: forall a. ToMaybe a => a -> ToMaybeT a
          with toMaybe @SqlDog
          (defined at sqlnohkd.hs:10:5)
    |
137 |                 _f SqlDog
    |                 ^^
Failed, no modules loaded.

That suggests toMaybe right there!

Conclusion

HKD buys us nothing but pain and heartache.

Two simple lil datatypes do the job extremely well with virtually no downside.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment