Safe Haskell | None |
---|---|
Language | Haskell2010 |
Provides utility functions for composing skills
- newtype Condition = Condition {}
- data Consumer = Consumer !Condition !Invokable
- data Skill = Skill {}
- data Recipe = Recipe {}
- class ToConsumer c where
- toConsumer :: c -> Consumer
- class Extensible e where
- (!+) :: ToConsumer c => e -> c -> e
- (>!+) :: (ToConsumer c, Monad m, Extensible e) => m e -> c -> m e
- (!+>) :: (ToConsumer c, Monad m, Extensible e) => e -> m c -> m e
- (>!+>) :: (ToConsumer c, Monad m, Extensible e) => m e -> m c -> m e
- skill :: String -> Skill
- recipe :: RecipeMethod -> String -> Recipe
- validConsumer :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Handler) -> Consumer
- validCondition :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Predicate) -> Condition
- (#-) :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r) => m -> MaskedConsumer r -> Consumer
- (#->) :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Handler) -> Consumer
- (#->>) :: (Append m (Cons EnsureLineEnd Nil) s, CallMask s Nil) => m -> Handler -> Consumer
- focusDirectC :: Consumer
- optionallyFocusDirectC :: Consumer
- callRecipe :: RecipeMethod -> Consumer
- runConsumer :: ToConsumer c => c -> Invokable
- wrapSkills :: [Skill] -> String -> Maybe Invokable
- wrapRecipes :: [Recipe] -> String -> Maybe (RecipeMethod -> Invokable)
Utility types
A wrapper type for skill execution preconditions.
A single consumer. Build it using bareAction
, bareCondition
and monoid concatenation.
Skill | |
|
class ToConsumer c where Source
Typeclass for everything that may act as a consumer.
toConsumer :: c -> Consumer Source
Compositors
class Extensible e where Source
Typeclass for everything that may be extended by consumers using !+
(!+) :: ToConsumer c => e -> c -> e infixl 4 Source
Add a consumer to the skill.
(>!+) :: (ToConsumer c, Monad m, Extensible e) => m e -> c -> m e infixl 4 Source
Add a consumer to the monadic extensible
(!+>) :: (ToConsumer c, Monad m, Extensible e) => e -> m c -> m e infixl 4 Source
Add a monadic consumer to the extensible
(>!+>) :: (ToConsumer c, Monad m, Extensible e) => m e -> m c -> m e infixl 4 Source
Add a monadic consumer to the monadic extensible
Builders
skill :: String -> Skill Source
Build a bogus skill that does nothing but has a name. Use this with !+
to build powerful skills.
recipe :: RecipeMethod -> String -> Recipe Source
Build a bogus recipe that does nothing has a name and a usage method. Use this with !+
to build powerful recipes.
validConsumer :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Handler) -> Consumer Source
Build a consumer using new-style input validation
validCondition :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Predicate) -> Condition Source
Build a condition using new-style input validation
(#-) :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r) => m -> MaskedConsumer r -> Consumer infixr 6 Source
Map a masked consumer to a call mask
(#->) :: (Append m (Cons EnsureLineEnd Nil) s, Append r Nil r, CallMask s r, Tuplify r t) => m -> (t -> Handler) -> Consumer infixr 6 Source
Infix version of validConsumer
(#->>) :: (Append m (Cons EnsureLineEnd Nil) s, CallMask s Nil) => m -> Handler -> Consumer infixr 6 Source
Infix version of validConsumer, swallowing the empty handler parameter
Sample consumers
focusDirectC :: Consumer Source
Focus direct object
optionallyFocusDirectC :: Consumer Source
Optionally ocus direct object (obligatory if none is focused yet)
callRecipe :: RecipeMethod -> Consumer Source
Dispatch the remaining part of the line as a recipe call
Final wrappers
runConsumer :: ToConsumer c => c -> Invokable Source
Run the given consumer
wrapSkills :: [Skill] -> String -> Maybe Invokable Source
Wrap the skills into a form that is accepted by stereotypes.
wrapRecipes :: [Recipe] -> String -> Maybe (RecipeMethod -> Invokable) Source
Wrap the recipes into a form that is accepted by stereotypes.