{-# 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


-- { Boilerplate instances

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)

-- }