{-# 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 Build_glirc (deps)
import Client.Configuration (configurationSpec, getConfigPath)
import Config.Schema.Docs (generateDocs)
import Control.Lens (view, (<>~), set, makeLenses)
import Data.Foldable (Foldable(foldl'), traverse_)
import Data.List (intercalate, sort)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Version (showVersion)
import GitHash (giHash, giDirty, tGitInfoCwdTry)
import Paths_glirc (version)
import System.Console.GetOpt
import System.Environment (getArgs)
import System.Exit (exitFailure, exitSuccess)
import System.Info (arch, compilerName, compilerVersion, os)
import System.IO (hPutStr, hPutStrLn, stderr)

-- | Command-line options
data Options = Options
  { Options -> Maybe String
_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
  { _optConfigFile :: Maybe String
_optConfigFile      = Maybe String
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 =
  [ String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"c" [String
"config"]  ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (ASetter Options Options (Maybe String) (Maybe String)
-> Maybe String -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Options Options (Maybe String) (Maybe String)
Lens' Options (Maybe String)
optConfigFile (Maybe String -> Options -> Options)
-> (String -> Maybe String) -> String -> Options -> Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just) String
"PATH")
    String
"Configuration file path"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"!" [String
"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))
    String
"Disable autoconnecting"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"h" [String
"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))
    String
"Show help"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"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))
    String
"Show configuration file format"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"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))
    String
"Show version"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"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))
    String
"Show version and versions of all linked Haskell libraries"
  ]

optOrder :: ArgOrder (Options -> Options)
optOrder :: ArgOrder (Options -> Options)
optOrder = (String -> Options -> Options) -> ArgOrder (Options -> Options)
forall a. (String -> a) -> ArgOrder a
ReturnInOrder (\String
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
<>~ [String -> Text
Text.pack String
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, [String]
_, [String]
errors) <- ArgOrder (Options -> Options)
-> [OptDescr (Options -> Options)]
-> [String]
-> ([Options -> Options], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (Options -> Options)
optOrder [OptDescr (Options -> Options)]
options ([String] -> ([Options -> Options], [String], [String]))
-> IO [String] -> IO ([Options -> Options], [String], [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs

     let opts :: Options
opts = (Options -> (Options -> Options) -> Options)
-> Options -> [Options -> Options] -> Options
forall b a. (b -> a -> b) -> b -> [a] -> b
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 :: String -> String
bullet String
x = String
"• " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x

         reportErrors :: IO ()
reportErrors =
           do Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Errors processing command-line options:"
              (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> String -> IO ()
hPutStr Handle
stderr) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
bullet [String]
errors)
              Handle -> String -> IO ()
hPutStrLn Handle
stderr String
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 -> String -> IO ()
putStr String
helpTxt        IO () -> IO Options -> IO Options
forall a b. IO a -> IO b -> IO b
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 -> String -> IO ()
putStr String
fullVersionTxt IO () -> IO Options -> IO Options
forall a b. IO a -> IO b -> IO b
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 -> String -> IO ()
putStr String
versionTxt     IO () -> IO Options -> IO Options
forall a b. IO a -> IO b -> IO b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitSuccess
        | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors                   -> Options -> IO Options
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Options
opts
        | Bool
otherwise                     -> IO ()
reportErrors          IO () -> IO Options -> IO Options
forall a b. IO a -> IO b -> IO b
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 String
path <- IO String
getConfigPath
     String -> IO ()
putStrLn String
""
     String -> IO ()
putStrLn (String
"Default configuration file path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)
     String -> IO ()
putStrLn String
""
     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 :: String
helpTxt = String -> [OptDescr (Options -> Options)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
"glirc [FLAGS] INITIAL_NETWORKS..." [OptDescr (Options -> Options)]
options

tryHelpTxt :: String
tryHelpTxt :: String
tryHelpTxt =
  String
"Run 'glirc --help' to see a list of available command line options."

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

versionTxt :: String
versionTxt :: String
versionTxt = [String] -> String
unlines
  [ String
"glirc-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
gitHashTxt
  , String
"Copyright 2016-2020 Eric Mertens"
  ]
  where
    gitHashTxt :: String
gitHashTxt =
      case $$String
String -> Either String GitInfo
forall a b. a -> Either a b
tGitInfoCwdTry of
        Left{}   -> String
""
        Right GitInfo
gi -> GitInfo -> String
giHash GitInfo
gi String -> String -> String
forall a. [a] -> [a] -> [a]
++ if GitInfo -> Bool
giDirty GitInfo
gi then String
"-dirty" else String
""

fullVersionTxt :: String
fullVersionTxt :: String
fullVersionTxt =
  String
versionTxt String -> String -> String
forall a. [a] -> [a] -> [a]
++
  [String] -> String
unlines
  (String
""
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"OS          : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"Architecture: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"Compiler    : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
compilerName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
compilerVersion)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
""
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"ghc         : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_ghc)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"ghc-pkg     : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_ghc_pkg)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"alex        : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_alex)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"happy       : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_happy)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
"hsc2hs      : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TOOL_VERSION_hsc2hs)
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
""
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
"Transitive dependencies:"
  String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
ver) | (String
name,[Int]
ver) <- [(String, [Int])] -> [(String, [Int])]
forall a. Ord a => [a] -> [a]
sort [(String, [Int])]
deps ]
  )