{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Opaleye.Internal.Unpackspec where
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.Field as F
import Control.Applicative (Applicative, pure, (<*>))
import Data.Profunctor (Profunctor, dimap)
import Data.Profunctor.Product (ProductProfunctor)
import qualified Data.Profunctor.Product as PP
import qualified Data.Profunctor.Product.Default as D
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
newtype Unpackspec fields fields' =
Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr fields fields')
unpackspecField :: Unpackspec (F.Field_ n a) (F.Field_ n a)
unpackspecField :: forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
unpackspecField = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (forall s a b t. (s -> a) -> (b -> t) -> PackMap a b s t
PM.iso forall (n :: Nullability) a. Field_ n a -> PrimExpr
IC.unColumn forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
IC.Column)
runUnpackspec :: Applicative f
=> Unpackspec columns b
-> (HPQ.PrimExpr -> f HPQ.PrimExpr)
-> columns -> f b
runUnpackspec :: forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec (Unpackspec PackMap PrimExpr PrimExpr columns b
f) = 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 :: forall s t. Unpackspec s t -> s -> [PrimExpr]
collectPEs Unpackspec s t
unpackspec = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec Unpackspec s t
unpackspec forall {b}. b -> ([b], b)
f
where f :: b -> ([b], b)
f b
pe = ([b
pe], b
pe)
instance D.Default Unpackspec (F.Field_ n a) (F.Field_ n a) where
def :: Unpackspec (Field_ n a) (Field_ n a)
def = forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
unpackspecField
instance Functor (Unpackspec a) where
fmap :: forall a b. (a -> b) -> Unpackspec a a -> Unpackspec a b
fmap a -> b
f (Unpackspec PackMap PrimExpr PrimExpr a a
g) = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (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 :: forall a. a -> Unpackspec a a
pure = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
Unpackspec PackMap PrimExpr PrimExpr a (a -> b)
f <*> :: forall a b.
Unpackspec a (a -> b) -> Unpackspec a a -> Unpackspec a b
<*> Unpackspec PackMap PrimExpr PrimExpr a a
x = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (PackMap PrimExpr PrimExpr a (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap PrimExpr PrimExpr a a
x)
instance Profunctor Unpackspec where
dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Unpackspec b c -> Unpackspec a d
dimap a -> b
f c -> d
g (Unpackspec PackMap PrimExpr PrimExpr b c
q) = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (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
purePP :: forall b a. b -> Unpackspec a b
purePP = forall (f :: * -> *) a. Applicative f => a -> f a
pure
**** :: forall a a b.
Unpackspec a (a -> b) -> Unpackspec a a -> Unpackspec a b
(****) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
instance PP.SumProfunctor Unpackspec where
Unpackspec PackMap PrimExpr PrimExpr a b
x1 +++! :: forall a b a' b'.
Unpackspec a b
-> Unpackspec a' b' -> Unpackspec (Either a a') (Either b b')
+++! Unpackspec PackMap PrimExpr PrimExpr a' b'
x2 = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (PackMap PrimExpr PrimExpr a b
x1 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)