module Network.MoHWS.Server.Options (
   T(Cons),
   serverRoot, configPath, inServerRoot,
   parse,
   ) where

import System.Console.GetOpt
          (getOpt, usageInfo,
           OptDescr(Option), ArgDescr(ReqArg), ArgOrder(Permute), )
import qualified System.FilePath as FilePath


data T =
   Cons {
      T -> FilePath
configFile :: FilePath,
      T -> FilePath
serverRoot :: FilePath
   }


options :: [OptDescr (T -> T)]
options :: [OptDescr (T -> T)]
options =
  FilePath
-> [FilePath] -> ArgDescr (T -> T) -> FilePath -> OptDescr (T -> T)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'f'] [FilePath
"config"] ((FilePath -> T -> T) -> FilePath -> ArgDescr (T -> T)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
path T
opt -> T
opt{configFile :: FilePath
configFile=FilePath
path}) FilePath
"filename")
     (FilePath
"default: \n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show (FilePath
"<server-root>/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
defltConfigFile)) OptDescr (T -> T) -> [OptDescr (T -> T)] -> [OptDescr (T -> T)]
forall a. a -> [a] -> [a]
:
  FilePath
-> [FilePath] -> ArgDescr (T -> T) -> FilePath -> OptDescr (T -> T)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'd'] [FilePath
"server-root"] ((FilePath -> T -> T) -> FilePath -> ArgDescr (T -> T)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
path T
opt -> T
opt{serverRoot :: FilePath
serverRoot=FilePath
path}) FilePath
"directory")
     (FilePath
"default: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
defltServerRoot) OptDescr (T -> T) -> [OptDescr (T -> T)] -> [OptDescr (T -> T)]
forall a. a -> [a] -> [a]
:
  []

usage :: String
usage :: FilePath
usage = FilePath
"usage: hws [option...]"

defltConfigFile :: FilePath
defltConfigFile :: FilePath
defltConfigFile = FilePath
"conf/httpd.conf"

defltServerRoot :: FilePath
defltServerRoot :: FilePath
defltServerRoot = FilePath
"."

deflt :: T
deflt :: T
deflt =
   Cons :: FilePath -> FilePath -> T
Cons {
      configFile :: FilePath
configFile = FilePath
defltConfigFile,
      serverRoot :: FilePath
serverRoot = FilePath
defltServerRoot
   }

configPath :: T -> FilePath
configPath :: T -> FilePath
configPath T
opts =
   T -> FilePath -> FilePath
inServerRoot T
opts (T -> FilePath
configFile T
opts)

inServerRoot :: T -> FilePath -> FilePath
inServerRoot :: T -> FilePath -> FilePath
inServerRoot T
opts =
   FilePath -> FilePath -> FilePath
FilePath.combine (T -> FilePath
serverRoot T
opts)

-- returns error message or options
parse :: [String] -> Either String T
parse :: [FilePath] -> Either FilePath T
parse [FilePath]
args =
    case ArgOrder (T -> T)
-> [OptDescr (T -> T)]
-> [FilePath]
-> ([T -> T], [FilePath], [FilePath])
forall a.
ArgOrder a
-> [OptDescr a] -> [FilePath] -> ([a], [FilePath], [FilePath])
getOpt ArgOrder (T -> T)
forall a. ArgOrder a
Permute [OptDescr (T -> T)]
options [FilePath]
args of
      ([T -> T]
flags, [], [])   -> T -> Either FilePath T
forall a b. b -> Either a b
Right (T -> Either FilePath T) -> T -> Either FilePath T
forall a b. (a -> b) -> a -> b
$ (T -> (T -> T) -> T) -> T -> [T -> T] -> T
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((T -> T) -> T -> T) -> T -> (T -> T) -> T
forall a b c. (a -> b -> c) -> b -> a -> c
flip (T -> T) -> T -> T
forall a b. (a -> b) -> a -> b
($)) T
deflt [T -> T]
flags
      ([T -> T]
_,     [FilePath]
_,  [FilePath]
errs) -> FilePath -> Either FilePath T
forall a b. a -> Either a b
Left ([FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath]
errs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
                                 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [OptDescr (T -> T)] -> FilePath
forall a. FilePath -> [OptDescr a] -> FilePath
usageInfo FilePath
usage [OptDescr (T -> T)]
options)