{-# LANGUAGE TemplateHaskell #-}

module Matterhorn.Options where

import Prelude ()
import Matterhorn.Prelude

import Data.Char ( toLower )
import Data.Foldable (traverse_)
import Data.Tuple ( swap )
import Data.Version ( showVersion )
import Development.GitRev
import Network.Mattermost.Version ( mmApiVersion )
import Paths_matterhorn ( version )
import System.Console.GetOpt
import System.Environment ( getArgs )
import System.Exit ( exitFailure, exitSuccess )
import System.IO ( hPutStrLn, stderr )

import Matterhorn.Config


data Behaviour
  = Normal
  | ShowVersion
  | ShowHelp
  | CheckConfig
    deriving (Behaviour -> Behaviour -> Bool
(Behaviour -> Behaviour -> Bool)
-> (Behaviour -> Behaviour -> Bool) -> Eq Behaviour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Behaviour -> Behaviour -> Bool
$c/= :: Behaviour -> Behaviour -> Bool
== :: Behaviour -> Behaviour -> Bool
$c== :: Behaviour -> Behaviour -> Bool
Eq, Int -> Behaviour -> ShowS
[Behaviour] -> ShowS
Behaviour -> String
(Int -> Behaviour -> ShowS)
-> (Behaviour -> String)
-> ([Behaviour] -> ShowS)
-> Show Behaviour
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Behaviour] -> ShowS
$cshowList :: [Behaviour] -> ShowS
show :: Behaviour -> String
$cshow :: Behaviour -> String
showsPrec :: Int -> Behaviour -> ShowS
$cshowsPrec :: Int -> Behaviour -> ShowS
Show)

data PrintFormat =
    Markdown | Plain deriving (PrintFormat -> PrintFormat -> Bool
(PrintFormat -> PrintFormat -> Bool)
-> (PrintFormat -> PrintFormat -> Bool) -> Eq PrintFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrintFormat -> PrintFormat -> Bool
$c/= :: PrintFormat -> PrintFormat -> Bool
== :: PrintFormat -> PrintFormat -> Bool
$c== :: PrintFormat -> PrintFormat -> Bool
Eq, Int -> PrintFormat -> ShowS
[PrintFormat] -> ShowS
PrintFormat -> String
(Int -> PrintFormat -> ShowS)
-> (PrintFormat -> String)
-> ([PrintFormat] -> ShowS)
-> Show PrintFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrintFormat] -> ShowS
$cshowList :: [PrintFormat] -> ShowS
show :: PrintFormat -> String
$cshow :: PrintFormat -> String
showsPrec :: Int -> PrintFormat -> ShowS
$cshowsPrec :: Int -> PrintFormat -> ShowS
Show)

data Options = Options
  { Options -> Maybe String
optConfLocation     :: Maybe FilePath
  , Options -> Maybe String
optLogLocation      :: Maybe FilePath
  , Options -> Behaviour
optBehaviour        :: Behaviour
  , Options -> Bool
optIgnoreConfig     :: Bool
  , Options -> Bool
optPrintKeybindings :: Bool
  , Options -> Bool
optPrintCommands    :: Bool
  , Options -> PrintFormat
optPrintFormat      :: PrintFormat
  } deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: Maybe String
-> Maybe String
-> Behaviour
-> Bool
-> Bool
-> Bool
-> PrintFormat
-> Options
Options
  { optConfLocation :: Maybe String
optConfLocation     = Maybe String
forall a. Maybe a
Nothing
  , optLogLocation :: Maybe String
optLogLocation      = Maybe String
forall a. Maybe a
Nothing
  , optBehaviour :: Behaviour
optBehaviour        = Behaviour
Normal
  , optIgnoreConfig :: Bool
optIgnoreConfig     = Bool
False
  , optPrintKeybindings :: Bool
optPrintKeybindings = Bool
False
  , optPrintCommands :: Bool
optPrintCommands    = Bool
False
  , optPrintFormat :: PrintFormat
optPrintFormat      = PrintFormat
Plain
  }

optDescrs :: [OptDescr (Options -> Options)]
optDescrs :: [OptDescr (Options -> Options)]
optDescrs =
  [ String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'c'] [String
"config"]
    ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\ String
path Options
c -> Options
c { optConfLocation :: Maybe String
optConfLocation = String -> Maybe String
forall a. a -> Maybe a
Just String
path }) String
"PATH")
    String
"Path to the configuration file"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'l'] [String
"logs"]
    ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\ String
path Options
c -> Options
c { optLogLocation :: Maybe String
optLogLocation = String -> Maybe String
forall a. a -> Maybe a
Just String
path }) String
"FILE")
    String
"Path to debug log output file"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'v'] [String
"version"]
    ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optBehaviour :: Behaviour
optBehaviour = Behaviour
ShowVersion }))
    String
"Print version information and exit"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'h'] [String
"help"]
    ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optBehaviour :: Behaviour
optBehaviour = Behaviour
ShowHelp }))
    String
"Print help for command-line flags and exit"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'i'] [String
"ignore-config"]
    ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optIgnoreConfig :: Bool
optIgnoreConfig = Bool
True }))
    String
"Start with no configuration"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'k'] [String
"keybindings"]
    ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optPrintKeybindings :: Bool
optPrintKeybindings = Bool
True }))
    String
"Print keybindings effective for the current configuration"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'm'] [String
"commands"]
    ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optPrintCommands :: Bool
optPrintCommands = Bool
True }))
    String
"Print available commands"
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'f'] [String
"format"]
    ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Options -> Options
handleFormat String
"FORMAT")
    (String
"Print keybinding or command output in the specified format " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
     String
"(options: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
formatChoicesStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", default: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
     PrintFormat -> String
formatStringFor (Options -> PrintFormat
optPrintFormat Options
defaultOptions) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"check-config"]
    ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optBehaviour :: Behaviour
optBehaviour = Behaviour
CheckConfig }))
    String
"Validate configuration file"
  ]

formatChoices :: [(String, PrintFormat)]
formatChoices :: [(String, PrintFormat)]
formatChoices =
    [ (String
"plain", PrintFormat
Plain)
    , (String
"markdown", PrintFormat
Markdown)
    ]

formatStringFor :: PrintFormat -> String
formatStringFor :: PrintFormat -> String
formatStringFor PrintFormat
fmt =
    case PrintFormat -> [(PrintFormat, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PrintFormat
fmt ((String, PrintFormat) -> (PrintFormat, String)
forall a b. (a, b) -> (b, a)
swap ((String, PrintFormat) -> (PrintFormat, String))
-> [(String, PrintFormat)] -> [(PrintFormat, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, PrintFormat)]
formatChoices) of
        Maybe String
Nothing -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"BUG: no format string for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PrintFormat -> String
forall a. Show a => a -> String
show PrintFormat
fmt
        Just String
s -> String
s

formatChoicesStr :: String
formatChoicesStr :: String
formatChoicesStr = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String, PrintFormat) -> String
forall a b. (a, b) -> a
fst ((String, PrintFormat) -> String)
-> [(String, PrintFormat)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, PrintFormat)]
formatChoices

handleFormat :: String -> Options -> Options
handleFormat :: String -> Options -> Options
handleFormat String
fmtStr Options
c =
    let fmt :: PrintFormat
fmt = case String -> [(String, PrintFormat)] -> Maybe PrintFormat
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
fmtStr) [(String, PrintFormat)]
formatChoices of
            Just PrintFormat
f -> PrintFormat
f
            Maybe PrintFormat
Nothing ->
                String -> PrintFormat
forall a. HasCallStack => String -> a
error (String -> PrintFormat) -> String -> PrintFormat
forall a b. (a -> b) -> a -> b
$ String
"Invalid format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
fmtStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", choices: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                        String
formatChoicesStr
    in Options
c { optPrintFormat :: PrintFormat
optPrintFormat = PrintFormat
fmt }

mhVersion :: String
mhVersion :: String
mhVersion
  | $(String
gitHash) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"UNKNOWN" :: String) = String
"matterhorn " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version
  | Bool
otherwise = String
"matterhorn " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                $(String
gitBranch) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
7 $(String
gitHash) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

fullVersionString :: String
fullVersionString :: String
fullVersionString = String
mhVersion String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n using " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mmApiVersion

usage :: IO ()
usage :: IO ()
usage = String -> IO ()
putStr (String -> [OptDescr (Options -> Options)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
"matterhorn" [OptDescr (Options -> Options)]
optDescrs)

grabOptions :: IO Options
grabOptions :: IO Options
grabOptions = do
  [String]
args <- IO [String]
getArgs
  case 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)
forall a. ArgOrder a
Permute [OptDescr (Options -> Options)]
optDescrs [String]
args of
    ([Options -> Options]
aps, [], []) -> do
      let rs :: Options
rs = ((Options -> Options)
 -> (Options -> Options) -> Options -> Options)
-> (Options -> Options)
-> [Options -> Options]
-> Options
-> Options
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Options -> Options) -> (Options -> Options) -> Options -> Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Options -> Options
forall a. a -> a
id [Options -> Options]
aps Options
defaultOptions
      case Options -> Behaviour
optBehaviour Options
rs of
        Behaviour
Normal -> Options -> IO Options
forall (m :: * -> *) a. Monad m => a -> m a
return Options
rs
        Behaviour
ShowHelp -> IO ()
usage IO () -> IO Options -> IO Options
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitSuccess
        Behaviour
ShowVersion -> String -> IO ()
putStrLn String
fullVersionString IO () -> IO Options -> IO Options
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Options
forall a. IO a
exitSuccess
        Behaviour
CheckConfig -> Maybe String -> IO Options
forall a. Maybe String -> IO a
checkConfiguration (Options -> Maybe String
optConfLocation Options
rs)
    ([Options -> Options]
_, [String]
_, [String]
errs) -> do
      (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStr [String]
errs
      IO ()
usage
      IO Options
forall a. IO a
exitFailure

checkConfiguration :: Maybe FilePath -> IO a
checkConfiguration :: Maybe String -> IO a
checkConfiguration Maybe String
mb =
  do Either String ([String], Config)
res <- Maybe String -> IO (Either String ([String], Config))
findConfig Maybe String
mb
     let writeLn :: String -> IO ()
writeLn = Handle -> String -> IO ()
hPutStrLn Handle
stderr
         printLocation :: Maybe String -> String
printLocation Maybe String
Nothing = String
"No configuration file"
         printLocation (Just String
fp) = String
"Location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp
     case Either String ([String], Config)
res of
       Left String
e ->
         do String -> IO ()
writeLn String
e
            IO a
forall a. IO a
exitFailure
       Right ([], Config
config) ->
         do String -> IO ()
writeLn String
"Configuration file valid"
            String -> IO ()
writeLn (Maybe String -> String
printLocation (Config -> Maybe String
configAbsPath Config
config))
            IO a
forall a. IO a
exitSuccess
       Right ([String]
ws, Config
config) ->
         do String -> IO ()
writeLn String
"Configuration file generated warnings"
            String -> IO ()
writeLn (Maybe String -> String
printLocation (Config -> Maybe String
configAbsPath Config
config))
            (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> IO ()
writeLn [String]
ws
            IO a
forall a. IO a
exitFailure