{-# LANGUAGE UndecidableInstances #-}
{-# 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 = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

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

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

instance Unrender LBS.ByteString where
  unrender :: Text -> Maybe ByteString
unrender = (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
LBS.fromStrict (Maybe ByteString -> Maybe ByteString)
-> (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe ByteString
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 :: Text -> Maybe a
unrenderSmall = (Text -> [(Text, a)] -> Maybe a) -> [(Text, a)] -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup [(String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x, a
x) | a
x <- [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound]]

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

instance Unrender Bool where
  unrender :: Text -> Maybe Bool
unrender = Text -> Maybe Bool
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
(WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i)
-> (Integer -> WrappedIntegral i)
-> Num (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, Num (WrappedIntegral i)
Ord (WrappedIntegral i)
Num (WrappedIntegral i)
-> Ord (WrappedIntegral i)
-> (WrappedIntegral i -> Rational)
-> Real (WrappedIntegral i)
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
$cp2Real :: forall i. Real i => Ord (WrappedIntegral i)
$cp1Real :: forall i. Real i => Num (WrappedIntegral i)
Real, Eq (WrappedIntegral i)
Eq (WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> Ordering)
-> (WrappedIntegral i -> WrappedIntegral i -> Bool)
-> (WrappedIntegral i -> WrappedIntegral i -> Bool)
-> (WrappedIntegral i -> WrappedIntegral i -> Bool)
-> (WrappedIntegral i -> WrappedIntegral i -> Bool)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> Ord (WrappedIntegral i)
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
$cp1Ord :: forall i. Ord i => Eq (WrappedIntegral i)
Ord, WrappedIntegral i -> WrappedIntegral i -> Bool
(WrappedIntegral i -> WrappedIntegral i -> Bool)
-> (WrappedIntegral i -> WrappedIntegral i -> Bool)
-> Eq (WrappedIntegral i)
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]
(WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i)
-> (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 -> [WrappedIntegral i])
-> Enum (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, Enum (WrappedIntegral i)
Real (WrappedIntegral i)
Real (WrappedIntegral i)
-> Enum (WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i)
-> (WrappedIntegral i
    -> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i))
-> (WrappedIntegral i
    -> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i))
-> (WrappedIntegral i -> Integer)
-> Integral (WrappedIntegral i)
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
$cp2Integral :: forall i. Integral i => Enum (WrappedIntegral i)
$cp1Integral :: forall i. Integral i => Real (WrappedIntegral i)
Integral)

instance (Typeable i, Integral i) => Unrender (WrappedIntegral i) where
  unrender :: Text -> Maybe (WrappedIntegral i)
unrender = (String -> Maybe (WrappedIntegral i))
-> ((Integer, Text) -> Maybe (WrappedIntegral i))
-> Either String (Integer, Text)
-> Maybe (WrappedIntegral i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (WrappedIntegral i) -> String -> Maybe (WrappedIntegral i)
forall a b. a -> b -> a
const Maybe (WrappedIntegral i)
forall a. Maybe a
Nothing) (Integer, Text) -> Maybe (WrappedIntegral i)
forall a a. (Eq a, IsString a, Num a) => (Integer, a) -> Maybe a
h (Either String (Integer, Text) -> Maybe (WrappedIntegral i))
-> (Text -> Either String (Integer, Text))
-> Text
-> Maybe (WrappedIntegral i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String (Integer, Text))
-> Text -> Either String (Integer, Text)
forall a. Num a => Reader a -> Reader a
signed Text -> Either String (Integer, Text)
forall a. Integral a => Reader a
decimal where
    h :: (Integer, a) -> Maybe a
h (Integer
n, a
"") = a -> Maybe a
forall a. a -> Maybe a
Just (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n)
    h (Integer, a)
_ = Maybe 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
(WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i)
-> (Integer -> WrappedNatural i)
-> Num (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, Num (WrappedNatural i)
Ord (WrappedNatural i)
Num (WrappedNatural i)
-> Ord (WrappedNatural i)
-> (WrappedNatural i -> Rational)
-> Real (WrappedNatural i)
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
$cp2Real :: forall i. Real i => Ord (WrappedNatural i)
$cp1Real :: forall i. Real i => Num (WrappedNatural i)
Real, Eq (WrappedNatural i)
Eq (WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> Ordering)
-> (WrappedNatural i -> WrappedNatural i -> Bool)
-> (WrappedNatural i -> WrappedNatural i -> Bool)
-> (WrappedNatural i -> WrappedNatural i -> Bool)
-> (WrappedNatural i -> WrappedNatural i -> Bool)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> Ord (WrappedNatural i)
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
$cp1Ord :: forall i. Ord i => Eq (WrappedNatural i)
Ord, WrappedNatural i -> WrappedNatural i -> Bool
(WrappedNatural i -> WrappedNatural i -> Bool)
-> (WrappedNatural i -> WrappedNatural i -> Bool)
-> Eq (WrappedNatural i)
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]
(WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i)
-> (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 -> [WrappedNatural i])
-> Enum (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, Enum (WrappedNatural i)
Real (WrappedNatural i)
Real (WrappedNatural i)
-> Enum (WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i -> WrappedNatural i -> WrappedNatural i)
-> (WrappedNatural i
    -> WrappedNatural i -> (WrappedNatural i, WrappedNatural i))
-> (WrappedNatural i
    -> WrappedNatural i -> (WrappedNatural i, WrappedNatural i))
-> (WrappedNatural i -> Integer)
-> Integral (WrappedNatural i)
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
$cp2Integral :: forall i. Integral i => Enum (WrappedNatural i)
$cp1Integral :: forall i. Integral i => Real (WrappedNatural i)
Integral)

instance (Typeable i, Integral i) => Unrender (WrappedNatural i) where
  unrender :: Text -> Maybe (WrappedNatural i)
unrender = (String -> Maybe (WrappedNatural i))
-> ((Integer, Text) -> Maybe (WrappedNatural i))
-> Either String (Integer, Text)
-> Maybe (WrappedNatural i)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (WrappedNatural i) -> String -> Maybe (WrappedNatural i)
forall a b. a -> b -> a
const Maybe (WrappedNatural i)
forall a. Maybe a
Nothing) (Integer, Text) -> Maybe (WrappedNatural i)
forall a a. (Eq a, IsString a, Num a) => (Integer, a) -> Maybe a
h (Either String (Integer, Text) -> Maybe (WrappedNatural i))
-> (Text -> Either String (Integer, Text))
-> Text
-> Maybe (WrappedNatural i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Integer, Text)
forall a. Integral a => Reader a
decimal where
    h :: (Integer, a) -> Maybe a
h (Integer
n, a
"") = if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then a -> Maybe a
forall a. a -> Maybe a
Just (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n) else Maybe a
forall a. Maybe a
Nothing
    h (Integer, a)
_ = Maybe 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 (Bool -> Char -> Bool
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. State -> Rep State x)
-> (forall x. Rep State x -> State) -> Generic State
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
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
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
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
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
Eq State
-> (State -> State -> Ordering)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> State)
-> (State -> State -> State)
-> Ord 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
$cp1Ord :: Eq State
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 { ProgramT (Env 'Required name t & p) m a -> t -> ProgramT p m a
unEnvProgramT'Required :: t -> ProgramT p m a }
  run :: ProgramT (Env 'Required name t & p) IO a -> CommanderT State IO a
run ProgramT (Env 'Required name t & p) IO a
f = (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> IO (CommanderT State IO a, State))
 -> CommanderT State IO a)
-> (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall a b. (a -> b) -> a -> b
$ \State
state -> do
    Maybe String
val <- String -> IO (Maybe String)
lookupEnv (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name))
    case Maybe String
val of
      Just String
v ->
        case Text -> Maybe t
forall t. Unrender t => Text -> Maybe t
unrender (String -> Text
pack String
v) of
          Just t
t -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (Env 'Required name t & p) IO a -> t -> ProgramT p IO a
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 -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
      Maybe String
Nothing -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
  hoist :: (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 f) = (t -> ProgramT p n a) -> ProgramT (Env 'Required name t & p) n a
forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Env 'Required name t & p) m a
EnvProgramT'Required ((forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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 p m a -> ProgramT p n a)
-> (t -> ProgramT p m a) -> t -> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ProgramT p m a
f)
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"required env: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t
forall k (t :: k). Proxy t
Proxy @t)))
    (HasProgram p => Forest String
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
    { ProgramT (Env 'Optional name t & p) m a
-> Maybe t -> ProgramT p m a
unEnvProgramT'Optional :: Maybe t -> ProgramT p m a
    , ProgramT (Env 'Optional name t & p) m a -> Maybe t
unEnvDefault :: Maybe t }
  run :: ProgramT (Env 'Optional name t & p) IO a -> CommanderT State IO a
run ProgramT (Env 'Optional name t & p) IO a
f = (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> IO (CommanderT State IO a, State))
 -> CommanderT State IO a)
-> (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall a b. (a -> b) -> a -> b
$ \State
state -> do
    Maybe String
val <- String -> IO (Maybe String)
lookupEnv (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name))
    case Maybe String
val of
      Just String
v -> do
        case Text -> Maybe t
forall t. Unrender t => Text -> Maybe t
unrender @t (String -> Text
pack String
v) of
          Just t
t -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (Env 'Optional name t & p) IO a
-> Maybe t -> ProgramT p IO a
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 (t -> Maybe t
forall a. a -> Maybe a
Just t
t)), State
state)  
          Maybe t
Nothing -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
      Maybe String
Nothing -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (Env 'Optional name t & p) IO a
-> Maybe t -> ProgramT p IO a
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 (ProgramT (Env 'Optional name t & p) IO a -> Maybe t
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 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 f d) = (Maybe t -> ProgramT p n a)
-> Maybe t -> ProgramT (Env 'Optional name t & p) n a
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 x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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 p m a -> ProgramT p n a)
-> (Maybe t -> ProgramT p m a) -> Maybe t -> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe t -> ProgramT p m a
f) Maybe t
d
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"optional env: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t
forall k (t :: k). Proxy t
Proxy @t)))
    (HasProgram p => Forest String
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 { ProgramT (Arg name t & p) m a -> t -> ProgramT p m a
unArgProgramT :: t -> ProgramT p m a }
  run :: ProgramT (Arg name t & p) IO a -> CommanderT State IO a
run ProgramT (Arg name t & p) IO a
f = (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> IO (CommanderT State IO a, State))
 -> CommanderT State IO a)
-> (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
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 Text -> Maybe t
forall t. Unrender t => Text -> Maybe t
unrender Text
x of
          Just t
t -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (Arg name t & p) IO a -> t -> ProgramT p IO a
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 :: [Text] -> HashMap Text Text -> HashSet Text -> State
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 -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State :: [Text] -> HashMap Text Text -> HashSet Text -> State
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]
..})
      [] -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State :: [Text] -> HashMap Text Text -> HashSet Text -> State
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 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 f) = (t -> ProgramT p n a) -> ProgramT (Arg name t & p) n a
forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Arg name t & p) m a
ArgProgramT ((forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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 p m a -> ProgramT p n a)
-> (t -> ProgramT p m a) -> t -> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ProgramT p m a
f)
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"argument: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t
forall k (t :: k). Proxy t
Proxy @t)))
    (HasProgram p => Forest String
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 :: ProgramT (x + y) IO a -> CommanderT State IO a
run (f :+: g) = ProgramT x IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT x IO a
f CommanderT State IO a
-> CommanderT State IO a -> CommanderT State IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProgramT y IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT y IO a
g
  hoist :: (forall x. m x -> n x)
-> ProgramT (x + y) m a -> ProgramT (x + y) n a
hoist forall x. m x -> n x
n (f :+: g) = (forall x. m x -> n x) -> ProgramT x m a -> ProgramT x n 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 x m a
f ProgramT x n a -> ProgramT y n a -> ProgramT (x + y) n a
forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
:+: (forall x. m x -> n x) -> ProgramT y m a -> ProgramT y n 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 = HasProgram x => Forest String
forall k (p :: k). HasProgram p => Forest String
documentation @x Forest String -> Forest String -> Forest String
forall a. Semigroup a => a -> a -> a
<> HasProgram y => Forest String
forall k (p :: k). HasProgram p => Forest String
documentation @y

infixr 2 :+:

instance HasProgram Raw where
  newtype ProgramT Raw m a = RawProgramT { ProgramT Raw m a -> m a
unRawProgramT :: m a }
  run :: ProgramT Raw IO a -> CommanderT State IO a
run = IO a -> CommanderT State IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> CommanderT State IO a)
-> (ProgramT Raw IO a -> IO a)
-> ProgramT Raw IO a
-> CommanderT State IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT Raw IO a -> IO a
forall (m :: * -> *) a. ProgramT Raw m a -> m a
unRawProgramT
  hoist :: (forall x. m x -> n x) -> ProgramT Raw m a -> ProgramT Raw n a
hoist forall x. m x -> n x
n (RawProgramT m) = n a -> ProgramT Raw n a
forall (m :: * -> *) a. m a -> ProgramT Raw m a
RawProgramT (m a -> n a
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
    { ProgramT (Opt option name t & p) m a -> Maybe t -> ProgramT p m a
unOptProgramT :: Maybe t -> ProgramT p m a
    , ProgramT (Opt option name t & p) m a -> Maybe t
unOptDefault :: Maybe t }
  run :: ProgramT (Opt option name t & p) IO a -> CommanderT State IO a
run ProgramT (Opt option name t & p) IO a
f = (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> IO (CommanderT State IO a, State))
 -> CommanderT State IO a)
-> (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
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 -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy option -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy option
forall k (t :: k). Proxy t
Proxy @option)) HashMap Text Text
options of
      Just Text
opt' -> 
        case Text -> Maybe t
forall t. Unrender t => Text -> Maybe t
unrender Text
opt' of
          Just t
t -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (Opt option name t & p) IO a -> Maybe t -> ProgramT p IO a
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 (t -> Maybe t
forall a. a -> Maybe a
Just t
t)), State :: [Text] -> HashMap Text Text -> HashSet Text -> State
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 -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State :: [Text] -> HashMap Text Text -> HashSet Text -> State
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  -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (Opt option name t & p) IO a -> Maybe t -> ProgramT p IO a
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 (ProgramT (Opt option name t & p) IO a -> Maybe t
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] -> HashMap Text Text -> HashSet Text -> State
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 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 f d) = (Maybe t -> ProgramT p n a)
-> Maybe t -> ProgramT (Opt option name t & p) n a
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 x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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 p m a -> ProgramT p n a)
-> (Maybe t -> ProgramT p m a) -> Maybe t -> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe t -> ProgramT p m a
f) Maybe t
d
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"option: -" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy option -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy option
forall k (t :: k). Proxy t
Proxy @option)
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" <" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" :: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t
forall k (t :: k). Proxy t
Proxy @t))
    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">")
    (HasProgram p => Forest 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 { ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT :: Bool -> ProgramT p m a }
  run :: ProgramT (Flag flag & p) IO a -> CommanderT State IO a
run ProgramT (Flag flag & p) IO a
f = (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> IO (CommanderT State IO a, State))
 -> CommanderT State IO a)
-> (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
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 = Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member (String -> Text
pack (Proxy flag -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy flag
forall k (t :: k). Proxy t
Proxy @flag))) HashSet Text
flags
    (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (Flag flag & p) IO a -> Bool -> ProgramT p IO a
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] -> HashMap Text Text -> HashSet Text -> State
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 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 = (Bool -> ProgramT p n a) -> ProgramT (Flag flag & p) n a
forall (flag :: Symbol) p (m :: * -> *) a.
(Bool -> ProgramT p m a) -> ProgramT (Flag flag & p) m a
FlagProgramT ((Bool -> ProgramT p n a) -> ProgramT (Flag flag & p) n a)
-> (ProgramT (Flag flag & p) m a -> Bool -> ProgramT p n a)
-> ProgramT (Flag flag & p) m a
-> ProgramT (Flag flag & p) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgramT p m a -> ProgramT p n a)
-> (Bool -> ProgramT p m a) -> Bool -> ProgramT p n a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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) ((Bool -> ProgramT p m a) -> Bool -> ProgramT p n a)
-> (ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a)
-> ProgramT (Flag flag & p) m a
-> Bool
-> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
forall (flag :: Symbol) p (m :: * -> *) a.
ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"flag: ~" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy flag -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy flag
forall k (t :: k). Proxy t
Proxy @flag))
    (HasProgram p => Forest String
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 { ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT :: ProgramT p m a }
  run :: ProgramT (Named name & p) IO a -> CommanderT State IO a
run = ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT p IO a -> CommanderT State IO a)
-> (ProgramT (Named name & p) IO a -> ProgramT p IO a)
-> ProgramT (Named name & p) IO a
-> CommanderT State IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (Named name & p) IO a -> ProgramT p IO a
forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT 
  hoist :: (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 = ProgramT p n a -> ProgramT (Named name & p) n a
forall (name :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Named name & p) m a
NamedProgramT (ProgramT p n a -> ProgramT (Named name & p) n a)
-> (ProgramT (Named name & p) m a -> ProgramT p n a)
-> ProgramT (Named name & p) m a
-> ProgramT (Named name & p) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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 p m a -> ProgramT p n a)
-> (ProgramT (Named name & p) m a -> ProgramT p m a)
-> ProgramT (Named name & p) m a
-> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (Named name & p) m a -> ProgramT p m a
forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"name: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name))
    (HasProgram p => Forest String
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 { ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT :: ProgramT p m a }
  run :: ProgramT (Description description & p) IO a
-> CommanderT State IO a
run = ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT p IO a -> CommanderT State IO a)
-> (ProgramT (Description description & p) IO a -> ProgramT p IO a)
-> ProgramT (Description description & p) IO a
-> CommanderT State IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (Description description & p) IO a -> ProgramT p IO a
forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT 
  hoist :: (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 = ProgramT p n a -> ProgramT (Description description & p) n a
forall (description :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Description description & p) m a
DescriptionProgramT (ProgramT p n a -> ProgramT (Description description & p) n a)
-> (ProgramT (Description description & p) m a -> ProgramT p n a)
-> ProgramT (Description description & p) m a
-> ProgramT (Description description & p) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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 p m a -> ProgramT p n a)
-> (ProgramT (Description description & p) m a -> ProgramT p m a)
-> ProgramT (Description description & p) m a
-> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (Description description & p) m a -> ProgramT p m a
forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"description: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy description -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy description
forall k (t :: k). Proxy t
Proxy @description))
    []] Forest String -> Forest String -> Forest String
forall a. Semigroup a => a -> a -> a
<> HasProgram p => Forest String
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 { ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT :: ProgramT (combinator & p) m a }
  run :: ProgramT (Annotated annotation combinator & p) IO a
-> CommanderT State IO a
run = ProgramT (combinator & p) IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT (combinator & p) IO a -> CommanderT State IO a)
-> (ProgramT (Annotated annotation combinator & p) IO a
    -> ProgramT (combinator & p) IO a)
-> ProgramT (Annotated annotation combinator & p) IO a
-> CommanderT State IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (Annotated annotation combinator & p) IO a
-> ProgramT (combinator & p) IO a
forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT 
  hoist :: (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 = ProgramT (combinator & p) n a
-> ProgramT (Annotated annotation combinator & p) n a
forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
AnnotatedProgramT (ProgramT (combinator & p) n a
 -> ProgramT (Annotated annotation combinator & p) n a)
-> (ProgramT (Annotated annotation combinator & p) m a
    -> ProgramT (combinator & p) n a)
-> ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> n x)
-> ProgramT (combinator & p) m a -> ProgramT (combinator & p) n 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 (combinator & p) m a -> ProgramT (combinator & p) n a)
-> (ProgramT (Annotated annotation combinator & p) m a
    -> ProgramT (combinator & p) m a)
-> ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT
  documentation :: Forest String
documentation = (Tree String -> Tree String) -> Forest String -> Forest String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Node String
x Forest String
s) -> String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node (String
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy annotation -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy annotation
forall k (t :: k). Proxy t
Proxy @annotation)) Forest String
s) (HasProgram (combinator & p) => Forest String
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 { ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT :: ProgramT p m a }
  run :: ProgramT (sub & p) IO a -> CommanderT State IO a
run ProgramT (sub & p) IO a
s = (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> IO (CommanderT State IO a, State))
 -> CommanderT State IO a)
-> (State -> IO (CommanderT State IO a, State))
-> CommanderT State IO a
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
pack (Proxy sub -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sub -> String) -> Proxy sub -> String
forall a b. (a -> b) -> a -> b
$ Proxy sub
forall k (t :: k). Proxy t
Proxy @sub) 
          then (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramT p IO a -> CommanderT State IO a
forall k (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (ProgramT p IO a -> CommanderT State IO a)
-> ProgramT p IO a -> CommanderT State IO a
forall a b. (a -> b) -> a -> b
$ ProgramT (sub & p) IO a -> ProgramT p IO a
forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT ProgramT (sub & p) IO a
s, State :: [Text] -> HashMap Text Text -> HashSet Text -> State
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 (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State :: [Text] -> HashMap Text Text -> HashSet Text -> State
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]
..})
      [] -> (CommanderT State IO a, State) -> IO (CommanderT State IO a, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommanderT State IO a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State :: [Text] -> HashMap Text Text -> HashSet Text -> State
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 x. m x -> n x)
-> ProgramT (sub & p) m a -> ProgramT (sub & p) n a
hoist forall x. m x -> n x
n = ProgramT p n a -> ProgramT (sub & p) n a
forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (sub & p) m a
SubProgramT (ProgramT p n a -> ProgramT (sub & p) n a)
-> (ProgramT (sub & p) m a -> ProgramT p n a)
-> ProgramT (sub & p) m a
-> ProgramT (sub & p) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n 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 p m a -> ProgramT p n a)
-> (ProgramT (sub & p) m a -> ProgramT p m a)
-> ProgramT (sub & p) m a
-> ProgramT p n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramT (sub & p) m a -> ProgramT p m a
forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT
  documentation :: Forest String
documentation = [String -> Forest String -> Tree String
forall a. a -> Forest a -> Tree a
Node
    (String
"subprogram: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy sub -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sub
forall k (t :: k). Proxy t
Proxy @sub))
    (HasProgram p => Forest String
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
  State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> IO State) -> State -> IO State
forall a b. (a -> b) -> a -> b
$ [Text] -> HashMap Text Text -> HashSet Text -> State
State [Text]
args' ([(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Text)]
opts) ([Text] -> HashSet Text
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' Text -> [Text] -> [Text]
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) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args) [Text]
flags [String]
y
        go [(Text, Text)]
opts [Text]
args [Text]
flags [] = ([(Text, Text)]
opts, [Text] -> [Text]
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_ :: ProgramT p IO a -> IO ()
command_ ProgramT p IO a
prog = IO (Maybe a) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe a) -> IO ()) -> IO (Maybe a) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO State
initialState IO State -> (State -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CommanderT State IO a -> State -> IO (Maybe a)
forall (m :: * -> *) state a.
Monad m =>
CommanderT state m a -> state -> m (Maybe a)
runCommanderT (ProgramT p IO a -> CommanderT State IO a
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 :: ProgramT p IO a -> IO (Maybe a)
command ProgramT p IO a
prog = IO State
initialState IO State -> (State -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CommanderT State IO a -> State -> IO (Maybe a)
forall (m :: * -> *) state a.
Monad m =>
CommanderT state m a -> state -> m (Maybe a)
runCommanderT (ProgramT p IO a -> CommanderT State IO a
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 :: (x -> ProgramT p m a) -> ProgramT (Env 'Required name x & p) m a
env = (x -> ProgramT p m a) -> ProgramT (Env 'Required name x & p) m a
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 :: (Maybe x -> ProgramT p m a)
-> ProgramT (Env 'Optional name x & p) m a
envOpt = ((Maybe x -> ProgramT p m a)
 -> Maybe x -> ProgramT (Env 'Optional name x & p) m a)
-> Maybe x
-> (Maybe x -> ProgramT p m a)
-> ProgramT (Env 'Optional name x & p) m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe x -> ProgramT p m a)
-> Maybe x -> ProgramT (Env 'Optional name x & p) m a
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 Maybe x
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 :: 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 :: 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 { unEnvDefault :: Maybe x
unEnvDefault = x -> Maybe x
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 -> String -> ProgramT p m a
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 :: (x -> ProgramT p m a) -> ProgramT (Arg name x & p) m a
arg = (x -> ProgramT p m a) -> ProgramT (Arg name x & p) m a
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 :: (Maybe x -> ProgramT p m a) -> ProgramT (Opt option name x & p) m a
opt = ((Maybe x -> ProgramT p m a)
 -> Maybe x -> ProgramT (Opt option name x & p) m a)
-> Maybe x
-> (Maybe x -> ProgramT p m a)
-> ProgramT (Opt option name x & p) m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe x -> ProgramT p m a)
-> Maybe x -> ProgramT (Opt option name x & p) m a
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 Maybe x
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 :: x -> (x -> ProgramT p m a) -> ProgramT (Opt option name x & p) m a
optDef x
x x -> ProgramT p m a
f = OptProgramT :: 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 { unOptDefault :: Maybe x
unOptDefault = x -> Maybe x
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 -> String -> ProgramT p m a
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 :: m a -> ProgramT Raw m a
raw = m a -> ProgramT Raw m a
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 :: ProgramT p m a -> ProgramT (s & p) m a
sub = ProgramT p m a -> ProgramT (s & p) m a
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 :: ProgramT p m a -> ProgramT (Named s & p) m a
named = ProgramT p m a -> ProgramT (Named s & p) m a
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 :: (Bool -> ProgramT p m a) -> ProgramT (Flag f & p) m a
flag = (Bool -> ProgramT p m a) -> ProgramT (Flag f & p) m a
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 :: ProgramT p m () -> ProgramT (Named s & (("help" & Raw) + p)) m ()
toplevel ProgramT p m ()
p = ProgramT (("help" & Raw) + p) m ()
-> ProgramT (Named s & (("help" & Raw) + p)) m ()
forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (Named s & p) m a
named (ProgramT Raw m () -> ProgramT ("help" & Raw) m ()
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 ()
forall (m :: * -> *).
(MonadIO m, HasProgram (Named s & (("help" & Raw) + p))) =>
ProgramT Raw m ()
usage @(Named s & ("help" & Raw + p))) ProgramT ("help" & Raw) m ()
-> ProgramT p m () -> ProgramT (("help" & Raw) + p) m ()
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
<+> :: ProgramT x m a -> ProgramT y m a -> ProgramT (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
(:+:)

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 :: ProgramT Raw m ()
usage = m () -> ProgramT Raw m ()
forall (m :: * -> *) a. m a -> ProgramT Raw m a
raw (m () -> ProgramT Raw m ()) -> m () -> ProgramT Raw m ()
forall a b. (a -> b) -> a -> b
$ do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"usage:"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (HasProgram p => String
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 :: ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
annotated = ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
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 :: ProgramT p m a -> ProgramT (Description description & p) m a
description = ProgramT p m a -> ProgramT (Description description & p) m a
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 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 -> (State -> n (CommanderT State n a, State)) -> CommanderT State n a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> n (CommanderT State n a, State))
 -> CommanderT State n a)
-> (State -> n (CommanderT State n a, State))
-> CommanderT State n a
forall a b. (a -> b) -> a -> b
$ \State
state -> do
    (CommanderT State m a
commander', State
state') <- m (CommanderT State m a, State) -> n (CommanderT State m a, State)
forall a. m a -> n a
f (State -> m (CommanderT State m a, State)
a State
state)
    (CommanderT State n a, State) -> n (CommanderT State n a, State)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((forall a. m a -> n a)
-> CommanderT State m a -> CommanderT State n a
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 -> CommanderT State n a
forall state (f :: * -> *) a. CommanderT state f a
Defeat
  Victory a
a -> a -> CommanderT State n 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 :: m a -> Middleware m m
withActionEffects m a
ma = (forall a. m a -> m a) -> Middleware m m
forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(forall a. m a -> n a) -> Middleware m n
transform (m a
ma m a -> m a -> m a
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 :: 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 -> (State -> m (CommanderT State m a, State)) -> CommanderT State m a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> m (CommanderT State m a, State))
 -> CommanderT State m a)
-> (State -> m (CommanderT State m a, State))
-> CommanderT State m a
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
    (CommanderT State m a, State) -> m (CommanderT State m a, State)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m a -> CommanderT State m a -> CommanderT State m a
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 -> (State -> m (CommanderT State m a, State)) -> CommanderT State m a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> m (CommanderT State m a, State))
 -> CommanderT State m a)
-> (State -> m (CommanderT State m a, State))
-> CommanderT State m a
forall a b. (a -> b) -> a -> b
$ \State
state -> m a
ma m a
-> (CommanderT State m a, State) -> m (CommanderT State m a, State)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (CommanderT State m a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
  Victory a
a -> a -> CommanderT State m 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 :: 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 -> (State -> m (CommanderT State m a, State)) -> CommanderT State m a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> m (CommanderT State m a, State))
 -> CommanderT State m a)
-> (State -> m (CommanderT State m a, State))
-> CommanderT State m a
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
    (CommanderT State m a, State) -> m (CommanderT State m a, State)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m a -> CommanderT State m a -> CommanderT State m a
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 -> CommanderT State m a
forall state (f :: * -> *) a. CommanderT state f a
Defeat
  Victory a
a -> (State -> m (CommanderT State m a, State)) -> CommanderT State m a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> m (CommanderT State m a, State))
 -> CommanderT State m a)
-> (State -> m (CommanderT State m a, State))
-> CommanderT State m a
forall a b. (a -> b) -> a -> b
$ \State
state -> m a
ma m a
-> (CommanderT State m a, State) -> m (CommanderT State m a, State)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (a -> CommanderT State m a
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 :: String
document = Forest String -> String
drawForest (HasProgram p => Forest String
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 :: 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 ->
        (State -> m (CommanderT State m a, State)) -> CommanderT State m a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> m (CommanderT State m a, State))
 -> CommanderT State m a)
-> (State -> m (CommanderT State m a, State))
-> CommanderT State m a
forall a b. (a -> b) -> a -> b
$ \State
state -> do
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State -> IO ()
forall a. Show a => a -> IO ()
print State
state
          ((CommanderT State m a, State) -> (CommanderT State m a, State))
-> m (CommanderT State m a, State)
-> m (CommanderT State m a, State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CommanderT State m a -> CommanderT State m a)
-> (CommanderT State m a, State) -> (CommanderT State m a, State)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first CommanderT State m a -> CommanderT State m a
forall (m :: * -> *). MonadIO m => Middleware m m
logState) (State -> m (CommanderT State m a, State)
a State
state)
      CommanderT State m a
Defeat ->
        (State -> m (CommanderT State m a, State)) -> CommanderT State m a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> m (CommanderT State m a, State))
 -> CommanderT State m a)
-> (State -> m (CommanderT State m a, State))
-> CommanderT State m a
forall a b. (a -> b) -> a -> b
$ \State
state -> do
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State -> IO ()
forall a. Show a => a -> IO ()
print State
state
          (CommanderT State m a, State) -> m (CommanderT State m a, State)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommanderT State m a
forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
      Victory a
a ->
        (State -> m (CommanderT State m a, State)) -> CommanderT State m a
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action ((State -> m (CommanderT State m a, State))
 -> CommanderT State m a)
-> (State -> m (CommanderT State m a, State))
-> CommanderT State m a
forall a b. (a -> b) -> a -> b
$ \State
state -> do
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State -> IO ()
forall a. Show a => a -> IO ()
print State
state
          (CommanderT State m a, State) -> m (CommanderT State m a, State)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> CommanderT State m a
forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a, State
state)