{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{- |
Module: Options.Commander
Description: A set of combinators for constructing and executing command line programs
Copyright: (c) Samuel Schlesinger 2020
License: MIT
Maintainer: sgschlesinger@gmail.com
Stability: experimental
Portability: POSIX, Windows

Commander is an embedded domain specific language describing a command line
interface, along with ways to run those as real programs. An complete example
of such a command line interface is:

@
main :: IO ()
main = command_ . toplevel @"file" $
 (sub @"maybe-read" $
  arg @"filename" \filename ->
  flag @"read" \b -> raw $
    if b
      then putStrLn =<< readFile filename
      else pure ())
  \<+\>
 (sub @"maybe-write" $
  opt @"file" @"file-to-write" \mfilename -> raw $
    case mfilename of
      Just filename -> putStrLn =<< readFile filename
      Nothing -> pure ())
@

If I run this program with the argument help, it will output:

@
usage:
name: file
|
+- subprogram: help
|
+- subprogram: maybe-read
|  |
|  `- argument: filename :: [Char]
|     |
|     `- flag: ~read
|
`- subprogram: maybe-write
   |
   `- option: -file <file-to-write :: [Char]>
@

The point of this library is mainly so that you can write command line
interfaces quickly and easily, with somewhat useful help messages, and 
not have to write any boilerplate.
-}
module Options.Commander (
  -- ** Parsing Arguments and Options
  {- |
    If you want to use a Haskell type as an argument or option, you will need
    to implement the 'Unrender' class. Your type needs to be 'Typeable' for
    the sake of generating documentation.
  -}
  Unrender(unrender),
  -- ** Defining CLI Programs
  {- |
    To construct a 'ProgramT' (a specification of a CLI program), you can
    have 'arg'uments, 'opt'ions, 'raw' actions in a monad (typically IO),
    'sub'programs, 'named' programs, 'env'ironment variables, you can combine 
    programs together using '<+>', and you can generate primitive 'usage'
    information with 'usage'. There are combinators for retrieving environment
    variables as well. We also have a convenience combinator, 'toplevel',
    which lets you add a name and a help command to your program using the 'usage' combinator.
  -}
  arg, opt, optDef, raw, sub, named, flag, toplevel, (<+>), usage, env, envOpt, envOptDef, description, annotated,
  -- ** Run CLI Programs
  {- |
    To run a 'ProgramT' (a specification of a CLI program), you will 
    need to use 'command' or 'command_'.
  -}
  command, command_,
  {- |
    Each 'ProgramT' has a type level description, build from these type level
    combinators.
  -}
  type (&), type (+), Arg, Opt, Named, Raw, Flag, Env, Optionality(Required, Optional), Description, Annotated,
  -- ** Interpreting CLI Programs
  {- |
    The 'HasProgram' class forms the backbone of this library, defining the
    syntax for CLI programs using the 'ProgramT' data family, and defining
    the interpretation of all of the various pieces of a CLI.
  -}
  HasProgram(ProgramT, run, hoist, documentation),
  ProgramT(ArgProgramT, unArgProgramT,
           OptProgramT, unOptProgramT, unOptDefault,
           RawProgramT, unRawProgramT,
           SubProgramT, unSubProgramT,
           NamedProgramT, unNamedProgramT,
           FlagProgramT, unFlagProgramT,
           EnvProgramT'Optional, unEnvProgramT'Optional, unEnvDefault,
           EnvProgramT'Required, unEnvProgramT'Required,
           DescriptionProgramT,
           AnnotatedProgramT,
           (:+:)
           ),
  -- ** The CommanderT Monad
  {- |
    The 'CommanderT' monad is how your CLI programs are interpreted by 'run'.
    It has the ability to backtrack and it maintains some state.
  -}
  CommanderT(Action, Defeat, Victory), runCommanderT, initialState, State(State, arguments, options, flags),
  -- ** Middleware for CommanderT
  {- |
    If you want to modify your interpreted CLI program, in its 'CommanderT'
    form, you can use the concept of 'Middleware'. A number of these are
    provided for debugging complex CLI programs, in case they aren't doing
    what you'd expect.
  -}
  Middleware, logState, transform, withActionEffects, withDefeatEffects, withVictoryEffects
) where

import Control.Applicative (Alternative(..))
import Control.Arrow (first)
import Control.Monad (ap, void, (<=<))
import Control.Monad.Trans (MonadIO(..), MonadTrans(..))
import Data.Functor (($>))
import Data.HashMap.Strict as HashMap
import Data.HashSet as HashSet
import Data.Int
import Data.Proxy (Proxy(..))
import Data.Text (Text, pack, unpack, stripPrefix, find)
import Data.Text.Read (decimal, signed)
import Data.Word
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import GHC.Generics (Generic)
import Numeric.Natural
import System.Environment (getArgs, lookupEnv)
import Data.Typeable (Typeable, typeRep)
import qualified Data.ByteString as SBS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import Control.Monad.Commander
import Data.Tree

-- | A class for interpreting command line arguments into Haskell types.
class Typeable t => Unrender t where
  unrender :: Text -> Maybe t

instance Unrender String where
  unrender :: Text -> Maybe String
unrender = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

instance Unrender Text where
  unrender :: Text -> Maybe Text
unrender = forall a. a -> Maybe a
Just

instance Unrender SBS.ByteString where
  unrender :: Text -> Maybe ByteString
unrender = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

instance Unrender LBS.ByteString where
  unrender :: Text -> Maybe ByteString
unrender = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
LBS.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Unrender t => Text -> Maybe t
unrender

-- | A useful default unrender for small, bounded data types.
unrenderSmall :: (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall :: forall a. (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup [(String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
x, a
x) | a
x <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]]

instance Unrender () where
  unrender :: Text -> Maybe ()
unrender = forall a. (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall

instance (Unrender a, Unrender b) => Unrender (Either a b) where
  unrender :: Text -> Maybe (Either a b)
unrender Text
x = forall {b}. Text -> Maybe (Either a b)
leftCase Text
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Text -> Maybe (Either a b)
rightCase Text
x where
    leftCase :: Text -> Maybe (Either a b)
leftCase  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Unrender t => Text -> Maybe t
unrender
    rightCase :: Text -> Maybe (Either a b)
rightCase = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Unrender t => Text -> Maybe t
unrender

instance Unrender Bool where
  unrender :: Text -> Maybe Bool
unrender = forall a. (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall

newtype WrappedIntegral i = WrappedIntegral i
  deriving newtype (Integer -> WrappedIntegral i
WrappedIntegral i -> WrappedIntegral i
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall i. Num i => Integer -> WrappedIntegral i
forall i. Num i => WrappedIntegral i -> WrappedIntegral i
forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> WrappedIntegral i
$cfromInteger :: forall i. Num i => Integer -> WrappedIntegral i
signum :: WrappedIntegral i -> WrappedIntegral i
$csignum :: forall i. Num i => WrappedIntegral i -> WrappedIntegral i
abs :: WrappedIntegral i -> WrappedIntegral i
$cabs :: forall i. Num i => WrappedIntegral i -> WrappedIntegral i
negate :: WrappedIntegral i -> WrappedIntegral i
$cnegate :: forall i. Num i => WrappedIntegral i -> WrappedIntegral i
* :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$c* :: forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
- :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$c- :: forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
+ :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$c+ :: forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
Num, WrappedIntegral i -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall {i}. Real i => Num (WrappedIntegral i)
forall {i}. Real i => Ord (WrappedIntegral i)
forall i. Real i => WrappedIntegral i -> Rational
toRational :: WrappedIntegral i -> Rational
$ctoRational :: forall i. Real i => WrappedIntegral i -> Rational
Real, WrappedIntegral i -> WrappedIntegral i -> Bool
WrappedIntegral i -> WrappedIntegral i -> Ordering
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {i}. Ord i => Eq (WrappedIntegral i)
forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> Ordering
forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
min :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cmin :: forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
max :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cmax :: forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
>= :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c>= :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
> :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c> :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
<= :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c<= :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
< :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c< :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
compare :: WrappedIntegral i -> WrappedIntegral i -> Ordering
$ccompare :: forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> Ordering
Ord, WrappedIntegral i -> WrappedIntegral i -> Bool
forall i. Eq i => WrappedIntegral i -> WrappedIntegral i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c/= :: forall i. Eq i => WrappedIntegral i -> WrappedIntegral i -> Bool
== :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c== :: forall i. Eq i => WrappedIntegral i -> WrappedIntegral i -> Bool
Eq, Int -> WrappedIntegral i
WrappedIntegral i -> Int
WrappedIntegral i -> [WrappedIntegral i]
WrappedIntegral i -> WrappedIntegral i
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
forall i. Enum i => Int -> WrappedIntegral i
forall i. Enum i => WrappedIntegral i -> Int
forall i. Enum i => WrappedIntegral i -> [WrappedIntegral i]
forall i. Enum i => WrappedIntegral i -> WrappedIntegral i
forall i.
Enum i =>
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
forall i.
Enum i =>
WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
$cenumFromThenTo :: forall i.
Enum i =>
WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
enumFromTo :: WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
$cenumFromTo :: forall i.
Enum i =>
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
enumFromThen :: WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
$cenumFromThen :: forall i.
Enum i =>
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
enumFrom :: WrappedIntegral i -> [WrappedIntegral i]
$cenumFrom :: forall i. Enum i => WrappedIntegral i -> [WrappedIntegral i]
fromEnum :: WrappedIntegral i -> Int
$cfromEnum :: forall i. Enum i => WrappedIntegral i -> Int
toEnum :: Int -> WrappedIntegral i
$ctoEnum :: forall i. Enum i => Int -> WrappedIntegral i
pred :: WrappedIntegral i -> WrappedIntegral i
$cpred :: forall i. Enum i => WrappedIntegral i -> WrappedIntegral i
succ :: WrappedIntegral i -> WrappedIntegral i
$csucc :: forall i. Enum i => WrappedIntegral i -> WrappedIntegral i
Enum, WrappedIntegral i -> Integer
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall {i}. Integral i => Enum (WrappedIntegral i)
forall {i}. Integral i => Real (WrappedIntegral i)
forall i. Integral i => WrappedIntegral i -> Integer
forall i.
Integral i =>
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: WrappedIntegral i -> Integer
$ctoInteger :: forall i. Integral i => WrappedIntegral i -> Integer
divMod :: WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
$cdivMod :: forall i.
Integral i =>
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
quotRem :: WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
$cquotRem :: forall i.
Integral i =>
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
mod :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cmod :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
div :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cdiv :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
rem :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$crem :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
quot :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cquot :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
Integral)

instance (Typeable i, Integral i) => Unrender (WrappedIntegral i) where
  unrender :: Text -> Maybe (WrappedIntegral i)
unrender = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall {a} {a}.
(Eq a, IsString a, Num a) =>
(Integer, a) -> Maybe a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal where
    h :: (Integer, a) -> Maybe a
h (Integer
n, a
"") = forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
fromInteger Integer
n)
    h (Integer, a)
_ = forall a. Maybe a
Nothing

deriving via WrappedIntegral Integer instance Unrender Integer
deriving via WrappedIntegral Int instance Unrender Int
deriving via WrappedIntegral Int8 instance Unrender Int8
deriving via WrappedIntegral Int16 instance Unrender Int16
deriving via WrappedIntegral Int32 instance Unrender Int32
deriving via WrappedIntegral Int64 instance Unrender Int64

newtype WrappedNatural i = WrappedNatural i
  deriving newtype (Integer -> WrappedNatural i
WrappedNatural i -> WrappedNatural i
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall i. Num i => Integer -> WrappedNatural i
forall i. Num i => WrappedNatural i -> WrappedNatural i
forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> WrappedNatural i
$cfromInteger :: forall i. Num i => Integer -> WrappedNatural i
signum :: WrappedNatural i -> WrappedNatural i
$csignum :: forall i. Num i => WrappedNatural i -> WrappedNatural i
abs :: WrappedNatural i -> WrappedNatural i
$cabs :: forall i. Num i => WrappedNatural i -> WrappedNatural i
negate :: WrappedNatural i -> WrappedNatural i
$cnegate :: forall i. Num i => WrappedNatural i -> WrappedNatural i
* :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$c* :: forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
- :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$c- :: forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
+ :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$c+ :: forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
Num, WrappedNatural i -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall {i}. Real i => Num (WrappedNatural i)
forall {i}. Real i => Ord (WrappedNatural i)
forall i. Real i => WrappedNatural i -> Rational
toRational :: WrappedNatural i -> Rational
$ctoRational :: forall i. Real i => WrappedNatural i -> Rational
Real, WrappedNatural i -> WrappedNatural i -> Bool
WrappedNatural i -> WrappedNatural i -> Ordering
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {i}. Ord i => Eq (WrappedNatural i)
forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Ordering
forall i.
Ord i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
min :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cmin :: forall i.
Ord i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
max :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cmax :: forall i.
Ord i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
>= :: WrappedNatural i -> WrappedNatural i -> Bool
$c>= :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
> :: WrappedNatural i -> WrappedNatural i -> Bool
$c> :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
<= :: WrappedNatural i -> WrappedNatural i -> Bool
$c<= :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
< :: WrappedNatural i -> WrappedNatural i -> Bool
$c< :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
compare :: WrappedNatural i -> WrappedNatural i -> Ordering
$ccompare :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Ordering
Ord, WrappedNatural i -> WrappedNatural i -> Bool
forall i. Eq i => WrappedNatural i -> WrappedNatural i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedNatural i -> WrappedNatural i -> Bool
$c/= :: forall i. Eq i => WrappedNatural i -> WrappedNatural i -> Bool
== :: WrappedNatural i -> WrappedNatural i -> Bool
$c== :: forall i. Eq i => WrappedNatural i -> WrappedNatural i -> Bool
Eq, Int -> WrappedNatural i
WrappedNatural i -> Int
WrappedNatural i -> [WrappedNatural i]
WrappedNatural i -> WrappedNatural i
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
forall i. Enum i => Int -> WrappedNatural i
forall i. Enum i => WrappedNatural i -> Int
forall i. Enum i => WrappedNatural i -> [WrappedNatural i]
forall i. Enum i => WrappedNatural i -> WrappedNatural i
forall i.
Enum i =>
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
forall i.
Enum i =>
WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
$cenumFromThenTo :: forall i.
Enum i =>
WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
enumFromTo :: WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
$cenumFromTo :: forall i.
Enum i =>
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
enumFromThen :: WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
$cenumFromThen :: forall i.
Enum i =>
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
enumFrom :: WrappedNatural i -> [WrappedNatural i]
$cenumFrom :: forall i. Enum i => WrappedNatural i -> [WrappedNatural i]
fromEnum :: WrappedNatural i -> Int
$cfromEnum :: forall i. Enum i => WrappedNatural i -> Int
toEnum :: Int -> WrappedNatural i
$ctoEnum :: forall i. Enum i => Int -> WrappedNatural i
pred :: WrappedNatural i -> WrappedNatural i
$cpred :: forall i. Enum i => WrappedNatural i -> WrappedNatural i
succ :: WrappedNatural i -> WrappedNatural i
$csucc :: forall i. Enum i => WrappedNatural i -> WrappedNatural i
Enum, WrappedNatural i -> Integer
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall {i}. Integral i => Enum (WrappedNatural i)
forall {i}. Integral i => Real (WrappedNatural i)
forall i. Integral i => WrappedNatural i -> Integer
forall i.
Integral i =>
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: WrappedNatural i -> Integer
$ctoInteger :: forall i. Integral i => WrappedNatural i -> Integer
divMod :: WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
$cdivMod :: forall i.
Integral i =>
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
quotRem :: WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
$cquotRem :: forall i.
Integral i =>
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
mod :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cmod :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
div :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cdiv :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
rem :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$crem :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
quot :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cquot :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
Integral)

instance (Typeable i, Integral i) => Unrender (WrappedNatural i) where
  unrender :: Text -> Maybe (WrappedNatural i)
unrender = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall {a} {a}.
(Eq a, IsString a, Num a) =>
(Integer, a) -> Maybe a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Reader a
decimal where
    h :: (Integer, a) -> Maybe a
h (Integer
n, a
"") = if Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
fromInteger Integer
n) else forall a. Maybe a
Nothing
    h (Integer, a)
_ = forall a. Maybe a
Nothing 

deriving via WrappedNatural Natural instance Unrender Natural
deriving via WrappedNatural Word instance Unrender Word
deriving via WrappedNatural Word8 instance Unrender Word8
deriving via WrappedNatural Word16 instance Unrender Word16
deriving via WrappedNatural Word32 instance Unrender Word32
deriving via WrappedNatural Word64 instance Unrender Word64

instance Unrender Char where
  unrender :: Text -> Maybe Char
unrender = (Char -> Bool) -> Text -> Maybe Char
find (forall a b. a -> b -> a
const Bool
True)

-- | The type level combinator for constructing 'named' programs, giving your
-- program a name at the toplevel for the sake of documentation.
data Named :: Symbol -> *

-- | The type level 'arg'ument combinator, with a 'Symbol' designating the
-- name of that argument.
data Arg :: Symbol -> * -> *

-- | The type level 'opt'ion combinator, with a 'Symbol' designating the
-- option's name and another representing the metavariables name for
-- documentation purposes.
data Opt :: Symbol -> Symbol -> * -> *

-- | The type level 'flag' combinator, taking a name as input, allowing your
-- program to take flags with the syntax @~flag@.
data Flag :: Symbol -> *

-- | The type level 'env'ironment variable combinator, taking a name as
-- input, allowing your program to take environment variables as input
-- automatically.
data Env :: Optionality -> Symbol -> * -> *

-- | The type level 'raw' monadic program combinator, allowing a command line
-- program to just do some computation.
data Raw :: *

-- | The type level 'description' combinator, allowing a command line program
-- to have better documentation.
data Description :: Symbol -> *

-- | The type level 'annotated' combinator, allowing a command line 
data Annotated :: Symbol -> * -> *

-- | The type level tag for whether or not a variable is required or not.
data Optionality = Required | Optional

-- | The type level program sequencing combinator, taking two program types
-- and sequencing them one after another.
data (&) :: k -> * -> *
infixr 4 &

-- | The type level combining combinator, taking two program types as
-- input, and being interpreted as a program which attempts to run the
-- first command line program and, if parsing its flags, subprograms,
-- options or arguments fails, runs the second, otherwise failing.
data a + b
infixr 2 +

-- | This is the 'State' that the 'CommanderT' library uses for its role in
-- this library. It is not inlined, because that does nothing but obfuscate
-- the 'CommanderT' monad. It consists of 'arguments', 'options', and
-- 'flags'.
data State = State 
  { State -> [Text]
arguments :: [Text]
  , State -> HashMap Text Text
options :: HashMap Text Text
  , State -> HashSet Text
flags :: HashSet Text
  } deriving (forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic, Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show, State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Eq State
State -> State -> Bool
State -> State -> Ordering
State -> State -> State
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: State -> State -> State
$cmin :: State -> State -> State
max :: State -> State -> State
$cmax :: State -> State -> State
>= :: State -> State -> Bool
$c>= :: State -> State -> Bool
> :: State -> State -> Bool
$c> :: State -> State -> Bool
<= :: State -> State -> Bool
$c<= :: State -> State -> Bool
< :: State -> State -> Bool
$c< :: State -> State -> Bool
compare :: State -> State -> Ordering
$ccompare :: State -> State -> Ordering
Ord)

-- | This is the workhorse of the library. Basically, it allows you to 
-- 'run' your 'ProgramT'
-- representation of your program as a 'CommanderT' and pump the 'State'
-- through it until you've processed all of the arguments, options, and
-- flags that you have specified must be used in your 'ProgramT'. You can
-- think of 'ProgramT' as a useful syntax for command line programs, but
-- 'CommanderT' as the semantics of that program. We also give the ability
-- to 'hoist' 'ProgramT' actions between monads if you can uniformly turn
-- computations in one into another. We also store 'documentation' in the
-- form of a @'Forest' 'String'@, in order to automatically generate
-- 'usage' programs.
class HasProgram p where
  data ProgramT p (m :: * -> *) a
  run :: ProgramT p IO a -> CommanderT State IO a
  hoist :: (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
  documentation :: Forest String

instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Env 'Required name t & p) where
  newtype ProgramT (Env 'Required name t & p) m a = EnvProgramT'Required { forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Required name t & p) m a -> t -> ProgramT p m a
unEnvProgramT'Required :: t -> ProgramT p m a }
  run :: forall a.
ProgramT (Env 'Required name t & p) IO a -> CommanderT State IO a
run ProgramT (Env 'Required name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
    Maybe String
val <- String -> IO (Maybe String)
lookupEnv (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name))
    case Maybe String
val of
      Just String
v ->
        case forall t. Unrender t => Text -> Maybe t
unrender (String -> Text
pack String
v) of
          Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Required name t & p) m a -> t -> ProgramT p m a
unEnvProgramT'Required ProgramT (Env 'Required name t & p) IO a
f t
t), State
state)  
          Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
      Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Env 'Required name t & p) m a
-> ProgramT (Env 'Required name t & p) n a
hoist forall x. m x -> n x
n (EnvProgramT'Required t -> ProgramT p m a
f) = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Env 'Required name t & p) m a
EnvProgramT'Required (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ProgramT p m a
f)
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"required env: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
    forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t)))
    (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]

instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Env 'Optional name t & p) where
  data ProgramT (Env 'Optional name t & p) m a = EnvProgramT'Optional
    { forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a
-> Maybe t -> ProgramT p m a
unEnvProgramT'Optional :: Maybe t -> ProgramT p m a
    , forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a -> Maybe t
unEnvDefault :: Maybe t }
  run :: forall a.
ProgramT (Env 'Optional name t & p) IO a -> CommanderT State IO a
run ProgramT (Env 'Optional name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
    Maybe String
val <- String -> IO (Maybe String)
lookupEnv (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name))
    case Maybe String
val of
      Just String
v -> do
        case forall t. Unrender t => Text -> Maybe t
unrender @t (String -> Text
pack String
v) of
          Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a
-> Maybe t -> ProgramT p m a
unEnvProgramT'Optional ProgramT (Env 'Optional name t & p) IO a
f (forall a. a -> Maybe a
Just t
t)), State
state)  
          Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
      Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a
-> Maybe t -> ProgramT p m a
unEnvProgramT'Optional ProgramT (Env 'Optional name t & p) IO a
f (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a -> Maybe t
unEnvDefault ProgramT (Env 'Optional name t & p) IO a
f)), State
state)

  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Env 'Optional name t & p) m a
-> ProgramT (Env 'Optional name t & p) n a
hoist forall x. m x -> n x
n (EnvProgramT'Optional Maybe t -> ProgramT p m a
f Maybe t
d) = forall (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Env 'Optional name t & p) m a
EnvProgramT'Optional (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe t -> ProgramT p m a
f) Maybe t
d
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"optional env: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
    forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t)))
    (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]

instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Arg name t & p) where
  newtype ProgramT (Arg name t & p) m a = ArgProgramT { forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Arg name t & p) m a -> t -> ProgramT p m a
unArgProgramT :: t -> ProgramT p m a }
  run :: forall a. ProgramT (Arg name t & p) IO a -> CommanderT State IO a
run ProgramT (Arg name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do
    case [Text]
arguments of
      (Text
x : [Text]
xs) -> 
        case forall t. Unrender t => Text -> Maybe t
unrender Text
x of
          Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Arg name t & p) m a -> t -> ProgramT p m a
unArgProgramT ProgramT (Arg name t & p) IO a
f t
t), State{ arguments :: [Text]
arguments = [Text]
xs, HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
.. })  
          Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Arg name t & p) m a -> ProgramT (Arg name t & p) n a
hoist forall x. m x -> n x
n (ArgProgramT t -> ProgramT p m a
f) = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Arg name t & p) m a
ArgProgramT (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ProgramT p m a
f)
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"argument: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
    forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t)))
    (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]

instance (HasProgram x, HasProgram y) => HasProgram (x + y) where
  data ProgramT (x + y) m a = ProgramT x m a :+: ProgramT y m a
  run :: forall a. ProgramT (x + y) IO a -> CommanderT State IO a
run (ProgramT x IO a
f :+: ProgramT y IO a
g) = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT x IO a
f forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT y IO a
g
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (x + y) m a -> ProgramT (x + y) n a
hoist forall x. m x -> n x
n (ProgramT x m a
f :+: ProgramT y m a
g) = forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n ProgramT x m a
f forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
:+: forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n ProgramT y m a
g
  documentation :: Forest String
documentation = forall {k} (p :: k). HasProgram p => Forest String
documentation @x forall a. Semigroup a => a -> a -> a
<> forall {k} (p :: k). HasProgram p => Forest String
documentation @y

infixr 2 :+:

instance HasProgram Raw where
  newtype ProgramT Raw m a = RawProgramT { forall (m :: * -> *) a. ProgramT Raw m a -> m a
unRawProgramT :: m a }
  run :: forall a. ProgramT Raw IO a -> CommanderT State IO a
run = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ProgramT Raw m a -> m a
unRawProgramT
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> ProgramT Raw m a -> ProgramT Raw n a
hoist forall x. m x -> n x
n (RawProgramT m a
m) = forall (m :: * -> *) a. m a -> ProgramT Raw m a
RawProgramT (forall x. m x -> n x
n m a
m)
  documentation :: Forest String
documentation = []

instance (KnownSymbol name, KnownSymbol option, HasProgram p, Unrender t) => HasProgram (Opt option name t & p) where
  data ProgramT (Opt option name t & p) m a = OptProgramT
    { forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t -> ProgramT p m a
unOptProgramT :: Maybe t -> ProgramT p m a
    , forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t
unOptDefault :: Maybe t }
  run :: forall a.
ProgramT (Opt option name t & p) IO a -> CommanderT State IO a
run ProgramT (Opt option name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do
    case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @option)) HashMap Text Text
options of
      Just Text
opt' -> 
        case forall t. Unrender t => Text -> Maybe t
unrender Text
opt' of
          Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t -> ProgramT p m a
unOptProgramT ProgramT (Opt option name t & p) IO a
f (forall a. a -> Maybe a
Just t
t)), State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
          Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
      Maybe Text
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t -> ProgramT p m a
unOptProgramT ProgramT (Opt option name t & p) IO a
f (forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t
unOptDefault ProgramT (Opt option name t & p) IO a
f)), State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Opt option name t & p) m a
-> ProgramT (Opt option name t & p) n a
hoist forall x. m x -> n x
n (OptProgramT Maybe t -> ProgramT p m a
f Maybe t
d) = forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Opt option name t & p) m a
OptProgramT (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe t -> ProgramT p m a
f) Maybe t
d
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"option: -" forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @option)
    forall a. Semigroup a => a -> a -> a
<> String
" <" forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
    forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t))
    forall a. Semigroup a => a -> a -> a
<> String
">")
    (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]

instance (KnownSymbol flag, HasProgram p) => HasProgram (Flag flag & p) where
  newtype ProgramT (Flag flag & p) m a = FlagProgramT { forall (flag :: Symbol) p (m :: * -> *) a.
ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT :: Bool -> ProgramT p m a }
  run :: forall a. ProgramT (Flag flag & p) IO a -> CommanderT State IO a
run ProgramT (Flag flag & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do
    let presence :: Bool
presence = forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member (String -> Text
pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @flag))) HashSet Text
flags
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (flag :: Symbol) p (m :: * -> *) a.
ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT ProgramT (Flag flag & p) IO a
f Bool
presence), State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Flag flag & p) m a -> ProgramT (Flag flag & p) n a
hoist forall x. m x -> n x
n = forall (flag :: Symbol) p (m :: * -> *) a.
(Bool -> ProgramT p m a) -> ProgramT (Flag flag & p) m a
FlagProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (flag :: Symbol) p (m :: * -> *) a.
ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"flag: ~" forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @flag))
    (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]

instance (KnownSymbol name, HasProgram p) => HasProgram (Named name & p) where
  newtype ProgramT (Named name & p) m a = NamedProgramT { forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT :: ProgramT p m a }
  run :: forall a. ProgramT (Named name & p) IO a -> CommanderT State IO a
run = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT 
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Named name & p) m a -> ProgramT (Named name & p) n a
hoist forall x. m x -> n x
n = forall (name :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Named name & p) m a
NamedProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"name: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name))
    (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]

instance (KnownSymbol description, HasProgram p) => HasProgram (Description description & p) where
  newtype ProgramT (Description description & p) m a = DescriptionProgramT { forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT :: ProgramT p m a }
  run :: forall a.
ProgramT (Description description & p) IO a
-> CommanderT State IO a
run = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT 
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Description description & p) m a
-> ProgramT (Description description & p) n a
hoist forall x. m x -> n x
n = forall (description :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Description description & p) m a
DescriptionProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"description: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @description))
    []] forall a. Semigroup a => a -> a -> a
<> forall {k} (p :: k). HasProgram p => Forest String
documentation @p

instance (KnownSymbol annotation, HasProgram (combinator & p)) => HasProgram (Annotated annotation combinator & p) where
  newtype ProgramT (Annotated annotation combinator & p) m a = AnnotatedProgramT { forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT :: ProgramT (combinator & p) m a }
  run :: forall a.
ProgramT (Annotated annotation combinator & p) IO a
-> CommanderT State IO a
run = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT 
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) n a
hoist forall x. m x -> n x
n = forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
AnnotatedProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT
  documentation :: Forest String
documentation = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Node String
x Forest String
s) -> forall a. a -> [Tree a] -> Tree a
Node (String
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @annotation)) Forest String
s) (forall {k} (p :: k). HasProgram p => Forest String
documentation @(combinator & p))

instance (KnownSymbol sub, HasProgram p) => HasProgram (sub & p) where
  newtype ProgramT (sub & p) m a = SubProgramT { forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT :: ProgramT p m a }
  run :: forall a. ProgramT (sub & p) IO a -> CommanderT State IO a
run ProgramT (sub & p) IO a
s = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do 
    case [Text]
arguments of
      (Text
x : [Text]
xs) -> 
        if Text
x forall a. Eq a => a -> a -> Bool
== String -> Text
pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @sub) 
          then forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall a b. (a -> b) -> a -> b
$ forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT ProgramT (sub & p) IO a
s, State{arguments :: [Text]
arguments = [Text]
xs, HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
..})
          else forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
  hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (sub & p) m a -> ProgramT (sub & p) n a
hoist forall x. m x -> n x
n = forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (sub & p) m a
SubProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT
  documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
    (String
"subprogram: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sub))
    (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]

-- | A simple default for getting out the arguments, options, and flags
-- using 'getArgs'. We use the syntax ~flag for flags and -opt
-- for options, with arguments using the typical ordered representation.
initialState :: IO State
initialState :: IO State
initialState = do
  [String]
args <- IO [String]
getArgs
  let ([(Text, Text)]
opts, [Text]
args', [Text]
flags) = [String] -> ([(Text, Text)], [Text], [Text])
takeOptions [String]
args
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> HashMap Text Text -> HashSet Text -> State
State [Text]
args' (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Text)]
opts) (forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [Text]
flags) 
    where
      takeOptions :: [String] -> ([(Text, Text)], [Text], [Text])
      takeOptions :: [String] -> ([(Text, Text)], [Text], [Text])
takeOptions = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [] [] [] where
        go :: [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [(Text, Text)]
opts [Text]
args [Text]
flags ((Char
'~':String
x') : [String]
z) = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [(Text, Text)]
opts [Text]
args (String -> Text
pack String
x' forall a. a -> [a] -> [a]
: [Text]
flags) [String]
z
        go [(Text, Text)]
opts [Text]
args [Text]
flags ((Char
'-':String
x) : String
y : [String]
z) = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go ((String -> Text
pack String
x, String -> Text
pack String
y) forall a. a -> [a] -> [a]
: [(Text, Text)]
opts) [Text]
args [Text]
flags [String]
z
        go [(Text, Text)]
opts [Text]
args [Text]
flags (String
x : [String]
y) = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [(Text, Text)]
opts (String -> Text
pack String
x forall a. a -> [a] -> [a]
: [Text]
args) [Text]
flags [String]
y
        go [(Text, Text)]
opts [Text]
args [Text]
flags [] = ([(Text, Text)]
opts, forall a. [a] -> [a]
reverse [Text]
args, [Text]
flags)

-- | This is a combinator which runs a 'ProgramT' with the options,
-- arguments, and flags that I get using the 'initialState' function,
-- ignoring the output of the program.
command_ :: forall p a.
            HasProgram p 
         => ProgramT p IO a 
         -> IO ()
command_ :: forall {k} (p :: k) a. HasProgram p => ProgramT p IO a -> IO ()
command_ ProgramT p IO a
prog = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO State
initialState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) state a.
Monad m =>
CommanderT state m a -> state -> m (Maybe a)
runCommanderT (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT p IO a
prog)

-- | This is a combinator which runs a 'ProgramT' with the options,
-- arguments, and flags that I get using the 'initialState' function,
-- returning 'Just' the output of the program upon successful option and argument
-- parsing and returning 'Nothing' otherwise.
command :: forall p a.
           HasProgram p 
        => ProgramT p IO a 
        -> IO (Maybe a)
command :: forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> IO (Maybe a)
command ProgramT p IO a
prog = IO State
initialState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) state a.
Monad m =>
CommanderT state m a -> state -> m (Maybe a)
runCommanderT (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT p IO a
prog)

-- | Required environment variable combinator
env :: forall name p x m a.
     KnownSymbol name
  => (x -> ProgramT p m a)
  -> ProgramT (Env 'Required name x & p) m a
env :: forall (name :: Symbol) p x (m :: * -> *) a.
KnownSymbol name =>
(x -> ProgramT p m a) -> ProgramT (Env 'Required name x & p) m a
env = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Env 'Required name t & p) m a
EnvProgramT'Required

-- | Optional environment variable combinator
envOpt :: forall name x p m a.
     KnownSymbol name
  => (Maybe x -> ProgramT p m a)
  -> ProgramT (Env 'Optional name x & p) m a
envOpt :: forall (name :: Symbol) x p (m :: * -> *) a.
KnownSymbol name =>
(Maybe x -> ProgramT p m a)
-> ProgramT (Env 'Optional name x & p) m a
envOpt = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Env 'Optional name t & p) m a
EnvProgramT'Optional forall a. Maybe a
Nothing

-- | Optional environment variable combinator with default
envOptDef :: forall name x p m a.
     KnownSymbol name
  => x
  -> (x -> ProgramT p m a)
  -> ProgramT (Env 'Optional name x & p) m a
envOptDef :: forall (name :: Symbol) x p (m :: * -> *) a.
KnownSymbol name =>
x
-> (x -> ProgramT p m a) -> ProgramT (Env 'Optional name x & p) m a
envOptDef x
x x -> ProgramT p m a
f = EnvProgramT'Optional { unEnvDefault :: Maybe x
unEnvDefault = forall a. a -> Maybe a
Just x
x, unEnvProgramT'Optional :: Maybe x -> ProgramT p m a
unEnvProgramT'Optional = \case { Just x
x -> x -> ProgramT p m a
f x
x; Maybe x
Nothing -> forall a. HasCallStack => String -> a
error String
"Violated invariant of optEnvDef" } }

-- | Environment 

-- | Argument combinator
arg :: forall name x p m a.
       KnownSymbol name
    => (x -> ProgramT p m a) 
    -> ProgramT (Arg name x & p) m a 
arg :: forall (name :: Symbol) x p (m :: * -> *) a.
KnownSymbol name =>
(x -> ProgramT p m a) -> ProgramT (Arg name x & p) m a
arg = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Arg name t & p) m a
ArgProgramT

-- | Option combinator
opt :: forall option name x p m a.
       (KnownSymbol option, KnownSymbol name)
    => (Maybe x -> ProgramT p m a) 
    -> ProgramT (Opt option name x & p) m a
opt :: forall (option :: Symbol) (name :: Symbol) x p (m :: * -> *) a.
(KnownSymbol option, KnownSymbol name) =>
(Maybe x -> ProgramT p m a) -> ProgramT (Opt option name x & p) m a
opt = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Opt option name t & p) m a
OptProgramT forall a. Maybe a
Nothing

-- | Option combinator with default
optDef :: forall option name x p m a.
     (KnownSymbol option, KnownSymbol name)
  => x
  -> (x -> ProgramT p m a)
  -> ProgramT (Opt option name x & p) m a
optDef :: forall (option :: Symbol) (name :: Symbol) x p (m :: * -> *) a.
(KnownSymbol option, KnownSymbol name) =>
x -> (x -> ProgramT p m a) -> ProgramT (Opt option name x & p) m a
optDef x
x x -> ProgramT p m a
f = OptProgramT { unOptDefault :: Maybe x
unOptDefault = forall a. a -> Maybe a
Just x
x, unOptProgramT :: Maybe x -> ProgramT p m a
unOptProgramT = \case { Just x
x -> x -> ProgramT p m a
f x
x; Maybe x
Nothing -> forall a. HasCallStack => String -> a
error String
"Violated invariant of optDef" } }

-- | Raw monadic combinator
raw :: forall m a.
       m a 
    -> ProgramT Raw m a
raw :: forall (m :: * -> *) a. m a -> ProgramT Raw m a
raw = forall (m :: * -> *) a. m a -> ProgramT Raw m a
RawProgramT

-- | Subcommand combinator
sub :: forall s p m a.
       KnownSymbol s 
    => ProgramT p m a 
    -> ProgramT (s & p) m a
sub :: forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (s & p) m a
sub = forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (sub & p) m a
SubProgramT

-- | Named command combinator, useful at the top level for naming
-- a program. Typically, the name will be the name or alias of the
-- executable you expect to produce.
named :: forall s p m a.
         KnownSymbol s 
      => ProgramT p m a 
      -> ProgramT (Named s & p) m a
named :: forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (Named s & p) m a
named = forall (name :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Named name & p) m a
NamedProgramT

-- | Boolean flag combinator
flag :: forall f p m a.
        KnownSymbol f 
     => (Bool -> ProgramT p m a) 
     -> ProgramT (Flag f & p) m a
flag :: forall (f :: Symbol) p (m :: * -> *) a.
KnownSymbol f =>
(Bool -> ProgramT p m a) -> ProgramT (Flag f & p) m a
flag = forall (flag :: Symbol) p (m :: * -> *) a.
(Bool -> ProgramT p m a) -> ProgramT (Flag flag & p) m a
FlagProgramT

-- | A convenience combinator that constructs the program I often want
-- to run out of a program I want to write.
toplevel :: forall s p m. (HasProgram p, KnownSymbol s, MonadIO m) 
         => ProgramT p m () 
         -> ProgramT (Named s & ("help" & Raw + p)) m ()
toplevel :: forall {k} (s :: Symbol) (p :: k) (m :: * -> *).
(HasProgram p, KnownSymbol s, MonadIO m) =>
ProgramT p m () -> ProgramT (Named s & (("help" & Raw) + p)) m ()
toplevel ProgramT p m ()
p = forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (Named s & p) m a
named (forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (s & p) m a
sub (forall {k} (p :: k) (m :: * -> *).
(MonadIO m, HasProgram p) =>
ProgramT Raw m ()
usage @(Named s & ("help" & Raw + p))) forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
<+> ProgramT p m ()
p)

-- | The command line program which consists of trying to enter one and
-- then trying the other.
(<+>) :: forall x y m a. ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
<+> :: forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
(<+>) = forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
(:+:)

infixr 2 <+>

-- | A meta-combinator that takes a type-level description of a command 
-- line program and produces a simple usage program.
usage :: forall p m. (MonadIO m, HasProgram p) => ProgramT Raw m ()
usage :: forall {k} (p :: k) (m :: * -> *).
(MonadIO m, HasProgram p) =>
ProgramT Raw m ()
usage = forall (m :: * -> *) a. m a -> ProgramT Raw m a
raw forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"usage:"
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (forall {k} (p :: k). HasProgram p => String
document @p)

-- | A combinator which augments the documentation of the next element, by
-- adding a description after its name and type.
annotated :: forall annotation combinator p m a. ProgramT (combinator & p) m a -> ProgramT (Annotated annotation combinator & p) m a
annotated :: forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
annotated = forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
AnnotatedProgramT

-- | A combinator which takes a program, and a type-level 'Symbol'
-- description of that program, and produces a program here the
-- documentation is annotated with the given description.
description :: forall description p m a. (HasProgram p, KnownSymbol description) => ProgramT p m a -> ProgramT (Description description & p) m a
description :: forall (description :: Symbol) p (m :: * -> *) a.
(HasProgram p, KnownSymbol description) =>
ProgramT p m a -> ProgramT (Description description & p) m a
description = forall (description :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Description description & p) m a
DescriptionProgramT

-- | The type of middleware, which can transform interpreted command line programs
-- by meddling with arguments, options, or flags, or by adding effects for
-- every step. You can also change the underlying monad.
type Middleware m n = forall a. CommanderT State m a -> CommanderT State n a

-- | Middleware to transform the base monad with a natural transformation.
transform :: (Monad m, Monad n) => (forall a. m a -> n a) -> Middleware m n
transform :: forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(forall a. m a -> n a) -> Middleware m n
transform forall a. m a -> n a
f CommanderT State m a
commander = case CommanderT State m a
commander of
  Action State -> m (CommanderT State m a, State)
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
    (CommanderT State m a
commander', State
state') <- forall a. m a -> n a
f (State -> m (CommanderT State m a, State)
a State
state)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(forall a. m a -> n a) -> Middleware m n
transform forall a. m a -> n a
f CommanderT State m a
commander', State
state')
  CommanderT State m a
Defeat -> forall state (f :: * -> *) a. CommanderT state f a
Defeat
  Victory a
a -> forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a 

-- | Middleware to add monadic effects for every 'Action'. Useful for
-- debugging complex command line programs.
withActionEffects :: Monad m => m a -> Middleware m m
withActionEffects :: forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withActionEffects m a
ma = forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(forall a. m a -> n a) -> Middleware m n
transform (m a
ma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)

-- | Middleware to have effects whenever the program might backtrack.
withDefeatEffects :: Monad m => m a -> Middleware m m
withDefeatEffects :: forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withDefeatEffects m a
ma CommanderT State m a
commander = case CommanderT State m a
commander of
  Action State -> m (CommanderT State m a, State)
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
    (CommanderT State m a
commander', State
state') <- State -> m (CommanderT State m a, State)
a State
state
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withDefeatEffects m a
ma CommanderT State m a
commander', State
state')
  CommanderT State m a
Defeat -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> m a
ma forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
  Victory a
a -> forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a

-- | Middleware to have effects whenever the program successfully computes
-- a result.
withVictoryEffects :: Monad m => m a -> Middleware m m
withVictoryEffects :: forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withVictoryEffects m a
ma CommanderT State m a
commander = case CommanderT State m a
commander of
  Action State -> m (CommanderT State m a, State)
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
    (CommanderT State m a
commander', State
state') <- State -> m (CommanderT State m a, State)
a State
state
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withVictoryEffects m a
ma CommanderT State m a
commander', State
state')
  CommanderT State m a
Defeat -> forall state (f :: * -> *) a. CommanderT state f a
Defeat
  Victory a
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> m a
ma forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a, State
state)


-- | Produce a 2-dimensional textual drawing of the 'Tree' description of
-- this program.
document :: forall p. HasProgram p => String
document :: forall {k} (p :: k). HasProgram p => String
document = Forest String -> String
drawForest (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)

-- | Middleware to log the state to standard out for every step of the
-- 'CommanderT' computation.
logState :: MonadIO m => Middleware m m
logState :: forall (m :: * -> *). MonadIO m => Middleware m m
logState CommanderT State m a
commander
  = case CommanderT State m a
commander of
      Action State -> m (CommanderT State m a, State)
a ->
        forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print State
state
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall (m :: * -> *). MonadIO m => Middleware m m
logState) (State -> m (CommanderT State m a, State)
a State
state)
      CommanderT State m a
Defeat ->
        forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print State
state
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
      Victory a
a ->
        forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print State
state
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a, State
state)