{-# 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 GitHash (giHash, giDirty, tGitInfoCwdTry)
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
{ Options -> Maybe FilePath
_optConfigFile :: Maybe FilePath
, Options -> [Text]
_optInitialNetworks :: [Text]
, Options -> Bool
_optNoConnect :: Bool
, Options -> Bool
_optShowHelp :: Bool
, Options -> Bool
_optShowVersion :: Bool
, Options -> Bool
_optShowFullVersion :: Bool
, Options -> Bool
_optShowConfigFormat:: Bool
}
makeLenses ''Options
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: Maybe FilePath
-> [Text] -> Bool -> Bool -> Bool -> Bool -> Bool -> Options
Options
{ _optConfigFile :: Maybe FilePath
_optConfigFile = Maybe FilePath
forall a. Maybe a
Nothing
, _optInitialNetworks :: [Text]
_optInitialNetworks = []
, _optShowHelp :: Bool
_optShowHelp = Bool
False
, _optShowVersion :: Bool
_optShowVersion = Bool
False
, _optShowFullVersion :: Bool
_optShowFullVersion = Bool
False
, _optNoConnect :: Bool
_optNoConnect = Bool
False
, _optShowConfigFormat :: Bool
_optShowConfigFormat= Bool
False
}
options :: [OptDescr (Options -> Options)]
options :: [OptDescr (Options -> Options)]
options =
[ FilePath
-> [FilePath]
-> ArgDescr (Options -> Options)
-> FilePath
-> OptDescr (Options -> Options)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option FilePath
"c" [FilePath
"config"] ((FilePath -> Options -> Options)
-> FilePath -> ArgDescr (Options -> Options)
forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (ASetter Options Options (Maybe FilePath) (Maybe FilePath)
-> Maybe FilePath -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Options Options (Maybe FilePath) (Maybe FilePath)
Lens' Options (Maybe FilePath)
optConfigFile (Maybe FilePath -> Options -> Options)
-> (FilePath -> Maybe FilePath) -> FilePath -> Options -> Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just) FilePath
"PATH")
FilePath
"Configuration file path"
, FilePath
-> [FilePath]
-> ArgDescr (Options -> Options)
-> FilePath
-> OptDescr (Options -> Options)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option FilePath
"!" [FilePath
"noconnect"] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (ASetter Options Options Bool Bool -> Bool -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Options Options Bool Bool
Lens' Options Bool
optNoConnect Bool
True))
FilePath
"Disable autoconnecting"
, FilePath
-> [FilePath]
-> ArgDescr (Options -> Options)
-> FilePath
-> OptDescr (Options -> Options)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option FilePath
"h" [FilePath
"help"] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (ASetter Options Options Bool Bool -> Bool -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Options Options Bool Bool
Lens' Options Bool
optShowHelp Bool
True))
FilePath
"Show help"
, FilePath
-> [FilePath]
-> ArgDescr (Options -> Options)
-> FilePath
-> OptDescr (Options -> Options)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option FilePath
"" [FilePath
"config-format"] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (ASetter Options Options Bool Bool -> Bool -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Options Options Bool Bool
Lens' Options Bool
optShowConfigFormat Bool
True))
FilePath
"Show configuration file format"
, FilePath
-> [FilePath]
-> ArgDescr (Options -> Options)
-> FilePath
-> OptDescr (Options -> Options)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option FilePath
"v" [FilePath
"version"] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (ASetter Options Options Bool Bool -> Bool -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Options Options Bool Bool
Lens' Options Bool
optShowVersion Bool
True))
FilePath
"Show version"
, FilePath
-> [FilePath]
-> ArgDescr (Options -> Options)
-> FilePath
-> OptDescr (Options -> Options)
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option FilePath
"" [FilePath
"full-version"] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (ASetter Options Options Bool Bool -> Bool -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Options Options Bool Bool
Lens' Options Bool
optShowFullVersion Bool
True))
FilePath
"Show version and versions of all linked Haskell libraries"
]
optOrder :: ArgOrder (Options -> Options)
optOrder :: ArgOrder (Options -> Options)
optOrder = (FilePath -> Options -> Options) -> ArgOrder (Options -> Options)
forall a. (FilePath -> a) -> ArgOrder a
ReturnInOrder (\FilePath
x -> ([Text] -> Identity [Text]) -> Options -> Identity Options
Lens' Options [Text]
optInitialNetworks (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [FilePath -> Text
Text.pack FilePath
x])
getOptions :: IO Options
getOptions :: IO Options
getOptions =
do ([Options -> Options]
flags, [FilePath]
_, [FilePath]
errors) <- ArgOrder (Options -> Options)
-> [OptDescr (Options -> Options)]
-> [FilePath]
-> ([Options -> Options], [FilePath], [FilePath])
forall a.
ArgOrder a
-> [OptDescr a] -> [FilePath] -> ([a], [FilePath], [FilePath])
getOpt ArgOrder (Options -> Options)
optOrder [OptDescr (Options -> Options)]
options ([FilePath] -> ([Options -> Options], [FilePath], [FilePath]))
-> IO [FilePath]
-> IO ([Options -> Options], [FilePath], [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
getArgs
let opts :: Options
opts = (Options -> (Options -> Options) -> Options)
-> Options -> [Options -> Options] -> Options
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Options
acc Options -> Options
f -> Options -> Options
f Options
acc) Options
defaultOptions [Options -> Options]
flags
bullet :: FilePath -> FilePath
bullet FilePath
x = FilePath
"• " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x
reportErrors :: IO ()
reportErrors =
do Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Errors processing command-line options:"
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> FilePath -> IO ()
hPutStr Handle
stderr) ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
bullet [FilePath]
errors)
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
tryHelpTxt
if | Getting Bool Options Bool -> Options -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Options Bool
Lens' Options Bool
optShowHelp Options
opts -> FilePath -> IO ()
putStr FilePath
helpTxt IO () -> IO Options -> IO Options
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitSuccess
| Getting Bool Options Bool -> Options -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Options Bool
Lens' Options Bool
optShowFullVersion Options
opts -> FilePath -> IO ()
putStr FilePath
fullVersionTxt IO () -> IO Options -> IO Options
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitSuccess
| Getting Bool Options Bool -> Options -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Options Bool
Lens' Options Bool
optShowVersion Options
opts -> FilePath -> IO ()
putStr FilePath
versionTxt IO () -> IO Options -> IO Options
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitSuccess
| Getting Bool Options Bool -> Options -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Options Bool
Lens' Options Bool
optShowConfigFormat Options
opts -> IO ()
printConfigFormat IO () -> IO Options -> IO Options
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitSuccess
| [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
errors -> Options -> IO Options
forall (m :: * -> *) a. Monad m => a -> m a
return Options
opts
| Bool
otherwise -> IO ()
reportErrors IO () -> IO Options -> IO Options
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitFailure
printConfigFormat :: IO ()
printConfigFormat :: IO ()
printConfigFormat =
do FilePath
path <- IO FilePath
getConfigPath
FilePath -> IO ()
putStrLn FilePath
""
FilePath -> IO ()
putStrLn (FilePath
"Default configuration file path: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path)
FilePath -> IO ()
putStrLn FilePath
""
Doc -> IO ()
forall a. Show a => a -> IO ()
print (ValueSpec (ServerSettings -> Configuration) -> Doc
forall a. ValueSpec a -> Doc
generateDocs ValueSpec (ServerSettings -> Configuration)
configurationSpec)
helpTxt :: String
helpTxt :: FilePath
helpTxt = FilePath -> [OptDescr (Options -> Options)] -> FilePath
forall a. FilePath -> [OptDescr a] -> FilePath
usageInfo FilePath
"glirc [FLAGS] INITIAL_NETWORKS..." [OptDescr (Options -> Options)]
options
tryHelpTxt :: String
tryHelpTxt :: FilePath
tryHelpTxt =
FilePath
"Run 'glirc --help' to see a list of available command line options."
versionTxt :: String
versionTxt :: FilePath
versionTxt = [FilePath] -> FilePath
unlines
[ FilePath
"glirc-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
version FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
gitHashTxt
, FilePath
"Copyright 2016-2020 Eric Mertens"
]
where
gitHashTxt :: FilePath
gitHashTxt =
case FilePath
FilePath -> Either FilePath GitInfo
forall a b. a -> Either a b
$$tGitInfoCwdTry of
Left{} -> FilePath
""
Right GitInfo
gi -> GitInfo -> FilePath
giHash GitInfo
gi FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ if GitInfo -> Bool
giDirty GitInfo
gi then FilePath
"-dirty" else FilePath
""
fullVersionTxt :: String
fullVersionTxt :: FilePath
fullVersionTxt =
FilePath
versionTxt FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
[FilePath] -> FilePath
unlines
(FilePath
""
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"OS : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
os)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"Architecture: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
arch)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"Compiler : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
compilerName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
compilerVersion)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:FilePath
""
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"ghc : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_ghc)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"ghc-pkg : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_ghc_pkg)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"alex : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_alex)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"happy : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_happy)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath
"hsc2hs : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_hsc2hs)
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:FilePath
""
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:FilePath
"Transitive dependencies:"
FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." ((Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FilePath
forall a. Show a => a -> FilePath
show [Int]
ver) | (FilePath
name,[Int]
ver) <- [(FilePath, [Int])] -> [(FilePath, [Int])]
forall a. Ord a => [a] -> [a]
sort [(FilePath, [Int])]
deps ]
)