{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Opaleye.SQLite.Internal.Unpackspec where
import qualified Opaleye.SQLite.Internal.PackMap as PM
import qualified Opaleye.SQLite.Internal.Column as IC
import qualified Opaleye.SQLite.Column as C
import Control.Applicative (Applicative, pure, (<*>))
import Data.Profunctor (Profunctor, dimap)
import Data.Profunctor.Product (ProductProfunctor, empty, (***!))
import qualified Data.Profunctor.Product as PP
import qualified Data.Profunctor.Product.Default as D
import qualified Opaleye.SQLite.Internal.HaskellDB.PrimQuery as HPQ
newtype Unpackspec columns columns' =
Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns columns')
unpackspecColumn :: Unpackspec (C.Column a) (C.Column a)
unpackspecColumn :: Unpackspec (Column a) (Column a)
unpackspecColumn = PackMap PrimExpr PrimExpr (Column a) (Column a)
-> Unpackspec (Column a) (Column a)
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec
((forall (f :: * -> *).
Applicative f =>
(PrimExpr -> f PrimExpr) -> Column a -> f (Column a))
-> PackMap PrimExpr PrimExpr (Column a) (Column a)
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap (\PrimExpr -> f PrimExpr
f (IC.Column pe) -> (PrimExpr -> Column a) -> f PrimExpr -> f (Column a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimExpr -> Column a
forall a. PrimExpr -> Column a
IC.Column (PrimExpr -> f PrimExpr
f PrimExpr
pe)))
runUnpackspec :: Applicative f
=> Unpackspec columns b
-> (HPQ.PrimExpr -> f HPQ.PrimExpr)
-> columns -> f b
runUnpackspec :: Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec (Unpackspec PackMap PrimExpr PrimExpr columns b
f) = PackMap PrimExpr PrimExpr columns b
-> (PrimExpr -> f PrimExpr) -> columns -> f b
forall (f :: * -> *) a b s t.
Applicative f =>
PackMap a b s t -> (a -> f b) -> s -> f t
PM.traversePM PackMap PrimExpr PrimExpr columns b
f
collectPEs :: Unpackspec s t -> s -> [HPQ.PrimExpr]
collectPEs :: Unpackspec s t -> s -> [PrimExpr]
collectPEs Unpackspec s t
unpackspec = ([PrimExpr], t) -> [PrimExpr]
forall a b. (a, b) -> a
fst (([PrimExpr], t) -> [PrimExpr])
-> (s -> ([PrimExpr], t)) -> s -> [PrimExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unpackspec s t
-> (PrimExpr -> ([PrimExpr], PrimExpr)) -> s -> ([PrimExpr], t)
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec Unpackspec s t
unpackspec PrimExpr -> ([PrimExpr], PrimExpr)
forall b. b -> ([b], b)
f
where f :: b -> ([b], b)
f b
pe = ([b
pe], b
pe)
instance D.Default Unpackspec (C.Column a) (C.Column a) where
def :: Unpackspec (Column a) (Column a)
def = Unpackspec (Column a) (Column a)
forall a. Unpackspec (Column a) (Column a)
unpackspecColumn
instance Functor (Unpackspec a) where
fmap :: (a -> b) -> Unpackspec a a -> Unpackspec a b
fmap a -> b
f (Unpackspec PackMap PrimExpr PrimExpr a a
g) = PackMap PrimExpr PrimExpr a b -> Unpackspec a b
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec ((a -> b)
-> PackMap PrimExpr PrimExpr a a -> PackMap PrimExpr PrimExpr a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap PrimExpr PrimExpr a a
g)
instance Applicative (Unpackspec a) where
pure :: a -> Unpackspec a a
pure = PackMap PrimExpr PrimExpr a a -> Unpackspec a a
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec (PackMap PrimExpr PrimExpr a a -> Unpackspec a a)
-> (a -> PackMap PrimExpr PrimExpr a a) -> a -> Unpackspec a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PackMap PrimExpr PrimExpr a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Unpackspec PackMap PrimExpr PrimExpr a (a -> b)
f <*> :: Unpackspec a (a -> b) -> Unpackspec a a -> Unpackspec a b
<*> Unpackspec PackMap PrimExpr PrimExpr a a
x = PackMap PrimExpr PrimExpr a b -> Unpackspec a b
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec (PackMap PrimExpr PrimExpr a (a -> b)
f PackMap PrimExpr PrimExpr a (a -> b)
-> PackMap PrimExpr PrimExpr a a -> PackMap PrimExpr PrimExpr a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap PrimExpr PrimExpr a a
x)
instance Profunctor Unpackspec where
dimap :: (a -> b) -> (c -> d) -> Unpackspec b c -> Unpackspec a d
dimap a -> b
f c -> d
g (Unpackspec PackMap PrimExpr PrimExpr b c
q) = PackMap PrimExpr PrimExpr a d -> Unpackspec a d
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec ((a -> b)
-> (c -> d)
-> PackMap PrimExpr PrimExpr b c
-> PackMap PrimExpr PrimExpr a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g PackMap PrimExpr PrimExpr b c
q)
instance ProductProfunctor Unpackspec where
empty :: Unpackspec () ()
empty = Unpackspec () ()
forall (p :: * -> * -> *). Applicative (p ()) => p () ()
PP.defaultEmpty
***! :: Unpackspec a b -> Unpackspec a' b' -> Unpackspec (a, a') (b, b')
(***!) = Unpackspec a b -> Unpackspec a' b' -> Unpackspec (a, a') (b, b')
forall (p :: * -> * -> *) a a' b b'.
(Applicative (p (a, a')), Profunctor p) =>
p a b -> p a' b' -> p (a, a') (b, b')
PP.defaultProfunctorProduct
instance PP.SumProfunctor Unpackspec where
Unpackspec PackMap PrimExpr PrimExpr a b
x1 +++! :: Unpackspec a b
-> Unpackspec a' b' -> Unpackspec (Either a a') (Either b b')
+++! Unpackspec PackMap PrimExpr PrimExpr a' b'
x2 = PackMap PrimExpr PrimExpr (Either a a') (Either b b')
-> Unpackspec (Either a a') (Either b b')
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec (PackMap PrimExpr PrimExpr a b
x1 PackMap PrimExpr PrimExpr a b
-> PackMap PrimExpr PrimExpr a' b'
-> PackMap PrimExpr PrimExpr (Either a a') (Either b b')
forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
PP.+++! PackMap PrimExpr PrimExpr a' b'
x2)