{-# Language CPP, TemplateHaskell, MultiWayIf #-}
#ifndef TOOL_VERSION_alex
#define TOOL_VERSION_alex "none"
#endif
#ifndef TOOL_VERSION_happy
#define TOOL_VERSION_happy "none"
#endif
module Client.Options
(
Options(..)
, optConfigFile
, optInitialNetworks
, optNoConnect
, getOptions
) where
import Config.Schema.Docs
import Control.Lens
import Data.Foldable
import Data.List
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 System.Info
import Paths_glirc (version)
import Build_glirc (deps)
import Client.Configuration
data Options = Options
{ _optConfigFile :: Maybe FilePath
, _optInitialNetworks :: [Text]
, _optNoConnect :: Bool
, _optShowHelp :: Bool
, _optShowVersion :: Bool
, _optShowFullVersion :: Bool
, _optShowConfigFormat:: Bool
}
makeLenses ''Options
defaultOptions :: Options
defaultOptions = Options
{ _optConfigFile = Nothing
, _optInitialNetworks = []
, _optShowHelp = False
, _optShowVersion = False
, _optShowFullVersion = False
, _optNoConnect = False
, _optShowConfigFormat= False
}
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 "" ["config-format"] (NoArg (set optShowConfigFormat True))
"Show configuration file format"
, Option "v" ["version"] (NoArg (set optShowVersion True))
"Show version"
, Option "" ["full-version"] (NoArg (set optShowFullVersion True))
"Show version and versions of all linked Haskell libraries"
]
optOrder :: ArgOrder (Options -> Options)
optOrder = ReturnInOrder (\x -> optInitialNetworks <>~ [Text.pack x])
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 optShowFullVersion opts -> putStr fullVersionTxt >> exitSuccess
| view optShowVersion opts -> putStr versionTxt >> exitSuccess
| view optShowConfigFormat opts -> printConfigFormat >> exitSuccess
| null errors -> return opts
| otherwise -> reportErrors >> exitFailure
printConfigFormat :: IO ()
printConfigFormat =
do path <- getNewConfigPath
putStrLn ""
putStrLn ("Default configuration file path: " ++ path)
putStrLn ""
print (generateDocs configurationSpec)
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"
]
fullVersionTxt :: String
fullVersionTxt =
versionTxt ++
unlines
(""
:("OS : " ++ os)
:("Architecture: " ++ arch)
:("Compiler : " ++ compilerName ++ "-" ++ showVersion compilerVersion)
:""
:("ghc : " ++ TOOL_VERSION_ghc)
:("ghc-pkg : " ++ TOOL_VERSION_ghc_pkg)
:("alex : " ++ TOOL_VERSION_alex)
:("happy : " ++ TOOL_VERSION_happy)
:("hsc2hs : " ++ TOOL_VERSION_hsc2hs)
:""
:"Transitive dependencies:"
: [ name ++ "-" ++ intercalate "." (map show ver) | (name,ver) <- sort deps ]
)
gitHashTxt :: String
gitHashTxt
| hashTxt == "UNKNOWN" = ""
| otherwise = '-':hashTxt
where
hashTxt = $gitHash
gitDirtyTxt :: String
gitDirtyTxt
| $gitDirty = "-dirty"
| otherwise = ""