{-# 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 (
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 = 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
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)
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. 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)
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)]
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)
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)
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)
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
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
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" } }
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
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
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 :: 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
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 :: 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
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
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)
(<+>) :: 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 <+>
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)
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
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
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 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
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
*>)
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
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)
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)
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)