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)
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 "
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
compileDropTable :: OnError -> Table a -> Text
compileDropTable Fail t = Text.unwords ["DROP TABLE",tableName t]
compileDropTable _ t = Text.unwords ["DROP TABLE IF EXISTS",tableName t]
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)
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 <> ")"
mkRow n ds cs = foldl' mkCols (n, []) (zip ds cs)
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))
mkCols (n, cols) (def, col) =
fmap (:cols) (mkCol n def col)
compileColAttr :: ColAttr -> Text
compileColAttr Primary = "PRIMARY KEY"
compileColAttr AutoIncrement = "AUTOINCREMENT"
compileColAttr Required = "NOT NULL"
compileColAttr Optional = "NULL"