{-# LANGUAGE NamedFieldPuns #-}
-- | Parameter substitution for the Untyped SQL AST.

module Preql.QuasiQuoter.Syntax.Params where

import Preql.QuasiQuoter.Syntax.Syntax

import Control.Monad.Trans.State
import Data.Generics
import Data.Text (Text)

numberAntiquotes :: Word -> Statement -> (Statement, AntiquoteState)
numberAntiquotes :: Word -> Statement -> (Statement, AntiquoteState)
numberAntiquotes Word
count Statement
q =
    let (Statement
rewritten, AntiquoteState
aqs) = State AntiquoteState Statement
-> AntiquoteState -> (Statement, AntiquoteState)
forall s a. State s a -> s -> (a, s)
runState
                   (GenericM (StateT AntiquoteState Identity)
-> Statement -> State AntiquoteState Statement
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
everywhereM ((Expr -> StateT AntiquoteState Identity Expr)
-> a -> StateT AntiquoteState Identity a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
mkM Expr -> StateT AntiquoteState Identity Expr
numberAntiquotesExpr) Statement
q)
                   (Word -> [Text] -> AntiquoteState
AntiquoteState Word
count [])
    in (Statement
rewritten, AntiquoteState
aqs { haskellExpressions :: [Text]
haskellExpressions = [Text] -> [Text]
forall a. [a] -> [a]
reverse (AntiquoteState -> [Text]
haskellExpressions AntiquoteState
aqs) })

numberAntiquotesExpr :: Expr -> State AntiquoteState Expr
numberAntiquotesExpr :: Expr -> StateT AntiquoteState Identity Expr
numberAntiquotesExpr (HaskellParam Text
txt) = do
    AntiquoteState { Word
paramCount :: AntiquoteState -> Word
paramCount :: Word
paramCount, [Text]
haskellExpressions :: [Text]
haskellExpressions :: AntiquoteState -> [Text]
haskellExpressions } <- StateT AntiquoteState Identity AntiquoteState
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let i :: Word
i = Word
paramCount Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1
    AntiquoteState -> StateT AntiquoteState Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Word -> [Text] -> AntiquoteState
AntiquoteState Word
i (Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
haskellExpressions))
    Expr -> StateT AntiquoteState Identity Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Expr
NumberedParam Word
i)
numberAntiquotesExpr Expr
expr = Expr -> StateT AntiquoteState Identity Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
expr

-- invariant: paramCount = length haskellExpressions
data AntiquoteState = AntiquoteState
    { AntiquoteState -> Word
paramCount :: Word
    , AntiquoteState -> [Text]
haskellExpressions :: [Text]
    } deriving (Int -> AntiquoteState -> ShowS
[AntiquoteState] -> ShowS
AntiquoteState -> String
(Int -> AntiquoteState -> ShowS)
-> (AntiquoteState -> String)
-> ([AntiquoteState] -> ShowS)
-> Show AntiquoteState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AntiquoteState] -> ShowS
$cshowList :: [AntiquoteState] -> ShowS
show :: AntiquoteState -> String
$cshow :: AntiquoteState -> String
showsPrec :: Int -> AntiquoteState -> ShowS
$cshowsPrec :: Int -> AntiquoteState -> ShowS
Show, AntiquoteState -> AntiquoteState -> Bool
(AntiquoteState -> AntiquoteState -> Bool)
-> (AntiquoteState -> AntiquoteState -> Bool) -> Eq AntiquoteState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AntiquoteState -> AntiquoteState -> Bool
$c/= :: AntiquoteState -> AntiquoteState -> Bool
== :: AntiquoteState -> AntiquoteState -> Bool
$c== :: AntiquoteState -> AntiquoteState -> Bool
Eq, Eq AntiquoteState
Eq AntiquoteState
-> (AntiquoteState -> AntiquoteState -> Ordering)
-> (AntiquoteState -> AntiquoteState -> Bool)
-> (AntiquoteState -> AntiquoteState -> Bool)
-> (AntiquoteState -> AntiquoteState -> Bool)
-> (AntiquoteState -> AntiquoteState -> Bool)
-> (AntiquoteState -> AntiquoteState -> AntiquoteState)
-> (AntiquoteState -> AntiquoteState -> AntiquoteState)
-> Ord AntiquoteState
AntiquoteState -> AntiquoteState -> Bool
AntiquoteState -> AntiquoteState -> Ordering
AntiquoteState -> AntiquoteState -> AntiquoteState
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
min :: AntiquoteState -> AntiquoteState -> AntiquoteState
$cmin :: AntiquoteState -> AntiquoteState -> AntiquoteState
max :: AntiquoteState -> AntiquoteState -> AntiquoteState
$cmax :: AntiquoteState -> AntiquoteState -> AntiquoteState
>= :: AntiquoteState -> AntiquoteState -> Bool
$c>= :: AntiquoteState -> AntiquoteState -> Bool
> :: AntiquoteState -> AntiquoteState -> Bool
$c> :: AntiquoteState -> AntiquoteState -> Bool
<= :: AntiquoteState -> AntiquoteState -> Bool
$c<= :: AntiquoteState -> AntiquoteState -> Bool
< :: AntiquoteState -> AntiquoteState -> Bool
$c< :: AntiquoteState -> AntiquoteState -> Bool
compare :: AntiquoteState -> AntiquoteState -> Ordering
$ccompare :: AntiquoteState -> AntiquoteState -> Ordering
$cp1Ord :: Eq AntiquoteState
Ord)

initialAntiquoteState :: AntiquoteState
initialAntiquoteState :: AntiquoteState
initialAntiquoteState = Word -> [Text] -> AntiquoteState
AntiquoteState Word
0 []

-- | Return the highest-numbered $1-style parameter.
maxParam :: Statement -> Word
maxParam :: Statement -> Word
maxParam = (Word -> Word -> Word) -> GenericQ Word -> GenericQ Word
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> (Expr -> Word) -> a -> Word
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Word
0 Expr -> Word
maxParamExpr)

maxParamExpr :: Expr -> Word
maxParamExpr :: Expr -> Word
maxParamExpr Expr
expr = case Expr
expr of
    NumberedParam Word
i -> Word
i
    HaskellParam Text
_ -> Word
0
    BinOp BinOp
_ Expr
l Expr
r     -> Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Expr -> Word
maxParamExpr Expr
l) (Expr -> Word
maxParamExpr Expr
r)
    Unary UnaryOp
_ Expr
e       -> Expr -> Word
maxParamExpr Expr
e
    Lit Literal
_           -> Word
0
    CRef Name
_ -> Word
0
    Indirection Expr
e NonEmpty Name
_ -> Expr -> Word
maxParamExpr Expr
e
    SelectExpr SelectStmt
stmt -> (Word -> Word -> Word) -> GenericQ Word -> SelectStmt -> Word
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> (Expr -> Word) -> a -> Word
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Word
0 Expr -> Word
maxParamExpr) SelectStmt
stmt
    L LikeE
likeE -> (Word -> Word -> Word) -> GenericQ Word -> LikeE -> Word
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> (Expr -> Word) -> a -> Word
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Word
0 Expr -> Word
maxParamExpr) LikeE
likeE
    -- L LikeE {string, likePattern, escape} -> maybe id (max . maxParamExpr) escape
    --   (max (maxParamExpr string) (maxParamExpr likePattern))
    Fun FunctionApplication
f -> (Word -> Word -> Word)
-> GenericQ Word -> FunctionApplication -> Word
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> (Expr -> Word) -> a -> Word
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Word
0 Expr -> Word
maxParamExpr) FunctionApplication
f
    Cas Case
cas -> (Word -> Word -> Word) -> GenericQ Word -> Case -> Word
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything Word -> Word -> Word
forall a. Ord a => a -> a -> a
max (Word -> (Expr -> Word) -> a -> Word
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ Word
0 Expr -> Word
maxParamExpr) Case
cas