{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
module Options.Commander (
Unrender(unrender),
arg, opt, optDef, raw, sub, named, flag, toplevel, (<+>), usage, env, envOpt, envOptDef, description, annotated,
command, command_,
type (&), type (+), Arg, Opt, Named, Raw, Flag, Env, Optionality(Required, Optional), Description, Annotated,
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,
(:+:)
),
CommanderT(Action, Defeat, Victory), runCommanderT, initialState, State(State, arguments, options, flags),
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
class Typeable t => Unrender t where
unrender :: Text -> Maybe t
instance Unrender String where
unrender :: Text -> Maybe String
unrender = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
instance Unrender Text where
unrender :: Text -> Maybe Text
unrender = forall a. a -> Maybe a
Just
instance Unrender SBS.ByteString where
unrender :: Text -> Maybe ByteString
unrender = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
instance Unrender LBS.ByteString where
unrender :: Text -> Maybe ByteString
unrender = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
LBS.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Unrender t => Text -> Maybe t
unrender
unrenderSmall :: (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall :: forall a. (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup [(String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
x, a
x) | a
x <- [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound]]
instance Unrender () where
unrender :: Text -> Maybe ()
unrender = forall a. (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall
instance (Unrender a, Unrender b) => Unrender (Either a b) where
unrender :: Text -> Maybe (Either a b)
unrender Text
x = forall {b}. Text -> Maybe (Either a b)
leftCase Text
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Text -> Maybe (Either a b)
rightCase Text
x where
leftCase :: Text -> Maybe (Either a b)
leftCase = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Unrender t => Text -> Maybe t
unrender
rightCase :: Text -> Maybe (Either a b)
rightCase = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Unrender t => Text -> Maybe t
unrender
instance Unrender Bool where
unrender :: Text -> Maybe Bool
unrender = forall a. (Enum a, Bounded a, Show a) => Text -> Maybe a
unrenderSmall
newtype WrappedIntegral i = WrappedIntegral i
deriving newtype (Integer -> WrappedIntegral i
WrappedIntegral i -> WrappedIntegral i
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall i. Num i => Integer -> WrappedIntegral i
forall i. Num i => WrappedIntegral i -> WrappedIntegral i
forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> WrappedIntegral i
$cfromInteger :: forall i. Num i => Integer -> WrappedIntegral i
signum :: WrappedIntegral i -> WrappedIntegral i
$csignum :: forall i. Num i => WrappedIntegral i -> WrappedIntegral i
abs :: WrappedIntegral i -> WrappedIntegral i
$cabs :: forall i. Num i => WrappedIntegral i -> WrappedIntegral i
negate :: WrappedIntegral i -> WrappedIntegral i
$cnegate :: forall i. Num i => WrappedIntegral i -> WrappedIntegral i
* :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$c* :: forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
- :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$c- :: forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
+ :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$c+ :: forall i.
Num i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
Num, WrappedIntegral i -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall {i}. Real i => Num (WrappedIntegral i)
forall {i}. Real i => Ord (WrappedIntegral i)
forall i. Real i => WrappedIntegral i -> Rational
toRational :: WrappedIntegral i -> Rational
$ctoRational :: forall i. Real i => WrappedIntegral i -> Rational
Real, WrappedIntegral i -> WrappedIntegral i -> Bool
WrappedIntegral i -> WrappedIntegral i -> Ordering
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {i}. Ord i => Eq (WrappedIntegral i)
forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> Ordering
forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
min :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cmin :: forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
max :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cmax :: forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
>= :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c>= :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
> :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c> :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
<= :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c<= :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
< :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c< :: forall i. Ord i => WrappedIntegral i -> WrappedIntegral i -> Bool
compare :: WrappedIntegral i -> WrappedIntegral i -> Ordering
$ccompare :: forall i.
Ord i =>
WrappedIntegral i -> WrappedIntegral i -> Ordering
Ord, WrappedIntegral i -> WrappedIntegral i -> Bool
forall i. Eq i => WrappedIntegral i -> WrappedIntegral i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c/= :: forall i. Eq i => WrappedIntegral i -> WrappedIntegral i -> Bool
== :: WrappedIntegral i -> WrappedIntegral i -> Bool
$c== :: forall i. Eq i => WrappedIntegral i -> WrappedIntegral i -> Bool
Eq, Int -> WrappedIntegral i
WrappedIntegral i -> Int
WrappedIntegral i -> [WrappedIntegral i]
WrappedIntegral i -> WrappedIntegral i
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
forall i. Enum i => Int -> WrappedIntegral i
forall i. Enum i => WrappedIntegral i -> Int
forall i. Enum i => WrappedIntegral i -> [WrappedIntegral i]
forall i. Enum i => WrappedIntegral i -> WrappedIntegral i
forall i.
Enum i =>
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
forall i.
Enum i =>
WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
$cenumFromThenTo :: forall i.
Enum i =>
WrappedIntegral i
-> WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
enumFromTo :: WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
$cenumFromTo :: forall i.
Enum i =>
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
enumFromThen :: WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
$cenumFromThen :: forall i.
Enum i =>
WrappedIntegral i -> WrappedIntegral i -> [WrappedIntegral i]
enumFrom :: WrappedIntegral i -> [WrappedIntegral i]
$cenumFrom :: forall i. Enum i => WrappedIntegral i -> [WrappedIntegral i]
fromEnum :: WrappedIntegral i -> Int
$cfromEnum :: forall i. Enum i => WrappedIntegral i -> Int
toEnum :: Int -> WrappedIntegral i
$ctoEnum :: forall i. Enum i => Int -> WrappedIntegral i
pred :: WrappedIntegral i -> WrappedIntegral i
$cpred :: forall i. Enum i => WrappedIntegral i -> WrappedIntegral i
succ :: WrappedIntegral i -> WrappedIntegral i
$csucc :: forall i. Enum i => WrappedIntegral i -> WrappedIntegral i
Enum, WrappedIntegral i -> Integer
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall {i}. Integral i => Enum (WrappedIntegral i)
forall {i}. Integral i => Real (WrappedIntegral i)
forall i. Integral i => WrappedIntegral i -> Integer
forall i.
Integral i =>
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: WrappedIntegral i -> Integer
$ctoInteger :: forall i. Integral i => WrappedIntegral i -> Integer
divMod :: WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
$cdivMod :: forall i.
Integral i =>
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
quotRem :: WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
$cquotRem :: forall i.
Integral i =>
WrappedIntegral i
-> WrappedIntegral i -> (WrappedIntegral i, WrappedIntegral i)
mod :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cmod :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
div :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cdiv :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
rem :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$crem :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
quot :: WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
$cquot :: forall i.
Integral i =>
WrappedIntegral i -> WrappedIntegral i -> WrappedIntegral i
Integral)
instance (Typeable i, Integral i) => Unrender (WrappedIntegral i) where
unrender :: Text -> Maybe (WrappedIntegral i)
unrender = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall {a} {a}.
(Eq a, IsString a, Num a) =>
(Integer, a) -> Maybe a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Reader a -> Reader a
signed forall a. Integral a => Reader a
decimal where
h :: (Integer, a) -> Maybe a
h (Integer
n, a
"") = forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
fromInteger Integer
n)
h (Integer, a)
_ = forall a. Maybe a
Nothing
deriving via WrappedIntegral Integer instance Unrender Integer
deriving via WrappedIntegral Int instance Unrender Int
deriving via WrappedIntegral Int8 instance Unrender Int8
deriving via WrappedIntegral Int16 instance Unrender Int16
deriving via WrappedIntegral Int32 instance Unrender Int32
deriving via WrappedIntegral Int64 instance Unrender Int64
newtype WrappedNatural i = WrappedNatural i
deriving newtype (Integer -> WrappedNatural i
WrappedNatural i -> WrappedNatural i
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall i. Num i => Integer -> WrappedNatural i
forall i. Num i => WrappedNatural i -> WrappedNatural i
forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> WrappedNatural i
$cfromInteger :: forall i. Num i => Integer -> WrappedNatural i
signum :: WrappedNatural i -> WrappedNatural i
$csignum :: forall i. Num i => WrappedNatural i -> WrappedNatural i
abs :: WrappedNatural i -> WrappedNatural i
$cabs :: forall i. Num i => WrappedNatural i -> WrappedNatural i
negate :: WrappedNatural i -> WrappedNatural i
$cnegate :: forall i. Num i => WrappedNatural i -> WrappedNatural i
* :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$c* :: forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
- :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$c- :: forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
+ :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$c+ :: forall i.
Num i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
Num, WrappedNatural i -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall {i}. Real i => Num (WrappedNatural i)
forall {i}. Real i => Ord (WrappedNatural i)
forall i. Real i => WrappedNatural i -> Rational
toRational :: WrappedNatural i -> Rational
$ctoRational :: forall i. Real i => WrappedNatural i -> Rational
Real, WrappedNatural i -> WrappedNatural i -> Bool
WrappedNatural i -> WrappedNatural i -> Ordering
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {i}. Ord i => Eq (WrappedNatural i)
forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Ordering
forall i.
Ord i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
min :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cmin :: forall i.
Ord i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
max :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cmax :: forall i.
Ord i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
>= :: WrappedNatural i -> WrappedNatural i -> Bool
$c>= :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
> :: WrappedNatural i -> WrappedNatural i -> Bool
$c> :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
<= :: WrappedNatural i -> WrappedNatural i -> Bool
$c<= :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
< :: WrappedNatural i -> WrappedNatural i -> Bool
$c< :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Bool
compare :: WrappedNatural i -> WrappedNatural i -> Ordering
$ccompare :: forall i. Ord i => WrappedNatural i -> WrappedNatural i -> Ordering
Ord, WrappedNatural i -> WrappedNatural i -> Bool
forall i. Eq i => WrappedNatural i -> WrappedNatural i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrappedNatural i -> WrappedNatural i -> Bool
$c/= :: forall i. Eq i => WrappedNatural i -> WrappedNatural i -> Bool
== :: WrappedNatural i -> WrappedNatural i -> Bool
$c== :: forall i. Eq i => WrappedNatural i -> WrappedNatural i -> Bool
Eq, Int -> WrappedNatural i
WrappedNatural i -> Int
WrappedNatural i -> [WrappedNatural i]
WrappedNatural i -> WrappedNatural i
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
forall i. Enum i => Int -> WrappedNatural i
forall i. Enum i => WrappedNatural i -> Int
forall i. Enum i => WrappedNatural i -> [WrappedNatural i]
forall i. Enum i => WrappedNatural i -> WrappedNatural i
forall i.
Enum i =>
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
forall i.
Enum i =>
WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
$cenumFromThenTo :: forall i.
Enum i =>
WrappedNatural i
-> WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
enumFromTo :: WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
$cenumFromTo :: forall i.
Enum i =>
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
enumFromThen :: WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
$cenumFromThen :: forall i.
Enum i =>
WrappedNatural i -> WrappedNatural i -> [WrappedNatural i]
enumFrom :: WrappedNatural i -> [WrappedNatural i]
$cenumFrom :: forall i. Enum i => WrappedNatural i -> [WrappedNatural i]
fromEnum :: WrappedNatural i -> Int
$cfromEnum :: forall i. Enum i => WrappedNatural i -> Int
toEnum :: Int -> WrappedNatural i
$ctoEnum :: forall i. Enum i => Int -> WrappedNatural i
pred :: WrappedNatural i -> WrappedNatural i
$cpred :: forall i. Enum i => WrappedNatural i -> WrappedNatural i
succ :: WrappedNatural i -> WrappedNatural i
$csucc :: forall i. Enum i => WrappedNatural i -> WrappedNatural i
Enum, WrappedNatural i -> Integer
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall {i}. Integral i => Enum (WrappedNatural i)
forall {i}. Integral i => Real (WrappedNatural i)
forall i. Integral i => WrappedNatural i -> Integer
forall i.
Integral i =>
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: WrappedNatural i -> Integer
$ctoInteger :: forall i. Integral i => WrappedNatural i -> Integer
divMod :: WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
$cdivMod :: forall i.
Integral i =>
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
quotRem :: WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
$cquotRem :: forall i.
Integral i =>
WrappedNatural i
-> WrappedNatural i -> (WrappedNatural i, WrappedNatural i)
mod :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cmod :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
div :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cdiv :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
rem :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$crem :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
quot :: WrappedNatural i -> WrappedNatural i -> WrappedNatural i
$cquot :: forall i.
Integral i =>
WrappedNatural i -> WrappedNatural i -> WrappedNatural i
Integral)
instance (Typeable i, Integral i) => Unrender (WrappedNatural i) where
unrender :: Text -> Maybe (WrappedNatural i)
unrender = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall {a} {a}.
(Eq a, IsString a, Num a) =>
(Integer, a) -> Maybe a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Reader a
decimal where
h :: (Integer, a) -> Maybe a
h (Integer
n, a
"") = if Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 then forall a. a -> Maybe a
Just (forall a. Num a => Integer -> a
fromInteger Integer
n) else forall a. Maybe a
Nothing
h (Integer, a)
_ = forall a. Maybe a
Nothing
deriving via WrappedNatural Natural instance Unrender Natural
deriving via WrappedNatural Word instance Unrender Word
deriving via WrappedNatural Word8 instance Unrender Word8
deriving via WrappedNatural Word16 instance Unrender Word16
deriving via WrappedNatural Word32 instance Unrender Word32
deriving via WrappedNatural Word64 instance Unrender Word64
instance Unrender Char where
unrender :: Text -> Maybe Char
unrender = (Char -> Bool) -> Text -> Maybe Char
find (forall a b. a -> b -> a
const Bool
True)
data Named :: Symbol -> *
data Arg :: Symbol -> * -> *
data Opt :: Symbol -> Symbol -> * -> *
data Flag :: Symbol -> *
data Env :: Optionality -> Symbol -> * -> *
data Raw :: *
data Description :: Symbol -> *
data Annotated :: Symbol -> * -> *
data Optionality = Required | Optional
data (&) :: k -> * -> *
infixr 4 &
data a + b
infixr 2 +
data State = State
{ State -> [Text]
arguments :: [Text]
, State -> HashMap Text Text
options :: HashMap Text Text
, State -> HashSet Text
flags :: HashSet Text
} deriving (forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic, Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show, State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Eq State
State -> State -> Bool
State -> State -> Ordering
State -> State -> State
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: State -> State -> State
$cmin :: State -> State -> State
max :: State -> State -> State
$cmax :: State -> State -> State
>= :: State -> State -> Bool
$c>= :: State -> State -> Bool
> :: State -> State -> Bool
$c> :: State -> State -> Bool
<= :: State -> State -> Bool
$c<= :: State -> State -> Bool
< :: State -> State -> Bool
$c< :: State -> State -> Bool
compare :: State -> State -> Ordering
$ccompare :: State -> State -> Ordering
Ord)
class HasProgram p where
data ProgramT p (m :: * -> *) a
run :: ProgramT p IO a -> CommanderT State IO a
hoist :: (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
documentation :: Forest String
instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Env 'Required name t & p) where
newtype ProgramT (Env 'Required name t & p) m a = EnvProgramT'Required { forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Required name t & p) m a -> t -> ProgramT p m a
unEnvProgramT'Required :: t -> ProgramT p m a }
run :: forall a.
ProgramT (Env 'Required name t & p) IO a -> CommanderT State IO a
run ProgramT (Env 'Required name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
Maybe String
val <- String -> IO (Maybe String)
lookupEnv (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name))
case Maybe String
val of
Just String
v ->
case forall t. Unrender t => Text -> Maybe t
unrender (String -> Text
pack String
v) of
Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Required name t & p) m a -> t -> ProgramT p m a
unEnvProgramT'Required ProgramT (Env 'Required name t & p) IO a
f t
t), State
state)
Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Env 'Required name t & p) m a
-> ProgramT (Env 'Required name t & p) n a
hoist forall x. m x -> n x
n (EnvProgramT'Required t -> ProgramT p m a
f) = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Env 'Required name t & p) m a
EnvProgramT'Required (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ProgramT p m a
f)
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"required env: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t)))
(forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]
instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Env 'Optional name t & p) where
data ProgramT (Env 'Optional name t & p) m a = EnvProgramT'Optional
{ forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a
-> Maybe t -> ProgramT p m a
unEnvProgramT'Optional :: Maybe t -> ProgramT p m a
, forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a -> Maybe t
unEnvDefault :: Maybe t }
run :: forall a.
ProgramT (Env 'Optional name t & p) IO a -> CommanderT State IO a
run ProgramT (Env 'Optional name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
Maybe String
val <- String -> IO (Maybe String)
lookupEnv (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name))
case Maybe String
val of
Just String
v -> do
case forall t. Unrender t => Text -> Maybe t
unrender @t (String -> Text
pack String
v) of
Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a
-> Maybe t -> ProgramT p m a
unEnvProgramT'Optional ProgramT (Env 'Optional name t & p) IO a
f (forall a. a -> Maybe a
Just t
t)), State
state)
Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a
-> Maybe t -> ProgramT p m a
unEnvProgramT'Optional ProgramT (Env 'Optional name t & p) IO a
f (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Env 'Optional name t & p) m a -> Maybe t
unEnvDefault ProgramT (Env 'Optional name t & p) IO a
f)), State
state)
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Env 'Optional name t & p) m a
-> ProgramT (Env 'Optional name t & p) n a
hoist forall x. m x -> n x
n (EnvProgramT'Optional Maybe t -> ProgramT p m a
f Maybe t
d) = forall (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Env 'Optional name t & p) m a
EnvProgramT'Optional (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe t -> ProgramT p m a
f) Maybe t
d
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"optional env: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t)))
(forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]
instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Arg name t & p) where
newtype ProgramT (Arg name t & p) m a = ArgProgramT { forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Arg name t & p) m a -> t -> ProgramT p m a
unArgProgramT :: t -> ProgramT p m a }
run :: forall a. ProgramT (Arg name t & p) IO a -> CommanderT State IO a
run ProgramT (Arg name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do
case [Text]
arguments of
(Text
x : [Text]
xs) ->
case forall t. Unrender t => Text -> Maybe t
unrender Text
x of
Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Arg name t & p) m a -> t -> ProgramT p m a
unArgProgramT ProgramT (Arg name t & p) IO a
f t
t), State{ arguments :: [Text]
arguments = [Text]
xs, HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
.. })
Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Arg name t & p) m a -> ProgramT (Arg name t & p) n a
hoist forall x. m x -> n x
n (ArgProgramT t -> ProgramT p m a
f) = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Arg name t & p) m a
ArgProgramT (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ProgramT p m a
f)
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"argument: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t)))
(forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]
instance (HasProgram x, HasProgram y) => HasProgram (x + y) where
data ProgramT (x + y) m a = ProgramT x m a :+: ProgramT y m a
run :: forall a. ProgramT (x + y) IO a -> CommanderT State IO a
run (ProgramT x IO a
f :+: ProgramT y IO a
g) = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT x IO a
f forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT y IO a
g
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (x + y) m a -> ProgramT (x + y) n a
hoist forall x. m x -> n x
n (ProgramT x m a
f :+: ProgramT y m a
g) = forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n ProgramT x m a
f forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
:+: forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n ProgramT y m a
g
documentation :: Forest String
documentation = forall {k} (p :: k). HasProgram p => Forest String
documentation @x forall a. Semigroup a => a -> a -> a
<> forall {k} (p :: k). HasProgram p => Forest String
documentation @y
infixr 2 :+:
instance HasProgram Raw where
newtype ProgramT Raw m a = RawProgramT { forall (m :: * -> *) a. ProgramT Raw m a -> m a
unRawProgramT :: m a }
run :: forall a. ProgramT Raw IO a -> CommanderT State IO a
run = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ProgramT Raw m a -> m a
unRawProgramT
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> ProgramT Raw m a -> ProgramT Raw n a
hoist forall x. m x -> n x
n (RawProgramT m a
m) = forall (m :: * -> *) a. m a -> ProgramT Raw m a
RawProgramT (forall x. m x -> n x
n m a
m)
documentation :: Forest String
documentation = []
instance (KnownSymbol name, KnownSymbol option, HasProgram p, Unrender t) => HasProgram (Opt option name t & p) where
data ProgramT (Opt option name t & p) m a = OptProgramT
{ forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t -> ProgramT p m a
unOptProgramT :: Maybe t -> ProgramT p m a
, forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t
unOptDefault :: Maybe t }
run :: forall a.
ProgramT (Opt option name t & p) IO a -> CommanderT State IO a
run ProgramT (Opt option name t & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @option)) HashMap Text Text
options of
Just Text
opt' ->
case forall t. Unrender t => Text -> Maybe t
unrender Text
opt' of
Just t
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t -> ProgramT p m a
unOptProgramT ProgramT (Opt option name t & p) IO a
f (forall a. a -> Maybe a
Just t
t)), State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
Maybe t
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t -> ProgramT p m a
unOptProgramT ProgramT (Opt option name t & p) IO a
f (forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
ProgramT (Opt option name t & p) m a -> Maybe t
unOptDefault ProgramT (Opt option name t & p) IO a
f)), State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Opt option name t & p) m a
-> ProgramT (Opt option name t & p) n a
hoist forall x. m x -> n x
n (OptProgramT Maybe t -> ProgramT p m a
f Maybe t
d) = forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Opt option name t & p) m a
OptProgramT (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe t -> ProgramT p m a
f) Maybe t
d
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"option: -" forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @option)
forall a. Semigroup a => a -> a -> a
<> String
" <" forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name)
forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @t))
forall a. Semigroup a => a -> a -> a
<> String
">")
(forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]
instance (KnownSymbol flag, HasProgram p) => HasProgram (Flag flag & p) where
newtype ProgramT (Flag flag & p) m a = FlagProgramT { forall (flag :: Symbol) p (m :: * -> *) a.
ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT :: Bool -> ProgramT p m a }
run :: forall a. ProgramT (Flag flag & p) IO a -> CommanderT State IO a
run ProgramT (Flag flag & p) IO a
f = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do
let presence :: Bool
presence = forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member (String -> Text
pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @flag))) HashSet Text
flags
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run (forall (flag :: Symbol) p (m :: * -> *) a.
ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT ProgramT (Flag flag & p) IO a
f Bool
presence), State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Flag flag & p) m a -> ProgramT (Flag flag & p) n a
hoist forall x. m x -> n x
n = forall (flag :: Symbol) p (m :: * -> *) a.
(Bool -> ProgramT p m a) -> ProgramT (Flag flag & p) m a
FlagProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (flag :: Symbol) p (m :: * -> *) a.
ProgramT (Flag flag & p) m a -> Bool -> ProgramT p m a
unFlagProgramT
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"flag: ~" forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @flag))
(forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]
instance (KnownSymbol name, HasProgram p) => HasProgram (Named name & p) where
newtype ProgramT (Named name & p) m a = NamedProgramT { forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT :: ProgramT p m a }
run :: forall a. ProgramT (Named name & p) IO a -> CommanderT State IO a
run = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Named name & p) m a -> ProgramT (Named name & p) n a
hoist forall x. m x -> n x
n = forall (name :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Named name & p) m a
NamedProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (name :: Symbol) p (m :: * -> *) a.
ProgramT (Named name & p) m a -> ProgramT p m a
unNamedProgramT
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"name: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @name))
(forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]
instance (KnownSymbol description, HasProgram p) => HasProgram (Description description & p) where
newtype ProgramT (Description description & p) m a = DescriptionProgramT { forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT :: ProgramT p m a }
run :: forall a.
ProgramT (Description description & p) IO a
-> CommanderT State IO a
run = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Description description & p) m a
-> ProgramT (Description description & p) n a
hoist forall x. m x -> n x
n = forall (description :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Description description & p) m a
DescriptionProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (description :: Symbol) p (m :: * -> *) a.
ProgramT (Description description & p) m a -> ProgramT p m a
unDescriptionProgramT
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"description: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @description))
[]] forall a. Semigroup a => a -> a -> a
<> forall {k} (p :: k). HasProgram p => Forest String
documentation @p
instance (KnownSymbol annotation, HasProgram (combinator & p)) => HasProgram (Annotated annotation combinator & p) where
newtype ProgramT (Annotated annotation combinator & p) m a = AnnotatedProgramT { forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT :: ProgramT (combinator & p) m a }
run :: forall a.
ProgramT (Annotated annotation combinator & p) IO a
-> CommanderT State IO a
run = forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) n a
hoist forall x. m x -> n x
n = forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
AnnotatedProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (Annotated annotation combinator & p) m a
-> ProgramT (combinator & p) m a
unAnnotatedProgramT
documentation :: Forest String
documentation = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Node String
x Forest String
s) -> forall a. a -> [Tree a] -> Tree a
Node (String
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @annotation)) Forest String
s) (forall {k} (p :: k). HasProgram p => Forest String
documentation @(combinator & p))
instance (KnownSymbol sub, HasProgram p) => HasProgram (sub & p) where
newtype ProgramT (sub & p) m a = SubProgramT { forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT :: ProgramT p m a }
run :: forall a. ProgramT (sub & p) IO a -> CommanderT State IO a
run ProgramT (sub & p) IO a
s = forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: State -> HashSet Text
options :: State -> HashMap Text Text
arguments :: State -> [Text]
..} -> do
case [Text]
arguments of
(Text
x : [Text]
xs) ->
if Text
x forall a. Eq a => a -> a -> Bool
== String -> Text
pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @sub)
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run forall a b. (a -> b) -> a -> b
$ forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT ProgramT (sub & p) IO a
s, State{arguments :: [Text]
arguments = [Text]
xs, HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
..})
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State{[Text]
HashSet Text
HashMap Text Text
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
flags :: HashSet Text
options :: HashMap Text Text
arguments :: [Text]
..})
hoist :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x)
-> ProgramT (sub & p) m a -> ProgramT (sub & p) n a
hoist forall x. m x -> n x
n = forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (sub & p) m a
SubProgramT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) (m :: * -> *) (n :: * -> *) a.
HasProgram p =>
(forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a
hoist forall x. m x -> n x
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT (sub & p) m a -> ProgramT p m a
unSubProgramT
documentation :: Forest String
documentation = [forall a. a -> [Tree a] -> Tree a
Node
(String
"subprogram: " forall a. Semigroup a => a -> a -> a
<> forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sub))
(forall {k} (p :: k). HasProgram p => Forest String
documentation @p)]
initialState :: IO State
initialState :: IO State
initialState = do
[String]
args <- IO [String]
getArgs
let ([(Text, Text)]
opts, [Text]
args', [Text]
flags) = [String] -> ([(Text, Text)], [Text], [Text])
takeOptions [String]
args
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> HashMap Text Text -> HashSet Text -> State
State [Text]
args' (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Text)]
opts) (forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [Text]
flags)
where
takeOptions :: [String] -> ([(Text, Text)], [Text], [Text])
takeOptions :: [String] -> ([(Text, Text)], [Text], [Text])
takeOptions = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [] [] [] where
go :: [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [(Text, Text)]
opts [Text]
args [Text]
flags ((Char
'~':String
x') : [String]
z) = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [(Text, Text)]
opts [Text]
args (String -> Text
pack String
x' forall a. a -> [a] -> [a]
: [Text]
flags) [String]
z
go [(Text, Text)]
opts [Text]
args [Text]
flags ((Char
'-':String
x) : String
y : [String]
z) = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go ((String -> Text
pack String
x, String -> Text
pack String
y) forall a. a -> [a] -> [a]
: [(Text, Text)]
opts) [Text]
args [Text]
flags [String]
z
go [(Text, Text)]
opts [Text]
args [Text]
flags (String
x : [String]
y) = [(Text, Text)]
-> [Text] -> [Text] -> [String] -> ([(Text, Text)], [Text], [Text])
go [(Text, Text)]
opts (String -> Text
pack String
x forall a. a -> [a] -> [a]
: [Text]
args) [Text]
flags [String]
y
go [(Text, Text)]
opts [Text]
args [Text]
flags [] = ([(Text, Text)]
opts, forall a. [a] -> [a]
reverse [Text]
args, [Text]
flags)
command_ :: forall p a.
HasProgram p
=> ProgramT p IO a
-> IO ()
command_ :: forall {k} (p :: k) a. HasProgram p => ProgramT p IO a -> IO ()
command_ ProgramT p IO a
prog = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO State
initialState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) state a.
Monad m =>
CommanderT state m a -> state -> m (Maybe a)
runCommanderT (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT p IO a
prog)
command :: forall p a.
HasProgram p
=> ProgramT p IO a
-> IO (Maybe a)
command :: forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> IO (Maybe a)
command ProgramT p IO a
prog = IO State
initialState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) state a.
Monad m =>
CommanderT state m a -> state -> m (Maybe a)
runCommanderT (forall {k} (p :: k) a.
HasProgram p =>
ProgramT p IO a -> CommanderT State IO a
run ProgramT p IO a
prog)
env :: forall name p x m a.
KnownSymbol name
=> (x -> ProgramT p m a)
-> ProgramT (Env 'Required name x & p) m a
env :: forall (name :: Symbol) p x (m :: * -> *) a.
KnownSymbol name =>
(x -> ProgramT p m a) -> ProgramT (Env 'Required name x & p) m a
env = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Env 'Required name t & p) m a
EnvProgramT'Required
envOpt :: forall name x p m a.
KnownSymbol name
=> (Maybe x -> ProgramT p m a)
-> ProgramT (Env 'Optional name x & p) m a
envOpt :: forall (name :: Symbol) x p (m :: * -> *) a.
KnownSymbol name =>
(Maybe x -> ProgramT p m a)
-> ProgramT (Env 'Optional name x & p) m a
envOpt = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Env 'Optional name t & p) m a
EnvProgramT'Optional forall a. Maybe a
Nothing
envOptDef :: forall name x p m a.
KnownSymbol name
=> x
-> (x -> ProgramT p m a)
-> ProgramT (Env 'Optional name x & p) m a
envOptDef :: forall (name :: Symbol) x p (m :: * -> *) a.
KnownSymbol name =>
x
-> (x -> ProgramT p m a) -> ProgramT (Env 'Optional name x & p) m a
envOptDef x
x x -> ProgramT p m a
f = EnvProgramT'Optional { unEnvDefault :: Maybe x
unEnvDefault = forall a. a -> Maybe a
Just x
x, unEnvProgramT'Optional :: Maybe x -> ProgramT p m a
unEnvProgramT'Optional = \case { Just x
x -> x -> ProgramT p m a
f x
x; Maybe x
Nothing -> forall a. HasCallStack => String -> a
error String
"Violated invariant of optEnvDef" } }
arg :: forall name x p m a.
KnownSymbol name
=> (x -> ProgramT p m a)
-> ProgramT (Arg name x & p) m a
arg :: forall (name :: Symbol) x p (m :: * -> *) a.
KnownSymbol name =>
(x -> ProgramT p m a) -> ProgramT (Arg name x & p) m a
arg = forall (name :: Symbol) t p (m :: * -> *) a.
(t -> ProgramT p m a) -> ProgramT (Arg name t & p) m a
ArgProgramT
opt :: forall option name x p m a.
(KnownSymbol option, KnownSymbol name)
=> (Maybe x -> ProgramT p m a)
-> ProgramT (Opt option name x & p) m a
opt :: forall (option :: Symbol) (name :: Symbol) x p (m :: * -> *) a.
(KnownSymbol option, KnownSymbol name) =>
(Maybe x -> ProgramT p m a) -> ProgramT (Opt option name x & p) m a
opt = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (option :: Symbol) (name :: Symbol) t p (m :: * -> *) a.
(Maybe t -> ProgramT p m a)
-> Maybe t -> ProgramT (Opt option name t & p) m a
OptProgramT forall a. Maybe a
Nothing
optDef :: forall option name x p m a.
(KnownSymbol option, KnownSymbol name)
=> x
-> (x -> ProgramT p m a)
-> ProgramT (Opt option name x & p) m a
optDef :: forall (option :: Symbol) (name :: Symbol) x p (m :: * -> *) a.
(KnownSymbol option, KnownSymbol name) =>
x -> (x -> ProgramT p m a) -> ProgramT (Opt option name x & p) m a
optDef x
x x -> ProgramT p m a
f = OptProgramT { unOptDefault :: Maybe x
unOptDefault = forall a. a -> Maybe a
Just x
x, unOptProgramT :: Maybe x -> ProgramT p m a
unOptProgramT = \case { Just x
x -> x -> ProgramT p m a
f x
x; Maybe x
Nothing -> forall a. HasCallStack => String -> a
error String
"Violated invariant of optDef" } }
raw :: forall m a.
m a
-> ProgramT Raw m a
raw :: forall (m :: * -> *) a. m a -> ProgramT Raw m a
raw = forall (m :: * -> *) a. m a -> ProgramT Raw m a
RawProgramT
sub :: forall s p m a.
KnownSymbol s
=> ProgramT p m a
-> ProgramT (s & p) m a
sub :: forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (s & p) m a
sub = forall (sub :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (sub & p) m a
SubProgramT
named :: forall s p m a.
KnownSymbol s
=> ProgramT p m a
-> ProgramT (Named s & p) m a
named :: forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (Named s & p) m a
named = forall (name :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Named name & p) m a
NamedProgramT
flag :: forall f p m a.
KnownSymbol f
=> (Bool -> ProgramT p m a)
-> ProgramT (Flag f & p) m a
flag :: forall (f :: Symbol) p (m :: * -> *) a.
KnownSymbol f =>
(Bool -> ProgramT p m a) -> ProgramT (Flag f & p) m a
flag = forall (flag :: Symbol) p (m :: * -> *) a.
(Bool -> ProgramT p m a) -> ProgramT (Flag flag & p) m a
FlagProgramT
toplevel :: forall s p m. (HasProgram p, KnownSymbol s, MonadIO m)
=> ProgramT p m ()
-> ProgramT (Named s & ("help" & Raw + p)) m ()
toplevel :: forall {k} (s :: Symbol) (p :: k) (m :: * -> *).
(HasProgram p, KnownSymbol s, MonadIO m) =>
ProgramT p m () -> ProgramT (Named s & (("help" & Raw) + p)) m ()
toplevel ProgramT p m ()
p = forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (Named s & p) m a
named (forall (s :: Symbol) p (m :: * -> *) a.
KnownSymbol s =>
ProgramT p m a -> ProgramT (s & p) m a
sub (forall {k} (p :: k) (m :: * -> *).
(MonadIO m, HasProgram p) =>
ProgramT Raw m ()
usage @(Named s & ("help" & Raw + p))) forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
<+> ProgramT p m ()
p)
(<+>) :: forall x y m a. ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
<+> :: forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
(<+>) = forall k k (x :: k) (y :: k) (m :: * -> *) a.
ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a
(:+:)
infixr 2 <+>
usage :: forall p m. (MonadIO m, HasProgram p) => ProgramT Raw m ()
usage :: forall {k} (p :: k) (m :: * -> *).
(MonadIO m, HasProgram p) =>
ProgramT Raw m ()
usage = forall (m :: * -> *) a. m a -> ProgramT Raw m a
raw forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"usage:"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (forall {k} (p :: k). HasProgram p => String
document @p)
annotated :: forall annotation combinator p m a. ProgramT (combinator & p) m a -> ProgramT (Annotated annotation combinator & p) m a
annotated :: forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
annotated = forall (annotation :: Symbol) combinator p (m :: * -> *) a.
ProgramT (combinator & p) m a
-> ProgramT (Annotated annotation combinator & p) m a
AnnotatedProgramT
description :: forall description p m a. (HasProgram p, KnownSymbol description) => ProgramT p m a -> ProgramT (Description description & p) m a
description :: forall (description :: Symbol) p (m :: * -> *) a.
(HasProgram p, KnownSymbol description) =>
ProgramT p m a -> ProgramT (Description description & p) m a
description = forall (description :: Symbol) p (m :: * -> *) a.
ProgramT p m a -> ProgramT (Description description & p) m a
DescriptionProgramT
type Middleware m n = forall a. CommanderT State m a -> CommanderT State n a
transform :: (Monad m, Monad n) => (forall a. m a -> n a) -> Middleware m n
transform :: forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(forall a. m a -> n a) -> Middleware m n
transform forall a. m a -> n a
f CommanderT State m a
commander = case CommanderT State m a
commander of
Action State -> m (CommanderT State m a, State)
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
(CommanderT State m a
commander', State
state') <- forall a. m a -> n a
f (State -> m (CommanderT State m a, State)
a State
state)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(forall a. m a -> n a) -> Middleware m n
transform forall a. m a -> n a
f CommanderT State m a
commander', State
state')
CommanderT State m a
Defeat -> forall state (f :: * -> *) a. CommanderT state f a
Defeat
Victory a
a -> forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a
withActionEffects :: Monad m => m a -> Middleware m m
withActionEffects :: forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withActionEffects m a
ma = forall (m :: * -> *) (n :: * -> *).
(Monad m, Monad n) =>
(forall a. m a -> n a) -> Middleware m n
transform (m a
ma forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)
withDefeatEffects :: Monad m => m a -> Middleware m m
withDefeatEffects :: forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withDefeatEffects m a
ma CommanderT State m a
commander = case CommanderT State m a
commander of
Action State -> m (CommanderT State m a, State)
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
(CommanderT State m a
commander', State
state') <- State -> m (CommanderT State m a, State)
a State
state
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withDefeatEffects m a
ma CommanderT State m a
commander', State
state')
CommanderT State m a
Defeat -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> m a
ma forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
Victory a
a -> forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a
withVictoryEffects :: Monad m => m a -> Middleware m m
withVictoryEffects :: forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withVictoryEffects m a
ma CommanderT State m a
commander = case CommanderT State m a
commander of
Action State -> m (CommanderT State m a, State)
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
(CommanderT State m a
commander', State
state') <- State -> m (CommanderT State m a, State)
a State
state
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) a. Monad m => m a -> Middleware m m
withVictoryEffects m a
ma CommanderT State m a
commander', State
state')
CommanderT State m a
Defeat -> forall state (f :: * -> *) a. CommanderT state f a
Defeat
Victory a
a -> forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> m a
ma forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a, State
state)
document :: forall p. HasProgram p => String
document :: forall {k} (p :: k). HasProgram p => String
document = Forest String -> String
drawForest (forall {k} (p :: k). HasProgram p => Forest String
documentation @p)
logState :: MonadIO m => Middleware m m
logState :: forall (m :: * -> *). MonadIO m => Middleware m m
logState CommanderT State m a
commander
= case CommanderT State m a
commander of
Action State -> m (CommanderT State m a, State)
a ->
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print State
state
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall (m :: * -> *). MonadIO m => Middleware m m
logState) (State -> m (CommanderT State m a, State)
a State
state)
CommanderT State m a
Defeat ->
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print State
state
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall state (f :: * -> *) a. CommanderT state f a
Defeat, State
state)
Victory a
a ->
forall state (f :: * -> *) a.
(state -> f (CommanderT state f a, state)) -> CommanderT state f a
Action forall a b. (a -> b) -> a -> b
$ \State
state -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print State
state
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall state (f :: * -> *) a. a -> CommanderT state f a
Victory a
a, State
state)