{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoFieldSelectors #-}
module Sq.Statement
( SQL
, sql
, Statement (..)
, readStatement
, writeStatement
, BoundStatement (..)
, bindStatement
) where
import Control.DeepSeq
import Control.Monad
import Data.Coerce
import Data.Functor.Contravariant
import Data.Profunctor
import Data.String
import Data.Text qualified as T
import Di.Df1 qualified as Di
import GHC.Records
import GHC.Show
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Prelude hiding (Read, log)
import Sq.Input
import Sq.Mode
import Sq.Output
newtype SQL = SQL T.Text
deriving newtype
( SQL -> SQL -> Bool
(SQL -> SQL -> Bool) -> (SQL -> SQL -> Bool) -> Eq SQL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQL -> SQL -> Bool
== :: SQL -> SQL -> Bool
$c/= :: SQL -> SQL -> Bool
/= :: SQL -> SQL -> Bool
Eq
, Eq SQL
Eq SQL =>
(SQL -> SQL -> Ordering)
-> (SQL -> SQL -> Bool)
-> (SQL -> SQL -> Bool)
-> (SQL -> SQL -> Bool)
-> (SQL -> SQL -> Bool)
-> (SQL -> SQL -> SQL)
-> (SQL -> SQL -> SQL)
-> Ord SQL
SQL -> SQL -> Bool
SQL -> SQL -> Ordering
SQL -> SQL -> SQL
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SQL -> SQL -> Ordering
compare :: SQL -> SQL -> Ordering
$c< :: SQL -> SQL -> Bool
< :: SQL -> SQL -> Bool
$c<= :: SQL -> SQL -> Bool
<= :: SQL -> SQL -> Bool
$c> :: SQL -> SQL -> Bool
> :: SQL -> SQL -> Bool
$c>= :: SQL -> SQL -> Bool
>= :: SQL -> SQL -> Bool
$cmax :: SQL -> SQL -> SQL
max :: SQL -> SQL -> SQL
$cmin :: SQL -> SQL -> SQL
min :: SQL -> SQL -> SQL
Ord
,
Int -> SQL -> ShowS
[SQL] -> ShowS
SQL -> String
(Int -> SQL -> ShowS)
-> (SQL -> String) -> ([SQL] -> ShowS) -> Show SQL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQL -> ShowS
showsPrec :: Int -> SQL -> ShowS
$cshow :: SQL -> String
show :: SQL -> String
$cshowList :: [SQL] -> ShowS
showList :: [SQL] -> ShowS
Show
, String -> SQL
(String -> SQL) -> IsString SQL
forall a. (String -> a) -> IsString a
$cfromString :: String -> SQL
fromString :: String -> SQL
IsString
, NonEmpty SQL -> SQL
SQL -> SQL -> SQL
(SQL -> SQL -> SQL)
-> (NonEmpty SQL -> SQL)
-> (forall b. Integral b => b -> SQL -> SQL)
-> Semigroup SQL
forall b. Integral b => b -> SQL -> SQL
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: SQL -> SQL -> SQL
<> :: SQL -> SQL -> SQL
$csconcat :: NonEmpty SQL -> SQL
sconcat :: NonEmpty SQL -> SQL
$cstimes :: forall b. Integral b => b -> SQL -> SQL
stimes :: forall b. Integral b => b -> SQL -> SQL
Semigroup
, SQL -> ()
(SQL -> ()) -> NFData SQL
forall a. (a -> ()) -> NFData a
$crnf :: SQL -> ()
rnf :: SQL -> ()
NFData
)
instance Di.ToMessage SQL where
message :: SQL -> Message
message = String -> Message
forall a. ToMessage a => a -> Message
Di.message (String -> Message) -> (SQL -> String) -> SQL -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> String
forall a. Show a => a -> String
show
instance HasField "text" SQL T.Text where getField :: SQL -> Text
getField = SQL -> Text
forall a b. Coercible a b => a -> b
coerce
sql :: QuasiQuoter
sql :: QuasiQuoter
sql =
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = \String
s -> [|fromString @SQL s|]
, quotePat :: String -> Q Pat
quotePat = \String
_ -> String -> Q Pat
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sql: No quotePat"
, quoteType :: String -> Q Type
quoteType = \String
_ -> String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sql: No quoteType"
, quoteDec :: String -> Q [Dec]
quoteDec = \String
_ -> String -> Q [Dec]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sql: No quoteDec"
}
data Statement (s :: Mode) i o = Statement
{ forall (s :: Mode) i o. Statement s i o -> Input i
input :: Input i
, forall (s :: Mode) i o. Statement s i o -> Output o
output :: Output o
, forall (s :: Mode) i o. Statement s i o -> SQL
sql :: SQL
}
instance Show (Statement s i o) where
showsPrec :: Int -> Statement s i o -> ShowS
showsPrec Int
n Statement s i o
s =
Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Statement{sql = "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> ShowS
forall a. Show a => a -> ShowS
shows Statement s i o
s.sql
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", input = .., output = ..}"
readStatement :: Input i -> Output o -> SQL -> Statement 'Read i o
readStatement :: forall i o. Input i -> Output o -> SQL -> Statement 'Read i o
readStatement = Input i -> Output o -> SQL -> Statement 'Read i o
forall (s :: Mode) i o.
Input i -> Output o -> SQL -> Statement s i o
Statement
{-# INLINE readStatement #-}
writeStatement :: Input i -> Output o -> SQL -> Statement 'Write i o
writeStatement :: forall i o. Input i -> Output o -> SQL -> Statement 'Write i o
writeStatement = Input i -> Output o -> SQL -> Statement 'Write i o
forall (s :: Mode) i o.
Input i -> Output o -> SQL -> Statement s i o
Statement
{-# INLINE writeStatement #-}
instance Functor (Statement s i) where
fmap :: forall a b. (a -> b) -> Statement s i a -> Statement s i b
fmap = (a -> b) -> Statement s i a -> Statement s i b
forall b c a. (b -> c) -> Statement s a b -> Statement s a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap
{-# INLINE fmap #-}
instance Profunctor (Statement s) where
dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Statement s b c -> Statement s a d
dimap a -> b
f c -> d
g (Statement Input b
i Output c
o SQL
s) = Input a -> Output d -> SQL -> Statement s a d
forall (s :: Mode) i o.
Input i -> Output o -> SQL -> Statement s i o
Statement (a -> b
f (a -> b) -> Input b -> Input a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Input b
i) (c -> d
g (c -> d) -> Output c -> Output d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output c
o) SQL
s
{-# INLINE dimap #-}
data BoundStatement (s :: Mode) o = BoundStatement
{ forall (s :: Mode) o. BoundStatement s o -> BoundInput
input :: BoundInput
, forall (s :: Mode) o. BoundStatement s o -> Output o
output :: Output o
, forall (s :: Mode) o. BoundStatement s o -> SQL
sql :: SQL
}
instance Show (BoundStatement s o) where
showsPrec :: Int -> BoundStatement s o -> ShowS
showsPrec Int
n BoundStatement s o
s =
Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Statement{sql = "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> ShowS
forall a. Show a => a -> ShowS
shows BoundStatement s o
s.sql
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", input = "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundInput -> ShowS
forall a. Show a => a -> ShowS
shows BoundStatement s o
s.input
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", output = ..}"
bindStatement :: Statement s i o -> i -> Either ErrInput (BoundStatement s o)
bindStatement :: forall (s :: Mode) i o.
Statement s i o -> i -> Either ErrInput (BoundStatement s o)
bindStatement Statement s i o
st i
i = do
BoundInput
bi <- Input i -> i -> Either ErrInput BoundInput
forall i. Input i -> i -> Either ErrInput BoundInput
bindInput Statement s i o
st.input i
i
BoundStatement s o -> Either ErrInput (BoundStatement s o)
forall a. a -> Either ErrInput a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoundStatement{input :: BoundInput
input = BoundInput
bi, output :: Output o
output = Statement s i o
st.output, sql :: SQL
sql = Statement s i o
st.sql}
{-# INLINE bindStatement #-}