{-| Module : Database.Persist.Migration.Utils.Sql Maintainer : Brandon Chinn Stability : experimental Portability : portable Defines helper functions for writing SQL queries. -} {-# LANGUAGE CPP #-} {-# 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(..)) #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif import Data.Text (Text) import qualified Data.Text as Text import Database.Persist.Sql (PersistValue(..), SqlPersistT) import qualified Database.Persist.Sql as Persist -- | Split the given line by commas, ignoring commas within parentheses. -- -- > commas "a,b,c" == ["a", "b", "c"] -- > commas "a,b,c (d,e),z" == ["a", "b", "c (d,e)", "z"] -- > commas "a,b,c (d,e,(f,g)),z" == ["a", "b", "c (d,e,(f,g))", "z"] 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 -- | Join the given Text with commas separating each item. uncommas :: [Text] -> Text uncommas = Text.intercalate "," -- | Join the given Text with commas separating each item and quoting them. uncommas' :: [Text] -> Text uncommas' = uncommas . map quote -- | Quote the given Text. quote :: Text -> Text quote t = "\"" <> t <> "\"" -- | A SQL query (with placeholders) and values to replace those placeholders. data MigrateSql = MigrateSql { sqlText :: Text , sqlVals :: [PersistValue] } deriving (Show) -- | Execute a SQL query. executeSql :: MonadIO m => MigrateSql -> SqlPersistT m () executeSql MigrateSql{..} = Persist.rawExecute sqlText sqlVals -- | Create a MigrateSql from the given Text. pureSql :: Text -> MigrateSql pureSql sql = MigrateSql sql [] -- | Map the SQL text with the given function. mapSql :: (Text -> Text) -> MigrateSql -> MigrateSql mapSql f sql = sql { sqlText = f $ sqlText sql } -- | Concatenate the given MigrateSql queries with the given combining function. concatSql :: ([Text] -> Text) -> [MigrateSql] -> MigrateSql concatSql f queries = MigrateSql { sqlText = f $ map sqlText queries , sqlVals = concatMap sqlVals queries }