module Composite.Opaleye.RecordTable where
import BasicPrelude
import Composite.Base (NamedField(fieldName))
import Control.Lens (Wrapped(type Unwrapped, _Wrapped'), from, view)
import Data.Profunctor (dimap)
import Data.Profunctor.Product ((***!))
import qualified Data.Profunctor.Product as PP
import Data.Proxy (Proxy(Proxy))
import Data.Text (unpack)
import Data.Vinyl.Core (Rec((:&), RNil))
import Data.Vinyl.Functor (Identity(Identity))
import Opaleye (Column, TableProperties, required, optional)
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 r reads w writes.
( NamedField w, NamedField r
, DefaultRecTableField (Unwrapped w) (Unwrapped r)
, DefaultRecTable writes reads
) => DefaultRecTable (w ': writes) (r ': reads) where
defaultRecTable =
dimap (\ (Identity (view _Wrapped' -> w) :& writeRs) -> (w, writeRs))
(\ (r, readRs) -> (Identity (view (from _Wrapped') r) :& readRs))
(step ***! recur)
where
step :: TableProperties (Unwrapped w) (Unwrapped r)
step = defaultRecTableField . unpack $ fieldName (Proxy :: Proxy r)
recur :: TableProperties (Rec Identity writes) (Rec Identity reads)
recur = defaultRecTable