{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
module Opaleye.SQLite.Constant where
import Opaleye.SQLite.Column (Column)
import qualified Opaleye.SQLite.Column as C
import qualified Opaleye.SQLite.SqlTypes as T
import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT
import qualified Data.Profunctor.Product as PP
import Data.Profunctor.Product (empty, (***!), (+++!))
import qualified Data.Profunctor.Product.Default as D
import qualified Data.Profunctor as P
import Control.Applicative (Applicative, pure, (<*>))
newtype Constant haskells columns =
Constant { Constant haskells columns -> haskells -> columns
constantExplicit :: haskells -> columns }
constant :: D.Default Constant haskells columns
=> haskells -> columns
constant :: haskells -> columns
constant = Constant haskells columns -> haskells -> columns
forall haskells columns.
Constant haskells columns -> haskells -> columns
constantExplicit Constant haskells columns
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance D.Default Constant haskell (Column sql)
=> D.Default Constant (Maybe haskell) (Column (C.Nullable sql)) where
def :: Constant (Maybe haskell) (Column (Nullable sql))
def = (Maybe haskell -> Column (Nullable sql))
-> Constant (Maybe haskell) (Column (Nullable sql))
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant (Maybe (Column sql) -> Column (Nullable sql)
forall a. Maybe (Column a) -> Column (Nullable a)
C.maybeToNullable (Maybe (Column sql) -> Column (Nullable sql))
-> (Maybe haskell -> Maybe (Column sql))
-> Maybe haskell
-> Column (Nullable sql)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (haskell -> Column sql) -> Maybe haskell -> Maybe (Column sql)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap haskell -> Column sql
f)
where Constant haskell -> Column sql
f = Constant haskell (Column sql)
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
instance D.Default Constant Int (Column T.SqlInt) where
def :: Constant Int (Column SqlInt)
def = (Int -> Column SqlInt) -> Constant Int (Column SqlInt)
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant Int -> Column SqlInt
T.sqlInt
instance D.Default Constant String (Column T.SqlText) where
def :: Constant String (Column SqlText)
def = (String -> Column SqlText) -> Constant String (Column SqlText)
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant String -> Column SqlText
T.sqlString
instance D.Default Constant ST.Text (Column T.SqlText) where
def :: Constant Text (Column SqlText)
def = (Text -> Column SqlText) -> Constant Text (Column SqlText)
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant Text -> Column SqlText
T.sqlStrictText
instance D.Default Constant LT.Text (Column T.SqlText) where
def :: Constant Text (Column SqlText)
def = (Text -> Column SqlText) -> Constant Text (Column SqlText)
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant Text -> Column SqlText
T.sqlLazyText
instance D.Default Constant Double (Column T.SqlReal) where
def :: Constant Double (Column SqlReal)
def = (Double -> Column SqlReal) -> Constant Double (Column SqlReal)
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant Double -> Column SqlReal
T.sqlReal
instance D.Default Constant Bool (Column T.SqlBool) where
def :: Constant Bool (Column SqlBool)
def = (Bool -> Column SqlBool) -> Constant Bool (Column SqlBool)
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant Bool -> Column SqlBool
T.sqlBool
instance Functor (Constant a) where
fmap :: (a -> b) -> Constant a a -> Constant a b
fmap a -> b
f (Constant a -> a
g) = (a -> b) -> Constant a b
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant ((a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
g)
instance Applicative (Constant a) where
pure :: a -> Constant a a
pure = (a -> a) -> Constant a a
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant ((a -> a) -> Constant a a) -> (a -> a -> a) -> a -> Constant a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Constant a -> a -> b
f <*> :: Constant a (a -> b) -> Constant a a -> Constant a b
<*> Constant a -> a
x = (a -> b) -> Constant a b
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant (a -> a -> b
f (a -> a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> a
x)
instance P.Profunctor Constant where
dimap :: (a -> b) -> (c -> d) -> Constant b c -> Constant a d
dimap a -> b
f c -> d
g (Constant b -> c
h) = (a -> d) -> Constant a d
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant ((a -> b) -> (c -> d) -> (b -> c) -> a -> d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap a -> b
f c -> d
g b -> c
h)
instance PP.ProductProfunctor Constant where
empty :: Constant () ()
empty = (() -> ()) -> Constant () ()
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant () -> ()
forall (p :: * -> * -> *). ProductProfunctor p => p () ()
empty
Constant a -> b
f ***! :: Constant a b -> Constant a' b' -> Constant (a, a') (b, b')
***! Constant a' -> b'
g = ((a, a') -> (b, b')) -> Constant (a, a') (b, b')
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant (a -> b
f (a -> b) -> (a' -> b') -> (a, a') -> (b, b')
forall (p :: * -> * -> *) a b a' b'.
ProductProfunctor p =>
p a b -> p a' b' -> p (a, a') (b, b')
***! a' -> b'
g)
instance PP.SumProfunctor Constant where
Constant a -> b
f +++! :: Constant a b
-> Constant a' b' -> Constant (Either a a') (Either b b')
+++! Constant a' -> b'
g = (Either a a' -> Either b b')
-> Constant (Either a a') (Either b b')
forall haskells columns.
(haskells -> columns) -> Constant haskells columns
Constant (a -> b
f (a -> b) -> (a' -> b') -> 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')
+++! a' -> b'
g)