module Shrun.Configuration.Args.Parsing.Utils
  ( withDisabledParser,
    withDisabledParserOpts,
    mkHelp,
    autoStripUnderscores,
  )
where

import Options.Applicative (Parser)
import Options.Applicative qualified as OA
import Options.Applicative.Builder (FlagFields, Mod, ReadM)
import Options.Applicative.Help.Chunk qualified as Chunk
import Options.Applicative.Help.Pretty qualified as Pretty
import Shrun.Configuration.Data.WithDisabled
  ( WithDisabled
      ( Disabled,
        With,
        Without
      ),
  )
import Shrun.Prelude
import Shrun.Utils qualified as ShrunUtils
import Text.Read (Read)

-- | Adds a '--no-x' switch to the parser.
withDisabledParser ::
  -- | Main parser.
  Parser (Maybe a) ->
  -- | Name for this option, to be used in disabled switch name.
  String ->
  Parser (WithDisabled a)
withDisabledParser :: forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
withDisabledParser Parser (Maybe a)
mainParser String
name =
  Mod FlagFields Bool
-> Parser (Maybe a) -> String -> Parser (WithDisabled a)
forall a.
Mod FlagFields Bool
-> Parser (Maybe a) -> String -> Parser (WithDisabled a)
withDisabledParserOpts Mod FlagFields Bool
opts Parser (Maybe a)
mainParser String
name
  where
    helpTxt :: String
helpTxt = String
"Disables --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    opts :: Mod FlagFields Bool
opts = String -> Mod FlagFields Bool
forall (f :: Type -> Type) a. String -> Mod f a
mkHelp String
helpTxt

-- | Like 'withDisabledParser', except it also takes an arg for the disabled
-- switch options.
withDisabledParserOpts ::
  -- | Disabled switch options.
  Mod FlagFields Bool ->
  -- | Main parser
  Parser (Maybe a) ->
  -- | Name for this option, to be used in disabled switch name.
  String ->
  Parser (WithDisabled a)
withDisabledParserOpts :: forall a.
Mod FlagFields Bool
-> Parser (Maybe a) -> String -> Parser (WithDisabled a)
withDisabledParserOpts Mod FlagFields Bool
disabledOpts Parser (Maybe a)
mainParser String
name = do
  Maybe a
mx <- Parser (Maybe a)
mainParser
  Bool
y <- Parser Bool
noParser
  pure
    $ if Bool
y
      then WithDisabled a
forall a. WithDisabled a
Disabled
      else WithDisabled a
-> (a -> WithDisabled a) -> Maybe a -> WithDisabled a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WithDisabled a
forall a. WithDisabled a
Without a -> WithDisabled a
forall a. a -> WithDisabled a
With Maybe a
mx
  where
    noParser :: Parser Bool
noParser =
      Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
OA.flag
        Bool
False
        Bool
True
        ( [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 -> Mod FlagFields Bool) -> String -> Mod FlagFields Bool
forall a b. (a -> b) -> a -> b
$ String
"no-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name,
              Mod FlagFields Bool
forall (f :: Type -> Type) a. Mod f a
OA.hidden,
              Mod FlagFields Bool
disabledOpts
            ]
        )

-- Looks a bit convoluted, but this gets us what we want:
-- 1. lines aligned (paragraph)
-- 2. linebreak at the end (fmap hardline)
mkHelp :: String -> OA.Mod f a
mkHelp :: forall (f :: Type -> Type) a. String -> Mod f a
mkHelp =
  Maybe Doc -> Mod f a
forall (f :: Type -> Type) a. Maybe Doc -> Mod f a
OA.helpDoc
    (Maybe Doc -> Mod f a)
-> (String -> Maybe Doc) -> String -> Mod f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> Maybe Doc -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
Pretty.hardline)
    (Maybe Doc -> Maybe Doc)
-> (String -> Maybe Doc) -> String -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk Doc -> Maybe Doc
forall a. Chunk a -> Maybe a
Chunk.unChunk
    (Chunk Doc -> Maybe Doc)
-> (String -> Chunk Doc) -> String -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Chunk Doc
Chunk.paragraph

-- | Reads 'Text', strips underscores, then uses the Read class. This is
-- essentially 'auto' but removes underscores. This is used for nicer
-- numeric values e.g. allowing parsing "1_000_000" as a Num.
autoStripUnderscores :: (Read a) => ReadM a
autoStripUnderscores :: forall a. Read a => ReadM a
autoStripUnderscores = ReadM Text
forall s. IsString s => ReadM s
OA.str ReadM Text -> (Text -> ReadM a) -> ReadM a
forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ReadM a
forall (m :: Type -> Type) a. (MonadFail m, Read a) => Text -> m a
ShrunUtils.readStripUnderscores