{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}

-- | Command-line options parser.

module Descriptive.Options
  (-- * Existence flags
   flag
  ,switch
  -- * Text input arguments
  ,prefix
  ,arg
   -- * Token consumers
   -- $tokens
  ,anyString
  ,constant
  -- * Special control
  ,stop
  -- * Description
  ,Option(..)
  ,textDescription
  ,textOpt)
  where

import           Descriptive

import           Control.Applicative
import           Control.Monad.State.Strict
import           Data.Char
import           Data.List
#if __GLASGOW_HASKELL__ < 804
import           Data.Monoid
#endif
import           Data.Text (Text)
import qualified Data.Text as T

-- | Description of a commandline option.
data Option a
  = AnyString !Text
  | Constant !Text !Text
  | Flag !Text !Text
  | Arg !Text !Text
  | Prefix !Text !Text
  | Stops
  | Stopped !a
  deriving (Int -> Option a -> ShowS
[Option a] -> ShowS
Option a -> String
(Int -> Option a -> ShowS)
-> (Option a -> String) -> ([Option a] -> ShowS) -> Show (Option a)
forall a. Show a => Int -> Option a -> ShowS
forall a. Show a => [Option a] -> ShowS
forall a. Show a => Option a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option a] -> ShowS
$cshowList :: forall a. Show a => [Option a] -> ShowS
show :: Option a -> String
$cshow :: forall a. Show a => Option a -> String
showsPrec :: Int -> Option a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Option a -> ShowS
Show,Option a -> Option a -> Bool
(Option a -> Option a -> Bool)
-> (Option a -> Option a -> Bool) -> Eq (Option a)
forall a. Eq a => Option a -> Option a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option a -> Option a -> Bool
$c/= :: forall a. Eq a => Option a -> Option a -> Bool
== :: Option a -> Option a -> Bool
$c== :: forall a. Eq a => Option a -> Option a -> Bool
Eq)

-- | If the consumer succeeds, stops the whole parser and returns
-- 'Stopped' immediately.
stop :: Monad m
     => Consumer [Text] (Option a) m a
     -- ^ A parser which, when it succeeds, causes the whole parser to stop.
     -> Consumer [Text] (Option a) m ()
stop :: Consumer [Text] (Option a) m a -> Consumer [Text] (Option a) m ()
stop =
  (StateT [Text] m (Description (Option a))
 -> StateT [Text] m (Description (Option a)))
-> (StateT [Text] m (Description (Option a))
    -> StateT [Text] m (Result (Description (Option a)) a)
    -> StateT [Text] m (Result (Description (Option a)) ()))
-> Consumer [Text] (Option a) m a
-> Consumer [Text] (Option a) m ()
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
    -> StateT t m (Result (Description d) a)
    -> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap ((Description (Option a) -> Description (Option a))
-> StateT [Text] m (Description (Option a))
-> StateT [Text] m (Description (Option a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Option a -> Description (Option a) -> Description (Option a)
forall a. a -> Description a -> Description a
Wrap Option a
forall a. Option a
Stops))
       (\d :: StateT [Text] m (Description (Option a))
d p :: StateT [Text] m (Result (Description (Option a)) a)
p ->
          do Result (Description (Option a)) a
r <- StateT [Text] m (Result (Description (Option a)) a)
p
             [Text]
s <- StateT [Text] m [Text]
forall s (m :: * -> *). MonadState s m => m s
get
             case Result (Description (Option a)) a
r of
               (Failed _) ->
                 Result (Description (Option a)) ()
-> StateT [Text] m (Result (Description (Option a)) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Result (Description (Option a)) ()
forall e a. a -> Result e a
Succeeded ())
               (Continued e :: Description (Option a)
e) ->
                 Result (Description (Option a)) ()
-> StateT [Text] m (Result (Description (Option a)) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) ()
forall e a. e -> Result e a
Continued Description (Option a)
e)
               (Succeeded a :: a
a) ->
                 do Description (Option a)
doc <- ([Text] -> [Text])
-> StateT [Text] m (Description (Option a))
-> StateT [Text] m (Description (Option a))
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT ([Text] -> [Text] -> [Text]
forall a b. a -> b -> a
const [Text]
s) StateT [Text] m (Description (Option a))
d
                    Result (Description (Option a)) ()
-> StateT [Text] m (Result (Description (Option a)) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) ()
forall e a. e -> Result e a
Failed (Option a -> Description (Option a) -> Description (Option a)
forall a. a -> Description a -> Description a
Wrap (a -> Option a
forall a. a -> Option a
Stopped a
a)
                                         Description (Option a)
doc)))

-- | Consume one argument from the argument list and pops it from the
-- start of the list.
anyString :: Monad m
          => Text -- Help for the string.
          -> Consumer [Text] (Option a) m Text
anyString :: Text -> Consumer [Text] (Option a) m Text
anyString help :: Text
help =
  StateT [Text] m (Description (Option a))
-> StateT [Text] m (Result (Description (Option a)) Text)
-> Consumer [Text] (Option a) m Text
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Option a) -> StateT [Text] m (Description (Option a))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Option a)
forall a. Description (Option a)
d)
           (do [Text]
s <- StateT [Text] m [Text]
forall s (m :: * -> *). MonadState s m => m s
get
               case [Text]
s of
                 [] -> Result (Description (Option a)) Text
-> StateT [Text] m (Result (Description (Option a)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) Text
forall e a. e -> Result e a
Failed Description (Option a)
forall a. Description (Option a)
d)
                 (x :: Text
x:s' :: [Text]
s') -> do [Text] -> StateT [Text] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Text]
s'
                              Result (Description (Option a)) Text
-> StateT [Text] m (Result (Description (Option a)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result (Description (Option a)) Text
forall e a. a -> Result e a
Succeeded Text
x))
  where d :: Description (Option a)
d = Option a -> Description (Option a)
forall a. a -> Description a
Unit (Text -> Option a
forall a. Text -> Option a
AnyString Text
help)

-- | Consume one argument from the argument list which must match the
-- given string, and also pops it off the argument list.
constant :: Monad m
         => Text -- ^ String.
         -> Text -- ^ Description.
         -> v
         -> Consumer [Text] (Option a) m v
constant :: Text -> Text -> v -> Consumer [Text] (Option a) m v
constant x' :: Text
x' desc :: Text
desc v :: v
v =
  StateT [Text] m (Description (Option a))
-> StateT [Text] m (Result (Description (Option a)) v)
-> Consumer [Text] (Option a) m v
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Option a) -> StateT [Text] m (Description (Option a))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Option a)
forall a. Description (Option a)
d)
           (do [Text]
s <- StateT [Text] m [Text]
forall s (m :: * -> *). MonadState s m => m s
get
               case [Text]
s of
                 (x :: Text
x:s' :: [Text]
s') | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' ->
                   do [Text] -> StateT [Text] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Text]
s'
                      Result (Description (Option a)) v
-> StateT [Text] m (Result (Description (Option a)) v)
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> Result (Description (Option a)) v
forall e a. a -> Result e a
Succeeded v
v)
                 _ -> Result (Description (Option a)) v
-> StateT [Text] m (Result (Description (Option a)) v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) v
forall e a. e -> Result e a
Failed Description (Option a)
forall a. Description (Option a)
d))
  where d :: Description (Option a)
d = Option a -> Description (Option a)
forall a. a -> Description a
Unit (Text -> Text -> Option a
forall a. Text -> Text -> Option a
Constant Text
x' Text
desc)

-- | Find a value flag which must succeed. Removes it from the
-- argument list if it succeeds.
flag :: Monad m
     => Text -- ^ Name.
     -> Text -- ^ Description.
     -> v    -- ^ Value returned when present.
     -> Consumer [Text] (Option a) m v
flag :: Text -> Text -> v -> Consumer [Text] (Option a) m v
flag name :: Text
name help :: Text
help v :: v
v =
  StateT [Text] m (Description (Option a))
-> StateT [Text] m (Result (Description (Option a)) v)
-> Consumer [Text] (Option a) m v
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Option a) -> StateT [Text] m (Description (Option a))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Option a)
forall a. Description (Option a)
d)
           (do [Text]
s <- StateT [Text] m [Text]
forall s (m :: * -> *). MonadState s m => m s
get
               if Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ("--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [Text]
s
                  then do [Text] -> StateT [Text] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [Text]
s)
                          Result (Description (Option a)) v
-> StateT [Text] m (Result (Description (Option a)) v)
forall (m :: * -> *) a. Monad m => a -> m a
return (v -> Result (Description (Option a)) v
forall e a. a -> Result e a
Succeeded v
v)
                  else Result (Description (Option a)) v
-> StateT [Text] m (Result (Description (Option a)) v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) v
forall e a. e -> Result e a
Failed Description (Option a)
forall a. Description (Option a)
d))
  where d :: Description (Option a)
d = Option a -> Description (Option a)
forall a. a -> Description a
Unit (Text -> Text -> Option a
forall a. Text -> Text -> Option a
Flag Text
name Text
help)

-- | Find a boolean flag. Always succeeds. Omission counts as
-- 'False'. Removes it from the argument list if it returns True.
switch :: Monad m
       => Text -- ^ Name.
       -> Text -- ^ Description.
       -> Consumer [Text] (Option a) m Bool
switch :: Text -> Text -> Consumer [Text] (Option a) m Bool
switch name :: Text
name help :: Text
help =
  Text -> Text -> Bool -> Consumer [Text] (Option a) m Bool
forall (m :: * -> *) v a.
Monad m =>
Text -> Text -> v -> Consumer [Text] (Option a) m v
flag Text
name Text
help Bool
True Consumer [Text] (Option a) m Bool
-> Consumer [Text] (Option a) m Bool
-> Consumer [Text] (Option a) m Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Bool -> Consumer [Text] (Option a) m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Find an argument prefixed by -X. Removes it from the argument
-- list when it succeeds.
prefix :: Monad m
       => Text -- ^ Prefix string.
       -> Text -- ^ Description.
       -> Consumer [Text] (Option a) m Text
prefix :: Text -> Text -> Consumer [Text] (Option a) m Text
prefix pref :: Text
pref help :: Text
help =
  StateT [Text] m (Description (Option a))
-> StateT [Text] m (Result (Description (Option a)) Text)
-> Consumer [Text] (Option a) m Text
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Option a) -> StateT [Text] m (Description (Option a))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Option a)
forall a. Description (Option a)
d)
           (do [Text]
s <- StateT [Text] m [Text]
forall s (m :: * -> *). MonadState s m => m s
get
               case (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
T.isPrefixOf ("-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pref)) [Text]
s of
                 Nothing -> Result (Description (Option a)) Text
-> StateT [Text] m (Result (Description (Option a)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) Text
forall e a. e -> Result e a
Failed Description (Option a)
forall a. Description (Option a)
d)
                 Just a :: Text
a -> do [Text] -> StateT [Text] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Text -> [Text] -> [Text]
forall a. Eq a => a -> [a] -> [a]
delete Text
a [Text]
s)
                              Result (Description (Option a)) Text
-> StateT [Text] m (Result (Description (Option a)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result (Description (Option a)) Text
forall e a. a -> Result e a
Succeeded (Int -> Text -> Text
T.drop (Text -> Int
T.length Text
pref Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Text
a)))
  where d :: Description (Option a)
d = Option a -> Description (Option a)
forall a. a -> Description a
Unit (Text -> Text -> Option a
forall a. Text -> Text -> Option a
Prefix Text
pref Text
help)

-- | Find a named argument e.g. @--name value@. Removes it from the
-- argument list when it succeeds.
arg :: Monad m
    => Text -- ^ Name.
    -> Text -- ^ Description.
    -> Consumer [Text] (Option a) m Text
arg :: Text -> Text -> Consumer [Text] (Option a) m Text
arg name :: Text
name help :: Text
help =
  StateT [Text] m (Description (Option a))
-> StateT [Text] m (Result (Description (Option a)) Text)
-> Consumer [Text] (Option a) m Text
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Option a) -> StateT [Text] m (Description (Option a))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Option a)
forall a. Description (Option a)
d)
           (do [Text]
s <- StateT [Text] m [Text]
forall s (m :: * -> *). MonadState s m => m s
get
               let indexedArgs :: [(Integer, Text)]
indexedArgs =
                     [Integer] -> [Text] -> [(Integer, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 :: Integer ..] [Text]
s
               case ((Integer, Text) -> Bool)
-> [(Integer, Text)] -> Maybe (Integer, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) (Text -> Bool)
-> ((Integer, Text) -> Text) -> (Integer, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Text) -> Text
forall a b. (a, b) -> b
snd) [(Integer, Text)]
indexedArgs of
                 Nothing -> Result (Description (Option a)) Text
-> StateT [Text] m (Result (Description (Option a)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) Text
forall e a. e -> Result e a
Failed Description (Option a)
forall a. Description (Option a)
d)
                 Just (i :: Integer
i,_) ->
                   case Integer -> [(Integer, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) [(Integer, Text)]
indexedArgs of
                     Nothing -> Result (Description (Option a)) Text
-> StateT [Text] m (Result (Description (Option a)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Option a) -> Result (Description (Option a)) Text
forall e a. e -> Result e a
Failed Description (Option a)
forall a. Description (Option a)
d)
                     Just text :: Text
text ->
                       do [Text] -> StateT [Text] m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (((Integer, Text) -> Text) -> [(Integer, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Text) -> Text
forall a b. (a, b) -> b
snd (((Integer, Text) -> Bool) -> [(Integer, Text)] -> [(Integer, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(j :: Integer
j,_) -> Integer
j Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
i Bool -> Bool -> Bool
&& Integer
j Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) [(Integer, Text)]
indexedArgs))
                          Result (Description (Option a)) Text
-> StateT [Text] m (Result (Description (Option a)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result (Description (Option a)) Text
forall e a. a -> Result e a
Succeeded Text
text))
  where d :: Description (Option a)
d = Option a -> Description (Option a)
forall a. a -> Description a
Unit (Text -> Text -> Option a
forall a. Text -> Text -> Option a
Arg Text
name Text
help)

-- | Make a text description of the command line options.
textDescription :: Description (Option a) -> Text
textDescription :: Description (Option a) -> Text
textDescription =
  Bool -> Description (Option a) -> Text
forall a. Bool -> Description (Option a) -> Text
go Bool
False (Description (Option a) -> Text)
-> (Description (Option a) -> Description (Option a))
-> Description (Option a)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Description (Option a) -> Description (Option a)
forall a. Description a -> Description a
clean
  where
        go :: Bool -> Description (Option a) -> Text
go inor :: Bool
inor d :: Description (Option a)
d =
          case Description (Option a)
d of
            Or None a :: Description (Option a)
a -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Description (Option a) -> Text
go Bool
inor Description (Option a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
            Or a :: Description (Option a)
a None -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Description (Option a) -> Text
go Bool
inor Description (Option a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
            Unit o :: Option a
o -> Option a -> Text
forall a. Option a -> Text
textOpt Option a
o
            Bounded min' :: Integer
min' _ d' :: Description (Option a)
d' ->
              "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Bool -> Description (Option a) -> Text
go Bool
inor Description (Option a)
d' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              "]" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              if Integer
min' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                 then "*"
                 else "+"
            And a :: Description (Option a)
a b :: Description (Option a)
b ->
              Bool -> Description (Option a) -> Text
go Bool
inor Description (Option a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Bool -> Description (Option a) -> Text
go Bool
inor Description (Option a)
b
            Or a :: Description (Option a)
a b :: Description (Option a)
b ->
              (if Bool
inor
                  then ""
                  else "(") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Bool -> Description (Option a) -> Text
go Bool
True Description (Option a)
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              "|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Bool -> Description (Option a) -> Text
go Bool
True Description (Option a)
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              (if Bool
inor
                  then ""
                  else ")")
            Sequence xs :: [Description (Option a)]
xs ->
              Text -> [Text] -> Text
T.intercalate " "
                            ((Description (Option a) -> Text)
-> [Description (Option a)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Description (Option a) -> Text
go Bool
inor) [Description (Option a)]
xs)
            Wrap o :: Option a
o d' :: Description (Option a)
d' ->
              Option a -> Text
forall a. Option a -> Text
textOpt Option a
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              (if Text -> Bool
T.null (Option a -> Text
forall a. Option a -> Text
textOpt Option a
o)
                  then ""
                  else " ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
              Bool -> Description (Option a) -> Text
go Bool
inor Description (Option a)
d'
            None -> ""

-- | Clean up the condition tree for single-line presentation.
clean :: Description a -> Description a
clean :: Description a -> Description a
clean (And None a :: Description a
a) = Description a -> Description a
forall a. Description a -> Description a
clean Description a
a
clean (And a :: Description a
a None) = Description a -> Description a
forall a. Description a -> Description a
clean Description a
a
clean (Or a :: Description a
a (Or b :: Description a
b None)) = Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
Or (Description a -> Description a
forall a. Description a -> Description a
clean Description a
a) (Description a -> Description a
forall a. Description a -> Description a
clean Description a
b)
clean (Or a :: Description a
a (Or None b :: Description a
b)) = Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
Or (Description a -> Description a
forall a. Description a -> Description a
clean Description a
a) (Description a -> Description a
forall a. Description a -> Description a
clean Description a
b)
clean (Or None (Or a :: Description a
a b :: Description a
b)) = Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
Or (Description a -> Description a
forall a. Description a -> Description a
clean Description a
a) (Description a -> Description a
forall a. Description a -> Description a
clean Description a
b)
clean (Or (Or a :: Description a
a b :: Description a
b) None) = Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
Or (Description a -> Description a
forall a. Description a -> Description a
clean Description a
a) (Description a -> Description a
forall a. Description a -> Description a
clean Description a
b)
clean (Or a :: Description a
a None) = Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
Or (Description a -> Description a
forall a. Description a -> Description a
clean Description a
a) Description a
forall a. Description a
None
clean (Or None b :: Description a
b) = Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
Or Description a
forall a. Description a
None (Description a -> Description a
forall a. Description a -> Description a
clean Description a
b)
clean (And a :: Description a
a b :: Description a
b) =
  Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
And (Description a -> Description a
forall a. Description a -> Description a
clean Description a
a)
      (Description a -> Description a
forall a. Description a -> Description a
clean Description a
b)
clean (Or a :: Description a
a b :: Description a
b) =
  Description a -> Description a -> Description a
forall a. Description a -> Description a -> Description a
Or (Description a -> Description a
forall a. Description a -> Description a
clean Description a
a)
     (Description a -> Description a
forall a. Description a -> Description a
clean Description a
b)
clean a :: Description a
a = Description a
a

-- | Make a text description of an option.
textOpt :: (Option a) -> Text
textOpt :: Option a -> Text
textOpt (AnyString t :: Text
t) = (Char -> Char) -> Text -> Text
T.map Char -> Char
toUpper Text
t
textOpt (Constant t :: Text
t _) = Text
t
textOpt (Flag t :: Text
t _) = "--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
textOpt (Arg t :: Text
t _) = "--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " <...>"
textOpt (Prefix t :: Text
t _) = "-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "<...>"
textOpt Stops = ""
textOpt (Stopped _) = ""