{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}

-- | Functions to parse command line arguments for Stack's @ls@ command.

module Stack.Options.LsParser
  ( lsOptsParser
  ) where

import qualified Options.Applicative as OA
import           Options.Applicative ( idm )
import           Options.Applicative.Builder.Extra ( boolFlags )
import           Stack.Constants ( globalFooter )
import           Stack.Ls
                   ( ListStylesOpts (..), ListToolsOpts (..), LsCmdOpts (..)
                   , LsCmds (..), LsView (..), SnapshotOpts (..)
                   )
import           Stack.Options.DotParser ( listDepsOptsParser )
import           Stack.Prelude

-- | Parse command line arguments for Stack's @ls@ command.

lsOptsParser :: OA.Parser LsCmdOpts
lsOptsParser :: Parser LsCmdOpts
lsOptsParser = LsCmds -> LsCmdOpts
LsCmdOpts
  (LsCmds -> LsCmdOpts) -> Parser LsCmds -> Parser LsCmdOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod CommandFields LsCmds -> Parser LsCmds
forall a. Mod CommandFields a -> Parser a
OA.hsubparser (Mod CommandFields LsCmds
lsSnapCmd Mod CommandFields LsCmds
-> Mod CommandFields LsCmds -> Mod CommandFields LsCmds
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields LsCmds
lsDepsCmd Mod CommandFields LsCmds
-> Mod CommandFields LsCmds -> Mod CommandFields LsCmds
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields LsCmds
lsStylesCmd Mod CommandFields LsCmds
-> Mod CommandFields LsCmds -> Mod CommandFields LsCmds
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields LsCmds
lsToolsCmd)

lsCmdOptsParser :: OA.Parser LsCmds
lsCmdOptsParser :: Parser LsCmds
lsCmdOptsParser = SnapshotOpts -> LsCmds
LsSnapshot (SnapshotOpts -> LsCmds) -> Parser SnapshotOpts -> Parser LsCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SnapshotOpts
lsViewSnapCmd

lsDepOptsParser :: OA.Parser LsCmds
lsDepOptsParser :: Parser LsCmds
lsDepOptsParser = ListDepsOpts -> LsCmds
LsDependencies (ListDepsOpts -> LsCmds) -> Parser ListDepsOpts -> Parser LsCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListDepsOpts
listDepsOptsParser

lsStylesOptsParser :: OA.Parser LsCmds
lsStylesOptsParser :: Parser LsCmds
lsStylesOptsParser = ListStylesOpts -> LsCmds
LsStyles (ListStylesOpts -> LsCmds)
-> Parser ListStylesOpts -> Parser LsCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListStylesOpts
listStylesOptsParser

lsToolsOptsParser :: OA.Parser LsCmds
lsToolsOptsParser :: Parser LsCmds
lsToolsOptsParser = ListToolsOpts -> LsCmds
LsTools (ListToolsOpts -> LsCmds) -> Parser ListToolsOpts -> Parser LsCmds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ListToolsOpts
listToolsOptsParser

listStylesOptsParser :: OA.Parser ListStylesOpts
listStylesOptsParser :: Parser ListStylesOpts
listStylesOptsParser = Bool -> Bool -> Bool -> ListStylesOpts
ListStylesOpts
  (Bool -> Bool -> Bool -> ListStylesOpts)
-> Parser Bool -> Parser (Bool -> Bool -> ListStylesOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
False
        String
"basic"
        String
"a basic report of the styles used. The default is a fuller one."
        Mod FlagFields Bool
forall m. Monoid m => m
idm
  Parser (Bool -> Bool -> ListStylesOpts)
-> Parser Bool -> Parser (Bool -> ListStylesOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
        String
"sgr"
        String
"the provision of the equivalent SGR instructions (provided by \
        \default). Flag ignored for a basic report."
        Mod FlagFields Bool
forall m. Monoid m => m
idm
  Parser (Bool -> ListStylesOpts)
-> Parser Bool -> Parser ListStylesOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
boolFlags Bool
True
        String
"example"
        String
"the provision of an example of the applied style (provided by default \
        \for colored output). Flag ignored for a basic report."
        Mod FlagFields Bool
forall m. Monoid m => m
idm

listToolsOptsParser :: OA.Parser ListToolsOpts
listToolsOptsParser :: Parser ListToolsOpts
listToolsOptsParser = String -> ListToolsOpts
ListToolsOpts
  (String -> ListToolsOpts) -> Parser String -> Parser ListToolsOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
        (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"filter"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"TOOL_NAME"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
OA.value String
""
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Filter by a tool name (eg 'ghc', 'ghc-git' or 'msys2') \
                   \- case sensitive. (default: no filter)"
        )

lsViewSnapCmd :: OA.Parser SnapshotOpts
lsViewSnapCmd :: Parser SnapshotOpts
lsViewSnapCmd = LsView -> Bool -> Bool -> SnapshotOpts
SnapshotOpts
  (LsView -> Bool -> Bool -> SnapshotOpts)
-> Parser LsView -> Parser (Bool -> Bool -> SnapshotOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Mod CommandFields LsView -> Parser LsView
forall a. Mod CommandFields a -> Parser a
OA.hsubparser (Mod CommandFields LsView
lsViewRemoteCmd Mod CommandFields LsView
-> Mod CommandFields LsView -> Mod CommandFields LsView
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields LsView
lsViewLocalCmd) Parser LsView -> Parser LsView -> Parser LsView
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LsView -> Parser LsView
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LsView
Local)
  Parser (Bool -> Bool -> SnapshotOpts)
-> Parser Bool -> Parser (Bool -> SnapshotOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch
        (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"lts"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'l'
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Only show LTS Haskell snapshots."
        )
  Parser (Bool -> SnapshotOpts) -> Parser Bool -> Parser SnapshotOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch
        (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"nightly"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'n'
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Only show Nightly snapshots."
        )

lsSnapCmd :: OA.Mod OA.CommandFields LsCmds
lsSnapCmd :: Mod CommandFields LsCmds
lsSnapCmd = String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"snapshots" (ParserInfo LsCmds -> Mod CommandFields LsCmds)
-> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a b. (a -> b) -> a -> b
$
  Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsCmdOptsParser (InfoMod LsCmds -> ParserInfo LsCmds)
-> InfoMod LsCmds -> ParserInfo LsCmds
forall a b. (a -> b) -> a -> b
$
       String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc String
"View snapshots. (default: local)"
    InfoMod LsCmds -> InfoMod LsCmds -> InfoMod LsCmds
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.footer String
localSnapshotMsg

lsDepsCmd :: OA.Mod OA.CommandFields LsCmds
lsDepsCmd :: Mod CommandFields LsCmds
lsDepsCmd = String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"dependencies" (ParserInfo LsCmds -> Mod CommandFields LsCmds)
-> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a b. (a -> b) -> a -> b
$
  Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsDepOptsParser (InfoMod LsCmds -> ParserInfo LsCmds)
-> InfoMod LsCmds -> ParserInfo LsCmds
forall a b. (a -> b) -> a -> b
$
       String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc String
"View the dependencies."
    InfoMod LsCmds -> InfoMod LsCmds -> InfoMod LsCmds
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.footer String
globalFooter

lsStylesCmd :: OA.Mod OA.CommandFields LsCmds
lsStylesCmd :: Mod CommandFields LsCmds
lsStylesCmd =
     String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
       String
"stack-colors"
       (Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsStylesOptsParser
                (String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc String
"View Stack's output styles."))
  Mod CommandFields LsCmds
-> Mod CommandFields LsCmds -> Mod CommandFields LsCmds
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
       String
"stack-colours"
       (Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsStylesOptsParser
                (String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc String
"View Stack's output styles (alias for \
                             \'stack-colors')."))

lsToolsCmd :: OA.Mod OA.CommandFields LsCmds
lsToolsCmd :: Mod CommandFields LsCmds
lsToolsCmd =
  String -> ParserInfo LsCmds -> Mod CommandFields LsCmds
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command
    String
"tools"
    (Parser LsCmds -> InfoMod LsCmds -> ParserInfo LsCmds
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info Parser LsCmds
lsToolsOptsParser
             (String -> InfoMod LsCmds
forall a. String -> InfoMod a
OA.progDesc String
"View Stack's installed tools."))

lsViewLocalCmd :: OA.Mod OA.CommandFields LsView
lsViewLocalCmd :: Mod CommandFields LsView
lsViewLocalCmd = String -> ParserInfo LsView -> Mod CommandFields LsView
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"local" (ParserInfo LsView -> Mod CommandFields LsView)
-> ParserInfo LsView -> Mod CommandFields LsView
forall a b. (a -> b) -> a -> b
$
  Parser LsView -> InfoMod LsView -> ParserInfo LsView
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (LsView -> Parser LsView
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LsView
Local) (InfoMod LsView -> ParserInfo LsView)
-> InfoMod LsView -> ParserInfo LsView
forall a b. (a -> b) -> a -> b
$
       String -> InfoMod LsView
forall a. String -> InfoMod a
OA.progDesc String
"View local snapshots."
    InfoMod LsView -> InfoMod LsView -> InfoMod LsView
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LsView
forall a. String -> InfoMod a
OA.footer String
localSnapshotMsg

lsViewRemoteCmd :: OA.Mod OA.CommandFields LsView
lsViewRemoteCmd :: Mod CommandFields LsView
lsViewRemoteCmd = String -> ParserInfo LsView -> Mod CommandFields LsView
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"remote" (ParserInfo LsView -> Mod CommandFields LsView)
-> ParserInfo LsView -> Mod CommandFields LsView
forall a b. (a -> b) -> a -> b
$
  Parser LsView -> InfoMod LsView -> ParserInfo LsView
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (LsView -> Parser LsView
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LsView
Remote) (InfoMod LsView -> ParserInfo LsView)
-> InfoMod LsView -> ParserInfo LsView
forall a b. (a -> b) -> a -> b
$
       String -> InfoMod LsView
forall a. String -> InfoMod a
OA.progDesc String
"View remote snapshots."
    InfoMod LsView -> InfoMod LsView -> InfoMod LsView
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod LsView
forall a. String -> InfoMod a
OA.footer String
pagerMsg

pagerMsg :: String
pagerMsg :: String
pagerMsg =
  String
"On a terminal, uses a pager, if one is available. Respects the PAGER \
  \environment variable (subject to that, prefers pager 'less' to 'more')."

localSnapshotMsg :: String
localSnapshotMsg :: String
localSnapshotMsg =
  String
"A local snapshot is identified by a hash code. " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pagerMsg