{- This file is part of irc-fun-messages. - - Written in 2015 by fr33domlover . - - ♡ 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 - . -} -- | This module deals with wildcard based masks, used for selecting users and -- servers. module Network.Irc.Messages.Mask ( parseMask , serializeMask , matches ) where import Data.Maybe (isJust) import Data.Text (Text, cons, unpack) import Network.Irc.Messages.Internal.Types import Network.Irc.Types import Text.Regex.Applicative import qualified Network.Irc.Messages.Internal.Tokens.Wildcards as T {- TODO "The mask MUST have at least 1 (one) "." in it and no wildcards following the last ".". This requirement exists to prevent people sending messages to "#*" or "$*", which would broadcast to all users." handle this somehow! e.g. a function that tests a mask for validity -} -- | Parse a mask string (e.g. @"*!*@*"@) into a 'Mask' value. Returns -- 'Nothing' if the string isn't a valid mask. parseMask :: Text -> Maybe Mask parseMask = match T.mask . unpack --TODO what about escaping and invalid chars? are they handled correctly? --prepend mapped part to given string serializeMaskPart :: MaskPart -> Text -> Text serializeMaskPart (MaskChar '?') t = '\\' `cons` '?' `cons` t serializeMaskPart (MaskChar '*') t = '\\' `cons` '*' `cons` t serializeMaskPart (MaskChar c) t = c `cons` t serializeMaskPart (MaskWildOne) t = '?' `cons` t serializeMaskPart (MaskWildMany) t = '*' `cons` t -- | Converts a 'Mask' value into its string representation in IRC messages. serializeMask :: Mask -> Text serializeMask (Mask parts) = foldr serializeMaskPart mempty parts -- TODO maybe fold MaskChars into strings? how much faster will it be? maskToRegex :: Mask -> Regex String maskToRegex (Mask parts) = snd <$> withMatched (foldr f (pure "") parts) where f (MaskChar c) regex = sym c *> regex f MaskWildOne regex = T.matchone *> regex f MaskWildMany regex = T.matchmany *> regex matches :: String -> Mask -> Bool matches s m = isJust $ match (maskToRegex m) s infix 2 `matches`