module Composite.Opaleye.RecordTable where
import Composite.Record ((:->)(Val), Rec((:&), RNil))
import Data.Functor.Identity (Identity(Identity))
import Data.Profunctor (dimap)
import Data.Profunctor.Product ((***!))
import qualified Data.Profunctor.Product as PP
import Data.Proxy (Proxy(Proxy))
import GHC.TypeLits (KnownSymbol, symbolVal)
import Opaleye (Column, required, optional)
import Opaleye.Internal.Table (TableProperties)
class DefaultRecTableField write read where
defaultRecTableField :: String -> TableProperties write read
instance DefaultRecTableField (Maybe (Column a)) (Column a) where
defaultRecTableField = optional
instance DefaultRecTableField (Column a) (Column a) where
defaultRecTableField = required
class DefaultRecTable write read where
defaultRecTable :: TableProperties (Rec Identity write) (Rec Identity read)
instance DefaultRecTable '[] '[] where
defaultRecTable = dimap (const ()) (const RNil) PP.empty
instance
forall s r reads w writes.
( KnownSymbol s
, DefaultRecTableField w r
, DefaultRecTable writes reads
) => DefaultRecTable (s :-> w ': writes) (s :-> r ': reads) where
defaultRecTable =
dimap (\ (Identity (Val w) :& writeRs) -> (w, writeRs))
(\ (r, readRs) -> (Identity (Val r) :& readRs))
(step ***! recur)
where
step :: TableProperties w r
step = defaultRecTableField $ symbolVal (Proxy :: Proxy s)
recur :: TableProperties (Rec Identity writes) (Rec Identity reads)
recur = defaultRecTable