{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, CPP #-}
module Database.Selda.Query.Type where
import Control.Monad.State.Strict
#if !MIN_VERSION_base(4, 11, 0)
import Data.Monoid
#endif
import Data.Text (pack)
import Database.Selda.SQL
import Database.Selda.Column
import Database.Selda.Types (ColName, mkColName, addColSuffix)
type Scope = Int
type Ident = Int
data Name = Name Scope Ident
instance Show Name where
show (Name 0 n) = concat [show n]
show (Name s n) = concat [show s, "s_", show n]
newtype Query s a = Query {unQ :: State GenState a}
deriving (Functor, Applicative, Monad)
runQueryM :: Scope -> Query s a -> (a, GenState)
runQueryM scope = flip runState (initState scope) . unQ
isolate :: Query s a -> State GenState (GenState, a)
isolate (Query q) = do
st <- get
put $ (initState (nameScope st)) {nameSupply = nameSupply st}
x <- q
st' <- get
put $ st {nameSupply = nameSupply st'}
return (st', x)
data GenState = GenState
{ sources :: ![SQL]
, staticRestricts :: ![Exp SQL Bool]
, groupCols :: ![SomeCol SQL]
, nameSupply :: !Int
, nameScope :: !Int
}
initState :: Int -> GenState
initState scope = GenState
{ sources = []
, staticRestricts = []
, groupCols = []
, nameSupply = 0
, nameScope = scope
}
renameAll :: [UntypedCol sql] -> State GenState [SomeCol sql]
renameAll = fmap concat . mapM rename
rename :: UntypedCol sql -> State GenState [SomeCol sql]
rename (Untyped col) = do
n <- freshId
return [Named (newName n) col]
where
newName ns =
case col of
Col n -> addColSuffix n $ "_" <> pack (show ns)
_ -> mkColName $ "tmp_" <> pack (show ns)
freshId :: State GenState Name
freshId = do
st <- get
put $ st {nameSupply = succ $ nameSupply st}
return (Name (nameScope st) (nameSupply st))
freshName :: State GenState ColName
freshName = do
n <- freshId
return $ mkColName $ "tmp_" <> pack (show n)