module Database.SQLite.Simple.Interpolate (
isql,
iquery,
iexecute,
ifold,
quoteInterpolatedSql,
) where
import CustomInterpolation
import Data.Maybe (catMaybes)
import Data.String (fromString)
import Database.SQLite.Simple
import Database.SQLite.Simple.ToField (toField)
import GHC.OldList (intercalate)
import Language.Haskell.TH (Exp, Q, appE, listE, sigE, stringE, tupE, varE)
import Language.Haskell.TH.Quote (QuasiQuoter (..))
isql :: QuasiQuoter
isql :: QuasiQuoter
isql =
QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteInterpolatedSql,
quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"This quasiquoter does not support usage in patterns",
quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"This quasiquoter does not support usage in types",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"This quasiquoter does not support usage in declarations"
}
quoteInterpolatedSql :: String -> Q Exp
quoteInterpolatedSql :: String -> Q Exp
quoteInterpolatedSql =
InterpolationConfig (Maybe (Q Exp)) -> String -> Q Exp
forall a. InterpolationConfig a -> String -> Q Exp
interpolate
InterpolationConfig Any
forall a. InterpolationConfig a
defaultConfig
{ finalize :: ([Maybe (Q Exp)], Q Exp) -> Q Exp
finalize = ([Maybe (Q Exp)], Q Exp) -> Q Exp
consumeInterpolated,
handlers :: [Interpolator (Maybe (Q Exp))]
handlers =
[ Interpolator ()
simpleInterpolator
{ prefix :: String
prefix = String
"",
handler :: Q Exp -> (Maybe (Q Exp), Q Exp)
handler = \Q Exp
sqlFieldExpr -> (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
listE [Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'toField) Q Exp
sqlFieldExpr], [|"?"|])
},
Interpolator ()
simpleInterpolator
{ prefix :: String
prefix = String
"!",
handler :: Q Exp -> (Maybe (Q Exp), Q Exp)
handler = \Q Exp
stringExpr -> (Maybe (Q Exp)
forall a. Maybe a
Nothing, Q Exp
stringExpr)
},
Interpolator ()
simpleInterpolator
{ prefix :: String
prefix = String
"@",
handler :: Q Exp -> (Maybe (Q Exp), Q Exp)
handler = \Q Exp
sqlRowExpr ->
let sqlRow :: Q Exp
sqlRow = Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'toRow) Q Exp
sqlRowExpr
rowLength :: Q Exp
rowLength = Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'length) Q Exp
sqlRow
intercalateCommas :: Q Exp -> Q Exp
intercalateCommas = Q Exp -> Q Exp -> Q Exp
appE (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'intercalate) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Q Exp
stringE String
","
questionMarks :: Q Exp
questionMarks = Q Exp -> Q Exp
intercalateCommas (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Exp -> Q Exp
appE (Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'replicate) Q Exp
rowLength) [|"?"|]
questionMarksWithParens :: Q Exp
questionMarksWithParens = Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'concat) (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Q Exp] -> Q Exp
listE [String -> Q Exp
stringE String
"(", Q Exp
questionMarks, String -> Q Exp
stringE String
")"]
in (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
sqlRow, Q Exp
questionMarksWithParens)
}
]
}
consumeInterpolated :: ([Maybe (Q Exp)], Q Exp) -> Q Exp
consumeInterpolated :: ([Maybe (Q Exp)], Q Exp) -> Q Exp
consumeInterpolated ([Maybe (Q Exp)]
sqlDataExprs, Q Exp
queryStrExpr) = [Q Exp] -> Q Exp
tupE [Q Exp
queryStr, Q Exp
sqlData]
where
queryStr :: Q Exp
queryStr = Q Exp -> Q Exp -> Q Exp
appE [|fromString :: String -> Query|] Q Exp
queryStrExpr
sqlData :: Q Exp
sqlData = Q Exp -> Q Type -> Q Exp
sigE (Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'concat) ([Q Exp] -> Q Exp
listE [Q Exp]
sqlDataExprs')) [t|[SQLData]|]
sqlDataExprs' :: [Q Exp]
sqlDataExprs' = [Maybe (Q Exp)] -> [Q Exp]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Q Exp)]
sqlDataExprs
iquery :: QuasiQuoter
iquery :: QuasiQuoter
iquery = QuasiQuoter
isql {quoteExp :: String -> Q Exp
quoteExp = Q Exp -> Q Exp -> Q Exp
appE [|\(q, qs) c -> query c q qs|] (Q Exp -> Q Exp) -> (String -> Q Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q Exp
quoteInterpolatedSql}
iexecute :: QuasiQuoter
iexecute :: QuasiQuoter
iexecute = QuasiQuoter
isql {quoteExp :: String -> Q Exp
quoteExp = Q Exp -> Q Exp -> Q Exp
appE [|\(q, qs) c -> execute c q qs|] (Q Exp -> Q Exp) -> (String -> Q Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q Exp
quoteInterpolatedSql}
ifold :: QuasiQuoter
ifold :: QuasiQuoter
ifold = QuasiQuoter
isql {quoteExp :: String -> Q Exp
quoteExp = Q Exp -> Q Exp -> Q Exp
appE [|\(q, qs) acc f c -> fold c q qs acc f|] (Q Exp -> Q Exp) -> (String -> Q Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q Exp
quoteInterpolatedSql}