irc-fun-messages 0.1.0.1 → 0.2.0.0

raw patch · 6 files changed

+399/−197 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• NEWS +24/−0
• irc-fun-messages.cabal +4/−3
• src/Network/IRC/Fun/Messages/Internal/Parse.hs +191/−177
• src/Network/IRC/Fun/Messages/Internal/Serialize.hs +10/−8
• src/Network/IRC/Fun/Messages/Internal/Types.hs +28/−9
• src/Network/IRC/Fun/Messages/Internal/Util.hs +142/−0

@@ -3,6 +3,30 @@   +irc-fun-messages 0.2.0.0 -- 2015-10-17+======================================++General, build and documentation changes:++* Prefix some record field names, they had too generic names++New APIs, features and enhancements:++* Recognize action messages (/me)+* Implement parsing of a few more IRC messages, previously unimplemented++Bug fixes:++* (None)++Dependency changes:++* (None)+++++ irc-fun-messages 0.1.0.1 -- 2015-09-10 ====================================== 

@@ -1,5 +1,5 @@ name:                irc-fun-messages-version:             0.1.0.1+version:             0.2.0.0 synopsis:            Types and functions for working with the IRC protocol. description:   Another IRC library. It doesn't provide a client API though. It just provides@@ -9,8 +9,8 @@   The package is based on RFC 2812, with modifications and extensions to work   with Freenode.   .-  NOTE: The handling of IRC protocol messages is FAR from complete, but there-  is enough to e.g. create a basic IRC bot. Missing features are being added as+  NOTE: The handling of IRC protocol messages is incomplete, but there+  is enough to e.g. create an IRC bot. Missing features are being added as   needed while working on <http://rel4tion.org/projects/funbot FunBot>, and of   course patches are welcome. homepage:            http://rel4tion.org/projects/irc-fun-messages/@@ -43,6 +43,7 @@                      , Network.IRC.Fun.Messages.Internal.Tokens.Target                      , Network.IRC.Fun.Messages.Internal.Tokens.Wildcards                      , Network.IRC.Fun.Messages.Internal.Types+                     , Network.IRC.Fun.Messages.Internal.Util   -- other-extensions:       build-depends:       base              >=4.7 && <5                      , regex-applicative >=0.3.1

@@ -28,17 +28,18 @@  import Data.Bits (testBit) import Data.Char (toUpper)-import Data.List (isSuffixOf)---import Data.Maybe (fromMaybe)+import Data.List (isSuffixOf, stripPrefix) import Network.IRC.Fun.Messages.Mask (parseMask) import Network.IRC.Fun.Messages.Modes (parseUserMode)+import Network.IRC.Fun.Messages.Internal.Types+import Network.IRC.Fun.Messages.Internal.Util+import Text.Regex.Applicative+import Text.Regex.Applicative.Common (decimal)+ import qualified Network.IRC.Fun.Messages.Internal.Tokens.Message as T import qualified Network.IRC.Fun.Messages.Internal.Tokens.Other as T import qualified Network.IRC.Fun.Messages.Internal.Tokens.Reply as T import qualified Network.IRC.Fun.Messages.Internal.Tokens.Target as T-import Network.IRC.Fun.Messages.Internal.Types-import Text.Regex.Applicative-import Text.Regex.Applicative.Common (decimal)  ------------------------------------------------------------------------------- -- Parsing@@ -54,12 +55,12 @@ messageIsReply :: GenericMessage -> Bool messageIsReply msg =     let prefOk =-            case prefix msg of+            case gmPrefix msg of                 Nothing         -> False                 Just (Server _) -> True                 Just (Nick {})  -> False         cmdOk =-            case command msg of+            case gmCommand msg of                 StringCommand _  -> False                 NumericCommand _ -> True     in  prefOk && cmdOk@@ -69,13 +70,13 @@ -- 'Left' an error message. messageToReply :: GenericMessage -> Either String GenericReply messageToReply msg =-    case (prefix msg, command msg, parameters msg) of+    case (gmPrefix msg, gmCommand msg, gmParams msg) of         (Just (Server s),   NumericCommand n, p : ps) ->             Right GenericReply-                { sender = s-                , code   = n-                , target = NickTarget p-                , params = ps+                { grSender = s+                , grCode   = n+                , grTarget = NickTarget p+                , grParams = ps                 }         (Just (Server _),   NumericCommand _, []) ->             Left "No parameters, must have at least one"@@ -101,183 +102,196 @@ -- Analysis ------------------------------------------------------------------------------- +mapLeft :: (a -> c) -> Either a b -> Either c b+mapLeft f (Left x)  = Left $ f x+mapLeft _ (Right y) = Right y+ analyzeMessage' :: Maybe Prefix                 -> String                 -> [Parameter]                 -> Either String Message-analyzeMessage' prefix cmd params =+analyzeMessage' _prefix cmd params = mapLeft show $     case map toUpper cmd of     -- Connection registration-        "PASS"     ->-            case params of-                [pass] -> Right $ PassMessage pass-                []     -> Left "Password missing"-                _      -> Left "Too many parameters"-        "NICK"     ->-            case params of-                [nick] -> Right $ NickMessage nick-                []     -> Left "Nickname missing"-                _      -> Left "Too many parameters"-        "USER"     ->-            case params of-                [user, mode, _, realname] ->-                    case match decimal mode :: Maybe Int of-                        (Just m) -> Right $ UserMessage user-                                            (testBit m 3)-                                            (testBit m 2)-                                            realname-                        Nothing  -> Left "<mode> should be a number"-                [_:_:_:_:_:_]             -> Left "Too many parameters"-                _                         -> Left "Too few parameters"-        "OPER"     ->-            case params of-                [name, pass] -> Right $ OperMessage name pass-                [_:_:_:_]    -> Left "Too many parameters"-                _            -> Left "Too few parameters"-        "MODE"     ->-            case params of-                (first:rest) ->-                    case (match T.nickname first, match T.channel first) of-                        (Just nick, _)       ->-                            case rest of-                                [mode] ->-                                    case parseUserMode mode of-                                        Just (remove, add) ->-                                            Right $ UserModeMessage nick-                                                                    remove-                                                                    add-                                        Nothing            ->-                                            Left "Invalid user mode string"-                                []    -> Left "Too few parameters"-                                _     -> Left "Too many parameters"-                        (Nothing, Just chan) -> Left "Not implemented yet"-                            {-case parseChannelModeParams rest of-                                Just X ->-                                Nothing ->-}-                        _                    -> Left "First parameter invalid"-                _         ->-                    Left "Too new parameters"-        "SERVICE"  ->-            case params of-                [nick, _, dist, _, _, info] ->-                    case parseMask dist of-                        Just m  -> Right $ ServiceMessage nick m info-                        Nothing -> Left "Distribution mask invalid"-                [_:_:_:_:_:_:_:_]           -> Left "Too many parameters"-                _                           -> Left "Too few parameters"-        "QUIT"     ->-            case params of-                []    -> Right $ QuitMessage Nothing-                [msg] -> Right $ QuitMessage (Just msg)-                _     -> Left "Too many parameters"-        "SQUIT"    ->-            case params of-                [server, comment] -> Right $ SQuitMessage server comment-                [_:_:_:_]         -> Left "Too many parameters"-                _                 -> Left "Too few parameters"+        "PASS"     -> req1 params $ \ pass -> Right $ PassMessage pass+        "NICK"     -> req1 params $ \ nick -> Right $ NickMessage nick+        "USER"     -> req4 params $ \ user mode _ realname ->+            case match decimal mode :: Maybe Int of+                Just m  ->+                    Right $+                    UserMessage user (testBit m 3) (testBit m 2) realname+                Nothing ->+                    Left $+                    InvalidArg+                        (Just 2)+                        (Just "mode")+                        (Just "Should be a number")+        "OPER"     -> req2 params $ \ name pass ->+                        Right $ OperMessage name pass+        "MODE"     -> min1 params $ \ first rest ->+            case (match T.nickname first, match T.channel first) of+                (Just nick, _)       ->+                    case rest of+                        [mode] ->+                            case parseUserMode mode of+                                Just (remove, add) ->+                                    Right $ UserModeMessage nick remove add+                                Nothing ->+                                    Left $+                                    InvalidArg (Just 1) (Just "mode") Nothing+                        l     -> Left $ WrongNumArgs (length l) Nothing+                (Nothing, Just _chan) ->+                    Left $ OtherError "Not implemented yet"+                    {-case parseChannelModeParams rest of+                        Just X ->+                        Nothing ->-}+                _                    ->+                    Left $ InvalidArg (Just 1) Nothing Nothing+        "SERVICE"  -> req6 params $ \ nick _ dist _ _ info ->+            case parseMask dist of+                Just m  -> Right $ ServiceMessage nick m info+                Nothing ->+                    Left $+                    InvalidArg (Just 3) (Just "distribution mask") Nothing+        "QUIT"     -> req0m1 params $ \ msg -> Right $ QuitMessage msg+        "SQUIT"    -> req2 params $ \ server comment ->+            Right $ SQuitMessage server comment     -- Channel operations-        "JOIN"     ->-            case params of-                ["0"]            -> Right $ JoinMessage Nothing-                [channels]       ->-                    let c = (:) <$> T.channel <*> many (sym ',' *> T.channel)-                    in  case match c channels of-                            Just cs -> Right $ JoinMessage $ Just (cs, [])-                            _       -> Left "Invalid parameters"-                [channels, keys] ->-                    let c = (:) <$> T.channel <*> many (sym ',' *> T.channel)-                        k = (:) <$> T.key     <*> many (sym ',' *> T.key)-                    in  case (match c channels, match k keys) of+        "JOIN"     -> req1m2 params $ \ chans mkeys ->+            case (chans, mkeys) of+                ("0", Nothing) -> Right $ JoinMessage Nothing+                _              ->+                    let mcs = match (listOf T.channel) chans+                        mks = maybe (Just []) (match $ listOf T.key) mkeys+                    in  case (mcs, mks) of+                            (Nothing, _)       ->+                                Left $+                                InvalidArg (Just 1) (Just "channels") Nothing+                            (Just _,  Nothing) ->+                                Left $+                                InvalidArg (Just 2) (Just "keys") Nothing                             (Just cs, Just ks) ->                                 Right $ JoinMessage $ Just (cs, ks)-                            _                  ->-                                Left "Invalid parameters"-                _                -> Left "Invalid parameters"-        "PART"     ->-            case params of-                [channels]      ->-                    case match c channels of-                        Just cs -> Right $ PartMessage cs Nothing-                        Nothing -> Left "Invalid channel list"-                [channels, msg] ->-                    case match c channels of-                        Just cs -> Right $ PartMessage cs $ Just msg-                        Nothing -> Left "Invalid channel list"-                _               -> Left "Wrong number of parameters"-                where-                c = (:) <$> T.channel <*> many (sym ',' *> T.channel)+        "PART"     -> req1m2 params $ \ chans msg ->+            case match (listOf T.channel) chans of+                Just cs -> Right $ PartMessage cs msg+                Nothing -> Left $ InvalidArg (Just 1) (Just "channels") Nothing         -- "MODE" -> Channel mode handled by MODE above-        "TOPIC"    ->-            case params of-                [channel]        -> Right $ TopicMessage channel Nothing-                [channel, topic] -> Right $ TopicMessage channel $ Just topic-                []               -> Left "No parameters given"-                _                -> Left "Too many parameters"-        "NAMES"    -> Left "Not implemented yet"-        "LIST"     -> Left "Not implemented yet"-        "INVITE"   -> Left "Not implemented yet"-        "KICK"     -> Left "Not implemented yet"-    -- Sending messages-        "PRIVMSG"  ->+        "TOPIC"    -> req1m2 params $ \ chan topic ->+            Right $ TopicMessage chan topic+        "NAMES"    ->             case params of-                [target, text] ->-                    case match T.msgto target of-                        Nothing -> Left $ "Invalid message target: " ++ target-                        Just t  -> Right $ PrivMsgMessage t text-                (_:_:_:_)      -> Left "Too many parameters"-                _              -> Left "Too few parameters"-        "NOTICE"   ->+                []              -> Right $ NamesMessage [] Nothing+                [chans]         ->+                    case match (listOf T.channel) chans of+                        Just cs -> Right $ NamesMessage cs Nothing+                        Nothing ->+                            Left $+                            InvalidArg (Just 1) (Just "channels") Nothing+                [chans, target] ->+                    case match (listOf T.channel) chans of+                        Just cs -> Right $ NamesMessage cs (Just target)+                        Nothing ->+                            Left $+                            InvalidArg (Just 1) (Just "channels") Nothing+                l               ->+                    Left $ WrongNumArgs (length l) (Just $ Between 0 2)+        "LIST"     ->             case params of-                [target, text] ->-                    case match T.msgto target of-                        Nothing -> Left $ "Invalid notice target: " ++ target-                        Just t  -> Right $ NoticeMessage t text-                (_:_:_:_)      -> Left "Too many parameters"-                _              -> Left "Too few parameters"+                []              -> Right $ ListMessage [] Nothing+                [chans]         ->+                    case match (listOf T.channel) chans of+                        Just cs -> Right $ ListMessage cs Nothing+                        Nothing ->+                            Left $+                            InvalidArg (Just 1) (Just "channels") Nothing+                [chans, target] ->+                    case match (listOf T.channel) chans of+                        Just cs -> Right $ ListMessage cs (Just target)+                        Nothing ->+                            Left $+                            InvalidArg (Just 1) (Just "channels") Nothing+                l               ->+                    Left $ WrongNumArgs (length l) (Just $ Between 0 2)+        "INVITE"   -> req2 params $ \ nick chan ->+            case (match T.nickname nick, match T.channel chan) of+                (Nothing, _)      ->+                    Left $ InvalidArg (Just 1) (Just "nickname") Nothing+                (Just _, Nothing) ->+                    Left $ InvalidArg (Just 2) (Just "channel") Nothing+                (Just n,  Just c) -> Right $ InviteMessage n c+        "KICK"     -> req2m3 params $ \ chans users comment ->+            let mcs = match (listOf T.channel) chans+                ucs = match (listOf T.nickname) users+            in  case (mcs, ucs) of+                    (Nothing, _)       ->+                        Left $ InvalidArg (Just 1) (Just "channels") Nothing+                    (Just _,  Nothing) ->+                        Left $ InvalidArg (Just 2) (Just "users") Nothing+                    (Just cs, Just us) ->+                        let lc = length cs+                            lu = length us+                        in  if lc == 1 || lc == lu+                                then Right $ KickMessage cs us comment+                                else Left $ OtherError "Invalid list lengths"+    -- Sending messages+        "PRIVMSG"  -> req2 params $ \ target text ->+            case match T.msgto target of+                Nothing ->+                    Left $ InvalidArg (Just 1) (Just "target") (Just target)+                Just t ->+                    Right $ case stripPrefix "\1ACTION " text of+                        Just s  ->+                            if not (null s) && last s == '\1'+                                then PrivActionMessage t $ init s+                                else PrivMsgMessage t text+                        Nothing -> PrivMsgMessage t text+        "NOTICE"   -> req2 params $ \ target text ->+            case match T.msgto target of+                Nothing ->+                    Left $ InvalidArg (Just 1) (Just "target") (Just target)+                Just t  ->+                    Right $ NoticeMessage t text     -- Server queries and commands-        "MOTD"     -> Left "Not implemented yet"-        "LUSERS"   -> Left "Not implemented yet"-        "VERSION"  -> Left "Not implemented yet"-        "STATS"    -> Left "Not implemented yet"-        "LINKS"    -> Left "Not implemented yet"-        "TIME"     -> Left "Not implemented yet"-        "CONNECT"  -> Left "Not implemented yet"-        "TRACE"    -> Left "Not implemented yet"-        "ADMIN"    -> Left "Not implemented yet"-        "INFO"     -> Left "Not implemented yet"+        "MOTD"     -> req0m1 params $ \ target -> Right $ MotdMessage target+        "LUSERS"   -> Left $ OtherError "Not implemented yet"+        "VERSION"  -> Left $ OtherError "Not implemented yet"+        "STATS"    -> Left $ OtherError "Not implemented yet"+        "LINKS"    -> Left $ OtherError "Not implemented yet"+        "TIME"     -> Left $ OtherError "Not implemented yet"+        "CONNECT"  -> Left $ OtherError "Not implemented yet"+        "TRACE"    -> Left $ OtherError "Not implemented yet"+        "ADMIN"    -> Left $ OtherError "Not implemented yet"+        "INFO"     -> req0m1 params $ \ target ->+            case target of+                Nothing -> Right $ InfoMessage Nothing+                Just t  ->+                    Right $ case match T.nickname t of+                        Just n  -> InfoMessage (Just $ NickTarget n)+                        Nothing -> InfoMessage (Just $ ServerTarget t)     -- Service query and commands-        "SERVLIST" -> Left "Not implemented yet"-        "SQUERY"   -> Left "Not implemented yet"+        "SERVLIST" -> Left $ OtherError "Not implemented yet"+        "SQUERY"   -> Left $ OtherError "Not implemented yet"     -- User based queries-        "WHO"      -> Left "Not implemented yet"-        "WHOIS"    -> Left "Not implemented yet"-        "WHOWAS"   -> Left "Not implemented yet"+        "WHO"      -> Left $ OtherError "Not implemented yet"+        "WHOIS"    -> Left $ OtherError "Not implemented yet"+        "WHOWAS"   -> Left $ OtherError "Not implemented yet"     -- Miscellaneous messages-        "KILL"     -> Left "Not implemented yet"-        "PING"     ->-            case params of-                []       -> Left "No parameters given"-                [s]      -> Right $ PingMessage s Nothing-                [s1, s2] -> Right $ PingMessage s1 (Just s2)-                _        -> Left "Too many parameters"-        "PONG"     ->-            case params of-                []       -> Left "No parameters given"-                [s]      -> Right $ PongMessage s Nothing-                [s1, s2] -> Right $ PongMessage s1 (Just s2)-                _        -> Left "Too many parameters"-        "ERROR"    -> Left "Not implemented yet"+        "KILL"     -> Left $ OtherError "Not implemented yet"+        "PING"     -> req1m2 params $ \ s1 s2 -> Right $ PingMessage s1 s2+        "PONG"     -> req1m2 params $ \ s1 s2 -> Right $ PongMessage s1 s2+        "ERROR"    -> Left $ OtherError "Not implemented yet"     -- Optional features-        "AWAY"     -> Left "Not implemented yet"-        "REHASH"   -> Left "Not implemented yet"-        "DIE"      -> Left "Not implemented yet"-        "RESTART"  -> Left "Not implemented yet"-        "SUMMON"   -> Left "Not implemented yet"-        "USERS"    -> Left "Not implemented yet"-        "WALLOPS"  -> Left "Not implemented yet"-        "USERHOST" -> Left "Not implemented yet"-        "ISON"     -> Left "Not implemented yet"-        _          -> Left "Unrecognized command"+        "AWAY"     -> req0m1 params $ \ text -> Right $ AwayMessage text+        "REHASH"   -> Left $ OtherError "Not implemented yet"+        "DIE"      -> Left $ OtherError "Not implemented yet"+        "RESTART"  -> Left $ OtherError "Not implemented yet"+        "SUMMON"   -> Left $ OtherError "Not implemented yet"+        "USERS"    -> Left $ OtherError "Not implemented yet"+        "WALLOPS"  -> Left $ OtherError "Not implemented yet"+        "USERHOST" -> Left $ OtherError "Not implemented yet"+        "ISON"     -> Left $ OtherError "Not implemented yet"+        _          -> Left $ OtherError "Unrecognized command"  -- | Read a generic message structure into specific message details. Return -- 'Left' an error description if analysis fails. If the message is detected@@ -287,10 +301,10 @@ analyzeMessage msg =     if messageIsReply msg         then fmap Left $ messageToReply msg-        else case command msg of+        else case gmCommand msg of             StringCommand c ->-                fmap (Right . SpecificMessage (prefix msg)) $-                analyzeMessage' (prefix msg) c (parameters msg)+                fmap (Right . SpecificMessage (gmPrefix msg)) $+                analyzeMessage' (gmPrefix msg) c (gmParams msg)             _               ->                 Left "Implementation error" @@ -313,8 +327,8 @@ -- 'Left' an error description if analysis fails. analyzeReply :: GenericReply -> Either String SpecificReply analyzeReply gr =-    fmap (SpecificReply (sender gr) (target gr)) $-    analyzeReply' (code gr) (target gr) (params gr)+    fmap (SpecificReply (grSender gr) (grTarget gr)) $+    analyzeReply' (grCode gr) (grTarget gr) (grParams gr)  -- | Read a generic reply structure into specific message or reply details. -- Return 'Left' an error description if analysis fails.

@@ -89,6 +89,8 @@         InviteMessage nn chan -> ("????", error "Not implemented")         KickMessage chans users s -> ("????", error "Not implemented")         PrivMsgMessage tgt text -> ("PRIVMSG", [showTarget tgt, text])+        PrivActionMessage tgt text ->+            ("PRIVMSG", [showTarget tgt, "\1ACTION " ++ text ++ "\1"])         NoticeMessage tgt text -> ("NOTICE", [showTarget tgt, text])         MotdMessage serv -> ("????", error "Not implemented")         LusersMessage serv -> ("????", error "Not implemented")@@ -162,13 +164,13 @@ -- generic message value. messageFromReply :: GenericReply -> GenericMessage messageFromReply reply = GenericMessage-    { prefix     = Just $ Server $ sender reply-    , command    = NumericCommand $ code reply-    , parameters = target' reply : params reply+    { gmPrefix  = Just $ Server $ grSender reply+    , gmCommand = NumericCommand $ grCode reply+    , gmParams  = target' reply : grParams reply     }     where-    target' (GenericReply { target = NickTarget n })   = n-    target' (GenericReply { target = ServerTarget s }) = s+    target' (GenericReply { grTarget = NickTarget n })   = n+    target' (GenericReply { grTarget = ServerTarget s }) = s  ------------------------------------------------------------------------------- -- Serializing@@ -198,9 +200,9 @@ -- | Write a message into an IRC protocol message formatted string. serializeMessage :: GenericMessage -> String serializeMessage msg = concat-    [ maybe "" (\ p -> ':' : serializePrefix p ++ " ") $ prefix msg-    , serializeCommand $ command msg-    , serializeParams $ parameters msg+    [ maybe "" (\ p -> ':' : serializePrefix p ++ " ") $ gmPrefix msg+    , serializeCommand $ gmCommand msg+    , serializeParams $ gmParams msg     , "\r\n"     ] 

@@ -45,6 +45,8 @@     , SpecificMessage (..)     , MessageTarget (..)     , Message (..)+    , AnalysisError (..)+    , ArgSpec (..)       -- * Modes     , UserMode (..)     , ChannelMode (..)@@ -179,9 +181,9 @@ -- | A generic IRC message. It consists of a sender prefix, command name -- (string or numeric) and optionally a list of parameters. data GenericMessage = GenericMessage-    { prefix     :: Maybe Prefix-    , command    :: Command-    , parameters :: [Parameter]+    { gmPrefix  :: Maybe Prefix+    , gmCommand :: Command+    , gmParams  :: [Parameter]     }     deriving Show @@ -251,14 +253,15 @@     | ChannelModeMessage [ChannelMode] [ChannelMode]     | TopicMessage ChannelName (Maybe ChannelTopic)     | NamesMessage [ChannelName] (Maybe ServerName)-    | ListMessage [ChannelName] (Maybe (Either ServerName Mask))+    | ListMessage [ChannelName] (Maybe ServerName)     | InviteMessage NickName ChannelName     | KickMessage [ChannelName] [UserName] (Maybe Comment) -- Sending messages     | PrivMsgMessage MessageTarget String+    | PrivActionMessage MessageTarget String     | NoticeMessage MessageTarget String -- Server queries and commands-    | MotdMessage (Maybe (Either ServerName Mask))+    | MotdMessage (Maybe ServerName)     | LusersMessage (Maybe (Mask, Maybe ServerName))     | VersionMessage (Maybe (Either ServerName Mask))     | StatsMessage (Maybe (Query, Maybe (Either ServerName Mask)))@@ -688,10 +691,10 @@  -- | TODO data GenericReply = GenericReply-    { sender     :: ServerName-    , code       :: Int-    , target     :: Target-    , params     :: [Parameter]+    { grSender :: ServerName+    , grCode   :: Int+    , grTarget :: Target+    , grParams :: [Parameter]     }     deriving Show @@ -879,3 +882,19 @@  -- data ChannelPrivacy = Secret | Private | Public deriving (Eq, Show)++--+data ArgSpec+    = Exactly Int+    | AtLeast Int+    | AtMost Int+    | Between Int Int+    | OneOf [Int]+    deriving (Show)++--+data AnalysisError+    = WrongNumArgs Int (Maybe ArgSpec)+    | InvalidArg (Maybe Int) (Maybe String) (Maybe String)+    | OtherError String+    deriving (Show)

@@ -0,0 +1,142 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Util+    ( listOf+    , req0+    , req1+    , req2+    , req3+    , req4+    , req5+    , req6+    , req0m1+    , req1m2+    , req2m3+    , req3m4+    , min1+    )+where++import Network.IRC.Fun.Messages.Internal.Types+import Text.Regex.Applicative++listOf :: Regex a -> Regex [a]+listOf re = (:) <$> re <*> many (sym ',' *> re)++req0 :: [Parameter]+     -> Either AnalysisError Message+     -> Either AnalysisError Message+req0 [] f = f+req0 l  _ = Left $ WrongNumArgs (length l) (Just $ Exactly 0)++req1 :: [Parameter]+     -> (Parameter -> Either AnalysisError Message)+     -> Either AnalysisError Message+req1 [p1] f = f p1+req1 l    _ = Left $ WrongNumArgs (length l) (Just $ Exactly 1)++req2 :: [Parameter]+     -> (Parameter -> Parameter -> Either AnalysisError Message)+     -> Either AnalysisError Message+req2 [p1, p2] f = f p1 p2+req2 l        _ = Left $ WrongNumArgs (length l) (Just $ Exactly 2)++req3 :: [Parameter]+     -> (Parameter -> Parameter -> Parameter -> Either AnalysisError Message)+     -> Either AnalysisError Message+req3 [p1, p2, p3] f = f p1 p2 p3+req3 l            _ = Left $ WrongNumArgs (length l) (Just $ Exactly 3)++req4 :: [Parameter]+     -> (  Parameter+        -> Parameter+        -> Parameter+        -> Parameter+        -> Either AnalysisError Message+        )+     -> Either AnalysisError Message+req4 [p1, p2, p3, p4] f = f p1 p2 p3 p4+req4 l            _     = Left $ WrongNumArgs (length l) (Just $ Exactly 4)++req5 :: [Parameter]+     -> (  Parameter+        -> Parameter+        -> Parameter+        -> Parameter+        -> Parameter+        -> Either AnalysisError Message+        )+     -> Either AnalysisError Message+req5 [p1, p2, p3, p4, p5] f = f p1 p2 p3 p4 p5+req5 l                    _ = Left $ WrongNumArgs (length l) (Just $ Exactly 5)++req6 :: [Parameter]+     -> (  Parameter+        -> Parameter+        -> Parameter+        -> Parameter+        -> Parameter+        -> Parameter+        -> Either AnalysisError Message+        )+     -> Either AnalysisError Message+req6 [p1, p2, p3, p4, p5,p6] f = f p1 p2 p3 p4 p5 p6+req6 l                       _ = Left $+                                 WrongNumArgs (length l) (Just $ Exactly 6)++req0m1 :: [Parameter]+       -> (Maybe Parameter -> Either AnalysisError Message)+       -> Either AnalysisError Message+req0m1 [] f   = f Nothing+req0m1 [p1] f = f $ Just p1+req0m1 l    _ = Left $ WrongNumArgs (length l) (Just $ Between 0 1)++req1m2 :: [Parameter]+       -> (Parameter -> Maybe Parameter -> Either AnalysisError Message)+       -> Either AnalysisError Message+req1m2 [p1]     f = f p1 Nothing+req1m2 [p1, p2] f = f p1 (Just p2)+req1m2 l        _ = Left $ WrongNumArgs (length l) (Just $ Between 1 2)++req2m3 :: [Parameter]+       -> (  Parameter+          -> Parameter+          -> Maybe Parameter+          -> Either AnalysisError Message+          )+       -> Either AnalysisError Message+req2m3 [p1, p2]     f = f p1 p2 Nothing+req2m3 [p1, p2, p3] f = f p1 p2 (Just p3)+req2m3 l            _ = Left $ WrongNumArgs (length l) (Just $ Between 2 3)++req3m4 :: [Parameter]+       -> (  Parameter+          -> Parameter+          -> Parameter+          -> Maybe Parameter+          -> Either AnalysisError Message+          )+       -> Either AnalysisError Message+req3m4 [p1, p2, p3]     f = f p1 p2 p3 Nothing+req3m4 [p1, p2, p3, p4] f = f p1 p2 p3 (Just p4)+req3m4 l                _ = Left $+                            WrongNumArgs (length l) (Just $ Between 3 4)++min1 :: [Parameter]+     -> (Parameter -> [Parameter] -> Either AnalysisError Message)+     -> Either AnalysisError Message+min1 []      _ = Left $ WrongNumArgs 0 (Just $ AtLeast 1)+min1 (p1:ps) f = f p1 ps