{-# LANGUAGE RecordWildCards #-}
module Clckwrks.GetOpts where

import Control.Applicative   ((<$>))
import Clckwrks.Monad        (ClckwrksConfig(..), TLSSettings(..))
import Data.Maybe            (fromMaybe)
import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt, usageInfo)
import System.Directory      (doesFileExist)
import System.Exit           (exitFailure, exitSuccess)

------------------------------------------------------------------------------
-- Command line options
------------------------------------------------------------------------------

-- | command-line Flags
data Flag
    = ModifyConfig (ClckwrksConfig -> ClckwrksConfig)
    | Help
    | Version

-- | Flag selectors
isHelp, isVersion :: Flag -> Bool
isHelp    flag = case flag of Help    -> True; _ -> False
isVersion flag = case flag of Version -> True; _ -> False

-- | Command line options.
clckwrksOpts :: ClckwrksConfig -> [OptDescr Flag]
clckwrksOpts def =
    [ Option [] ["help"]          (NoArg Help)                    "Display this help message"
    , Option [] ["http-port"]     (ReqArg setPort "port")         ("Port to bind http server, default: " ++ show (clckPort def))
    , Option [] ["https-port"]    (ReqArg setTLSPort "port")      ("Port to bind https server, default:" ++ maybe "disabled." show (clckTLSPort <$> (clckTLS def)))
    , Option [] ["tls-cert"]      (ReqArg setTLSCert "path")      ("Path to tls .cert file. (required for https).")
    , Option [] ["tls-key"]       (ReqArg setTLSKey "path")       ("Path to tls .key file. (required for https).")
    , Option [] ["tls-ca"]        (ReqArg setTLSCA "path")       ("Path to tls .pem file. (required for some certs).")
    , Option [] ["hide-port"]     (NoArg setHidePort)             "Do not show the port number in the URL"
    , Option [] ["hostname"]      (ReqArg setHostname "hostname") ("Server hostname, default: " ++ show (clckHostname def))
    , Option [] ["jquery-path"]   (ReqArg setJQueryPath   "path") ("path to jquery directory, default: " ++ show (clckJQueryPath def))
    , Option [] ["jqueryui-path"] (ReqArg setJQueryUIPath "path") ("path to jqueryui directory, default: " ++ show (clckJQueryUIPath def))
    , Option [] ["jstree-path"]   (ReqArg setJSTreePath   "path") ("path to jstree directory, default: " ++ show (clckJSTreePath def))
    , Option [] ["json2-path"]    (ReqArg setJSON2Path    "path") ("path to json2 directory, default: " ++ show (clckJSON2Path def))
    , Option [] ["top"]           (ReqArg setTopDir       "path") ("path to directory that holds the state directory, uploads, etc")
    , Option [] ["enable-analytics"] (NoArg setAnalytics)         "enable google analytics tracking"
    ]
    where
      nullTLSSettings     = TLSSettings { clckTLSPort = 443
                                        , clckTLSCert = ""
                                        , clckTLSKey  = ""
                                        , clckTLSCA   = Nothing
                                        }
      modifyTLS f cc =
          Just $ case clckTLS cc of
            Nothing -> f nullTLSSettings
            (Just tls) -> f tls
      noop            _   = ModifyConfig $ id
      setPort         str = ModifyConfig $ \c -> c { clckPort         = read str }
      setTLSPort      str = ModifyConfig $ \c -> c { clckTLS          = modifyTLS (\tls -> tls { clckTLSPort = read str }) c }
      setTLSCert      str = ModifyConfig $ \c -> c { clckTLS          = modifyTLS (\tls -> tls { clckTLSCert = str }) c }
      setTLSKey       str = ModifyConfig $ \c -> c { clckTLS          = modifyTLS (\tls -> tls { clckTLSKey = str }) c }
      setTLSCA        str = ModifyConfig $ \c -> c { clckTLS          = modifyTLS (\tls -> tls { clckTLSCA = Just str }) c }
      setHostname     str = ModifyConfig $ \c -> c { clckHostname     = str      }
      setHidePort         = ModifyConfig $ \c -> c { clckHidePort     = True     }
      setJQueryPath   str = ModifyConfig $ \c -> c { clckJQueryPath   = str      }
      setJQueryUIPath str = ModifyConfig $ \c -> c { clckJQueryUIPath = str      }
      setJSTreePath   str = ModifyConfig $ \c -> c { clckJSTreePath   = str      }
      setJSON2Path    str = ModifyConfig $ \c -> c { clckJSON2Path    = str      }
      setTopDir       str = ModifyConfig $ \c -> c { clckTopDir       = Just str }
      setAnalytics        = ModifyConfig $ \c -> c { clckEnableAnalytics = True  }

-- | Parse the command line arguments into a list of flags. Exits with usage
-- message, in case of failure.
parseArgs :: [OptDescr Flag] -> [String] -> IO (ClckwrksConfig -> IO ClckwrksConfig)
parseArgs opts args =
    do case getOpt Permute opts args of
         (flags,_,[]) ->
             if any isHelp flags
             then do putStr (helpMessage opts)
                     exitSuccess
             else do let f config = checkTLS $ foldr (.) id [f | (ModifyConfig f) <- flags ] config
                     return f
         (_,_,errs)   ->
             do putStr ("Failure while parsing command line:\n"++unlines errs)
                putStr (helpMessage opts)
                exitFailure
    where
      checkTLS cc =
          case clckTLS cc of
            Nothing -> return cc
            (Just TLSSettings{..}) ->
                do mCertError <-
                       if null clckTLSCert
                          then return (Just "--tls-cert not set.")
                          else do b <- doesFileExist clckTLSCert
                                  if b
                                     then return Nothing
                                     else return (Just $ "Can not find the file " ++ clckTLSCert)
                   mKeyError <-
                       if null clckTLSKey
                          then return (Just "--tls-key not set.")
                          else do b <- doesFileExist clckTLSKey
                                  if b
                                     then return Nothing
                                     else return (Just $ "Can not find the file " ++ clckTLSKey)
                   case (mCertError, mKeyError) of
                     (Nothing, Nothing) -> return cc
                     _ -> do putStrLn "It seems you are trying to enable https support. To do that you need to use both the --tls-cert and --tls-key flags."
                             putStrLn $ unlines [fromMaybe "" mCertError, fromMaybe "" mKeyError]
                             putStrLn $ helpMessage opts
                             exitFailure

-- | A simple usage message listing all flags possible.
helpMessage :: [OptDescr Flag] -> String
helpMessage opts =
    usageInfo header opts
    where
      header = "Usage: clckwrks [OPTION...]"