{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}

module Opaleye.Internal.Values where

import           Opaleye.Internal.Column (Field_(Column))
import qualified Opaleye.Internal.Column as C
import qualified Opaleye.Column as OC
import qualified Opaleye.Internal.Unpackspec as U
import qualified Opaleye.Internal.Tag as T
import qualified Opaleye.Internal.Operators as O
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.QueryArr as Q
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import qualified Opaleye.Internal.PGTypes
import qualified Opaleye.SqlTypes

import           Control.Arrow (returnA)
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.List.NonEmpty as NEL
import           Data.Profunctor (Profunctor, dimap, rmap, lmap)
import           Data.Profunctor.Product (ProductProfunctor)
import qualified Data.Profunctor.Product as PP
import           Data.Profunctor.Product.Default (Default, def)
import           Data.Semigroup (Semigroup, (<>))

import           Control.Applicative (Applicative, pure, (<*>), liftA2)

nonEmptyValues :: Rowspec columns columns'
               -> NEL.NonEmpty columns
               -> Q.Select columns'
nonEmptyValues :: Rowspec columns columns' -> NonEmpty columns -> Select columns'
nonEmptyValues Rowspec columns columns'
rowspec NonEmpty columns
rows =
  let nerowspec' :: NonEmptyRowspec columns columns'
nerowspec' = case Rowspec columns columns'
rowspec of
        NonEmptyRows NonEmptyRowspec columns columns'
nerowspec -> NonEmptyRowspec columns columns'
nerowspec
        EmptyRows columns'
fields ->
          (columns -> Field SqlInt4)
-> (Field SqlInt4 -> columns')
-> NonEmptyRowspec (Field SqlInt4) (Field SqlInt4)
-> NonEmptyRowspec columns columns'
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (Field SqlInt4 -> columns -> Field SqlInt4
forall a b. a -> b -> a
const Field SqlInt4
zero) (columns' -> Field SqlInt4 -> columns'
forall a b. a -> b -> a
const columns'
fields) NonEmptyRowspec (Field SqlInt4) (Field SqlInt4)
forall (n :: Nullability) a.
NonEmptyRowspec (Field_ n a) (Field_ n a)
nonEmptyRowspecField
          where zero :: Field SqlInt4
zero = Field SqlInt4
0 :: C.Field Opaleye.SqlTypes.SqlInt4
  in NonEmptyRowspec columns columns'
-> NonEmpty columns -> Select columns'
forall fields fields'.
NonEmptyRowspec fields fields' -> NonEmpty fields -> Select fields'
nonEmptyRows NonEmptyRowspec columns columns'
nerowspec' NonEmpty columns
rows

nonEmptyRows :: NonEmptyRowspec fields fields'
             -> NEL.NonEmpty fields
             -> Q.Select fields'
nonEmptyRows :: NonEmptyRowspec fields fields' -> NonEmpty fields -> Select fields'
nonEmptyRows (NonEmptyRowspec fields -> NonEmpty PrimExpr
runRow State Tag (NonEmpty Symbol, fields')
fields) NonEmpty fields
rows =
  State Tag (fields', PrimQuery) -> Select fields'
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (fields', PrimQuery) -> Select fields')
-> State Tag (fields', PrimQuery) -> Select fields'
forall a b. (a -> b) -> a -> b
$ do
    (NonEmpty Symbol
valuesPEs, fields'
newColumns) <- State Tag (NonEmpty Symbol, fields')
fields
    (fields', PrimQuery) -> State Tag (fields', PrimQuery)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (fields'
newColumns, [Symbol] -> NonEmpty [PrimExpr] -> PrimQuery
forall a. [Symbol] -> NonEmpty [PrimExpr] -> PrimQuery' a
PQ.Values (NonEmpty Symbol -> [Symbol]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Symbol
valuesPEs) ((fields -> [PrimExpr]) -> NonEmpty fields -> NonEmpty [PrimExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty PrimExpr -> [PrimExpr]
forall a. NonEmpty a -> [a]
NEL.toList (NonEmpty PrimExpr -> [PrimExpr])
-> (fields -> NonEmpty PrimExpr) -> fields -> [PrimExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. fields -> NonEmpty PrimExpr
runRow) NonEmpty fields
rows))

emptySelectExplicit :: Nullspec columns a -> Q.Select a
emptySelectExplicit :: Nullspec columns a -> Select a
emptySelectExplicit Nullspec columns a
nullspec = proc () -> do
  SelectArr (Field SqlBool) ()
O.restrict -< Bool -> Field SqlBool
Opaleye.SqlTypes.sqlBool Bool
False
  SelectArr a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Nullspec columns a -> a
forall a fields. Nullspec a fields -> fields
nullFields Nullspec columns a
nullspec

data NonEmptyRowspec fields fields' =
  NonEmptyRowspec (fields -> NEL.NonEmpty HPQ.PrimExpr)
                  (State.State T.Tag (NEL.NonEmpty HPQ.Symbol, fields'))

-- Some overlap here with extractAttrPE
nonEmptyRowspecField :: NonEmptyRowspec (Field_ n a) (Field_ n a)
nonEmptyRowspecField :: NonEmptyRowspec (Field_ n a) (Field_ n a)
nonEmptyRowspecField = (Field_ n a -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, Field_ n a)
-> NonEmptyRowspec (Field_ n a) (Field_ n a)
forall fields fields'.
(fields -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, fields')
-> NonEmptyRowspec fields fields'
NonEmptyRowspec (PrimExpr -> NonEmpty PrimExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimExpr -> NonEmpty PrimExpr)
-> (Field_ n a -> PrimExpr) -> Field_ n a -> NonEmpty PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field_ n a -> PrimExpr
forall (n :: Nullability) a. Field_ n a -> PrimExpr
C.unColumn) State Tag (NonEmpty Symbol, Field_ n a)
forall (n :: Nullability) sqlType.
StateT Tag Identity (NonEmpty Symbol, Field_ n sqlType)
s
  where s :: StateT Tag Identity (NonEmpty Symbol, Field_ n sqlType)
s = do
          Tag
t <- State Tag Tag
T.fresh
          let symbol :: Symbol
symbol = String -> Tag -> Symbol
HPQ.Symbol String
"values" Tag
t
          (NonEmpty Symbol, Field_ n sqlType)
-> StateT Tag Identity (NonEmpty Symbol, Field_ n sqlType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol -> NonEmpty Symbol
forall (f :: * -> *) a. Applicative f => a -> f a
pure Symbol
symbol, PrimExpr -> Field_ n sqlType
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
C.Column (Symbol -> PrimExpr
HPQ.AttrExpr Symbol
symbol))

rowspecField :: Rowspec (Field_ n a) (Field_ n a)
rowspecField :: Rowspec (Field_ n a) (Field_ n a)
rowspecField = NonEmptyRowspec (Field_ n a) (Field_ n a)
-> Rowspec (Field_ n a) (Field_ n a)
forall fields fields'.
NonEmptyRowspec fields fields' -> Rowspec fields fields'
NonEmptyRows NonEmptyRowspec (Field_ n a) (Field_ n a)
forall (n :: Nullability) a.
NonEmptyRowspec (Field_ n a) (Field_ n a)
nonEmptyRowspecField

data Rowspec fields fields' =
    NonEmptyRows (NonEmptyRowspec fields fields')
  | EmptyRows fields'

data Valuesspec fields fields' =
  ValuesspecSafe (Nullspec fields fields')
                 (Rowspec fields fields')

valuesspecField :: Opaleye.SqlTypes.IsSqlType a
                => Valuesspec (Field_ n a) (Field_ n a)
valuesspecField :: Valuesspec (Field_ n a) (Field_ n a)
valuesspecField = Valuesspec (Field_ n a) (Field_ n a)
forall (n :: Nullability). Valuesspec (Field_ n a) (Field_ n a)
def_
    where def_ :: Valuesspec (Field_ n a) (Field_ n a)
def_ = String -> Valuesspec (Field_ n a) (Field_ n a)
forall (n :: Nullability) a.
String -> Valuesspec (Field_ n a) (Field_ n a)
valuesspecFieldType (Maybe a -> String
forall sqlType (proxy :: * -> *).
IsSqlType sqlType =>
proxy sqlType -> String
Opaleye.Internal.PGTypes.showSqlType Maybe a
sqlType)
          sqlType :: Maybe a
sqlType = Valuesspec (Field_ n a) (Field_ n a) -> Maybe a
forall (f :: * -> *) (n :: Nullability) sqlType.
f (Field_ n sqlType) -> Maybe sqlType
columnProxy Valuesspec (Field_ n a) (Field_ n a)
def_
          columnProxy :: f (Field_ n sqlType) -> Maybe sqlType
          columnProxy :: f (Field_ n sqlType) -> Maybe sqlType
columnProxy f (Field_ n sqlType)
_ = Maybe sqlType
forall a. Maybe a
Nothing

-- For rel8
valuesspecFieldType :: String -> Valuesspec (Field_ n a) (Field_ n a)
valuesspecFieldType :: String -> Valuesspec (Field_ n a) (Field_ n a)
valuesspecFieldType String
sqlType =
  Nullspec (Field_ n a) (Field_ n a)
-> Rowspec (Field_ n a) (Field_ n a)
-> Valuesspec (Field_ n a) (Field_ n a)
forall fields fields'.
Nullspec fields fields'
-> Rowspec fields fields' -> Valuesspec fields fields'
ValuesspecSafe (String -> Nullspec (Field_ n a) (Field_ n a)
forall a (n :: Nullability) sqlType.
String -> Nullspec a (Field_ n sqlType)
nullspecFieldType String
sqlType) Rowspec (Field_ n a) (Field_ n a)
forall (n :: Nullability) a. Rowspec (Field_ n a) (Field_ n a)
rowspecField

instance forall a n. Opaleye.Internal.PGTypes.IsSqlType a
  => Default Valuesspec (Field_ n a) (Field_ n a) where
  def :: Valuesspec (Field_ n a) (Field_ n a)
def = Nullspec (Field_ n a) (Field_ n a)
-> Rowspec (Field_ n a) (Field_ n a)
-> Valuesspec (Field_ n a) (Field_ n a)
forall fields fields'.
Nullspec fields fields'
-> Rowspec fields fields' -> Valuesspec fields fields'
ValuesspecSafe Nullspec (Field_ n a) (Field_ n a)
forall a (n :: Nullability) sqlType.
IsSqlType sqlType =>
Nullspec a (Field_ n sqlType)
nullspecField Rowspec (Field_ n a) (Field_ n a)
forall (n :: Nullability) a. Rowspec (Field_ n a) (Field_ n a)
rowspecField

newtype Nullspec fields fields' = Nullspec fields'

nullspecField :: forall a n sqlType.
                 Opaleye.SqlTypes.IsSqlType sqlType
              => Nullspec a (Field_ n sqlType)
nullspecField :: Nullspec a (Field_ n sqlType)
nullspecField = String -> Nullspec a (Field_ n sqlType)
forall a (n :: Nullability) sqlType.
String -> Nullspec a (Field_ n sqlType)
nullspecFieldType String
ty
  where ty :: String
ty = Maybe sqlType -> String
forall sqlType (proxy :: * -> *).
IsSqlType sqlType =>
proxy sqlType -> String
Opaleye.Internal.PGTypes.showSqlType (Maybe sqlType
forall a. Maybe a
Nothing :: Maybe sqlType)

nullspecFieldType :: String
                  -> Nullspec a (Field_ n sqlType)
nullspecFieldType :: String -> Nullspec a (Field_ n sqlType)
nullspecFieldType String
sqlType =
  (Field_ n sqlType -> Nullspec a (Field_ n sqlType)
forall fields fields'. fields' -> Nullspec fields fields'
Nullspec
  (Field_ n sqlType -> Nullspec a (Field_ n sqlType))
-> (Field_ 'Nullable Any -> Field_ n sqlType)
-> Field_ 'Nullable Any
-> Nullspec a (Field_ n sqlType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Field_ n Any -> Field_ n sqlType
forall (n :: Nullability) a b. String -> Field_ n a -> Field_ n b
C.unsafeCast String
sqlType
  (Field_ n Any -> Field_ n sqlType)
-> (Field_ 'Nullable Any -> Field_ n Any)
-> Field_ 'Nullable Any
-> Field_ n sqlType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field_ 'Nullable Any -> Field_ n Any
forall (n :: Nullability) a (n' :: Nullability) b.
Field_ n a -> Field_ n' b
C.unsafeCoerceColumn)
  Field_ 'Nullable Any
forall a. Column (Nullable a)
OC.null

nullspecList :: Nullspec a [b]
nullspecList :: Nullspec a [b]
nullspecList = [b] -> Nullspec a [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

nullspecEitherLeft :: Nullspec a b
                   -> Nullspec a (Either b b')
nullspecEitherLeft :: Nullspec a b -> Nullspec a (Either b b')
nullspecEitherLeft = (b -> Either b b') -> Nullspec a b -> Nullspec a (Either b b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b b'
forall a b. a -> Either a b
Left

nullspecEitherRight :: Nullspec a b'
                    -> Nullspec a (Either b b')
nullspecEitherRight :: Nullspec a b' -> Nullspec a (Either b b')
nullspecEitherRight = (b' -> Either b b') -> Nullspec a b' -> Nullspec a (Either b b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b' -> Either b b'
forall a b. b -> Either a b
Right

instance Opaleye.SqlTypes.IsSqlType b
  => Default Nullspec a (Field_ n b) where
  def :: Nullspec a (Field_ n b)
def = Nullspec a (Field_ n b)
forall a (n :: Nullability) sqlType.
IsSqlType sqlType =>
Nullspec a (Field_ n sqlType)
nullspecField

-- | All fields @NULL@, even though technically the type may forbid
-- that!  Used to create such fields when we know we will never look
-- at them expecting to find something non-NULL.
nullFields :: Nullspec a fields -> fields
nullFields :: Nullspec a fields -> fields
nullFields (Nullspec fields
v) = fields
v

-- {

-- Boilerplate instance definitions.  Theoretically, these are derivable.

instance Functor (ValuesspecUnsafe a) where
  fmap :: (a -> b) -> ValuesspecUnsafe a a -> ValuesspecUnsafe a b
fmap a -> b
f (Valuesspec PackMap () PrimExpr () a
g) = PackMap () PrimExpr () b -> ValuesspecUnsafe a b
forall columns columns'.
PackMap () PrimExpr () columns'
-> ValuesspecUnsafe columns columns'
Valuesspec ((a -> b) -> PackMap () PrimExpr () a -> PackMap () PrimExpr () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap () PrimExpr () a
g)

instance Applicative (ValuesspecUnsafe a) where
  pure :: a -> ValuesspecUnsafe a a
pure = PackMap () PrimExpr () a -> ValuesspecUnsafe a a
forall columns columns'.
PackMap () PrimExpr () columns'
-> ValuesspecUnsafe columns columns'
Valuesspec (PackMap () PrimExpr () a -> ValuesspecUnsafe a a)
-> (a -> PackMap () PrimExpr () a) -> a -> ValuesspecUnsafe a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PackMap () PrimExpr () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Valuesspec PackMap () PrimExpr () (a -> b)
f <*> :: ValuesspecUnsafe a (a -> b)
-> ValuesspecUnsafe a a -> ValuesspecUnsafe a b
<*> Valuesspec PackMap () PrimExpr () a
x = PackMap () PrimExpr () b -> ValuesspecUnsafe a b
forall columns columns'.
PackMap () PrimExpr () columns'
-> ValuesspecUnsafe columns columns'
Valuesspec (PackMap () PrimExpr () (a -> b)
f PackMap () PrimExpr () (a -> b)
-> PackMap () PrimExpr () a -> PackMap () PrimExpr () b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap () PrimExpr () a
x)

instance Profunctor ValuesspecUnsafe where
  dimap :: (a -> b)
-> (c -> d) -> ValuesspecUnsafe b c -> ValuesspecUnsafe a d
dimap a -> b
_ c -> d
g (Valuesspec PackMap () PrimExpr () c
q) = PackMap () PrimExpr () d -> ValuesspecUnsafe a d
forall columns columns'.
PackMap () PrimExpr () columns'
-> ValuesspecUnsafe columns columns'
Valuesspec ((c -> d) -> PackMap () PrimExpr () c -> PackMap () PrimExpr () d
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap c -> d
g PackMap () PrimExpr () c
q)

instance ProductProfunctor ValuesspecUnsafe where
  purePP :: b -> ValuesspecUnsafe a b
purePP = b -> ValuesspecUnsafe a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: ValuesspecUnsafe a (b -> c)
-> ValuesspecUnsafe a b -> ValuesspecUnsafe a c
(****) = ValuesspecUnsafe a (b -> c)
-> ValuesspecUnsafe a b -> ValuesspecUnsafe a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance Functor (Valuesspec a) where
  fmap :: (a -> b) -> Valuesspec a a -> Valuesspec a b
fmap a -> b
f (ValuesspecSafe Nullspec a a
g Rowspec a a
h) = Nullspec a b -> Rowspec a b -> Valuesspec a b
forall fields fields'.
Nullspec fields fields'
-> Rowspec fields fields' -> Valuesspec fields fields'
ValuesspecSafe ((a -> b) -> Nullspec a a -> Nullspec a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Nullspec a a
g) ((a -> b) -> Rowspec a a -> Rowspec a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Rowspec a a
h)

instance Applicative (Valuesspec a) where
  pure :: a -> Valuesspec a a
pure a
a = Nullspec a a -> Rowspec a a -> Valuesspec a a
forall fields fields'.
Nullspec fields fields'
-> Rowspec fields fields' -> Valuesspec fields fields'
ValuesspecSafe (a -> Nullspec a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (a -> Rowspec a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  ValuesspecSafe Nullspec a (a -> b)
f Rowspec a (a -> b)
f' <*> :: Valuesspec a (a -> b) -> Valuesspec a a -> Valuesspec a b
<*> ValuesspecSafe Nullspec a a
x Rowspec a a
x' =
    Nullspec a b -> Rowspec a b -> Valuesspec a b
forall fields fields'.
Nullspec fields fields'
-> Rowspec fields fields' -> Valuesspec fields fields'
ValuesspecSafe (Nullspec a (a -> b)
f Nullspec a (a -> b) -> Nullspec a a -> Nullspec a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Nullspec a a
x) (Rowspec a (a -> b)
f' Rowspec a (a -> b) -> Rowspec a a -> Rowspec a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rowspec a a
x')

instance Profunctor Valuesspec where
  dimap :: (a -> b) -> (c -> d) -> Valuesspec b c -> Valuesspec a d
dimap a -> b
f c -> d
g (ValuesspecSafe Nullspec b c
q Rowspec b c
q') = Nullspec a d -> Rowspec a d -> Valuesspec a d
forall fields fields'.
Nullspec fields fields'
-> Rowspec fields fields' -> Valuesspec fields fields'
ValuesspecSafe ((a -> b) -> (c -> d) -> Nullspec b c -> Nullspec 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 Nullspec b c
q) ((a -> b) -> (c -> d) -> Rowspec b c -> Rowspec 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 Rowspec b c
q')

instance ProductProfunctor Valuesspec where
  purePP :: b -> Valuesspec a b
purePP = b -> Valuesspec a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: Valuesspec a (b -> c) -> Valuesspec a b -> Valuesspec a c
(****) = Valuesspec a (b -> c) -> Valuesspec a b -> Valuesspec a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance Functor (Nullspec a) where
  fmap :: (a -> b) -> Nullspec a a -> Nullspec a b
fmap a -> b
f (Nullspec a
g) = b -> Nullspec a b
forall fields fields'. fields' -> Nullspec fields fields'
Nullspec (a -> b
f a
g)

instance Applicative (Nullspec a) where
  pure :: a -> Nullspec a a
pure = a -> Nullspec a a
forall fields fields'. fields' -> Nullspec fields fields'
Nullspec
  Nullspec a -> b
f <*> :: Nullspec a (a -> b) -> Nullspec a a -> Nullspec a b
<*> Nullspec a
x = b -> Nullspec a b
forall fields fields'. fields' -> Nullspec fields fields'
Nullspec (a -> b
f a
x)

instance Profunctor Nullspec where
  dimap :: (a -> b) -> (c -> d) -> Nullspec b c -> Nullspec a d
dimap a -> b
_ c -> d
g (Nullspec c
q) = d -> Nullspec a d
forall fields fields'. fields' -> Nullspec fields fields'
Nullspec (c -> d
g c
q)

instance ProductProfunctor Nullspec where
  purePP :: b -> Nullspec a b
purePP = b -> Nullspec a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: Nullspec a (b -> c) -> Nullspec a b -> Nullspec a c
(****) = Nullspec a (b -> c) -> Nullspec a b -> Nullspec a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance Functor (NonEmptyRowspec a) where
  fmap :: (a -> b) -> NonEmptyRowspec a a -> NonEmptyRowspec a b
fmap = (a -> b) -> NonEmptyRowspec a a -> NonEmptyRowspec a b
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap

instance Profunctor NonEmptyRowspec where
  dimap :: (a -> b) -> (c -> d) -> NonEmptyRowspec b c -> NonEmptyRowspec a d
dimap a -> b
f c -> d
g (NonEmptyRowspec b -> NonEmpty PrimExpr
a State Tag (NonEmpty Symbol, c)
b) =
    (a -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, d) -> NonEmptyRowspec a d
forall fields fields'.
(fields -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, fields')
-> NonEmptyRowspec fields fields'
NonEmptyRowspec ((a -> b) -> (b -> NonEmpty PrimExpr) -> a -> NonEmpty PrimExpr
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f b -> NonEmpty PrimExpr
a) ((((NonEmpty Symbol, c) -> (NonEmpty Symbol, d))
-> State Tag (NonEmpty Symbol, c) -> State Tag (NonEmpty Symbol, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((NonEmpty Symbol, c) -> (NonEmpty Symbol, d))
 -> State Tag (NonEmpty Symbol, c)
 -> State Tag (NonEmpty Symbol, d))
-> ((c -> d) -> (NonEmpty Symbol, c) -> (NonEmpty Symbol, d))
-> (c -> d)
-> State Tag (NonEmpty Symbol, c)
-> State Tag (NonEmpty Symbol, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (NonEmpty Symbol, c) -> (NonEmpty Symbol, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) c -> d
g State Tag (NonEmpty Symbol, c)
b)

instance Functor (Rowspec a) where
  fmap :: (a -> b) -> Rowspec a a -> Rowspec a b
fmap = (a -> b) -> Rowspec a a -> Rowspec a b
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap

instance Applicative (Rowspec a) where
  pure :: a -> Rowspec a a
pure a
x = a -> Rowspec a a
forall a a. a -> Rowspec a a
EmptyRows a
x
  Rowspec a (a -> b)
r1 <*> :: Rowspec a (a -> b) -> Rowspec a a -> Rowspec a b
<*> Rowspec a a
r2 = case (Rowspec a (a -> b)
r1, Rowspec a a
r2) of
    (EmptyRows a -> b
f, EmptyRows a
x) -> b -> Rowspec a b
forall a a. a -> Rowspec a a
EmptyRows (a -> b
f a
x)
    (EmptyRows a -> b
f, NonEmptyRows (NonEmptyRowspec a -> NonEmpty PrimExpr
x1 State Tag (NonEmpty Symbol, a)
x2)) ->
      NonEmptyRowspec a b -> Rowspec a b
forall fields fields'.
NonEmptyRowspec fields fields' -> Rowspec fields fields'
NonEmptyRows ((a -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, b) -> NonEmptyRowspec a b
forall fields fields'.
(fields -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, fields')
-> NonEmptyRowspec fields fields'
NonEmptyRowspec a -> NonEmpty PrimExpr
x1 ((((NonEmpty Symbol, a) -> (NonEmpty Symbol, b))
-> State Tag (NonEmpty Symbol, a) -> State Tag (NonEmpty Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((NonEmpty Symbol, a) -> (NonEmpty Symbol, b))
 -> State Tag (NonEmpty Symbol, a)
 -> State Tag (NonEmpty Symbol, b))
-> ((a -> b) -> (NonEmpty Symbol, a) -> (NonEmpty Symbol, b))
-> (a -> b)
-> State Tag (NonEmpty Symbol, a)
-> State Tag (NonEmpty Symbol, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (NonEmpty Symbol, a) -> (NonEmpty Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f State Tag (NonEmpty Symbol, a)
x2))
    (NonEmptyRows (NonEmptyRowspec a -> NonEmpty PrimExpr
f1 State Tag (NonEmpty Symbol, a -> b)
f2), EmptyRows a
x) ->
     NonEmptyRowspec a b -> Rowspec a b
forall fields fields'.
NonEmptyRowspec fields fields' -> Rowspec fields fields'
NonEmptyRows ((a -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, b) -> NonEmptyRowspec a b
forall fields fields'.
(fields -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, fields')
-> NonEmptyRowspec fields fields'
NonEmptyRowspec a -> NonEmpty PrimExpr
f1 ((((NonEmpty Symbol, a -> b) -> (NonEmpty Symbol, b))
-> State Tag (NonEmpty Symbol, a -> b)
-> State Tag (NonEmpty Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((NonEmpty Symbol, a -> b) -> (NonEmpty Symbol, b))
 -> State Tag (NonEmpty Symbol, a -> b)
 -> State Tag (NonEmpty Symbol, b))
-> (((a -> b) -> b)
    -> (NonEmpty Symbol, a -> b) -> (NonEmpty Symbol, b))
-> ((a -> b) -> b)
-> State Tag (NonEmpty Symbol, a -> b)
-> State Tag (NonEmpty Symbol, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> b)
-> (NonEmpty Symbol, a -> b) -> (NonEmpty Symbol, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) State Tag (NonEmpty Symbol, a -> b)
f2))
    (NonEmptyRows (NonEmptyRowspec a -> NonEmpty PrimExpr
f1 State Tag (NonEmpty Symbol, a -> b)
f2),
     NonEmptyRows (NonEmptyRowspec a -> NonEmpty PrimExpr
x1 State Tag (NonEmpty Symbol, a)
x2)) ->
      NonEmptyRowspec a b -> Rowspec a b
forall fields fields'.
NonEmptyRowspec fields fields' -> Rowspec fields fields'
NonEmptyRows ((a -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, b) -> NonEmptyRowspec a b
forall fields fields'.
(fields -> NonEmpty PrimExpr)
-> State Tag (NonEmpty Symbol, fields')
-> NonEmptyRowspec fields fields'
NonEmptyRowspec
            (a -> NonEmpty PrimExpr
f1 (a -> NonEmpty PrimExpr)
-> (a -> NonEmpty PrimExpr) -> a -> NonEmpty PrimExpr
forall a. Semigroup a => a -> a -> a
<> a -> NonEmpty PrimExpr
x1)
            ((((NonEmpty Symbol, a -> b)
 -> (NonEmpty Symbol, a) -> (NonEmpty Symbol, b))
-> State Tag (NonEmpty Symbol, a -> b)
-> State Tag (NonEmpty Symbol, a)
-> State Tag (NonEmpty Symbol, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (((NonEmpty Symbol, a -> b)
  -> (NonEmpty Symbol, a) -> (NonEmpty Symbol, b))
 -> State Tag (NonEmpty Symbol, a -> b)
 -> State Tag (NonEmpty Symbol, a)
 -> State Tag (NonEmpty Symbol, b))
-> (((a -> b) -> a -> b)
    -> (NonEmpty Symbol, a -> b)
    -> (NonEmpty Symbol, a)
    -> (NonEmpty Symbol, b))
-> ((a -> b) -> a -> b)
-> State Tag (NonEmpty Symbol, a -> b)
-> State Tag (NonEmpty Symbol, a)
-> State Tag (NonEmpty Symbol, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> a -> b)
-> (NonEmpty Symbol, a -> b)
-> (NonEmpty Symbol, a)
-> (NonEmpty Symbol, b)
forall m a' b c.
Semigroup m =>
(a' -> b -> c) -> (m, a') -> (m, b) -> (m, c)
liftF2) (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) State Tag (NonEmpty Symbol, a -> b)
f2 State Tag (NonEmpty Symbol, a)
x2))

    where -- Instead of depending on Apply
          -- https://www.stackage.org/haddock/lts-19.16/semigroupoids-5.3.7/Data-Functor-Apply.html#v:liftF2
          liftF2 :: Semigroup m
                 => (a' -> b -> c) -> (m, a') -> (m, b) -> (m, c)
          liftF2 :: (a' -> b -> c) -> (m, a') -> (m, b) -> (m, c)
liftF2 a' -> b -> c
f (m
ys1, a'
x1) (m
ys2, b
x2) = (m
ys1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
ys2, a' -> b -> c
f a'
x1 b
x2)

instance Profunctor Rowspec where
  dimap :: (a -> b) -> (c -> d) -> Rowspec b c -> Rowspec a d
dimap a -> b
f c -> d
g = \case
    EmptyRows c
x -> d -> Rowspec a d
forall a a. a -> Rowspec a a
EmptyRows (c -> d
g c
x)
    NonEmptyRows NonEmptyRowspec b c
x -> NonEmptyRowspec a d -> Rowspec a d
forall fields fields'.
NonEmptyRowspec fields fields' -> Rowspec fields fields'
NonEmptyRows ((a -> b) -> (c -> d) -> NonEmptyRowspec b c -> NonEmptyRowspec 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 NonEmptyRowspec b c
x)

instance ProductProfunctor Rowspec where
  purePP :: b -> Rowspec a b
purePP = b -> Rowspec a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: Rowspec a (b -> c) -> Rowspec a b -> Rowspec a c
(****) = Rowspec a (b -> c) -> Rowspec a b -> Rowspec a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

-- }

{-# DEPRECATED valuesU "Will be removed in 0.10" #-}
valuesU :: U.Unpackspec columns columns'
        -> ValuesspecUnsafe columns columns'
        -> [columns]
        -> ((), T.Tag) -> (columns', PQ.PrimQuery)
valuesU :: Unpackspec columns columns'
-> ValuesspecUnsafe columns columns'
-> [columns]
-> ((), Tag)
-> (columns', PrimQuery)
valuesU Unpackspec columns columns'
unpack ValuesspecUnsafe columns columns'
valuesspec [columns]
rows ((), Tag
t) = (columns'
newColumns, PrimQuery
primQ')
  where runRow :: columns -> [PrimExpr]
runRow columns
row = [PrimExpr]
valuesRow
           where (columns'
_, [PrimExpr]
valuesRow) =
                   PM [PrimExpr] columns' -> (columns', [PrimExpr])
forall a r. PM [a] r -> (r, [a])
PM.run (Unpackspec columns columns'
-> (PrimExpr -> StateT ([PrimExpr], Int) Identity PrimExpr)
-> columns
-> PM [PrimExpr] columns'
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
U.runUnpackspec Unpackspec columns columns'
unpack PrimExpr -> StateT ([PrimExpr], Int) Identity PrimExpr
extractValuesEntry columns
row)

        (columns'
newColumns, [(Symbol, ())]
valuesPEs_nulls) =
          PM [(Symbol, ())] columns' -> (columns', [(Symbol, ())])
forall a r. PM [a] r -> (r, [a])
PM.run (ValuesspecUnsafe columns columns'
-> (() -> StateT ([(Symbol, ())], Int) Identity PrimExpr)
-> PM [(Symbol, ())] columns'
forall (f :: * -> *) columns columns'.
Applicative f =>
ValuesspecUnsafe columns columns'
-> (() -> f PrimExpr) -> f columns'
runValuesspec ValuesspecUnsafe columns columns'
valuesspec (Tag -> () -> StateT ([(Symbol, ())], Int) Identity PrimExpr
forall primExpr.
Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
extractValuesField Tag
t))

        valuesPEs :: [Symbol]
valuesPEs = ((Symbol, ()) -> Symbol) -> [(Symbol, ())] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (Symbol, ()) -> Symbol
forall a b. (a, b) -> a
fst [(Symbol, ())]
valuesPEs_nulls

        values :: [[HPQ.PrimExpr]]
        values :: [[PrimExpr]]
values = (columns -> [PrimExpr]) -> [columns] -> [[PrimExpr]]
forall a b. (a -> b) -> [a] -> [b]
map columns -> [PrimExpr]
runRow [columns]
rows

        primQ' :: PrimQuery
primQ' = case [[PrimExpr]] -> Maybe (NonEmpty [PrimExpr])
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [[PrimExpr]]
values of
          Maybe (NonEmpty [PrimExpr])
Nothing      -> () -> PrimQuery
forall a. a -> PrimQuery' a
PQ.Empty ()
          Just NonEmpty [PrimExpr]
values' -> [Symbol] -> NonEmpty [PrimExpr] -> PrimQuery
forall a. [Symbol] -> NonEmpty [PrimExpr] -> PrimQuery' a
PQ.Values [Symbol]
valuesPEs NonEmpty [PrimExpr]
values'

{-# DEPRECATED extractValuesEntry "Will be removed in 0.10" #-}
extractValuesEntry :: HPQ.PrimExpr -> PM.PM [HPQ.PrimExpr] HPQ.PrimExpr
extractValuesEntry :: PrimExpr -> StateT ([PrimExpr], Int) Identity PrimExpr
extractValuesEntry PrimExpr
pe = do
  PrimExpr -> PM [PrimExpr] ()
forall a. a -> PM [a] ()
PM.write PrimExpr
pe
  PrimExpr -> StateT ([PrimExpr], Int) Identity PrimExpr
forall (m :: * -> *) a. Monad m => a -> m a
return PrimExpr
pe

{-# DEPRECATED extractValuesField "Will be removed in 0.10" #-}
extractValuesField :: T.Tag -> primExpr
                   -> PM.PM [(HPQ.Symbol, primExpr)] HPQ.PrimExpr
extractValuesField :: Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
extractValuesField = String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
forall primExpr.
String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
PM.extractAttr String
"values"

{-# DEPRECATED runValuesspec "Will be removed in 0.10" #-}
runValuesspec :: Applicative f => ValuesspecUnsafe columns columns'
              -> (() -> f HPQ.PrimExpr) -> f columns'
runValuesspec :: ValuesspecUnsafe columns columns'
-> (() -> f PrimExpr) -> f columns'
runValuesspec (Valuesspec PackMap () PrimExpr () columns'
v) () -> f PrimExpr
f = PackMap () PrimExpr () columns'
-> (() -> f PrimExpr) -> () -> f columns'
forall (f :: * -> *) a b s t.
Applicative f =>
PackMap a b s t -> (a -> f b) -> s -> f t
PM.traversePM PackMap () PrimExpr () columns'
v () -> f PrimExpr
f ()

newtype ValuesspecUnsafe columns columns' =
  Valuesspec (PM.PackMap () HPQ.PrimExpr () columns')

instance Default ValuesspecUnsafe (Field_ n a) (Field_ n a) where
  def :: ValuesspecUnsafe (Field_ n a) (Field_ n a)
def = PackMap () PrimExpr () (Field_ n a)
-> ValuesspecUnsafe (Field_ n a) (Field_ n a)
forall columns columns'.
PackMap () PrimExpr () columns'
-> ValuesspecUnsafe columns columns'
Valuesspec ((() -> ())
-> (PrimExpr -> Field_ n a) -> PackMap () PrimExpr () (Field_ n a)
forall s a b t. (s -> a) -> (b -> t) -> PackMap a b s t
PM.iso () -> ()
forall a. a -> a
id PrimExpr -> Field_ n a
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column)

{-# DEPRECATED ValuesspecSafe "Use Valuesspec instead.  Will be removed in version 0.10." #-}
type ValuesspecSafe = Valuesspec