{-# 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,
  )
where

import Data.List qualified as L
import Data.String (IsString (fromString))
import Data.Text qualified as T
import Data.Version (Version (versionBranch))
import Effects.Optparse (validOsPath)
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.Types (ArgPolicy (Intersperse))
import Paths_shrun qualified as Paths
import Shrun.Configuration.Args.Parsing.Core qualified as Core
import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
import Shrun.Configuration.Args.TH (getDefaultConfigTH)
import Shrun.Configuration.Data.Core (CoreConfigArgs)
import Shrun.Configuration.Data.WithDisabled (WithDisabled)
import Shrun.Prelude
import Shrun.Utils qualified as U

-- | CLI args.
data Args = MkArgs
  { -- | Optional config file.
    Args -> WithDisabled OsPath
configPath :: WithDisabled OsPath,
    -- | Core config.
    Args -> CoreConfigArgs
coreConfig :: CoreConfigArgs,
    -- | List of commands.
    Args -> NESeq Text
commands :: NESeq Text
  }
  deriving stock (Args -> Args -> Bool
(Args -> Args -> Bool) -> (Args -> Args -> Bool) -> Eq Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
/= :: Args -> Args -> Bool
Eq, Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args -> ShowS
showsPrec :: Int -> Args -> ShowS
$cshow :: Args -> String
show :: Args -> String
$cshowList :: [Args] -> ShowS
showList :: [Args] -> ShowS
Show)

instance
  (k ~ A_Lens, a ~ WithDisabled OsPath, b ~ WithDisabled OsPath) =>
  LabelOptic "configPath" k Args Args a b
  where
  labelOptic :: Optic k NoIx Args Args a b
labelOptic = LensVL Args Args a b -> Lens Args Args a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL Args Args a b -> Lens Args Args a b)
-> LensVL Args Args a b -> Lens Args Args a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs WithDisabled OsPath
_configPath CoreConfigArgs
_coreConfig NESeq Text
_commands) ->
    (WithDisabled OsPath -> Args) -> f (WithDisabled OsPath) -> f Args
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WithDisabled OsPath
configPath' -> WithDisabled OsPath -> CoreConfigArgs -> NESeq Text -> Args
MkArgs WithDisabled OsPath
configPath' CoreConfigArgs
_coreConfig NESeq Text
_commands) (a -> f b
f a
WithDisabled OsPath
_configPath)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ CoreConfigArgs, b ~ CoreConfigArgs) =>
  LabelOptic "coreConfig" k Args Args a b
  where
  labelOptic :: Optic k NoIx Args Args a b
labelOptic = LensVL Args Args a b -> Lens Args Args a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL Args Args a b -> Lens Args Args a b)
-> LensVL Args Args a b -> Lens Args Args a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs WithDisabled OsPath
_configPath CoreConfigArgs
_coreConfig NESeq Text
_commands) ->
    (CoreConfigArgs -> Args) -> f CoreConfigArgs -> f Args
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
coreConfig' -> WithDisabled OsPath -> CoreConfigArgs -> NESeq Text -> Args
MkArgs WithDisabled OsPath
_configPath CoreConfigArgs
coreConfig' NESeq Text
_commands) (a -> f b
f a
CoreConfigArgs
_coreConfig)
  {-# INLINE labelOptic #-}

instance
  (k ~ A_Lens, a ~ NESeq Text, b ~ NESeq Text) =>
  LabelOptic "commands" k Args Args a b
  where
  labelOptic :: Optic k NoIx Args Args a b
labelOptic = LensVL Args Args a b -> Lens Args Args a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL Args Args a b -> Lens Args Args a b)
-> LensVL Args Args a b -> Lens Args Args a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkArgs WithDisabled OsPath
_configPath CoreConfigArgs
_coreConfig NESeq Text
_commands) ->
    (NESeq Text -> Args) -> f (NESeq Text) -> f Args
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (WithDisabled OsPath -> CoreConfigArgs -> NESeq Text -> Args
MkArgs WithDisabled OsPath
_configPath CoreConfigArgs
_coreConfig) (a -> f b
f a
NESeq Text
_commands)
  {-# INLINE labelOptic #-}

-- | 'ParserInfo' type for parsing 'Args'.
parserInfoArgs :: ParserInfo Args
parserInfoArgs :: ParserInfo Args
parserInfoArgs =
  ParserInfo
    { infoParser :: Parser Args
infoParser = Parser Args
argsParser,
      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
versNum
    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
"Shrun runs shell commands concurrently. In addition to providing ",
                String
"basic timing and logging functionality, we also provide the ",
                String
"ability to pass in a config file that can be used to define ",
                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
"In general, each option --foo has a --no-foo variant that ",
                String
"disables cli and toml configuration for that field. For ",
                String
"example, the --no-console-log-command option will instruct shrun to ",
                String
"ignore both cli --console-log-command and toml console-log.command, ",
                String
"ensuring the default behavior is used (i.e. no command logging)."
              ],
          String -> Chunk Doc
Chunk.paragraph String
"See github.com/tbidne/shrun#README for full documentation."
        ]

argsParser :: Parser Args
argsParser :: Parser Args
argsParser = do
  WithDisabled OsPath -> CoreConfigArgs -> NESeq Text -> Args
MkArgs
    (WithDisabled OsPath -> CoreConfigArgs -> NESeq Text -> Args)
-> Parser (WithDisabled OsPath)
-> Parser (CoreConfigArgs -> NESeq Text -> Args)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (WithDisabled OsPath)
configParser
    Parser (CoreConfigArgs -> NESeq Text -> Args)
-> Parser CoreConfigArgs -> Parser (NESeq Text -> Args)
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 CoreConfigArgs
Core.coreParser
    Parser (NESeq Text -> Args)
-> Parser ((NESeq Text -> Args) -> NESeq Text -> Args)
-> Parser (NESeq Text -> Args)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser ((NESeq Text -> Args) -> NESeq Text -> Args)
forall a. Parser (a -> a)
defaultConfig
    Parser (NESeq Text -> Args)
-> Parser ((NESeq Text -> Args) -> NESeq Text -> Args)
-> Parser (NESeq Text -> Args)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser ((NESeq Text -> Args) -> NESeq Text -> Args)
forall a. Parser (a -> a)
version
    Parser (NESeq Text -> Args)
-> Parser ((NESeq Text -> Args) -> NESeq Text -> Args)
-> Parser (NESeq Text -> Args)
forall (f :: Type -> Type) a b.
Applicative f =>
f a -> f (a -> b) -> f b
<**> Parser ((NESeq Text -> Args) -> NESeq Text -> Args)
forall a. Parser (a -> a)
OA.helper
    Parser (NESeq Text -> Args) -> Parser (NESeq Text) -> Parser Args
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 (NESeq Text)
commandsParser

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
versNum
    (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"version",
        Char -> Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OA.short Char
'v',
        Mod OptionFields (a -> a)
forall (f :: Type -> Type) a. Mod f a
OA.hidden
      ]

versNum :: String
versNum :: String
versNum = String
"Version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> [Int]
versionBranch Version
Paths.version)

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 Text
txt) (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
    txt :: Text
txt = [Text] -> Text
T.unlines $$Addr#
Int#
Text
Addr# -> Int -> Text
Int# -> Int
empty :: Text
unpackCStringLen# :: Addr# -> Int -> Text
getDefaultConfigTH
    help :: String
help = String
"Writes a default config.toml file to stdout."

configParser :: Parser (WithDisabled OsPath)
configParser :: Parser (WithDisabled OsPath)
configParser = Parser (Maybe OsPath) -> String -> Parser (WithDisabled OsPath)
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe OsPath)
mainParser String
"config"
  where
    mainParser :: Parser (Maybe OsPath)
mainParser =
      Parser OsPath -> Parser (Maybe OsPath)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser OsPath -> Parser (Maybe OsPath))
-> Parser OsPath -> Parser (Maybe OsPath)
forall a b. (a -> b) -> a -> b
$ ReadM OsPath -> Mod OptionFields OsPath -> Parser OsPath
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          ReadM OsPath
validOsPath
          ( [Mod OptionFields OsPath] -> Mod OptionFields OsPath
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields OsPath
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"config",
                Char -> Mod OptionFields OsPath
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OA.short Char
'c',
                String -> Mod OptionFields OsPath
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
mainHelpTxt,
                String -> Mod OptionFields OsPath
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"PATH"
              ]
          )
    mainHelpTxt :: String
mainHelpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Path to TOML config file. If this argument is not given ",
          String
"we automatically look in the XDG config directory ",
          String
"e.g. ~/.config/shrun/config.toml. The --no-config option disables ",
          String
"--config and the automatic XDG lookup."
        ]

commandsParser :: Parser (NESeq Text)
commandsParser :: Parser (NESeq Text)
commandsParser =
  [Text] -> NESeq Text
forall a. HasCallStack => List a -> NESeq a
U.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 (String -> Mod ArgumentFields String
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"Commands...")
      )