module Database.PostgreSQL.Store.Query.Builder (
QueryBuilder,
insertCode,
insertTypedValue,
insertValue,
insertValue',
insertQuote,
insertName,
insertCommaSeperated,
FromQueryBuilder (..)
) where
import Control.Monad.State.Strict
import Data.List
import qualified Data.ByteString as B
import Database.PostgreSQL.LibPQ (invalidOid)
import Database.PostgreSQL.Store.Types
import Database.PostgreSQL.Store.Utilities
data BuilderState = BuilderState {
queryCode :: B.ByteString,
queryIndex :: Word,
queryValues :: [TypedValue]
}
type QueryBuilder = State BuilderState ()
insertCode :: B.ByteString -> QueryBuilder
insertCode code =
modify (\ state -> state {queryCode = B.append (queryCode state) code})
insertTypedValue :: TypedValue -> QueryBuilder
insertTypedValue typedValue =
modify $ \ BuilderState {..} ->
BuilderState {
queryCode = B.concat [queryCode, B.singleton 36, showByteString queryIndex],
queryIndex = queryIndex + 1,
queryValues = queryValues ++ [typedValue]
}
insertValue :: Value -> QueryBuilder
insertValue value =
insertTypedValue (TypedValue invalidOid (Just value))
insertValue' :: B.ByteString -> Value -> QueryBuilder
insertValue' typ value = do
insertCode "("
insertValue value
insertCode "::"
insertCode typ
insertCode ")"
insertQuote :: B.ByteString -> QueryBuilder
insertQuote contents =
insertCode (B.concat [B.singleton 39,
B.concatMap replaceDelim contents,
B.singleton 39])
where
replaceDelim 39 = B.pack [39, 39]
replaceDelim x = B.singleton x
insertCommaSeperated :: [QueryBuilder] -> QueryBuilder
insertCommaSeperated bs =
sequence_ (intersperse (insertCode ",") bs)
insertName :: B.ByteString -> QueryBuilder
insertName name =
if isAllowed then
insertCode name
else
insertCode (B.concat [B.singleton 34,
B.intercalate (B.pack [34, 34]) (B.split 34 name),
B.singleton 34])
where
isAllowedHead b =
(b >= 97 && b <= 122)
|| (b >= 65 && b <= 90)
|| b == 95
isAllowedBody b =
isAllowedHead b
|| (b >= 48 && b <= 57)
isAllowed =
case B.uncons name of
Nothing -> True
Just (h, b) -> isAllowedHead h && B.all isAllowedBody b
class FromQueryBuilder a where
buildQuery :: QueryBuilder -> a
instance FromQueryBuilder QueryBuilder where
buildQuery = id
instance FromQueryBuilder B.ByteString where
buildQuery builder =
queryCode (execState builder (BuilderState B.empty 1 []))
instance FromQueryBuilder (B.ByteString, [TypedValue]) where
buildQuery builder =
(code, values)
where BuilderState code _ values = execState builder (BuilderState B.empty 1 [])
instance FromQueryBuilder (Query a) where
buildQuery builder =
Query code values
where BuilderState code _ values = execState builder (BuilderState B.empty 1 [])