fix: help entry, logging

services/mysql/serverman-service-mysql.cabal

@@ -18,4 +18,5 @@ executable mysql
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , data-default-class
-                     , mysql >= 0.1.4 && < 1
+                     , mysql-haskell >= 0.1.4 && < 1
+                     , text 

services/mysql/src/Main.hs

@@ -1,54 +1,77 @@
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main (call, main) where
   import System.Serverman.Types
   import System.Serverman.Utils hiding (execute)
   import Types
 
-  import Database.MySQL.Base
+  import "mysql-haskell" Database.MySQL.Base
   import qualified Data.ByteString.Char8 as BS
+  import qualified Data.ByteString.Lazy as BL
+  import qualified Data.Text as T
   import Data.List
   import Control.Monad
-  import Control.Monad.State
+  import Control.Monad.State hiding (liftIO)
+
+  help :: App String
+  help = return $
+          mkHelp "mysql [--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
+    let params@(DatabaseParams { database, dummyData, user, pass, host, port }) = toDBParams arguments
+
+    servermanPort <- usingPort port
 
     liftIO $ do
-      conn <- connect $ defaultConnectInfo { connectUser = user, connectPassword = pass, connectHost = host }
+      conn <- connect $ defaultConnectInfo { ciUser = BS.pack user, ciPassword = BS.pack pass, ciHost = host, ciPort = read servermanPort }
 
-      query conn $ BS.pack ("CREATE DATABASE IF NOT EXISTS " ++ database)
-      
+      print $ renderParams "CREATE DATABASE IF NOT EXISTS ?" [One (MySQLText $ T.pack database)]
+
+      execute conn "CREATE DATABASE IF NOT EXISTS ?;" [One (MySQLText $ T.pack database)]
 
       when dummyData $ do
         let (tableName, _, _) = dummy
 
-        query conn $ BS.pack createDummyTables
-        query conn $ BS.pack clearTable
-        query conn $ BS.pack insertToDummyTables
+        execute_ conn createDummyTables
+        execute_ conn clearTable
+        execute_ conn insertToDummyTables
 
         putStrLn $ "Created dummy table '" ++ tableName ++ "' and filled it with data."
         return ()
 
+    clearPort servermanPort
+
     return ()
 
-  clearTable = "DELETE FROM " ++ tableName
+  clearTable :: Query
+  clearTable = renderParams "DELETE FROM ?" [One (MySQLBytes $ BS.pack tableName)]
     where (tableName, _, _) = dummy
 
+  createDummyTables :: Query
   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)"
+      createTable (tableName, columns, rows) = renderParams "CREATE TABLE IF NOT EXISTS ? (?)" [One (MySQLBytes $ BS.pack tableName), Many (map columnDef columns)]
+      columnDef "children" = MySQLText "children INT"
+      columnDef "birth_date" = MySQLText "birth_date DATETIME"
+      columnDef "gender" = MySQLText "gender ENUM('Male', 'Female')"
+      columnDef name = MySQLBytes (BL.toStrict . fromQuery $ renderParams "? VARCHAR(255)" [One (MySQLBytes $ BS.pack name)])
 
+  insertToDummyTables :: Query
   insertToDummyTables = insertTable dummy
     where
-      insertTable (tableName, _, rows) = "INSERT INTO " ++ tableName ++ " VALUES " ++ intercalate "," (map insertRow rows)
-      insertRow row = "('" ++ intercalate "','" row ++ "')"
+      insertTable (tableName, _, rows) = renderParams "INSERT INTO ? VALUES (?)" [One (MySQLBytes $ BS.pack tableName), Many (map insertRow rows)]
+      insertRow row = MySQLBytes (BL.toStrict . fromQuery $ renderParams "?" [Many $ map (MySQLBytes . BS.pack) row])
     
 
 

services/mysql/src/Types.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Types (DatabaseParams(..), toDBParams, dummy) where
   import System.Serverman.Utils
   
@@ -6,9 +8,11 @@ module Types (DatabaseParams(..), toDBParams, dummy) where
   toDBParams :: [(String, Maybe String)] -> DatabaseParams
   toDBParams (("database", Just value):xs) = (toDBParams xs) { database = value }
   toDBParams (("user", Just value):xs) = (toDBParams xs) { user = value }
-  toDBParams (("pass", Just value):xs) = (toDBParams xs) { pass = value }
+  toDBParams (("password", 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 (("port", Just value):xs) = (toDBParams xs) { port = value }
+  toDBParams (("dummy-data", Nothing):xs) = (toDBParams xs) { dummyData = True }
+  toDBParams (_:xs) = (toDBParams xs)
   toDBParams _ = def
 
   data DatabaseParams = DatabaseParams { database  :: String
@@ -16,6 +20,7 @@ module Types (DatabaseParams(..), toDBParams, dummy) where
                                        , user      :: String
                                        , pass      :: String
                                        , host      :: String
+                                       , port      :: String
                                        } deriving (Eq, Show)
 
   instance Default DatabaseParams where
@@ -24,6 +29,7 @@ module Types (DatabaseParams(..), toDBParams, dummy) where
                          , user      = "serverman"
                          , pass      = "serverman"
                          , host      = "localhost"
+                         , port      = "3306"
                          }
 
   dummy = ("serverman_users", ["first_name", "last_name", "email", "children", "birth_date", "gender"], [