{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Opaleye.Internal.TableMaker where
import qualified Opaleye.Column as C
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.Unpackspec as U
import Data.Profunctor (Profunctor, dimap)
import Data.Profunctor.Product (ProductProfunctor, empty, (***!))
import qualified Data.Profunctor.Product as PP
import Data.Profunctor.Product.Default (Default, def)
import Control.Applicative (Applicative, pure, (<*>))
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
newtype ViewColumnMaker strings columns =
ViewColumnMaker (PM.PackMap () () strings columns)
runViewColumnMaker :: ViewColumnMaker strings tablecolumns ->
strings -> tablecolumns
runViewColumnMaker (ViewColumnMaker f) = PM.overPM f id
{-# DEPRECATED ColumnMaker "Use Unpackspec instead" #-}
type ColumnMaker = U.Unpackspec
{-# DEPRECATED runColumnMaker "Use runUnpackspec instead" #-}
runColumnMaker :: Applicative f
=> ColumnMaker tablecolumns columns
-> (HPQ.PrimExpr -> f HPQ.PrimExpr)
-> tablecolumns -> f columns
runColumnMaker = U.runUnpackspec
tableColumn :: ViewColumnMaker String (C.Column a)
tableColumn = ViewColumnMaker
(PM.PackMap (\f s -> fmap (const (mkColumn s)) (f ())))
where mkColumn = IC.Column . HPQ.BaseTableAttrExpr
instance Default ViewColumnMaker String (C.Column a) where
def = tableColumn
{-# DEPRECATED column "Use unpackspecColumn instead" #-}
column :: ColumnMaker (C.Column a) (C.Column a)
column = U.unpackspecColumn
instance Functor (ViewColumnMaker a) where
fmap f (ViewColumnMaker g) = ViewColumnMaker (fmap f g)
instance Applicative (ViewColumnMaker a) where
pure = ViewColumnMaker . pure
ViewColumnMaker f <*> ViewColumnMaker x = ViewColumnMaker (f <*> x)
instance Profunctor ViewColumnMaker where
dimap f g (ViewColumnMaker q) = ViewColumnMaker (dimap f g q)
instance ProductProfunctor ViewColumnMaker where
empty = PP.defaultEmpty
(***!) = PP.defaultProfunctorProduct