{-# LANGUAGE OverloadedStrings #-}

module System.Console.Options.Failure.Internal
  ( mkUnrecognized
  , unsaturated
  , oversaturated
  ) where

import           System.Console.Options.Help.Internal

import           Data.Text (Text)
import           Prettyprinter
import           Prettyprinter.Internal.Type
import           System.Console.Options (Name)



{-# INLINE mkUnrecognized #-}
mkUnrecognized :: (String -> Name -> [Name]) -> String -> Name -> Doc ann
mkUnrecognized :: forall ann. (String -> Name -> [Name]) -> String -> Name -> Doc ann
mkUnrecognized String -> Name -> [Name]
suggest String
arg Name
n =
  Doc ann
"invalid option '" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall ann. Name -> Doc ann
name Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
squote
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> case String -> Name -> [Name]
suggest String
arg Name
n of
         []     -> Doc ann
forall ann. Doc ann
emptyDoc
         [Name]
ss     ->
           Doc ann
"; perhaps you meant "
             Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ( case [Name]
ss of
                    [Name
x]    -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Name -> Doc ann
forall ann. Name -> Doc ann
name Name
x)
                    Name
x:Name
y:[Name]
zs -> Doc ann
"any of " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> [Doc ann] -> Doc ann
orFold (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Name -> Doc ann
forall ann. Name -> Doc ann
name Name
x)) (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Name -> Doc ann
forall ann. Name -> Doc ann
name Name
y))
                                             (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Doc ann -> Doc ann) -> (Name -> Doc ann) -> Name -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Doc ann
forall ann. Name -> Doc ann
name (Name -> Doc ann) -> [Name] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
zs)
                )
             Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
Char Char
'?'

-- | @_, _, _, _ or _@.
orFold :: Doc ann -> Doc ann -> [Doc ann] -> Doc ann
orFold :: forall ann. Doc ann -> Doc ann -> [Doc ann] -> Doc ann
orFold Doc ann
x Doc ann
y [Doc ann]
zs =
  case [Doc ann]
zs of
    []   -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" or " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y
    Doc ann
z:[Doc ann]
as -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> [Doc ann] -> Doc ann
orFold Doc ann
y Doc ann
z [Doc ann]
as



-- | 'Codec.Console.Options.Unsaturated' failure case.
--
--   >>> unsaturated (Long 'foo')
--   option '--foo' requires an argument
unsaturated :: Name -> Doc ann
unsaturated :: forall ann. Name -> Doc ann
unsaturated Name
n = Doc ann
"option '" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall ann. Name -> Doc ann
name Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"' requires an argument"

-- | 'Codec.Console.Options.Oversaturated' failure case.
--
--   >>> oversaturated "foo"
--   option '--foo' doesn't allow an argument
--   >>> oversaturated ""
--   end of options delimiter '--' doesn't allow an argument
oversaturated
  :: Text    -- ^ Long option name, may be empty (consider @--=ARG@).
  -> Doc ann
oversaturated :: forall ann. Text -> Doc ann
oversaturated Text
ls =
     ( case Text
ls of
        Text
"" -> Doc ann
"end of options delimiter '--"
        Text
_  -> Doc ann
"option '--" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
ls
     )
  Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"' doesn't allow an argument"