Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- emit :: forall c p. (Parameter (PList p), KnownSymbol c) => Msg c p -> ByteString
- emitSome :: SomeMsg -> ByteString
- class Fetch a
- fetch :: Fetch a => ByteString -> Maybe a
- fetch' :: forall c p. (Parameter (PList p), KnownSymbol c) => Parser (Msg c p)
- build :: Build '[] f => f
- buildPrefix :: Build '[] f => Prefix -> f
- vacant :: Msg c '[]
- castMsg :: (KnownSymbol c1, KnownSymbol c2) => Msg c1 p -> Msg c2 p
- (<:>) :: x -> Msg c xs -> Msg c (x ': xs)
- data Host = Host Nickname (Maybe Username) (Maybe Hostname)
- hostNick :: Lens' Host Nickname
- hostUser :: Lens' Host (Maybe Username)
- hostHost :: Lens' Host (Maybe Hostname)
- data UReply = UReply Nickname Bool Bool Hostname
- ureplyNick :: Lens' UReply Nickname
- ureplyIsOp :: Lens' UReply Bool
- ureplyIsAway :: Lens' UReply Bool
- ureplyHostname :: Lens' UReply Hostname
- data Member a = Member (Maybe Char) a
- memberPrefix :: forall a. Lens' (Member a) (Maybe Char)
- memberData :: forall a a. Lens (Member a) (Member a) a a
- type Hostname = Text
- type Mask = Text
- type Nickname = Text
- type Username = Text
- data PList a where
- newtype CList a = CList {
- getCList :: [a]
- newtype SList a = SList {
- getSList :: [a]
- data Flag a
- data Unused (a :: Symbol) = Unused
- class Parameter a where
- render :: a -> ByteString
- seize :: Parser a
- data SomeMsg where
- data Msg command params = Msg {}
- data Prefix
- phead :: Parameter x' => Lens (PList (x ': xs)) (PList (x' ': xs)) x x'
- ptail :: Lens (PList (x ': xs)) (PList (x ': xs')) (PList xs) (PList xs')
- newtype Channel = Channel {
- getChannel :: Text
- params :: forall command params command params. Lens (Msg command params) (Msg command params) (PList params) (PList params)
- prefix :: forall command params command. Lens (Msg command params) (Msg command params) (Maybe Prefix) (Maybe Prefix)
- newtype Message = Message {
- getMessage :: Text
- newtype Modes = Modes {}
- data Token
Documentation
emit :: forall c p. (Parameter (PList p), KnownSymbol c) => Msg c p -> ByteString Source #
Encode an IRC message to a ByteString
, ready for the network
emitSome :: SomeMsg -> ByteString Source #
Encode existentially quantified message.
fetch :: Fetch a => ByteString -> Maybe a Source #
Decode an IRC message from a ByteString
into a Msg
or a coproduct
thereof. This function is return type polymorphic and will pick a parser
that fits the requested type, which is determined either by type
inference or can be picked by explicit type annotation.
fetch' :: forall c p. (Parameter (PList p), KnownSymbol c) => Parser (Msg c p) Source #
Like fetch
but offers the underlying attoparsec Parser. This can be used
for e.g. the construction of ad-hoc sum types catching multiple message
types.
Messages
build :: Build '[] f => f Source #
Generalized constructor function for the creation of Msg
values. The
types here may seem opaque, but essentially this is a variadic type-safe
constructor.
build "hunter2" :: Pass build [Channel "#haskell"] (Message "hello world!") :: PrivMsg
The type annotations may or may not be necessary, depending on the information available to the compiler at the use site.
buildPrefix :: Build '[] f => Prefix -> f Source #
castMsg :: (KnownSymbol c1, KnownSymbol c2) => Msg c1 p -> Msg c2 p Source #
Safely cast one message to another. Equality of parameter lists is statically enforced.
Types
Instances
Eq Host Source # | |
Ord Host Source # | |
Read Host Source # | |
Show Host Source # | |
Generic Host Source # | |
Parameter Host Source # | |
type Rep Host Source # | |
Defined in Network.Yak.Types type Rep Host = D1 (MetaData "Host" "Network.Yak.Types" "yak-0.2.0.0-DpGRvARnWRP1pvWDPQg9Pa" False) (C1 (MetaCons "Host" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Nickname) :*: (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe Username)) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe Hostname))))) |
Replies to Userhost
queries.
Instances
Eq UReply Source # | |
Ord UReply Source # | |
Read UReply Source # | |
Show UReply Source # | |
Generic UReply Source # | |
Parameter UReply Source # | |
type Rep UReply Source # | |
Defined in Network.Yak.Types type Rep UReply = D1 (MetaData "UReply" "Network.Yak.Types" "yak-0.2.0.0-DpGRvARnWRP1pvWDPQg9Pa" False) (C1 (MetaCons "UReply" PrefixI False) ((S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Nickname) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool)) :*: (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Hostname)))) |
Instances
Eq a => Eq (Member a) Source # | |
Ord a => Ord (Member a) Source # | |
Defined in Network.Yak.Types | |
Read a => Read (Member a) Source # | |
Show a => Show (Member a) Source # | |
Generic (Member a) Source # | |
Parameter a => Parameter (Member a) Source # | |
type Rep (Member a) Source # | |
Defined in Network.Yak.Types type Rep (Member a) = D1 (MetaData "Member" "Network.Yak.Types" "yak-0.2.0.0-DpGRvARnWRP1pvWDPQg9Pa" False) (C1 (MetaCons "Member" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Maybe Char)) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a))) |
Heterogeneous list of parameters.
Instances
(Eq x, Eq (PList xs)) => Eq (PList (x ': xs)) Source # | |
Eq (PList ([] :: [Type])) Source # | |
(Show x, Show (PList xs)) => Show (PList (x ': xs)) Source # | |
Show (PList ([] :: [Type])) Source # | |
(Parameter x, Parameter (PList xs)) => Parameter (PList (x ': xs)) Source # | |
Parameter (PList ([] :: [Type])) Source # | |
(Parameter x, Parameter x') => Field1 (PList (x ': xs)) (PList (x' ': xs)) x x' Source # | |
(Parameter x, Parameter x') => Field2 (PList (a ': (x ': xs))) (PList (a ': (x' ': xs))) x x' Source # | |
(Parameter x, Parameter x') => Field3 (PList (a ': (b ': (x ': xs)))) (PList (a ': (b ': (x' ': xs)))) x x' Source # | |
(Parameter x, Parameter x') => Field4 (PList (a ': (b ': (c ': (x ': xs))))) (PList (a ': (b ': (c ': (x' ': xs))))) x x' Source # | |
(Parameter x, Parameter x') => Field5 (PList (a ': (b ': (c ': (d ': (x ': xs)))))) (PList (a ': (b ': (c ': (d ': (x' ': xs)))))) x x' Source # | |
(Parameter x, Parameter x') => Field6 (PList (a ': (b ': (c ': (d ': (e ': (x ': xs))))))) (PList (a ': (b ': (c ': (d ': (e ': (x' ': xs))))))) x x' Source # | |
(Parameter x, Parameter x') => Field7 (PList (a ': (b ': (c ': (d ': (e ': (f ': (x ': xs)))))))) (PList (a ': (b ': (c ': (d ': (e ': (f ': (x' ': xs)))))))) x x' Source # | |
(Parameter x, Parameter x') => Field8 (PList (a ': (b ': (c ': (d ': (e ': (f ': (g ': (x ': xs))))))))) (PList (a ': (b ': (c ': (d ': (e ': (f ': (g ': (x' ': xs))))))))) x x' Source # | |
(Parameter x, Parameter x') => Field9 (PList (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (x ': xs)))))))))) (PList (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (x' ': xs)))))))))) x x' Source # | |
Space separated lists after colon. Used in some numeric replies
Instances
Space separated lists. Use with caution, since spaces are also the
separator for PList
!
Instances
Type for expressing possibly missing flags.
data Unused (a :: Symbol) Source #
Proxy type for inserting special syntax
class Parameter a where Source #
Class for any kind of IRC parameter that can be rendered to ByteString
and read from a ByteString
Instances
data Msg command params Source #
Proxy type for holding IRC messages
Instances
Instances
Eq Prefix Source # | |
Ord Prefix Source # | |
Read Prefix Source # | |
Show Prefix Source # | |
Generic Prefix Source # | |
type Rep Prefix Source # | |
Defined in Network.Yak.Types type Rep Prefix = D1 (MetaData "Prefix" "Network.Yak.Types" "yak-0.2.0.0-DpGRvARnWRP1pvWDPQg9Pa" False) (C1 (MetaCons "PrefixServer" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)) :+: C1 (MetaCons "PrefixUser" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Host))) |
Instances
params :: forall command params command params. Lens (Msg command params) (Msg command params) (PList params) (PList params) Source #
prefix :: forall command params command. Lens (Msg command params) (Msg command params) (Maybe Prefix) (Maybe Prefix) Source #
Instances
Eq Message Source # | |
Ord Message Source # | |
Read Message Source # | |
Show Message Source # | |
IsString Message Source # | |
Defined in Network.Yak.Types fromString :: String -> Message # | |
Generic Message Source # | |
Semigroup Message Source # | |
Monoid Message Source # | |
Wrapped Message Source # | |
Parameter Message Source # | |
HasNick Privmsg Source # | |
Defined in Network.Yak.Client | |
HasNick Notice Source # | |
Defined in Network.Yak.Client | |
HasNick Kill Source # | |
Defined in Network.Yak.Client | |
HasNick Kick Source # | |
Defined in Network.Yak.Client | |
HasChannel Part Source # | |
Defined in Network.Yak.Client | |
HasChannel Topic Source # | |
Defined in Network.Yak.Client | |
HasChannel Privmsg Source # | |
Defined in Network.Yak.Client | |
HasChannel Notice Source # | |
Defined in Network.Yak.Client | |
HasChannel Kick Source # | |
Defined in Network.Yak.Client | |
Message ~ t => Rewrapped Message t Source # | |
Defined in Network.Yak.Types | |
type Rep Message Source # | |
Defined in Network.Yak.Types | |
type Unwrapped Message Source # | |
Defined in Network.Yak.Types |
Instances
Eq Token Source # | |
Ord Token Source # | |
Read Token Source # | |
Show Token Source # | |
Generic Token Source # | |
Parameter Token Source # | |
type Rep Token Source # | |
Defined in Network.Yak.Types type Rep Token = D1 (MetaData "Token" "Network.Yak.Types" "yak-0.2.0.0-DpGRvARnWRP1pvWDPQg9Pa" False) (C1 (MetaCons "KeyValue" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)) :+: (C1 (MetaCons "PositiveToken" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)) :+: C1 (MetaCons "NegativeToken" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)))) |