{-# Language TemplateHaskell, MultiWayIf #-}
module Client.Options
(
Options(..)
, optConfigFile
, optInitialNetworks
, optNoConnect
, getOptions
) where
import Control.Lens
import Data.Foldable
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Version
import Development.GitRev (gitHash, gitDirty)
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.IO
import Paths_glirc (version)
data Options = Options
{ _optConfigFile :: Maybe FilePath
, _optInitialNetworks :: [Text]
, _optNoConnect :: Bool
, _optShowHelp :: Bool
, _optShowVersion :: Bool
}
makeLenses ''Options
-- | Default values for 'Options'
defaultOptions :: Options
defaultOptions = Options
{ _optConfigFile = Nothing
, _optInitialNetworks = []
, _optShowHelp = False
, _optShowVersion = False
, _optNoConnect = False
}
-- | Option descriptions
options :: [OptDescr (Options -> Options)]
options =
[ Option "c" ["config"] (ReqArg (set optConfigFile . Just) "PATH")
"Configuration file path"
, Option "!" ["noconnect"] (NoArg (set optNoConnect True))
"Disable autoconnecting"
, Option "h" ["help"] (NoArg (set optShowHelp True))
"Show help"
, Option "v" ["version"] (NoArg (set optShowVersion True))
"Show version"
]
optOrder :: ArgOrder (Options -> Options)
optOrder = ReturnInOrder (\x -> optInitialNetworks <>~ [Text.pack x])
-- | Load command line options. This action will terminate early
-- in the case of the version flag, help flag, or an error.
getOptions :: IO Options
getOptions =
do (flags, _, errors) <- getOpt optOrder options <$> getArgs
let opts = foldl' (\acc f -> f acc) defaultOptions flags
bullet x = "• " ++ x
reportErrors =
do hPutStrLn stderr "Errors processing command-line options:"
traverse_ (hPutStr stderr) (map bullet errors)
hPutStrLn stderr tryHelpTxt
if | view optShowHelp opts -> putStr helpTxt >> exitSuccess
| view optShowVersion opts -> putStr versionTxt >> exitSuccess
| null errors -> return opts
| otherwise -> reportErrors >> exitFailure
helpTxt :: String
helpTxt = usageInfo "glirc2 [FLAGS] INITIAL_NETWORKS..." options
tryHelpTxt :: String
tryHelpTxt =
"Run 'glirc2 --help' to see a list of available command line options."
versionTxt :: String
versionTxt = unlines
[ "glirc-" ++ showVersion version ++ gitHashTxt ++ gitDirtyTxt
, "Copyright 2016 Eric Mertens"
]
-- git version information ---------------------------------------------
-- | Returns @"-SOMEHASH"@ when in a git repository, @""@ otherwise.
gitHashTxt :: String
gitHashTxt
| hashTxt == "UNKNOWN" = ""
| otherwise = '-':hashTxt
where
hashTxt = $gitHash
-- | Returns @"-dirty"@ when in a dirty git repository, @""@ otherwise.
gitDirtyTxt :: String
gitDirtyTxt
| $gitDirty = "-dirty"
| otherwise = ""