{-# 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
Description : Processing of command-line options
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module process command-line options provided when launching the client.

-}
module Client.Options
  (
  -- * Command-line options
    Options(..)

  -- * Lenses
  , optConfigFile
  , optInitialNetworks
  , optNoConnect

  -- * Options loader
  , 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

-- | Command-line options
data Options = Options
  { Options -> Maybe FilePath
_optConfigFile      :: Maybe FilePath -- ^ configuration file path
  , Options -> [Text]
_optInitialNetworks :: [Text]         -- ^ initial networks
  , Options -> Bool
_optNoConnect       :: Bool           -- ^ disable autoconnect
  , Options -> Bool
_optShowHelp        :: Bool           -- ^ show help message
  , Options -> Bool
_optShowVersion     :: Bool           -- ^ show version message
  , Options -> Bool
_optShowFullVersion :: Bool           -- ^ show version of ALL transitive dependencies
  , Options -> Bool
_optShowConfigFormat:: Bool           -- ^ show configuration file format
  }

makeLenses ''Options

-- | Default values for '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
  }

-- | Option descriptions
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])

-- | 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 :: 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."

-- version information ---------------------------------------------

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 ]
  )