{-# 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