{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Network.Yak.Capabilities
(
Identifier,
Subcommand,
CapModifier(..),
_ModDisable,
_ModAck,
_ModSticky,
_ModNone,
Capability(..),
modifier,
capability,
ReqAnswer(..),
_Ack,
_Nak,
ErrInvalidcap,
errInvalidcapIdentifier,
errInvalidcapCommand,
errInvalidcapMessage,
CapLs,
capLs302,
SrvCapLs,
srvCapLsIdentifier,
srvCapLsMultiLine,
srvCapLsCapabilities,
CapList,
SrvCapList,
srvCapListIdentifier,
srvCapListMultiLine,
srvCapListCapabilities,
CapReq,
capReqCapabilities,
SrvCapReq,
srvCapReqIdentifier,
srvCapReqAnswer,
srvCapReqCapabilities,
CapAck,
capAckCapabilities,
CapEnd,
SrvCapNew,
srvCapNewIdentifier,
srvCapNewCapabilities,
SrvCapDel,
srvCapDelIdentifier,
srvCapDelCapabilities,
)
where
import Control.Lens
import Control.Applicative
import Data.Attoparsec.ByteString.Char8 (string, choice, char)
import Data.Text (Text)
import Network.Yak.TH
import Network.Yak.Types
type Identifier = Either (Unused "*") Text
type Subcommand = Unused
data CapModifier
= ModDisable
| ModAck
| ModSticky
| ModNone
deriving (Eq, Show, Read, Ord)
makePrisms ''CapModifier
declareLenses [d|
data Capability = Capability
{ modifier :: CapModifier
, capability :: Text
}
deriving (Eq, Show, Read, Ord)
|]
instance Parameter Capability where
render (Capability m c) = render $ modChar m `mappend` c
where modChar ModDisable = "-"
modChar ModAck = "~"
modChar ModSticky = "="
modChar ModNone = ""
seize = Capability
<$> choice [ ModDisable <$ char '-'
, ModAck <$ char '~'
, ModSticky <$ char '='
, pure ModNone ]
<*> seize
data ReqAnswer = Ack | Nak
deriving (Eq, Show, Read, Ord)
makePrisms ''ReqAnswer
instance Parameter ReqAnswer where
render Ack = "ACK"
render Nak = "NAK"
seize = (Ack <$ string "ACK") <|> (Nak <$ string "NAK")
type ErrInvalidcap = Msg "410" [Identifier, Text, Message]
makeMsgLenses ''ErrInvalidcap ["identifier", "command", "message"]
type CapLs = Msg "CAP LS" '[Flag "302"]
makeMsgLenses ''CapLs ["302"]
type SrvCapLs = Msg "CAP"
'[Identifier, Subcommand "LS", Flag "*", CList Capability]
makeMsgLenses ''SrvCapLs ["identifier", "unused", "multiLine", "caps"]
srvCapLsCapabilities :: Lens' SrvCapLs [Capability]
srvCapLsCapabilities = srvCapLsCaps . _Wrapped
type CapList = Msg "CAP LIST" '[]
type SrvCapList = Msg "CAP"
'[Identifier, Subcommand "LIST", Flag "*", CList Capability]
makeMsgLenses ''SrvCapList ["identifier", "unused", "multiLine", "caps"]
srvCapListCapabilities :: Lens' SrvCapList [Capability]
srvCapListCapabilities = srvCapListCaps . _Wrapped
type CapReq = Msg "CAP REQ" '[CList Capability]
makeMsgLenses ''CapReq ["caps"]
capReqCapabilities :: Lens' CapReq [Capability]
capReqCapabilities = capReqCaps . _Wrapped
type SrvCapReq = Msg "CAP" '[Identifier, ReqAnswer, CList Capability]
makeMsgLenses ''SrvCapReq ["identifier", "answer", "caps"]
srvCapReqCapabilities :: Lens' SrvCapReq [Capability]
srvCapReqCapabilities = srvCapReqCaps . _Wrapped
type CapAck = Msg "CAP ACK" '[CList Capability]
makeMsgLenses ''CapAck ["caps"]
capAckCapabilities :: Lens' CapAck [Capability]
capAckCapabilities = capAckCaps . _Wrapped
type CapEnd = Msg "CAP END" '[]
type SrvCapNew = Msg "CAP" '[Identifier, Subcommand "NEW", CList Capability]
makeMsgLenses ''SrvCapNew ["identifier", "subcommand", "caps"]
srvCapNewCapabilities :: Lens' SrvCapNew [Capability]
srvCapNewCapabilities = srvCapNewCaps . _Wrapped
type SrvCapDel = Msg "CAP" '[Identifier, Subcommand "DEL", CList Capability]
makeMsgLenses ''SrvCapDel ["identifier", "subcommand", "caps"]
srvCapDelCapabilities :: Lens' SrvCapDel [Capability]
srvCapDelCapabilities = srvCapDelCaps . _Wrapped