lucienne-0.0.1: Lucienne/Args.hs

module Lucienne.Args
  (Args (..), getArgs, dbConnectionString)
where

import           Control.Monad (when)
import           System.Console.GetOpt
import qualified System.Environment as Env
import           Data.List (intercalate)

data Args = Args { applicationPort :: Int
                 , databaseHost    :: String
                 , databasePort    :: Int
                 }

defaultArgs :: Args
defaultArgs = Args 8000 "127.0.0.1" 27017

options :: [OptDescr (Args -> Args)]
options =
 [ Option ['p'] ["port"]
    (ReqArg (\a args -> args { applicationPort = read a }) "PORT")
    "Port of incoming requests"
 , Option ['d'] ["databaseHost"]
    (ReqArg (\a args -> args { databaseHost = a }) "HOST")
    "Database host"
 , Option ['e'] ["databasePort"]
    (ReqArg (\a args -> args { databasePort = read a }) "PORT")
    "Database port"
 , Option ['h'] ["help"]
    (NoArg (\_ -> error $ usageInfo "" options))
    "Print this help"
 ]

getArgs :: IO Args
getArgs = do
  cmdArgs <- Env.getArgs
  case getOpt RequireOrder options cmdArgs of
    (o,n,[]) ->
      do when (not $ null n) $ putStrLn $ "Omitting arguments " ++ (intercalate "," n)
         return $ foldr ($) defaultArgs o 
    (_,_,errors) -> error $ concat errors ++ usageInfo "" options

dbConnectionString :: Args -> String
dbConnectionString args = databaseHost args ++ ":" ++ (show $ databasePort args)