{- | t'Failure' pretty printing.
 -}

{-# LANGUAGE OverloadedStrings #-}

module System.Console.Options.Failure
  ( failure

    -- | === Constituents
  , unrecognized
  , unsaturated
  , oversaturated
  ) where

import           Data.Console.Options.Help

import           Data.ByteString.Short (ShortByteString)
import           Data.Console.Options
import           Data.Functor.Identity
import           Data.Text.Short (ShortText)
import qualified Data.Text.Short as ST
import qualified Data.Text.Short.Unsafe as ST
import           Prettyprinter
import           Prettyprinter.Internal.Type
import           System.Console.Options



-- | Failure description, with 'suggestions' if applicable.
--
--   Examples for each specific failure case are given below.
failure :: Options Identity f -> Failure -> Doc ann
failure :: forall f ann. Options Identity f -> Failure -> Doc ann
failure Options Identity f
opts Failure
f =
  case Failure
f of
    NonPortable OsString
_ ShortByteString
arg    -> ShortByteString -> Doc ann
forall ann. ShortByteString -> Doc ann
nonPortable ShortByteString
arg
    Unrecognized OsString
_ ShortByteString
arg Name
n -> Options Identity f -> ShortByteString -> Name -> Doc ann
forall f ann.
Options Identity f -> ShortByteString -> Name -> Doc ann
unrecognized Options Identity f
opts ShortByteString
arg Name
n
    Unsaturated Name
n        -> Name -> Doc ann
forall ann. Name -> Doc ann
unsaturated Name
n
    Oversaturated ShortText
ls OsString
_   -> ShortText -> Doc ann
forall ann. ShortText -> Doc ann
oversaturated ShortText
ls



-- | 'NonPortable' failure case.
--
--   >>> nonPortable "--non\xED\xB3\xBF\&ascii"
--   option 'nonascii�' is uninterpretable
nonPortable
  :: ShortByteString -- ^ Argument converted to WTF-8.
  -> Doc ann
nonPortable :: forall ann. ShortByteString -> Doc ann
nonPortable ShortByteString
arg =
  let sanitized :: ShortText
sanitized = [Char] -> ShortText
ST.pack ([Char] -> ShortText)
-> (ShortText -> [Char]) -> ShortText -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> [Char]
ST.unpack (ShortText -> ShortText) -> ShortText -> ShortText
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ShortText
ST.fromShortByteStringUnsafe ShortByteString
arg
  in 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 (ShortText -> Text
ST.toText ShortText
sanitized) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"'"



-- | 'Unrecognized' failure case, with 'suggestions' if applicable.
--
--   >>> let opt = Option [Short 'i', Short 'a', Short 'b', Long "abode"] Plain
--   >>> let opts = insert opt id none
--   >>> unrecognized opts "--abid" (Long "abid")
--   invalid option '--abid'; perhaps you meant any of '-a', '-b', '-i' or '--abode'?
unrecognized
  :: Options Identity f
  -> ShortByteString    -- ^ Argument converted to WTF-8.
  -> Name
  -> Doc ann
unrecognized :: forall f ann.
Options Identity f -> ShortByteString -> Name -> Doc ann
unrecognized Options Identity f
opts ShortByteString
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 Options Identity f -> ShortByteString -> Name -> [Name]
forall f. Options Identity f -> ShortByteString -> Name -> [Name]
suggestions Options Identity f
opts ShortByteString
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



-- | '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"

-- | 'Oversaturated' failure case.
--
--   >>> oversaturated "foo"
--   option '--foo' doesn't allow an argument
--   >>> oversaturated ""
--   end of options delimiter '--' doesn't allow an argument
oversaturated
  :: ShortText -- ^ Long option name, may be empty (consider @--=ARG@).
  -> Doc ann
oversaturated :: forall ann. ShortText -> Doc ann
oversaturated ShortText
ls =
     ( case ShortText
ls of
        ShortText
"" -> Doc ann
"end of options delimiter '--"
        ShortText
_  -> 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 (ShortText -> Text
ST.toText ShortText
ls)
     )
  Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"' doesn't allow an argument"