55 lines
1.9 KiB
Haskell
55 lines
1.9 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
module System.Serverman.Actions.MongoDB (mongodb) where
|
|
import System.Serverman.Actions.Database
|
|
import System.Serverman.Utils hiding (execute)
|
|
import Database.MongoDB
|
|
import qualified Data.ByteString.Char8 as BS
|
|
import Data.List hiding (delete)
|
|
import qualified Data.Text as T
|
|
import Control.Monad
|
|
import System.IO.Error
|
|
|
|
mongodb :: DatabaseParams -> IO ()
|
|
mongodb (DatabaseParams { database, dummyData, databaseHost }) = do
|
|
result <- tryIOError $ connect (readHostPort databaseHost)
|
|
|
|
case result of
|
|
Right pipe -> do
|
|
e <- access pipe master (T.pack database) run
|
|
|
|
close pipe
|
|
Left err -> do
|
|
putStrLn $ show err
|
|
putStrLn $ "[Error] could not connect to MongoDB server " ++ databaseHost
|
|
|
|
where
|
|
run = do
|
|
when dummyData $ do
|
|
clearCollection
|
|
insertToCollection
|
|
return ()
|
|
|
|
clearCollection = delete (select [] (T.pack collectionName))
|
|
where (collectionName, _, _) = dummy
|
|
|
|
insertToCollection = insertMany (T.pack collectionName) records
|
|
where
|
|
(collectionName, definitions, rows) = dummy
|
|
records = map (\row -> zipWith (\def value -> def =: row) (map T.pack definitions) row) rows
|
|
|
|
|
|
createDummyTables = createTable dummy
|
|
where
|
|
createTable (tableName, columns, rows) = "CREATE TABLE IF NOT EXISTS " ++ tableName ++ "(" ++ intercalate "," (map columnDef columns) ++ ")";
|
|
columnDef "children" = "children INT"
|
|
columnDef "birth_date" = "birth_date DATETIME"
|
|
columnDef "gender" = "gender ENUM('Male', 'Female')"
|
|
columnDef name = name ++ " VARCHAR(255)"
|
|
|
|
insertToDummyTables = insertTable dummy
|
|
where
|
|
insertTable (tableName, _, rows) = "INSERT INTO " ++ tableName ++ " VALUES " ++ intercalate "," (map insertRow rows)
|
|
insertRow row = "('" ++ intercalate "','" row ++ "')"
|
|
|