TH for defining type synonyms

[tomjaguarpaw]

If we have a Person table with columns name :: string, height :: double, birthday :: date, we would represent it with a type like

data Person' a b c = Person { name :: a, height :: b, birthday :: c }

and give it synonyms like

type Person = Person' String Double Day
type PersonWire = Person' (Wire String) (Wire Double) (Wire Day)

If you want to insert a Person you have to come up with a value myRow of type

myRow :: Expr (Person' (Maybe (Wire String)) (Maybe (Wire String)) 
                       (Maybe (Wire Double)))

This proliferation of types becomes tedious. Some generic way to make the types would be nice, TH or otherwise.

[tomjaguarpaw]

Here's a neat way of dealing with this issue with no TH. The idea is to write something like the following

{-# LANGUAGE LiberalTypeSynonyms #-}
-- ...

-- Import these from somewhere
type I a = a
type MaybeWire a = Maybe (Wire a)
-- ...

type Person'' f = Person' (f String) (f Double) (f Day)
type Person = Person'' I
type PersonWire = Person'' Wire
type PersonMaybeWire = Person'' MaybeWire

[bergmark]

Nice!

You also need PersonWireMaybe if you want do to a left join.

[bergmark]

The TH would still be nice though, I may look into it. Thinking about something like:

makeType [d|
  data Person
    { id          :: Int
    , name        :: Text
    , createdTime :: UTCTime
    }
  ]
makeAdaptorAndInstance "pPerson" ''PersonP
makeTable "people" ''PersonP

=>

data PersonP a b = PersonP { id :: a, name :: b, createdTime :: c }
type PersonF f = PersonP (f Int) (f Text) (f UTCTime)
type Person   = PersonF I
type PersonW  = PersonF Wire
type PersonMW = PersonF MaybeWire
type PersonWM = PersonF WireMaybe

makeAdaptorAndInstance "pPerson" ''PersonP

table :: Table PersonW
table = Table "people" $ PersonP (Wire "id") (Wire "name") (Wire "created_time")

It would make the assumption that it should uncamelcase field names (which we want), but that could be made configurable.

We could also inline the type synonyms Liberal*.

[tomjaguarpaw]

That sounds very cool.

[k0001]

I quite like this idea. I wonder if it's worth introducing all of the Person, PersonW, PersonMW and PersonWM type synonyms, or if just PersonP and PersonF are enough. Or even less, perhaps just having a single Person f a b = Person { id :: f a, name :: f b } generated from that makeType TH or just written once by hand is more manegeable.

[bergmark]

While you can just use PersonWireF Wire anywhere, unless I'm mistaken you'll need to enable LiberalTypeSynonyms on every use site. Might be a bit annoying.

Just generating Person f a b = Person { id :: f a, name :: f b } would also be nice, but we'd need a more general implementation of makeAdaptorAndInstance. My experience with using higher order polymorphism like this is that it ends up pretty messy eventually, but I can't tell how it'd do in this case.

[tomjaguarpaw]

If we find an approach that works well then I'm happy to update the TH appropriately. It's hard to discuss these in the abstract so I encourage everyone to try different approaches to see what works well in practice.

[bergmark]

@tomjaguarpaw would you mind writing out the adaptor and instance would be for Person f a b = Person { id :: f a, name :: f b } so I can play with it a bit? I got confused :-S

[tomjaguarpaw]

Hmm, well I'm not sure there is one really. The adaptor and instance only make sense when f is Identity as far as I can tell.

[bergmark]

Here's what we've come up with so far, first we make a type family:

type family To (a :: * -> *) (b :: *) :: *

type instance To x (a, b) = (x a, x b)
type instance To x (a, b, c) = (x a, x b, x c)
[...]

Instead of making a bunch of type aliases you can now say To Wire User, To Maybe (To Wire User).

And then some TH:

makeTypes
  [d| data User
        = User {id :: Int, firstName :: String, lastName :: String}
        deriving (Show)
    |]

======>

data UserP a b c
  = User {id :: a, firstName :: b, lastName :: c}
  deriving (Show)

type User = UserP Int String String

type instance To x (UserP a b c) = UserP (x a) (x b) (x c)

And to define a table (no TH for this yet):

userTable :: Table (To Wire User)
userTable = Table "users"
  User
    { id        = Wire "id"
    , firstName = Wire "first_name"
    , lastName  = Wire "last_name"
    }

I also aliased runInsertConnDef to be:

insert
  :: ( Default TableMaybeWrapper wires maybewires
     , Default (PPOfContravariant Assocer) maybewires maybewires
     , maybewires ~ To Maybe wires
     )
  => Connection -> Table wires -> Expr maybewires -> IO Int64
insert = runInsertConnDef

which constrains the type a bit so you don't need a type signature for MakeExpr calls.

I also have a type family Ins for inserts, could as well have a type alias for this but I think it looks nicer:

type family Ins a :: *

type instance Ins (User a b c) = UserP () b c

runInsertUser :: Ins User -> Connection -> IO ()
runInsertUser (User () b c) conn = insert conn userTable $ makeMaybeExpr (Nothing :: Maybe Int) (Just b) (Just c)

[dbp]

Another issue that I'd love to have dealt with via TH or some convention would be to have normal, non-polymorphic versions of the records, with some easy conversion.

Especially when starting out on projects, it's really nice to be able to take advantage of the TH derived instances (in libraries I regularly use: aeson, digestive-functors, heist), which doesn't work with the type aliases (at least I've confirmed aeson won't, and assume the rest won't).

So it might be nice to have a record FooC (for concrete; other names welcome!), and some sort of conversion class. Also, I'm not familiar with TH, but what is the phase behavior? Would such a record that was going to be used in other TH need to be written out explicitly? If that were the case, then perhaps the code could look like:

data User = User { id :: Int, name :: String } deriving (Show, Eq)

makeOpal ''User

where makeOpal would expand to:

data UserP a b = UserP { id :: a, name :: b }
type UserO = UserP Int String
...
instance OpalConvert UserO User where
  toConcrete (UserP i n) = User i n
  fromConcrete (User i n) = UserP i n

Though perhaps people have better ideas how to accomplish this?

[bergmark]

What makes you say aeson won't work? Seems fine to me, using FlexibleInstances and

type User = UserP Int String String
instance ToJSON User

[bergmark]

Also note that in your example User and the TH call would need to be in different modules to avoid name clashes.

Too early for me to tell if a separate concrete type "inside" opaleye code is useful. We already have concrete types for everything that we would map this to so I think it wouldn't give us much.

[dbp]

@bergmark Manually defining instances works fine. It's 'deriveJSON' and similar functions that don't work.

[bergmark]

instance ToJSON User uses GHC generics, so you don't need to write instances manually.

[bergmark]

Here's the code if anyone wants to play with it, first time writing TH for me so it's probably terrible! :)

https://gist.github.com/bergmark/1fa4331e00f329be306c

[bergmark]

Here's another type family that seems useful. With the code above we can say things like To Maybe (To Wire User), but we also want to be able to write nice type signatures when we do joins and return multiple haskells

type family MapTo (t :: * -> *) a :: *

type instance MapTo x (a,b) = (To x a, To x b)

allUsersTwice :: Query (MapTo Wire (User, User))
allUsersTwice = arr (id &&& id) . queryTable userTable

[tomjaguarpaw]

This is interesting. What is To here? We could have a type instance generated for every product type.

[bergmark]

See this comment

[tomjaguarpaw]

So it applies To a further level down?

[bergmark]

Right, MapTo Wire (X a b,Y c d) = (To Wire (X a b), To Wire (Y c d)) = (X (Wire a) (Wire b), Y (Wire c) (Wire d))

[bergmark]

And you can also do MapTo Maybe (MapTo Wire (X,Y))

[tomjaguarpaw]

Is it possible to do To (To Wire) ... instead of MapTo Wire ...? Perhaps that's problematic because the type family is partially applied. It seems that morally speaking that is what we want, though.

[bergmark]

I'm not sure, maybe @hesselink knows?

[bergmark]

If you do a left join you end up with Query (MapTo Wire (User, To Maybe Post)) or you can write Query (To Wire User, To Wire (To Maybe Post))

[hesselink]

Nope, as far as I know you cannot partially apply a type family. The same goes for any type synonym, in fact. That's why we made MapTo instead of a more general Map To.

[tomjaguarpaw]

This seems like it will be problematic then, as a different combinator will be required for every level of nesting.

[hesselink]

Well, the usual way around it is to have a data type corresponding to your type family, and an extra type family Apply to interpret that data type and apply the corresponding type family. For example:

data IdP = IdP

type family Apply f x :: *
type instance Apply IdP x = Id x

type family Map f x :: *
type instance Map f [x] = [Apply f x]

x :: Map IdP [Bool]
x = [True]

data MapP f = MapP f
type instance Apply (MapP f) x = Map f x

y :: Map (MapP IdP) [[Bool]]
y = [[True]]

This might be able to do what you want, though I'm not sure it will be pretty.

[bergmark]

I don't think it's problematic with To and MapTo. You can inline MapTo to just use To if you'd like, otherwise be craazy and use MapTo like I am. I don't think opaleye itself will be using MapTo for anything, I think that could be completely external, whereas To would be very useful inside Opaleye.

[tomjaguarpaw]

The more I see To the more I like it. Would it be naughty to call it Fmap?

[bergmark]

I like To, it's short, and you end up typing it A LOT

[tomjaguarpaw]

I came up with a scheme based on To that deals generically with all possible conversions, even ones like Wire a -> Wire (Nullable a) which I don't think can be expressed with the earlier version. It should be easy to implement so anyone who wants to please go ahead!

https://github.com/karamaan/karamaan-opaleye/blob/dev/TODO.md