fix: help entry, logging

services/mongodb/src/Main.hs

@@ -2,61 +2,57 @@
 module Main (call, main) where
   import System.Serverman.Types
   import System.Serverman.Utils hiding (execute)
-  import Database.MongoDB
+  import Types
+
+  import qualified Database.MongoDB as DB
   import qualified Data.ByteString.Char8 as BS
   import Data.List hiding (delete)
   import qualified Data.Text as T
   import Control.Monad
-  import Control.Monad.State
+  import Control.Monad.State hiding (liftIO)
   import System.IO.Error
 
+  help :: App String
+  help = return $
+          mkHelp "mongodb [--options]"
+                  [ ("--database <name>", "database name, default: serverman")
+                  , ("--user <username>", "database username, default: serverman")
+                  , ("--password <password>", "database password, default: serverman")
+                  , ("--host <domain>", "database hostname")
+                  , ("--port <num>", "database port number")
+                  , ("--dummy-data", "insert dummy data into database")]
+
   call :: Service -> App ()
   call s@(Service { name, version, service })= do
     (AppState { arguments }) <- get
 
     let params@(DatabaseParams { database, dummyData, user, pass, host }) = toDBParams arguments
+        run = do
+          when dummyData $ do
+            clearCollection
+            insertToCollection
+            return ()
     
     liftIO $ do
-      result <- tryIOError $ connect (readHostPort databaseHost)
+      result <- tryIOError $ DB.connect (DB.readHostPort host)
 
       case result of
         Right pipe -> do
-          e <- access pipe master (T.pack database) run
+          e <- DB.access pipe DB.master (T.pack database) run
 
-          close pipe
+          DB.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 ()
+          putStrLn $ "[Error] could not connect to MongoDB server " ++ host
 
-      clearCollection = delete (select [] (T.pack collectionName))
+    where
+      clearCollection = DB.delete (DB.select [] (T.pack collectionName))
         where (collectionName, _, _) = dummy
 
-      insertToCollection = insertMany (T.pack collectionName) records
+      insertToCollection = DB.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 ++ "')"
-    
+          records = map (\row -> zipWith (\def value -> def DB.=: row) (map T.pack definitions) row) rows
 
   main :: IO ()
   main = return ()

services/mongodb/src/Types.hs

@@ -9,6 +9,7 @@ module Types (DatabaseParams(..), toDBParams, dummy) where
   toDBParams (("pass", Just value):xs) = (toDBParams xs) { pass = value }
   toDBParams (("host", Just value):xs) = (toDBParams xs) { host = value }
   toDBParams (("dummy-data", Just value):xs) = (toDBParams xs) { dummyData = True }
+  toDBParams (_:xs) = (toDBParams xs)
   toDBParams _ = def
 
   data DatabaseParams = DatabaseParams { database  :: String