{-# 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
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
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
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
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
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
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
  { optConfLocation :: Maybe String
optConfLocation     = forall a. Maybe a
Nothing
  , optLogLocation :: Maybe String
optLogLocation      = 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 =
  [ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'c'] [String
"config"]
    (forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\ String
path Options
c -> Options
c { optConfLocation :: Maybe String
optConfLocation = forall a. a -> Maybe a
Just String
path }) String
"PATH")
    String
"Path to the configuration file"
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'l'] [String
"logs"]
    (forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\ String
path Options
c -> Options
c { optLogLocation :: Maybe String
optLogLocation = forall a. a -> Maybe a
Just String
path }) String
"FILE")
    String
"Path to debug log output file"
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'v'] [String
"version"]
    (forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optBehaviour :: Behaviour
optBehaviour = Behaviour
ShowVersion }))
    String
"Print version information and exit"
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'h'] [String
"help"]
    (forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optBehaviour :: Behaviour
optBehaviour = Behaviour
ShowHelp }))
    String
"Print help for command-line flags and exit"
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'i'] [String
"ignore-config"]
    (forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optIgnoreConfig :: Bool
optIgnoreConfig = Bool
True }))
    String
"Start with no configuration"
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'k'] [String
"keybindings"]
    (forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optPrintKeybindings :: Bool
optPrintKeybindings = Bool
True }))
    String
"Print keybindings effective for the current configuration"
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'm'] [String
"commands"]
    (forall a. a -> ArgDescr a
NoArg (\ Options
c -> Options
c { optPrintCommands :: Bool
optPrintCommands = Bool
True }))
    String
"Print available commands"
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'f'] [String
"format"]
    (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Options -> Options
handleFormat String
"FORMAT")
    (String
"Print keybinding or command output in the specified format " forall a. Semigroup a => a -> a -> a
<>
     String
"(options: " forall a. Semigroup a => a -> a -> a
<> String
formatChoicesStr forall a. Semigroup a => a -> a -> a
<> String
", default: " forall a. Semigroup a => a -> a -> a
<>
     PrintFormat -> String
formatStringFor (Options -> PrintFormat
optPrintFormat Options
defaultOptions) forall a. Semigroup a => a -> a -> a
<> String
")")
  , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"check-config"]
    (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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PrintFormat
fmt (forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, PrintFormat)]
formatChoices) of
        Maybe String
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: no format string for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show PrintFormat
fmt
        Just String
s -> String
s

formatChoicesStr :: String
formatChoicesStr :: String
formatChoicesStr = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst 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 forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Char -> Char
toLower 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 ->
                forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Invalid format: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fmtStr forall a. Semigroup a => a -> a -> a
<> String
", choices: " forall a. Semigroup a => a -> a -> a
<>
                        String
formatChoicesStr
    in Options
c { optPrintFormat :: PrintFormat
optPrintFormat = PrintFormat
fmt }

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

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

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

checkConfiguration :: Maybe FilePath -> IO a
checkConfiguration :: forall a. 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: " forall a. [a] -> [a] -> [a]
++ String
fp
     case Either String ([String], Config)
res of
       Left String
e ->
         do String -> IO ()
writeLn String
e
            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))
            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))
            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> IO ()
writeLn [String]
ws
            forall a. IO a
exitFailure