{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Opaleye.Internal.MaybeFields where

import           Control.Applicative hiding (optional)
import           Control.Arrow (returnA, (<<<), (>>>))

import qualified Opaleye.Internal.Binary as B
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.ToFields as Constant
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import           Opaleye.Internal.Inferrable (Inferrable(Inferrable),
                                              runInferrable)
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.QueryArr as IQ
import qualified Opaleye.Internal.Rebind as Rebind
import qualified Opaleye.Internal.RunQuery as RQ
import qualified Opaleye.Internal.Tag as Tag
import qualified Opaleye.Internal.Unpackspec as U
import qualified Opaleye.Internal.Values as V
import           Opaleye.Select (Select, SelectArr)
import qualified Opaleye.Column
import qualified Opaleye.Field
import           Opaleye.Field (Field)
import           Opaleye.Internal.Operators ((.&&), (.||), (.==), restrict, not,
                                             ifExplict, IfPP, EqPP(EqPP))
import qualified Opaleye.Internal.Lateral
import qualified Opaleye.SqlTypes
import           Opaleye.SqlTypes (SqlBool, IsSqlType)

import           Control.Monad (replicateM_)

import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product as PP
import qualified Data.Profunctor.Product.Default as PP

import qualified Database.PostgreSQL.Simple.FromRow as PGSR

-- | The Opaleye analogue of 'Data.Maybe.Maybe'
data MaybeFields fields =
  MaybeFields {
    MaybeFields fields -> Column SqlBool
mfPresent :: Opaleye.Column.Column Opaleye.SqlTypes.SqlBool
  , MaybeFields fields -> fields
mfFields  :: fields
  }
  deriving a -> MaybeFields b -> MaybeFields a
(a -> b) -> MaybeFields a -> MaybeFields b
(forall a b. (a -> b) -> MaybeFields a -> MaybeFields b)
-> (forall a b. a -> MaybeFields b -> MaybeFields a)
-> Functor MaybeFields
forall a b. a -> MaybeFields b -> MaybeFields a
forall a b. (a -> b) -> MaybeFields a -> MaybeFields b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MaybeFields b -> MaybeFields a
$c<$ :: forall a b. a -> MaybeFields b -> MaybeFields a
fmap :: (a -> b) -> MaybeFields a -> MaybeFields b
$cfmap :: forall a b. (a -> b) -> MaybeFields a -> MaybeFields b
Functor

instance Applicative MaybeFields where
  pure :: a -> MaybeFields a
pure a
fields = MaybeFields :: forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields { mfPresent :: Column SqlBool
mfPresent = Bool -> Field SqlBool
Opaleye.SqlTypes.sqlBool Bool
True
                            , mfFields :: a
mfFields  = a
fields
                            }
  MaybeFields Column SqlBool
t a -> b
f <*> :: MaybeFields (a -> b) -> MaybeFields a -> MaybeFields b
<*> MaybeFields Column SqlBool
t' a
a =
    MaybeFields :: forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields {
      mfPresent :: Column SqlBool
mfPresent = Column SqlBool
t Column SqlBool -> Column SqlBool -> Column SqlBool
.&& Column SqlBool
t'
    , mfFields :: b
mfFields  = a -> b
f a
a
    }

instance Monad MaybeFields where
  return :: a -> MaybeFields a
return = a -> MaybeFields a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  MaybeFields Column SqlBool
t a
a >>= :: MaybeFields a -> (a -> MaybeFields b) -> MaybeFields b
>>= a -> MaybeFields b
f = case a -> MaybeFields b
f a
a of
    MaybeFields Column SqlBool
t' b
b -> Column SqlBool -> b -> MaybeFields b
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields (Column SqlBool
t Column SqlBool -> Column SqlBool -> Column SqlBool
.&& Column SqlBool
t') b
b

-- | The Opaleye analogue of 'Data.Maybe.Nothing'.
nothingFields :: PP.Default V.Nullspec a a => MaybeFields a
nothingFields :: MaybeFields a
nothingFields = Nullspec a a -> MaybeFields a
forall a b. Nullspec a b -> MaybeFields b
nothingFieldsExplicit Nullspec a a
forall a. Default Nullspec a a => Nullspec a a
def
  where def :: PP.Default V.Nullspec a a => V.Nullspec a a
        def :: Nullspec a a
def = Nullspec a a
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

-- | The Opaleye analogue of @'Prelude.const' 'Data.Maybe.Nothing'@.
-- Can be useful to avoid type inference problems, because it doesn't
-- pick up a type class constraint.
nothingFieldsOfTypeOf :: a -> MaybeFields a
nothingFieldsOfTypeOf :: a -> MaybeFields a
nothingFieldsOfTypeOf a
a = MaybeFields :: forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields {
    mfPresent :: Column SqlBool
mfPresent = Bool -> Field SqlBool
Opaleye.SqlTypes.sqlBool Bool
False
  , mfFields :: a
mfFields  = a
a
  }

-- | The Opaleye analogue of 'Data.Maybe.Just'.  Equivalent to
-- 'Control.Applicative.pure'.
justFields :: a -> MaybeFields a
justFields :: a -> MaybeFields a
justFields = a -> MaybeFields a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | The Opaleye analogue of 'Data.Maybe.maybe'
maybeFields :: PP.Default IfPP b b => b -> (a -> b) -> MaybeFields a -> b
maybeFields :: b -> (a -> b) -> MaybeFields a -> b
maybeFields = IfPP b b -> b -> (a -> b) -> MaybeFields a -> b
forall b b' a. IfPP b b' -> b -> (a -> b) -> MaybeFields a -> b'
maybeFieldsExplicit IfPP b b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

-- | The Opaleye analogue of 'Data.Maybe.fromMaybe'
fromMaybeFields :: PP.Default IfPP b b => b -> MaybeFields b -> b
fromMaybeFields :: b -> MaybeFields b -> b
fromMaybeFields = IfPP b b -> b -> MaybeFields b -> b
forall b. IfPP b b -> b -> MaybeFields b -> b
fromMaybeFieldsExplicit IfPP b b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

-- | The Opaleye analogue of 'Data.Maybe.maybeToList'
maybeFieldsToSelect :: SelectArr (MaybeFields a) a
maybeFieldsToSelect :: SelectArr (MaybeFields a) a
maybeFieldsToSelect = proc MaybeFields a
mf -> do
  SelectArr (Column SqlBool) ()
SelectArr (Field SqlBool) ()
restrict -< MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields a
mf
  SelectArr a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< MaybeFields a -> a
forall fields. MaybeFields fields -> fields
mfFields MaybeFields a
mf

-- | The Opaleye analogue of 'Data.Maybe.catMaybes'
catMaybeFields :: SelectArr i (MaybeFields a) -> SelectArr i a
catMaybeFields :: SelectArr i (MaybeFields a) -> SelectArr i a
catMaybeFields = (SelectArr i (MaybeFields a)
-> SelectArr (MaybeFields a) a -> SelectArr i a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SelectArr (MaybeFields a) a
forall a. SelectArr (MaybeFields a) a
maybeFieldsToSelect)

maybeFieldsExplicit :: IfPP b b' -> b -> (a -> b) -> MaybeFields a -> b'
maybeFieldsExplicit :: IfPP b b' -> b -> (a -> b) -> MaybeFields a -> b'
maybeFieldsExplicit IfPP b b'
ifpp b
b a -> b
f MaybeFields a
mf =
  IfPP b b' -> Column SqlBool -> b -> b -> b'
forall columns columns'.
IfPP columns columns'
-> Column SqlBool -> columns -> columns -> columns'
ifExplict IfPP b b'
ifpp (MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields a
mf) (a -> b
f (MaybeFields a -> a
forall fields. MaybeFields fields -> fields
mfFields MaybeFields a
mf)) b
b

fromMaybeFieldsExplicit :: IfPP b b -> b -> MaybeFields b -> b
fromMaybeFieldsExplicit :: IfPP b b -> b -> MaybeFields b -> b
fromMaybeFieldsExplicit IfPP b b
ifpp = (b -> (b -> b) -> MaybeFields b -> b)
-> (b -> b) -> b -> MaybeFields b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (IfPP b b -> b -> (b -> b) -> MaybeFields b -> b
forall b b' a. IfPP b b' -> b -> (a -> b) -> MaybeFields a -> b'
maybeFieldsExplicit IfPP b b
ifpp) b -> b
forall a. a -> a
id

nothingFieldsExplicit :: V.Nullspec a b -> MaybeFields b
nothingFieldsExplicit :: Nullspec a b -> MaybeFields b
nothingFieldsExplicit = b -> MaybeFields b
forall a. a -> MaybeFields a
nothingFieldsOfTypeOf (b -> MaybeFields b)
-> (Nullspec a b -> b) -> Nullspec a b -> MaybeFields b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nullspec a b -> b
forall a fields. Nullspec a fields -> fields
V.nullFields

traverseMaybeFields :: SelectArr a b -> SelectArr (MaybeFields a) (MaybeFields b)
traverseMaybeFields :: SelectArr a b -> SelectArr (MaybeFields a) (MaybeFields b)
traverseMaybeFields SelectArr a b
query = proc MaybeFields a
mfInput -> do
  MaybeFields b
mfOutput <- SelectArr (MaybeFields a) b
-> SelectArr (MaybeFields a) (MaybeFields b)
forall i a. SelectArr i a -> SelectArr i (MaybeFields a)
optional (SelectArr a b
query SelectArr a b
-> SelectArr (MaybeFields a) a -> SelectArr (MaybeFields a) b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< SelectArr (MaybeFields a) a
forall a. SelectArr (MaybeFields a) a
maybeFieldsToSelect) -< MaybeFields a
mfInput
  SelectArr (Column SqlBool) ()
SelectArr (Field SqlBool) ()
restrict -< MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields a
mfInput Column SqlBool -> Column SqlBool -> Column SqlBool
`implies` MaybeFields b -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields b
mfOutput
  SelectArr (MaybeFields b) (MaybeFields b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Column SqlBool -> b -> MaybeFields b
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields (MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields a
mfInput) (MaybeFields b -> b
forall fields. MaybeFields fields -> fields
mfFields MaybeFields b
mfOutput)

  where Column SqlBool
a implies :: Column SqlBool -> Column SqlBool -> Field SqlBool
`implies` Column SqlBool
b = Field SqlBool -> Field SqlBool
Opaleye.Internal.Operators.not Column SqlBool
Field SqlBool
a Field SqlBool -> Field SqlBool -> Field SqlBool
.|| Column SqlBool
Field SqlBool
b

optional :: SelectArr i a -> SelectArr i (MaybeFields a)
optional :: SelectArr i a -> SelectArr i (MaybeFields a)
optional = (Select a -> Select (MaybeFields a))
-> SelectArr i a -> SelectArr i (MaybeFields a)
forall a b i.
(Select a -> Select b) -> SelectArr i a -> SelectArr i b
Opaleye.Internal.Lateral.laterally ((Field (Nullable SqlBool) -> a -> MaybeFields a)
-> Select a -> Select (MaybeFields a)
forall a r.
(Field (Nullable SqlBool) -> a -> r) -> Select a -> Select r
optionalInternal (Column SqlBool -> a -> MaybeFields a
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields (Column SqlBool -> a -> MaybeFields a)
-> (Column (Nullable SqlBool) -> Column SqlBool)
-> Column (Nullable SqlBool)
-> a
-> MaybeFields a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column (Nullable SqlBool) -> Column SqlBool
forall a. Column (Nullable a) -> Column SqlBool
isNotNull))
  where isNotNull :: Column (Nullable a) -> Column SqlBool
isNotNull = Column SqlBool -> Column SqlBool
Field SqlBool -> Field SqlBool
Opaleye.Internal.Operators.not (Column SqlBool -> Column SqlBool)
-> (Column (Nullable a) -> Column SqlBool)
-> Column (Nullable a)
-> Column SqlBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column (Nullable a) -> Column SqlBool
forall a. FieldNullable a -> Field SqlBool
Opaleye.Field.isNull

optionalInternal :: (Field (Opaleye.Column.Nullable SqlBool) -> a -> r) -> Select a -> Select r
optionalInternal :: (Field (Nullable SqlBool) -> a -> r) -> Select a -> Select r
optionalInternal Field (Nullable SqlBool) -> a -> r
f = (((), Tag) -> (r, Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select r
forall a b.
((a, Tag) -> (b, Lateral -> PrimQuery -> PrimQuery, Tag))
-> SelectArr a b
IQ.QueryArr ((((), Tag) -> (r, Lateral -> PrimQuery -> PrimQuery, Tag))
 -> Select r)
-> (Select a
    -> ((), Tag) -> (r, Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select a
-> Select r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select a
-> ((), Tag) -> (r, Lateral -> PrimQuery -> PrimQuery, Tag)
go
  where
    -- This is basically a left join on TRUE, but Shane (@duairc)
    -- wrote it to ensure that we don't need an Unpackspec a a.
    go :: Select a
-> ((), Tag) -> (r, Lateral -> PrimQuery -> PrimQuery, Tag)
go Select a
query ((), Tag)
arg = (r
r, Lateral -> PrimQuery -> PrimQuery
join, Tag -> Tag
Tag.next Tag
tag')
      where
        (r
r, PrimQuery
right, Tag
tag') = (Select r -> ((), Tag) -> (r, PrimQuery, Tag))
-> ((), Tag) -> Select r -> (r, PrimQuery, Tag)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Select r -> ((), Tag) -> (r, PrimQuery, Tag)
forall a b. QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
IQ.runSimpleQueryArr ((), Tag)
arg (Select r -> (r, PrimQuery, Tag))
-> Select r -> (r, PrimQuery, Tag)
forall a b. (a -> b) -> a -> b
$ proc () -> do
          a
a <- Select a
query -< ()
          Column (Nullable SqlBool)
true_ <- SelectArr (Column (Nullable SqlBool)) (Column (Nullable SqlBool))
forall a. Default Unpackspec a a => SelectArr a a
Rebind.rebind -< Column SqlBool -> Column (Nullable SqlBool)
forall a. Column a -> Column (Nullable a)
Opaleye.Column.toNullable (PrimExpr -> Column SqlBool
forall pgType. PrimExpr -> Column pgType
IC.Column PrimExpr
true)
          SelectArr r r
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Field (Nullable SqlBool) -> a -> r
f Column (Nullable SqlBool)
Field (Nullable SqlBool)
true_ a
a

        join :: Lateral -> PrimQuery -> PrimQuery
join Lateral
lat PrimQuery
left = JoinType
-> PrimExpr
-> (Lateral, PrimQuery)
-> (Lateral, PrimQuery)
-> PrimQuery
forall a.
JoinType
-> PrimExpr
-> (Lateral, PrimQuery' a)
-> (Lateral, PrimQuery' a)
-> PrimQuery' a
PQ.Join JoinType
PQ.LeftJoin PrimExpr
true (Lateral
PQ.NonLateral, PrimQuery
left) (Lateral
lat, PrimQuery
right)
    true :: PrimExpr
true = Literal -> PrimExpr
HPQ.ConstExpr (Bool -> Literal
HPQ.BoolLit Bool
True)


-- | An example to demonstrate how the functionality of (lateral)
-- @LEFT JOIN@ can be recovered using 'optional'.
lateralLeftJoinOptional :: SelectArr i a
                        -> SelectArr i b
                        -> ((a, b) -> Opaleye.Field.Field Opaleye.SqlTypes.SqlBool)
                        -> SelectArr i (a, MaybeFields b)
lateralLeftJoinOptional :: SelectArr i a
-> SelectArr i b
-> ((a, b) -> Field SqlBool)
-> SelectArr i (a, MaybeFields b)
lateralLeftJoinOptional SelectArr i a
fieldsL SelectArr i b
fieldsR (a, b) -> Field SqlBool
cond = proc i
i -> do
  a
fieldsL' <- SelectArr i a
fieldsL -< i
i
  MaybeFields b
maybeFieldsR' <- SelectArr (a, i) b -> SelectArr (a, i) (MaybeFields b)
forall i a. SelectArr i a -> SelectArr i (MaybeFields a)
optional (proc (a
fieldsL', i
i) -> do
                                b
fieldsR' <- SelectArr i b
fieldsR -< i
i
                                SelectArr (Column SqlBool) ()
SelectArr (Field SqlBool) ()
restrict -< (a, b) -> Field SqlBool
cond (a
fieldsL', b
fieldsR')
                                SelectArr b b
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< b
fieldsR'
                                ) -< (a
fieldsL', i
i)
  SelectArr (a, MaybeFields b) (a, MaybeFields b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a
fieldsL', MaybeFields b
maybeFieldsR')

-- | An example to demonstrate how the functionality of
-- 'Opaleye.Join.optionalRestrict' can be recovered using 'optional'.
optionalRestrictOptional :: Select a
                         -> SelectArr (a -> Field SqlBool) (MaybeFields a)
optionalRestrictOptional :: Select a -> SelectArr (a -> Field SqlBool) (MaybeFields a)
optionalRestrictOptional Select a
q = SelectArr (a -> Column SqlBool) a
-> SelectArr (a -> Column SqlBool) (MaybeFields a)
forall i a. SelectArr i a -> SelectArr i (MaybeFields a)
optional (SelectArr (a -> Column SqlBool) a
 -> SelectArr (a -> Column SqlBool) (MaybeFields a))
-> SelectArr (a -> Column SqlBool) a
-> SelectArr (a -> Column SqlBool) (MaybeFields a)
forall a b. (a -> b) -> a -> b
$ proc a -> Column SqlBool
cond -> do
  a
a <- Select a
q -< ()
  SelectArr (Column SqlBool) ()
SelectArr (Field SqlBool) ()
restrict -< a -> Column SqlBool
cond a
a
  SelectArr a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
a

fromFieldsMaybeFields :: RQ.FromFields fields haskells
                      -> RQ.FromFields (MaybeFields fields) (Maybe haskells)
fromFieldsMaybeFields :: FromFields fields haskells
-> FromFields (MaybeFields fields) (Maybe haskells)
fromFieldsMaybeFields (RQ.QueryRunner Unpackspec fields ()
u fields -> RowParser haskells
p fields -> Int
c) = Unpackspec (MaybeFields fields) ()
-> (MaybeFields fields -> RowParser (Maybe haskells))
-> (MaybeFields fields -> Int)
-> FromFields (MaybeFields fields) (Maybe haskells)
forall columns haskells.
Unpackspec columns ()
-> (columns -> RowParser haskells)
-> (columns -> Int)
-> FromFields columns haskells
RQ.QueryRunner Unpackspec (MaybeFields fields) ()
u' MaybeFields fields -> RowParser (Maybe haskells)
p' MaybeFields fields -> Int
c'
  where u' :: Unpackspec (MaybeFields fields) ()
u' = () ()
-> Unpackspec (MaybeFields fields) (MaybeFields ())
-> Unpackspec (MaybeFields fields) ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Unpackspec (Field SqlBool) (Field SqlBool)
-> Unpackspec fields ()
-> Unpackspec (MaybeFields fields) (MaybeFields ())
forall (p :: * -> * -> *) a b.
ProductProfunctor p =>
p (Field SqlBool) (Field SqlBool)
-> p a b -> p (MaybeFields a) (MaybeFields b)
productProfunctorMaybeFields Unpackspec (Field SqlBool) (Field SqlBool)
forall a. Unpackspec (Column a) (Column a)
U.unpackspecField Unpackspec fields ()
u

        p' :: MaybeFields fields -> RowParser (Maybe haskells)
p' = \MaybeFields fields
mf -> do
          Bool
hIsPresent <- RowParser Bool
forall a. FromField a => RowParser a
PGSR.field

          case Bool
hIsPresent of
            Bool
True  -> haskells -> Maybe haskells
forall a. a -> Maybe a
Just (haskells -> Maybe haskells)
-> RowParser haskells -> RowParser (Maybe haskells)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> fields -> RowParser haskells
p (MaybeFields fields -> fields
forall fields. MaybeFields fields -> fields
mfFields MaybeFields fields
mf)
            Bool
False -> Maybe haskells
forall a. Maybe a
Nothing Maybe haskells -> RowParser () -> RowParser (Maybe haskells)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> RowParser () -> RowParser ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (fields -> Int
c (MaybeFields fields -> fields
forall fields. MaybeFields fields -> fields
mfFields MaybeFields fields
mf))
                                            (FieldParser () -> RowParser ()
forall a. FieldParser a -> RowParser a
PGSR.fieldWith (\Field
_ Maybe ByteString
_ -> () -> Conversion ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

        c' :: MaybeFields fields -> Int
c' = \MaybeFields fields
mf -> fields -> Int
c (MaybeFields fields -> fields
forall fields. MaybeFields fields -> fields
mfFields MaybeFields fields
mf) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | This is not safe in general because it relies on p not doing
-- anything observable with the @a@s if @mfPresent@ is false.  In
-- particular, it won't work for
-- 'Opaleye.Internal.Distinct.Distinctspec' because it does indeed
-- look at the @mfFields@ to check distinctness.
productProfunctorMaybeFields :: PP.ProductProfunctor p
                             => p (Field SqlBool) (Field SqlBool)
                             -> p a b
                             -> p (MaybeFields a) (MaybeFields b)
productProfunctorMaybeFields :: p (Field SqlBool) (Field SqlBool)
-> p a b -> p (MaybeFields a) (MaybeFields b)
productProfunctorMaybeFields p (Field SqlBool) (Field SqlBool)
b p a b
p = Column SqlBool -> b -> MaybeFields b
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields (Column SqlBool -> b -> MaybeFields b)
-> p (MaybeFields a) (Column SqlBool)
-> p (MaybeFields a) (b -> MaybeFields b)
forall (p :: * -> * -> *) b c a.
ProductProfunctor p =>
(b -> c) -> p a b -> p a c
PP.***$ (MaybeFields a -> Column SqlBool)
-> p (Column SqlBool) (Column SqlBool)
-> p (MaybeFields a) (Column SqlBool)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent p (Column SqlBool) (Column SqlBool)
p (Field SqlBool) (Field SqlBool)
b
                                               p (MaybeFields a) (b -> MaybeFields b)
-> p (MaybeFields a) b -> p (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b c.
ProductProfunctor p =>
p a (b -> c) -> p a b -> p a c
PP.**** (MaybeFields a -> a) -> p a b -> p (MaybeFields a) b
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap MaybeFields a -> a
forall fields. MaybeFields fields -> fields
mfFields p a b
p

nullspecMaybeFields :: V.Nullspec a b
                    -> V.Nullspec (MaybeFields a) (MaybeFields b)
nullspecMaybeFields :: Nullspec a b -> Nullspec (MaybeFields a) (MaybeFields b)
nullspecMaybeFields = Nullspec (Field SqlBool) (Field SqlBool)
-> Nullspec a b -> Nullspec (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b.
ProductProfunctor p =>
p (Field SqlBool) (Field SqlBool)
-> p a b -> p (MaybeFields a) (MaybeFields b)
productProfunctorMaybeFields Nullspec (Field SqlBool) (Field SqlBool)
forall b a. IsSqlType b => Nullspec a (Column b)
V.nullspecField

unpackspecMaybeFields :: U.Unpackspec a b
                      -> U.Unpackspec (MaybeFields a) (MaybeFields b)
unpackspecMaybeFields :: Unpackspec a b -> Unpackspec (MaybeFields a) (MaybeFields b)
unpackspecMaybeFields = Unpackspec (Field SqlBool) (Field SqlBool)
-> Unpackspec a b -> Unpackspec (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b.
ProductProfunctor p =>
p (Field SqlBool) (Field SqlBool)
-> p a b -> p (MaybeFields a) (MaybeFields b)
productProfunctorMaybeFields Unpackspec (Field SqlBool) (Field SqlBool)
forall a. Unpackspec (Column a) (Column a)
U.unpackspecField

valuesspecMaybeFields :: V.Valuesspec a b
                      -> V.Valuesspec (MaybeFields a) (MaybeFields b)
valuesspecMaybeFields :: Valuesspec a b -> Valuesspec (MaybeFields a) (MaybeFields b)
valuesspecMaybeFields = Valuesspec (Field SqlBool) (Field SqlBool)
-> Valuesspec a b -> Valuesspec (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b.
ProductProfunctor p =>
p (Field SqlBool) (Field SqlBool)
-> p a b -> p (MaybeFields a) (MaybeFields b)
productProfunctorMaybeFields Valuesspec (Field SqlBool) (Field SqlBool)
forall a. IsSqlType a => Valuesspec (Column a) (Column a)
V.valuesspecField

toFieldsMaybeFields :: V.Nullspec a b
                    -> Constant.ToFields a b
                    -> Constant.ToFields (Maybe a) (MaybeFields b)
toFieldsMaybeFields :: Nullspec a b -> ToFields a b -> ToFields (Maybe a) (MaybeFields b)
toFieldsMaybeFields Nullspec a b
n ToFields a b
p = (Maybe a -> MaybeFields b) -> ToFields (Maybe a) (MaybeFields b)
forall haskells fields.
(haskells -> fields) -> ToFields haskells fields
Constant.toToFields ((Maybe a -> MaybeFields b) -> ToFields (Maybe a) (MaybeFields b))
-> (Maybe a -> MaybeFields b) -> ToFields (Maybe a) (MaybeFields b)
forall a b. (a -> b) -> a -> b
$ \case
  Maybe a
Nothing -> Nullspec a b -> MaybeFields b
forall a b. Nullspec a b -> MaybeFields b
nothingFieldsExplicit Nullspec a b
n
  Just a
a  -> b -> MaybeFields b
forall a. a -> MaybeFields a
justFields (ToFields a b -> a -> b
forall haskells fields.
ToFields haskells fields -> haskells -> fields
Constant.toFieldsExplicit ToFields a b
p a
a)

ifPPMaybeFields :: IfPP a b -> IfPP (MaybeFields a) (MaybeFields b)
ifPPMaybeFields :: IfPP a b -> IfPP (MaybeFields a) (MaybeFields b)
ifPPMaybeFields = IfPP (Field SqlBool) (Field SqlBool)
-> IfPP a b -> IfPP (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b.
ProductProfunctor p =>
p (Field SqlBool) (Field SqlBool)
-> p a b -> p (MaybeFields a) (MaybeFields b)
productProfunctorMaybeFields IfPP (Field SqlBool) (Field SqlBool)
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

-- I'd rather not crack open EqPP to implement this but the
-- alternative is adding an operation eqPPOr :: EqPP a b -> EqPP a' b
-- -> EqPP (a, a') b, and possibly even more than that, so I can't be
-- bothered right now.
eqPPMaybeFields :: EqPP a b -> EqPP (MaybeFields a) (MaybeFields b)
eqPPMaybeFields :: EqPP a b -> EqPP (MaybeFields a) (MaybeFields b)
eqPPMaybeFields (EqPP a -> a -> Column SqlBool
eqFields) = (MaybeFields a -> MaybeFields a -> Column SqlBool)
-> EqPP (MaybeFields a) (MaybeFields b)
forall a b. (a -> a -> Column SqlBool) -> EqPP a b
EqPP (\MaybeFields a
m1 MaybeFields a
m2 ->
    (MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields a
m1 Column SqlBool -> Column SqlBool -> Column SqlBool
forall columns.
Default EqPP columns columns =>
columns -> columns -> Column SqlBool
.== MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields a
m2)
    Column SqlBool -> Column SqlBool -> Column SqlBool
.&& (MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent MaybeFields a
m1 Column SqlBool -> Column SqlBool -> Column SqlBool
`implies` a -> a -> Column SqlBool
eqFields (MaybeFields a -> a
forall fields. MaybeFields fields -> fields
mfFields MaybeFields a
m1) (MaybeFields a -> a
forall fields. MaybeFields fields -> fields
mfFields MaybeFields a
m2)))
  where Column SqlBool
a implies :: Column SqlBool -> Column SqlBool -> Field SqlBool
`implies` Column SqlBool
b = Field SqlBool -> Field SqlBool
Opaleye.Internal.Operators.not Column SqlBool
Field SqlBool
a Field SqlBool -> Field SqlBool -> Field SqlBool
.|| Column SqlBool
Field SqlBool
b

-- | This is only safe if d is OK with having nulls passed through it
-- when they claim to be non-null.
unWithNulls :: PP.ProductProfunctor p
            => p (Field SqlBool) (Field SqlBool)
            -> WithNulls p a b
            -> p (MaybeFields a) (MaybeFields b)
unWithNulls :: p (Field SqlBool) (Field SqlBool)
-> WithNulls p a b -> p (MaybeFields a) (MaybeFields b)
unWithNulls p (Field SqlBool) (Field SqlBool)
b (WithNulls p (MaybeFields a) b
d) =
    Column SqlBool -> b -> MaybeFields b
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields (Column SqlBool -> b -> MaybeFields b)
-> p (MaybeFields a) (Column SqlBool)
-> p (MaybeFields a) (b -> MaybeFields b)
forall (p :: * -> * -> *) b c a.
ProductProfunctor p =>
(b -> c) -> p a b -> p a c
PP.***$ (MaybeFields a -> Column SqlBool)
-> p (Column SqlBool) (Column SqlBool)
-> p (MaybeFields a) (Column SqlBool)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent p (Column SqlBool) (Column SqlBool)
p (Field SqlBool) (Field SqlBool)
b
                p (MaybeFields a) (b -> MaybeFields b)
-> p (MaybeFields a) b -> p (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b c.
ProductProfunctor p =>
p a (b -> c) -> p a b -> p a c
PP.**** p (MaybeFields a) b
d

newtype WithNulls p a b =
  WithNulls (p (MaybeFields a) b)

-- | This is only safe if d is OK with having nulls passed through it
-- when they claim to be non-null.
mapMaybeFieldsWithNulls :: PP.ProductProfunctor p
                        => p (Field SqlBool) (Field SqlBool)
                        -> WithNulls p a b
                        -> WithNulls p (MaybeFields a) (MaybeFields b)
mapMaybeFieldsWithNulls :: p (Field SqlBool) (Field SqlBool)
-> WithNulls p a b -> WithNulls p (MaybeFields a) (MaybeFields b)
mapMaybeFieldsWithNulls p (Field SqlBool) (Field SqlBool)
b WithNulls p a b
d =
  Column SqlBool -> b -> MaybeFields b
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields (Column SqlBool -> b -> MaybeFields b)
-> WithNulls p (MaybeFields a) (Column SqlBool)
-> WithNulls p (MaybeFields a) (b -> MaybeFields b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MaybeFields a -> Column SqlBool)
-> WithNulls p (Column SqlBool) (Column SqlBool)
-> WithNulls p (MaybeFields a) (Column SqlBool)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap MaybeFields a -> Column SqlBool
forall fields. MaybeFields fields -> Column SqlBool
mfPresent (p (Column SqlBool) (Column SqlBool)
-> WithNulls p (Column SqlBool) (Column SqlBool)
forall a (p :: * -> * -> *).
(IsSqlType a, Profunctor p) =>
p (Column a) (Column a) -> WithNulls p (Column a) (Column a)
withNullsField p (Column SqlBool) (Column SqlBool)
p (Field SqlBool) (Field SqlBool)
b)
              WithNulls p (MaybeFields a) (b -> MaybeFields b)
-> WithNulls p (MaybeFields a) b
-> WithNulls p (MaybeFields a) (MaybeFields b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MaybeFields a -> a)
-> WithNulls p a b -> WithNulls p (MaybeFields a) b
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap MaybeFields a -> a
forall fields. MaybeFields fields -> fields
mfFields WithNulls p a b
d

-- | This is only safe if d is OK with having nulls passed through it
-- when they claim to be non-null.
withNullsField :: (IsSqlType a, P.Profunctor p)
               => p (IC.Column a) (IC.Column a)
               -> WithNulls p (IC.Column a) (IC.Column a)
withNullsField :: p (Column a) (Column a) -> WithNulls p (Column a) (Column a)
withNullsField p (Column a) (Column a)
col = WithNulls p (Column a) (Column a)
result
  where result :: WithNulls p (Column a) (Column a)
result = p (MaybeFields (Column a)) (Column a)
-> WithNulls p (Column a) (Column a)
forall (p :: * -> * -> *) a b.
p (MaybeFields a) b -> WithNulls p a b
WithNulls ((MaybeFields (Column a) -> Column a)
-> p (Column a) (Column a) -> p (MaybeFields (Column a)) (Column a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap (\(MaybeFields Column SqlBool
b Column a
c) ->
                                      IfPP (Column a) (Column a)
-> Column SqlBool -> Column a -> Column a -> Column a
forall columns columns'.
IfPP columns columns'
-> Column SqlBool -> columns -> columns -> columns'
ifExplict IfPP (Column a) (Column a)
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def Column SqlBool
b Column a
c Column a
nullC) p (Column a) (Column a)
col)
        nullC :: Column a
nullC = PrimExpr -> Column a
forall pgType. PrimExpr -> Column pgType
IC.Column (Maybe a -> PrimExpr
forall a (proxy :: * -> *). IsSqlType a => proxy a -> PrimExpr
V.nullPE (WithNulls p (Column a) (Column a) -> Maybe a
forall (f :: * -> *) sqlType. f (Column sqlType) -> Maybe sqlType
columnProxy WithNulls p (Column a) (Column a)
result))

        columnProxy :: f (IC.Column sqlType) -> Maybe sqlType
        columnProxy :: f (Column sqlType) -> Maybe sqlType
columnProxy f (Column sqlType)
_ = Maybe sqlType
forall a. Maybe a
Nothing

binaryspecMaybeFields
  :: WithNulls B.Binaryspec a b
  -> B.Binaryspec (MaybeFields a) (MaybeFields b)
binaryspecMaybeFields :: WithNulls Binaryspec a b
-> Binaryspec (MaybeFields a) (MaybeFields b)
binaryspecMaybeFields = Binaryspec (Field SqlBool) (Field SqlBool)
-> WithNulls Binaryspec a b
-> Binaryspec (MaybeFields a) (MaybeFields b)
forall (p :: * -> * -> *) a b.
ProductProfunctor p =>
p (Field SqlBool) (Field SqlBool)
-> WithNulls p a b -> p (MaybeFields a) (MaybeFields b)
unWithNulls Binaryspec (Field SqlBool) (Field SqlBool)
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance P.Profunctor p => P.Profunctor (WithNulls p) where
  dimap :: (a -> b) -> (c -> d) -> WithNulls p b c -> WithNulls p a d
dimap a -> b
f c -> d
g (WithNulls p (MaybeFields b) c
d) = p (MaybeFields a) d -> WithNulls p a d
forall (p :: * -> * -> *) a b.
p (MaybeFields a) b -> WithNulls p a b
WithNulls ((MaybeFields a -> MaybeFields b)
-> (c -> d) -> p (MaybeFields b) c -> p (MaybeFields a) d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap ((a -> b) -> MaybeFields a -> MaybeFields b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) c -> d
g p (MaybeFields b) c
d)

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

instance PP.ProductProfunctor p => Applicative (WithNulls p a) where
  pure :: a -> WithNulls p a a
pure = p (MaybeFields a) a -> WithNulls p a a
forall (p :: * -> * -> *) a b.
p (MaybeFields a) b -> WithNulls p a b
WithNulls (p (MaybeFields a) a -> WithNulls p a a)
-> (a -> p (MaybeFields a) a) -> a -> WithNulls p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> p (MaybeFields a) a
forall (p :: * -> * -> *) b a. ProductProfunctor p => b -> p a b
PP.purePP
  WithNulls p (MaybeFields a) (a -> b)
fd <*> :: WithNulls p a (a -> b) -> WithNulls p a a -> WithNulls p a b
<*> WithNulls p (MaybeFields a) a
xd = p (MaybeFields a) b -> WithNulls p a b
forall (p :: * -> * -> *) a b.
p (MaybeFields a) b -> WithNulls p a b
WithNulls (p (MaybeFields a) (a -> b)
fd p (MaybeFields a) (a -> b)
-> p (MaybeFields a) a -> p (MaybeFields a) b
forall (p :: * -> * -> *) a b c.
ProductProfunctor p =>
p a (b -> c) -> p a b -> p a c
PP.**** p (MaybeFields a) a
xd)

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

instance PP.SumProfunctor p => PP.SumProfunctor (WithNulls p) where
  WithNulls p (MaybeFields a) b
ff +++! :: WithNulls p a b
-> WithNulls p a' b' -> WithNulls p (Either a a') (Either b b')
+++! WithNulls p (MaybeFields a') b'
xf =
    p (MaybeFields (Either a a')) (Either b b')
-> WithNulls p (Either a a') (Either b b')
forall (p :: * -> * -> *) a b.
p (MaybeFields a) b -> WithNulls p a b
WithNulls (((MaybeFields (Either a a')
  -> Either (MaybeFields a) (MaybeFields a'))
 -> p (Either (MaybeFields a) (MaybeFields a')) (Either b b')
 -> p (MaybeFields (Either a a')) (Either b b'))
-> p (Either (MaybeFields a) (MaybeFields a')) (Either b b')
-> (MaybeFields (Either a a')
    -> Either (MaybeFields a) (MaybeFields a'))
-> p (MaybeFields (Either a a')) (Either b b')
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MaybeFields (Either a a')
 -> Either (MaybeFields a) (MaybeFields a'))
-> p (Either (MaybeFields a) (MaybeFields a')) (Either b b')
-> p (MaybeFields (Either a a')) (Either b b')
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
P.lmap (p (MaybeFields a) b
ff p (MaybeFields a) b
-> p (MaybeFields a') b'
-> p (Either (MaybeFields a) (MaybeFields 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.+++! p (MaybeFields a') b'
xf) ((MaybeFields (Either a a')
  -> Either (MaybeFields a) (MaybeFields a'))
 -> p (MaybeFields (Either a a')) (Either b b'))
-> (MaybeFields (Either a a')
    -> Either (MaybeFields a) (MaybeFields a'))
-> p (MaybeFields (Either a a')) (Either b b')
forall a b. (a -> b) -> a -> b
$ \case
                  MaybeFields Column SqlBool
b (Left a
l)  -> MaybeFields a -> Either (MaybeFields a) (MaybeFields a')
forall a b. a -> Either a b
Left  (Column SqlBool -> a -> MaybeFields a
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields Column SqlBool
b a
l)
                  MaybeFields Column SqlBool
b (Right a'
r) -> MaybeFields a' -> Either (MaybeFields a) (MaybeFields a')
forall a b. b -> Either a b
Right (Column SqlBool -> a' -> MaybeFields a'
forall fields. Column SqlBool -> fields -> MaybeFields fields
MaybeFields Column SqlBool
b a'
r))

instance PP.Default RQ.FromFields fields haskells
  => PP.Default RQ.FromFields (MaybeFields fields) (Maybe haskells) where
  def :: FromFields (MaybeFields fields) (Maybe haskells)
def = FromFields fields haskells
-> FromFields (MaybeFields fields) (Maybe haskells)
forall fields haskells.
FromFields fields haskells
-> FromFields (MaybeFields fields) (Maybe haskells)
fromFieldsMaybeFields FromFields fields haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance PP.Default U.Unpackspec a b
  => PP.Default U.Unpackspec (MaybeFields a) (MaybeFields b) where
  def :: Unpackspec (MaybeFields a) (MaybeFields b)
def = Unpackspec a b -> Unpackspec (MaybeFields a) (MaybeFields b)
forall a b.
Unpackspec a b -> Unpackspec (MaybeFields a) (MaybeFields b)
unpackspecMaybeFields Unpackspec a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance PP.Default V.Valuesspec a b
  => PP.Default V.Valuesspec (MaybeFields a) (MaybeFields b) where
  def :: Valuesspec (MaybeFields a) (MaybeFields b)
def = Valuesspec a b -> Valuesspec (MaybeFields a) (MaybeFields b)
forall a b.
Valuesspec a b -> Valuesspec (MaybeFields a) (MaybeFields b)
valuesspecMaybeFields Valuesspec a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance (PP.Default Constant.ToFields a b, PP.Default V.Nullspec a b)
  => PP.Default Constant.ToFields (Maybe a) (MaybeFields b) where
  def :: ToFields (Maybe a) (MaybeFields b)
def = Nullspec a b -> ToFields a b -> ToFields (Maybe a) (MaybeFields b)
forall a b.
Nullspec a b -> ToFields a b -> ToFields (Maybe a) (MaybeFields b)
toFieldsMaybeFields Nullspec a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def ToFields a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance PP.Default IfPP a b
  => PP.Default IfPP (MaybeFields a) (MaybeFields b) where
  def :: IfPP (MaybeFields a) (MaybeFields b)
def = IfPP a b -> IfPP (MaybeFields a) (MaybeFields b)
forall a b. IfPP a b -> IfPP (MaybeFields a) (MaybeFields b)
ifPPMaybeFields IfPP a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance PP.Default EqPP a b
  => PP.Default EqPP (MaybeFields a) (MaybeFields b) where
  def :: EqPP (MaybeFields a) (MaybeFields b)
def = EqPP a b -> EqPP (MaybeFields a) (MaybeFields b)
forall a b. EqPP a b -> EqPP (MaybeFields a) (MaybeFields b)
eqPPMaybeFields EqPP a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance (P.Profunctor p, IsSqlType a, PP.Default p (IC.Column a) (IC.Column a))
  => PP.Default (WithNulls p) (IC.Column a) (IC.Column a) where
  def :: WithNulls p (Column a) (Column a)
def = p (Column a) (Column a) -> WithNulls p (Column a) (Column a)
forall a (p :: * -> * -> *).
(IsSqlType a, Profunctor p) =>
p (Column a) (Column a) -> WithNulls p (Column a) (Column a)
withNullsField p (Column a) (Column a)
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance PP.Default (WithNulls B.Binaryspec) a b
  => PP.Default B.Binaryspec (MaybeFields a) (MaybeFields b) where
  def :: Binaryspec (MaybeFields a) (MaybeFields b)
def = WithNulls Binaryspec a b
-> Binaryspec (MaybeFields a) (MaybeFields b)
forall a b.
WithNulls Binaryspec a b
-> Binaryspec (MaybeFields a) (MaybeFields b)
binaryspecMaybeFields WithNulls Binaryspec a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def

instance (PP.Default (Inferrable RQ.FromFields) fields haskells,
          Maybe haskells ~ maybe_haskells)
  => PP.Default (Inferrable RQ.FromFields) (MaybeFields fields) maybe_haskells where
  def :: Inferrable FromFields (MaybeFields fields) maybe_haskells
def = FromFields (MaybeFields fields) (Maybe haskells)
-> Inferrable FromFields (MaybeFields fields) (Maybe haskells)
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (FromFields fields haskells
-> FromFields (MaybeFields fields) (Maybe haskells)
forall fields haskells.
FromFields fields haskells
-> FromFields (MaybeFields fields) (Maybe haskells)
fromFieldsMaybeFields (Inferrable FromFields fields haskells -> FromFields fields haskells
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable FromFields fields haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def))

instance (PP.Default (Inferrable Constant.ToFields) a b, PP.Default V.Nullspec a b,
          MaybeFields b ~ maybeFields_b)
  => PP.Default (Inferrable Constant.ToFields) (Maybe a) maybeFields_b where
  def :: Inferrable ToFields (Maybe a) maybeFields_b
def = ToFields (Maybe a) (MaybeFields b)
-> Inferrable ToFields (Maybe a) (MaybeFields b)
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (Nullspec a b -> ToFields a b -> ToFields (Maybe a) (MaybeFields b)
forall a b.
Nullspec a b -> ToFields a b -> ToFields (Maybe a) (MaybeFields b)
toFieldsMaybeFields Nullspec a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def (Inferrable ToFields a b -> ToFields a b
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable ToFields a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
PP.def))