{-# LANGUAGE OverloadedStrings #-} -- | Generating SQL for creating and deleting tables. module Database.Selda.Table.Compile where import Database.Selda.Table import Data.List (foldl') import Data.Monoid import Data.Text (Text, intercalate, pack) import qualified Data.Text as Text data OnError = Fail | Ignore deriving (Eq, Ord, Show) -- | Compile a @CREATE TABLE@ query from a table definition. compileCreateTable :: (Text -> [ColAttr] -> Maybe Text) -> OnError -> Table a -> Text compileCreateTable customColType ifex tbl = mconcat [ "CREATE TABLE ", ifNotExists ifex, tableName tbl, "(" , intercalate ", " (map (compileTableCol customColType) (tableCols tbl)) , ")" ] where ifNotExists Fail = "" ifNotExists Ignore = "IF NOT EXISTS " -- | Compile a table column. compileTableCol :: (Text -> [ColAttr] -> Maybe Text) -> ColInfo -> Text compileTableCol customColType ci = Text.unwords [ colName ci , case customColType typ attrs of Just s -> s _ -> typ <> " " <> Text.unwords (map compileColAttr attrs) ] where typ = colType ci attrs = colAttrs ci -- | Compile a @DROP TABLE@ query. compileDropTable :: OnError -> Table a -> Text compileDropTable Fail t = Text.unwords ["DROP TABLE",tableName t] compileDropTable _ t = Text.unwords ["DROP TABLE IF EXISTS",tableName t] -- | Compile an @INSERT INTO@ query inserting @m@ rows with @n@ cols each. -- Note that backends expect insertions to NOT have a semicolon at the end. compInsert :: Text -> Table a -> [[Bool]] -> Text compInsert defaultKeyword tbl defs = Text.unwords ["INSERT INTO", tableName tbl, names, "VALUES", values] where colNames = map colName $ tableCols tbl names = "(" <> Text.intercalate ", " colNames <> ")" values = Text.intercalate ", " (mkRows (1 :: Int) defs) -- Build all rows: just recurse over the list of defaults (which encodes -- the # of elements in total as well), building each row, keeping track -- of the next parameter identifier. mkRows n (ds:dss) = case mkRow n ds (tableCols tbl) of (n', vals) -> mkRowText (reverse vals) : mkRows n' dss mkRows _ _ = [] mkRowText vals = "(" <> Text.intercalate ", " vals <> ")" -- Build a row: use the NULL/DEFAULT keyword for default rows, otherwise -- use a parameter. mkRow n ds cs = foldl' mkCols (n, []) (zip ds cs) -- Build a column: default values only available for for auto-incrementing -- primary keys. mkCol n def col | def && not (AutoIncrement `elem` colAttrs col) = error "only auto-incrementing primary keys may have defaults" | def = (n, defaultKeyword) | otherwise = (n+1, pack ('$':show n)) -- Create a colum and return the next parameter id, plus the column itself. mkCols (n, cols) (def, col) = fmap (:cols) (mkCol n def col) -- | Compile a column attribute. compileColAttr :: ColAttr -> Text compileColAttr Primary = "PRIMARY KEY" compileColAttr AutoIncrement = "AUTOINCREMENT" compileColAttr Required = "NOT NULL" compileColAttr Optional = "NULL"