{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

{- HLINT ignore "Unused LANGUAGE pragma" -}
-- For TH, for some reason

-- | Provides functionality for parsing command line arguments.
module Shrun.Configuration.Args.Parsing
  ( Args (..),
    parserInfoArgs,
    parserPrefs,
  )
where

import Data.List qualified as L
import Data.Text qualified as T
import Data.Version (showVersion)
import Effects.Optparse (validOsPath)
import Effects.Optparse.Completer qualified as EOC
import FileSystem.OsString (OsString)
import FileSystem.OsString qualified as OsString
import Options.Applicative
  ( Parser,
    ParserInfo
      ( ParserInfo,
        infoFailureCode,
        infoFooter,
        infoFullDesc,
        infoHeader,
        infoParser,
        infoPolicy,
        infoProgDesc
      ),
  )
import Options.Applicative qualified as OA
import Options.Applicative.Help.Chunk (Chunk (Chunk))
import Options.Applicative.Help.Chunk qualified as Chunk
import Options.Applicative.Help.Pretty qualified as Pretty
import Options.Applicative.Types (ArgPolicy (Intersperse), ParserPrefs)
import Paths_shrun qualified as Paths
import Shrun.Configuration.Args.Parsing.Core qualified as Core
import Shrun.Configuration.Args.Parsing.Graph qualified as Graph
import Shrun.Configuration.Args.Parsing.TH qualified as TH
import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
import Shrun.Configuration.Data.Core (CoreConfigArgs)
import Shrun.Configuration.Data.Graph (EdgeArgs)
import Shrun.Configuration.Data.WithDisabled (WithDisabled)
import Shrun.Prelude
import System.Info qualified as Info

-- | CLI args.
data Args m = MkArgs
  { -- | Optional config file.
    forall m. Args m -> Seq (WithDisabled OsPath)
configPaths :: Seq (WithDisabled OsPath),
    -- | Core config.
    forall m. Args m -> CoreConfigArgs m
coreConfig :: CoreConfigArgs m,
    -- | List of commands.
    forall m. Args m -> NESeq Text
commands :: NESeq Text,
    -- | Whether to print the config.
    forall m. Args m -> Bool
dryRun :: Bool,
    -- | Command dependencies.
    forall m. Args m -> Maybe (WithDisabled EdgeArgs)
edges :: Maybe (WithDisabled EdgeArgs)
  }
  deriving stock (Args m -> Args m -> Bool
(Args m -> Args m -> Bool)
-> (Args m -> Args m -> Bool) -> Eq (Args m)
forall m. Args m -> Args m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall m. Args m -> Args m -> Bool
== :: Args m -> Args m -> Bool
$c/= :: forall m. Args m -> Args m -> Bool
/= :: Args m -> Args m -> Bool
Eq, Int -> Args m -> ShowS
[Args m] -> ShowS
Args m -> String
(Int -> Args m -> ShowS)
-> (Args m -> String) -> ([Args m] -> ShowS) -> Show (Args m)
forall m. Int -> Args m -> ShowS
forall m. [Args m] -> ShowS
forall m. Args m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall m. Int -> Args m -> ShowS
showsPrec :: Int -> Args m -> ShowS
$cshow :: forall m. Args m -> String
show :: Args m -> String
$cshowList :: forall m. [Args m] -> ShowS
showList :: [Args m] -> ShowS
Show)

instance
  (k ~ A_Lens, a ~ Seq (WithDisabled OsPath), b ~ Seq (WithDisabled OsPath)) =>
  LabelOptic "configPaths" k (Args m) (Args m) a b
  where
  labelOptic :: Optic k NoIx (Args m) (Args m) a b
labelOptic = LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b)
-> LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) ->
    (Seq (WithDisabled OsPath) -> Args m)
-> f (Seq (WithDisabled OsPath)) -> f (Args m)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq (WithDisabled OsPath)
b -> Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
forall m.
Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
MkArgs Seq (WithDisabled OsPath)
b CoreConfigArgs m
a2 NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) (a -> f b
f a
Seq (WithDisabled OsPath)
a1)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ CoreConfigArgs m, b ~ CoreConfigArgs m) =>
  LabelOptic "coreConfig" k (Args m) (Args m) a b
  where
  labelOptic :: Optic k NoIx (Args m) (Args m) a b
labelOptic = LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b)
-> LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) ->
    (CoreConfigArgs m -> Args m) -> f (CoreConfigArgs m) -> f (Args m)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CoreConfigArgs m
b -> Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
forall m.
Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
b NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) (a -> f b
f a
CoreConfigArgs m
a2)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ NESeq Text, b ~ NESeq Text) =>
  LabelOptic "commands" k (Args m) (Args m) a b
  where
  labelOptic :: Optic k NoIx (Args m) (Args m) a b
labelOptic = LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b)
-> LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) ->
    (NESeq Text -> Args m) -> f (NESeq Text) -> f (Args m)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NESeq Text
b -> Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
forall m.
Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
b Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) (a -> f b
f a
NESeq Text
a3)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ Bool, b ~ Bool) =>
  LabelOptic "dryRun" k (Args m) (Args m) a b
  where
  labelOptic :: Optic k NoIx (Args m) (Args m) a b
labelOptic = LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b)
-> LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) ->
    (Bool -> Args m) -> f Bool -> f (Args m)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
b -> Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
forall m.
Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
a3 Bool
b Maybe (WithDisabled EdgeArgs)
a5) (a -> f b
f a
Bool
a4)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ Maybe (WithDisabled EdgeArgs), b ~ Maybe (WithDisabled EdgeArgs)) =>
  LabelOptic "edges" k (Args m) (Args m) a b
  where
  labelOptic :: Optic k NoIx (Args m) (Args m) a b
labelOptic = LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b)
-> LensVL (Args m) (Args m) a b -> Lens (Args m) (Args m) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
a5) ->
    (Maybe (WithDisabled EdgeArgs) -> Args m)
-> f (Maybe (WithDisabled EdgeArgs)) -> f (Args m)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (WithDisabled EdgeArgs)
b -> Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
forall m.
Seq (WithDisabled OsPath)
-> CoreConfigArgs m
-> NESeq Text
-> Bool
-> Maybe (WithDisabled EdgeArgs)
-> Args m
MkArgs Seq (WithDisabled OsPath)
a1 CoreConfigArgs m
a2 NESeq Text
a3 Bool
a4 Maybe (WithDisabled EdgeArgs)
b) (a -> f b
f a
Maybe (WithDisabled EdgeArgs)
a5)
  {-# INLINE labelOptic #-}

-- | 'ParserInfo' type for parsing 'Args'.
parserInfoArgs :: List String -> ParserInfo (Args m)
parserInfoArgs :: forall m. [String] -> ParserInfo (Args m)
parserInfoArgs [String]
prevKeys =
  ParserInfo
    { infoParser :: Parser (Args m)
infoParser = [String] -> Parser (Args m)
forall m. [String] -> Parser (Args m)
argsParser [String]
prevKeys,
      infoFullDesc :: Bool
infoFullDesc = Bool
True,
      infoProgDesc :: Chunk Doc
infoProgDesc = Chunk Doc
desc,
      infoHeader :: Chunk Doc
infoHeader = Maybe Doc -> Chunk Doc
forall a. Maybe a -> Chunk a
Chunk Maybe Doc
headerTxt,
      infoFooter :: Chunk Doc
infoFooter = Maybe Doc -> Chunk Doc
forall a. Maybe a -> Chunk a
Chunk Maybe Doc
footerTxt,
      infoFailureCode :: Int
infoFailureCode = Int
1,
      infoPolicy :: ArgPolicy
infoPolicy = ArgPolicy
Intersperse
    }
  where
    headerTxt :: Maybe Doc
headerTxt = Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
"Shrun: A tool for running shell commands concurrently."
    footerTxt :: Maybe Doc
footerTxt = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
forall a. IsString a => String -> a
fromString String
versShort
    desc :: Chunk Doc
desc =
      [Chunk Doc] -> Chunk Doc
Chunk.vsepChunks
        [ String -> Chunk Doc
Chunk.paragraph
            (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
Item [String]
"Shrun runs shell commands concurrently. In addition to providing ",
                String
Item [String]
"basic timing and logging functionality, we also provide the ",
                String
Item [String]
"ability to pass in a config file that can be used to define ",
                String
Item [String]
"aliases for commands."
              ],
          String -> Chunk Doc
Chunk.paragraph
            (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
Item [String]
"CLI options override toml config so e.g. ",
                String
Item [String]
"'--console-log-command off' will disable ",
                String
Item [String]
"command logging, regardless of the toml's console-log.command."
              ],
          Item [Chunk Doc]
Chunk Doc
completions,
          String -> Chunk Doc
Chunk.paragraph String
"See github.com/tbidne/shrun#README for full documentation.",
          String -> Chunk Doc
Chunk.paragraph String
"Examples:",
          NonEmpty String -> Chunk Doc
mkExample
            [ String
Item (NonEmpty String)
"1. Runs cmd1, cmd2, cmd3 concurrently:",
              String
Item (NonEmpty String)
"",
              String
Item (NonEmpty String)
"$ shrun cmd1 cmd2 cmd3",
              String
Item (NonEmpty String)
"[Command][cmd1] cmd1 output...",
              String
Item (NonEmpty String)
"[Command][cmd2] cmd2 output...",
              String
Item (NonEmpty String)
"[Command][cmd3] cmd3 output...",
              String
Item (NonEmpty String)
"[Status][0|3|0|0] 5 seconds"
            ],
          NonEmpty String -> Chunk Doc
mkExample
            [ String
Item (NonEmpty String)
"2. Uses --edges to specify command dependencies. Commands cmd1 and",
              String
Item (NonEmpty String)
"cmd2 are run concurrently; cmd3 is started after cmd1 and cmd2 finish",
              String
Item (NonEmpty String)
"successfully.",
              String
Item (NonEmpty String)
"",
              String
Item (NonEmpty String)
"$ shrun --edges \"1 & 3, 2 & 3\" cmd1 cmd2 cmd3",
              String
Item (NonEmpty String)
"[Command][cmd1] cmd1 output...",
              String
Item (NonEmpty String)
"[Command][cmd2] cmd2 output...",
              String
Item (NonEmpty String)
"[Status][1|2|0|0] 5 seconds"
            ],
          NonEmpty String -> Chunk Doc
mkExample
            [ String
Item (NonEmpty String)
"3. Uses config file aliases i.e. builds frontend, backend, and db",
              String
Item (NonEmpty String)
"concurrently, then runs deploy if those tasks completed successfully.",
              String
Item (NonEmpty String)
"",
              String
Item (NonEmpty String)
"# config.toml",
              String
Item (NonEmpty String)
"legend = [",
              String
Item (NonEmpty String)
"  # Aliases for multiple commands",
              String
Item (NonEmpty String)
"  { key = 'deploy', val = [ 'build', 'ds' ], edges = '1 & 2' },",
              String
Item (NonEmpty String)
"  { key = 'build', val = [ 'frontend', 'backend', 'db' ] },",
              String
Item (NonEmpty String)
"",
              String
Item (NonEmpty String)
"  # Aliases to actual commands",
              String
Item (NonEmpty String)
"  { key = 'frontend', val = 'npm run build' },",
              String
Item (NonEmpty String)
"  { key = 'backend', val = 'javac ...' },",
              String
Item (NonEmpty String)
"  { key = 'db', val = 'db.sh' },",
              String
Item (NonEmpty String)
"  { key = 'ds', val = 'deploy.sh' },",
              String
Item (NonEmpty String)
"]",
              String
Item (NonEmpty String)
"",
              String
Item (NonEmpty String)
"$ shrun --config config.toml deploy",
              String
Item (NonEmpty String)
"[Command][frontend] Running npm...",
              String
Item (NonEmpty String)
"[Command][backend] Running javac...",
              String
Item (NonEmpty String)
"[Command][db] Running db.sh...",
              String
Item (NonEmpty String)
"[Status][1|3|0|0] 5 seconds"
            ]
        ]

    completions :: Chunk Doc
completions =
      [Chunk Doc] -> Chunk Doc
Chunk.vcatChunks
        [ String -> Chunk Doc
Chunk.paragraph
            (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
Item [String]
"Shrun also supports tab-completions for bash, fish, and zsh. ",
                String
Item [String]
"To load them, run the appropriate script:"
              ],
          Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
Pretty.nest Int
2
            (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chunk Doc] -> Chunk Doc
Chunk.vcatChunks
              [ Int -> String -> Chunk Doc
toChunk Int
0 String
"",
                String -> Chunk Doc
Chunk.stringChunk String
"$ source <(shrun --bash-completion-script `which shrun`)",
                String -> Chunk Doc
Chunk.stringChunk String
"$ source <(shrun --fish-completion-script `which shrun`)",
                String -> Chunk Doc
Chunk.stringChunk String
"$ source <(shrun --zsh-completion-script `which shrun`)"
              ]
        ]

    mkExample :: NonEmpty String -> Chunk DocOA
    mkExample :: NonEmpty String -> Chunk Doc
mkExample = Int -> Int -> NonEmpty String -> Chunk Doc
identPara Int
2 Int
5

    identPara :: Int -> Int -> NonEmpty String -> Chunk DocOA
    identPara :: Int -> Int -> NonEmpty String -> Chunk Doc
identPara Int
hIndent Int
lIndent (String
h :| [String]
xs) =
      [Chunk Doc] -> Chunk Doc
Chunk.vcatChunks
        ([Chunk Doc] -> Chunk Doc)
-> ([String] -> [Chunk Doc]) -> [String] -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (\[Chunk Doc]
ys -> Int -> String -> Chunk Doc
toChunk Int
hIndent String
h Chunk Doc -> [Chunk Doc] -> [Chunk Doc]
forall a. a -> [a] -> [a]
: [Chunk Doc]
ys)
        ([Chunk Doc] -> [Chunk Doc])
-> ([String] -> [Chunk Doc]) -> [String] -> [Chunk Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> Chunk Doc) -> [String] -> [Chunk Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> Chunk Doc
toChunk Int
lIndent)
        ([String] -> Chunk Doc) -> [String] -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ [String]
xs

    toChunk :: Int -> String -> Chunk Doc
toChunk Int
_ String
"" = Chunk Doc
forall {ann}. Chunk (Doc ann)
line
    toChunk Int
i String
other = (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall a b. (a -> b) -> Chunk a -> Chunk b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
Pretty.indent Int
i) (Chunk Doc -> Chunk Doc)
-> (String -> Chunk Doc) -> String -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Chunk Doc
Chunk.stringChunk (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ String
other

    line :: Chunk (Doc ann)
line = Maybe (Doc ann) -> Chunk (Doc ann)
forall a. Maybe a -> Chunk a
Chunk (Doc ann -> Maybe (Doc ann)
forall a. a -> Maybe a
Just Doc ann
forall ann. Doc ann
Pretty.softline)

parserPrefs :: ParserPrefs
parserPrefs :: ParserPrefs
parserPrefs =
  PrefsMod -> ParserPrefs
OA.prefs
    (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$ [PrefsMod] -> PrefsMod
forall a. Monoid a => [a] -> a
mconcat
      [ Int -> PrefsMod
OA.helpIndent Int
6
      ]

argsParser :: List String -> Parser (Args m)
argsParser :: forall m. [String] -> Parser (Args m)
argsParser [String]
prevKeys = do
  Seq (WithDisabled OsPath)
configPaths <- Parser (Seq (WithDisabled OsPath))
configParser
  Maybe (WithDisabled EdgeArgs)
edges <- Parser (Maybe (WithDisabled EdgeArgs))
Graph.edgesParser
  CoreConfigArgs m
coreConfig <-
    Parser (CoreConfigArgs m)
forall m. Parser (CoreConfigArgs m)
Core.coreParser
      Parser (CoreConfigArgs m)
-> Parser (CoreConfigArgs m -> CoreConfigArgs m)
-> Parser (CoreConfigArgs m)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (CoreConfigArgs m -> CoreConfigArgs m)
forall a. Parser (a -> a)
version
      Parser (CoreConfigArgs m)
-> Parser (CoreConfigArgs m -> CoreConfigArgs m)
-> Parser (CoreConfigArgs m)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser (CoreConfigArgs m -> CoreConfigArgs m)
forall a. Parser (a -> a)
OA.helper

  Bool
dryRun <- Parser Bool
miscParser

  NESeq Text
commands <- [String] -> Parser (NESeq Text)
commandsParser [String]
prevKeys

  pure
    $ MkArgs
      { Seq (WithDisabled OsPath)
configPaths :: Seq (WithDisabled OsPath)
configPaths :: Seq (WithDisabled OsPath)
configPaths,
        CoreConfigArgs m
coreConfig :: CoreConfigArgs m
coreConfig :: CoreConfigArgs m
coreConfig,
        NESeq Text
commands :: NESeq Text
commands :: NESeq Text
commands,
        Maybe (WithDisabled EdgeArgs)
edges :: Maybe (WithDisabled EdgeArgs)
edges :: Maybe (WithDisabled EdgeArgs)
edges,
        Bool
dryRun :: Bool
dryRun :: Bool
dryRun
      }
  where
    -- Want to put this in its own group. We put defaultConfig first for
    -- alphabetical order.
    miscParser :: Parser Bool
miscParser =
      String -> Parser Bool -> Parser Bool
forall a. String -> Parser a -> Parser a
OA.parserOptionGroup
        String
"Miscellaneous options:"
        (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Parser (Bool -> Bool)
forall a. Parser (a -> a)
defaultConfig
        Parser (Bool -> Bool) -> Parser Bool -> Parser Bool
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Parser Bool
dryRunParser

version :: Parser (a -> a)
version :: forall a. Parser (a -> a)
version = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
OA.infoOption String
versLong (String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OA.short Char
'v' Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. Mod f a
OA.hidden)

versShort :: String
versShort :: String
versShort =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
Item [String]
"Shrun: ",
      Version -> String
showVersion Version
Paths.version,
      String
Item [String]
" (",
      OsPath -> String
OsString.decodeLenient VersionInfo
versionInfo.gitShortHash,
      String
Item [String]
")"
    ]

versLong :: String
versLong :: String
versLong =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
    String
"\n"
    [ String
"Shrun: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
Paths.version,
      String
" - Git revision: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> OsPath -> String
OsString.decodeLenient VersionInfo
versionInfo.gitHash,
      String
" - Commit date:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> OsPath -> String
OsString.decodeLenient VersionInfo
versionInfo.gitCommitDate,
      String
" - GHC version:  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VersionInfo
versionInfo.ghc
    ]

data VersionInfo = MkVersionInfo
  { VersionInfo -> OsPath
gitCommitDate :: OsString,
    VersionInfo -> String
ghc :: String,
    VersionInfo -> OsPath
gitHash :: OsString,
    VersionInfo -> OsPath
gitShortHash :: OsString
  }

versionInfo :: VersionInfo
versionInfo :: VersionInfo
versionInfo =
  MkVersionInfo
    { gitCommitDate :: OsPath
gitCommitDate = OsPath
d,
      ghc :: String
ghc = Version -> String
showVersion Version
Info.fullCompilerVersion,
      gitHash :: OsPath
gitHash = OsPath
h,
      gitShortHash :: OsPath
gitShortHash = OsPath
sh
    }
  where
    (OsPath
d, OsPath
h, OsPath
sh) = $$Addr#
Int
Int -> Addr# -> ByteArray
ByteArray -> ShortByteString
ShortByteString -> PosixString
OsPath -> OsPath -> OsPath -> (OsPath, OsPath, OsPath)
PosixString -> OsPath
forall a b c. a -> b -> c -> (a, b, c)
TH.gitData

defaultConfig :: Parser (a -> a)
defaultConfig :: forall a. Parser (a -> a)
defaultConfig =
  String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
OA.infoOption
    (Text -> String
unpack $$Addr#
Int#
Addr# -> Int -> Text
Int# -> Int
TH.defaultToml)
    (String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"default-config" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
help)
  where
    help :: String
help = String
"Writes a default toml config file to stdout."

configParser :: Parser (Seq (WithDisabled OsPath))
configParser :: Parser (Seq (WithDisabled OsPath))
configParser =
  ([WithDisabled OsPath] -> Seq (WithDisabled OsPath))
-> Parser [WithDisabled OsPath]
-> Parser (Seq (WithDisabled OsPath))
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [WithDisabled OsPath] -> Seq (WithDisabled OsPath)
forall a. [a] -> Seq a
listToSeq
    (Parser [WithDisabled OsPath]
 -> Parser (Seq (WithDisabled OsPath)))
-> (Parser (WithDisabled OsPath) -> Parser [WithDisabled OsPath])
-> Parser (WithDisabled OsPath)
-> Parser (Seq (WithDisabled OsPath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser (WithDisabled OsPath) -> Parser [WithDisabled OsPath]
forall a. Parser a -> Parser [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many
    (Parser (WithDisabled OsPath)
 -> Parser (Seq (WithDisabled OsPath)))
-> Parser (WithDisabled OsPath)
-> Parser (Seq (WithDisabled OsPath))
forall a b. (a -> b) -> a -> b
$ ReadM OsPath
-> [Mod OptionFields (WithDisabled OsPath)]
-> Parser (WithDisabled OsPath)
forall a.
ReadM a
-> [Mod OptionFields (WithDisabled a)] -> Parser (WithDisabled a)
Utils.withDisabledParserNoOpts
      ReadM OsPath
validOsPath
      [Mod OptionFields (WithDisabled OsPath)]
opts
  where
    opts :: [Mod OptionFields (WithDisabled OsPath)]
opts =
      [ String -> Mod OptionFields (WithDisabled OsPath)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"config",
        Char -> Mod OptionFields (WithDisabled OsPath)
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OA.short Char
'c',
        String -> Mod OptionFields (WithDisabled OsPath)
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"(PATH | off)...",
        Completer -> Mod OptionFields (WithDisabled OsPath)
forall (f :: Type -> Type) a.
HasCompleter f =>
Completer -> Mod f a
OA.completer Completer
EOC.compgenCwdPathsCompleter,
        [String] -> Mod OptionFields (WithDisabled OsPath)
forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
OA.completeWith [String
Item [String]
"off"],
        Item [Mod OptionFields (WithDisabled OsPath)]
Mod OptionFields (WithDisabled OsPath)
helpTxt
      ]

    helpTxt :: Mod OptionFields (WithDisabled OsPath)
helpTxt =
      Maybe Doc -> Mod OptionFields (WithDisabled OsPath)
forall (f :: Type -> Type) a. Maybe Doc -> Mod f a
OA.helpDoc
        (Maybe Doc -> Mod OptionFields (WithDisabled OsPath))
-> (Chunk Doc -> Maybe Doc)
-> Chunk Doc
-> Mod OptionFields (WithDisabled OsPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Chunk Doc -> Maybe Doc
forall a. Chunk a -> Maybe a
Chunk.unChunk
        (Chunk Doc -> Mod OptionFields (WithDisabled OsPath))
-> Chunk Doc -> Mod OptionFields (WithDisabled OsPath)
forall a b. (a -> b) -> a -> b
$ [Chunk Doc] -> Chunk Doc
Chunk.vcatChunks
          [ Item [Chunk Doc]
Chunk Doc
helpList,
            Doc -> Chunk Doc
forall a. a -> Chunk a
Utils.toChunk Doc
forall ann. Doc ann
Pretty.softline,
            Item [Chunk Doc]
Chunk Doc
outtro,
            Doc -> Chunk Doc
forall a. a -> Chunk a
Utils.toChunk Doc
forall ann. Doc ann
Pretty.softline
          ]

    helpList :: Chunk Doc
helpList =
      NESeq String -> Chunk Doc
Utils.itemizeHelper
        (NESeq String -> Chunk Doc) -> NESeq String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ String
intro
        String -> Seq String -> NESeq String
forall a. a -> Seq a -> NESeq a
:<|| [ String
Item (Seq String)
"<XDG_config>/shrun/config.toml",
               String
Item (Seq String)
"<XDG_config>/shrun/.shrun.toml",
               String
Item (Seq String)
"<XDG_config>/shrun/shrun.toml",
               String
Item (Seq String)
"./.shrun.toml",
               String
Item (Seq String)
"./shrun.toml"
             ]

    intro :: String
intro =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"Path(s) to TOML config file(s). This argument can be given multiple ",
          String
Item [String]
"times, in which case all keys are merged. When there is a conflict, ",
          String
Item [String]
"the right-most config wins. The legends are also merged, with the ",
          String
Item [String]
"same right-bias for conflicting keys. The string 'off' disables ",
          String
Item [String]
"all config files to its left. Finally, we also search in specific ",
          String
Item [String]
"locations automatically. These are:"
        ]

    outtro :: Chunk Doc
outtro =
      String -> Chunk Doc
Chunk.paragraph
        (String -> Chunk Doc) -> String -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
Item [String]
"These files are considered 'left' of any configs explicitly given ",
            String
Item [String]
"with --config, hence disabled with 'off'."
          ]

commandsParser :: List String -> Parser (NESeq Text)
commandsParser :: [String] -> Parser (NESeq Text)
commandsParser [String]
prevKeys =
  [Text] -> NESeq Text
forall a. HasCallStack => [a] -> NESeq a
unsafeListToNESeq
    ([Text] -> NESeq Text) -> Parser [Text] -> Parser (NESeq Text)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser [Text]
forall a. Parser a -> Parser [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
OA.some
      ( String -> Text
T.pack
          (String -> Text) -> Parser String -> Parser Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
OA.argument ReadM String
forall s. IsString s => ReadM s
OA.str Mod ArgumentFields String
opts
      )
  where
    opts :: Mod ArgumentFields String
opts =
      [Mod ArgumentFields String] -> Mod ArgumentFields String
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod ArgumentFields String
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"Commands...",
          [String] -> Mod ArgumentFields String
forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
OA.completeWith [String]
prevKeys,
          Completer -> Mod ArgumentFields String
forall (f :: Type -> Type) a.
HasCompleter f =>
Completer -> Mod f a
OA.completer Completer
EOC.compgenCwdPathsCompleter
        ]

dryRunParser :: Parser Bool
dryRunParser :: Parser Bool
dryRunParser =
  Mod FlagFields Bool -> Parser Bool
OA.switch
    (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod FlagFields Bool
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"dry-run",
        String -> Mod FlagFields Bool
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelpNoLine String
"Prints the configuration and commands that would be run to stdout, then exits."
      ]