{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeInType #-} -- TODO -- Updater -- easier -- this one's probably not needed -- NullMaker -- easier -- Constant -- harder -- QueryRunner -- harder module Opaleye.Internal.TypeFamilies where import Opaleye.Column (Column, Nullable) import qualified Opaleye.Field as F type family IMap f a data HT data OT data NullsT data WT type NN = 'F.Nullable type N = 'F.NonNullable data Optionality = OReq | OOpt type Req = 'OReq type Opt = 'OOpt type family A (a :: Arr h k1 k2) (b :: k1) :: k2 data Arr h k1 k2 where K :: k1 -> Arr h k2 k1 S :: Arr h k1 (k2 -> k3) -> Arr h k1 k2 -> Arr h k1 k3 I :: Arr h k1 k1 H :: h -> Arr h k2 k3 type (:<*>) = 'S type Pure = 'K type (:<$>) f = (:<*>) (Pure f) type Id = 'I type (:<|) f x = A f x type instance A 'I a = a type instance A ('K k1) _ = k1 type instance A ('S f x) a = (A f a) (A x a) data C a = C (a, a, F.Nullability) data TC a = TC ((a, a, F.Nullability), Optionality) type instance A ('H HT) ('C '(h, o, NN)) = h type instance A ('H HT) ('C '(h, o, N)) = Maybe h type instance A ('H OT) ('C '(h, o, NN)) = Column o type instance A ('H OT) ('C '(h, o, N)) = Column (Nullable o) type instance A ('H NullsT) ('C '(h, o, NN)) = Column (Nullable o) type instance A ('H HT) ('TC '(t, b)) = A ('H HT) ('C t) type instance A ('H OT) ('TC '(t, b)) = A ('H OT) ('C t) type instance A ('H WT) ('TC '(t, Req)) = A ('H OT) ('C t) type instance A ('H WT) ('TC '(t, Opt)) = Maybe (A ('H OT) ('C t)) type instance A ('H NullsT) ('TC '(t, b)) = A ('H NullsT) ('C t) type RecordField f a b c = A f ('C '(a, b, c)) type TableField f a b c d = A f ('TC '( '(a, b, c), d)) type H = 'H HT type O = 'H OT type Nulls = 'H NullsT type W = 'H WT type F = 'H