Safe Haskell | None |
---|---|
Language | Haskell98 |
Synopsis
- lambdabotVersion :: Version
- data Config t
- data DSum (tag :: k -> Type) (f :: k -> Type) = !(tag a) :=> (f a)
- (==>) :: forall (f :: Type -> Type) tag a. Applicative f => tag a -> a -> DSum tag f
- lambdabotMain :: Modules -> [DSum Config Identity] -> IO ExitCode
- type Modules = [(String, Some Module)]
- modules :: [String] -> Q Exp
- module Lambdabot.Plugin.Core
- data Priority
Documentation
data DSum (tag :: k -> Type) (f :: k -> Type) #
A basic dependent sum type where the first component is a tag that specifies the type of the second. For example, think of a GADT such as:
data Tag a where AString :: Tag String AnInt :: Tag Int Rec :: Tag (DSum Tag Identity)
Then we can write expressions where the RHS of (
has
different types depending on the :=>
)Tag
constructor used. Here are
some expressions of type DSum Tag
:Identity
AString :=> Identity "hello!" AnInt :=> Identity 42
Often, the f
we choose has an Applicative
instance, and we can
use the helper function (
. The following expressions all
have the type ==>
)Applicative f => DSum Tag f
:
AString ==> "hello!" AnInt ==> 42
We can write functions that consume DSum Tag f
values by
matching, such as:
toString :: DSum Tag Identity -> String toString (AString :=> Identity str) = str toString (AnInt :=> Identity int) = show int toString (Rec :=> Identity sum) = toString sum
The (
constructor and :=>
)(
helper are chosen to
resemble the ==>
)(key => value)
construction for dictionary entries
in many dynamic languages. The :=>
and ==>
operators have very
low precedence and bind to the right, making repeated use of these
operators behave as you'd expect:
-- Parses as: Rec ==> (AnInt ==> (3 + 4)) -- Has type: Applicative f => DSum Tag f Rec ==> AnInt ==> 3 + 4
The precedence of these operators is just above that of $
, so
foo bar $ AString ==> "eep"
is equivalent to foo bar (AString
==> "eep")
.
To use the Eq
, Ord
, Read
, and Show
instances for
, you will need an DSum
tag fArgDict
instance for your tag type. Use
deriveArgDict
from the
constraints-extras
package to generate this
instance.
!(tag a) :=> (f a) infixr 1 |
Instances
(GEq tag, Has' Eq tag f) => Eq (DSum tag f) | |
(GCompare tag, Has' Eq tag f, Has' Ord tag f) => Ord (DSum tag f) | |
(GRead tag, Has' Read tag f) => Read (DSum tag f) | |
(GShow tag, Has' Show tag f) => Show (DSum tag f) | |
(==>) :: forall (f :: Type -> Type) tag a. Applicative f => tag a -> a -> DSum tag f infixr 1 #
Convenience helper. Uses pure
to lift a
into f a
.
lambdabotMain :: Modules -> [DSum Config Identity] -> IO ExitCode Source #
The Lambdabot entry point. Initialise plugins, connect, and run the bot in the LB monad
Also, handle any fatal exceptions (such as non-recoverable signals), (i.e. print a message and exit). Non-fatal exceptions should be dealt with in the mainLoop or further down.
module Lambdabot.Plugin.Core
Priorities are used to define how important a log message is. Users can filter log messages based on priorities.
These have their roots on the traditional syslog system. The standard definitions are given below, but you are free to interpret them however you like. They are listed here in ascending importance order.
DEBUG | Debug messages |
INFO | Information |
NOTICE | Normal runtime conditions |
WARNING | General Warnings |
ERROR | General Errors |
CRITICAL | Severe situations |
ALERT | Take immediate action |
EMERGENCY | System is unusable |
Instances
Bounded Priority | |
Enum Priority | |
Eq Priority | |
Data Priority | |
Defined in System.Log gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Priority -> c Priority # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Priority # toConstr :: Priority -> Constr # dataTypeOf :: Priority -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Priority) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Priority) # gmapT :: (forall b. Data b => b -> b) -> Priority -> Priority # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Priority -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Priority -> r # gmapQ :: (forall d. Data d => d -> u) -> Priority -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Priority -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Priority -> m Priority # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Priority -> m Priority # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Priority -> m Priority # | |
Ord Priority | |
Read Priority | |
Show Priority | |
Generic Priority | |
NFData Priority | Since: hslogger-1.3.1.0 |
Defined in System.Log | |
type Rep Priority | |
Defined in System.Log type Rep Priority = D1 ('MetaData "Priority" "System.Log" "hslogger-1.3.1.0-5wuGlq9z9vR9CoeH001Os3" 'False) (((C1 ('MetaCons "DEBUG" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "INFO" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NOTICE" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WARNING" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "ERROR" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CRITICAL" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "ALERT" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "EMERGENCY" 'PrefixI 'False) (U1 :: Type -> Type)))) |