{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Database.Persist.Migration.Utils.Sql
( commas
, uncommas
, uncommas'
, quote
, MigrateSql(..)
, executeSql
, pureSql
, mapSql
, concatSql
) where
import Control.Monad.IO.Class (MonadIO(..))
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as Text
import Database.Persist.Sql (PersistValue(..), SqlPersistT)
import qualified Database.Persist.Sql as Persist
commas :: Text -> [Text]
commas t = go (Text.unpack t) "" [] (0 :: Int)
where
go src buffer result level =
let result' = result ++ [Text.pack buffer]
in case src of
"" -> result'
',':xs | level == 0 -> go xs "" result' level
'(':xs -> go xs (buffer ++ "(") result (level + 1)
')':xs -> go xs (buffer ++ ")") result (max 0 $ level - 1)
x:xs -> go xs (buffer ++ [x]) result level
uncommas :: [Text] -> Text
uncommas = Text.intercalate ","
uncommas' :: [Text] -> Text
uncommas' = uncommas . map quote
quote :: Text -> Text
quote t = "\"" <> t <> "\""
data MigrateSql = MigrateSql
{ sqlText :: Text
, sqlVals :: [PersistValue]
} deriving (Show)
executeSql :: MonadIO m => MigrateSql -> SqlPersistT m ()
executeSql MigrateSql{..} = Persist.rawExecute sqlText sqlVals
pureSql :: Text -> MigrateSql
pureSql sql = MigrateSql sql []
mapSql :: (Text -> Text) -> MigrateSql -> MigrateSql
mapSql f sql = sql { sqlText = f $ sqlText sql }
concatSql :: ([Text] -> Text) -> [MigrateSql] -> MigrateSql
concatSql f queries = MigrateSql
{ sqlText = f $ map sqlText queries
, sqlVals = concatMap sqlVals queries
}