{-# Language BangPatterns #-}
module Irc.Modes
(
ModeTypes(..)
, modesLists
, modesAlwaysArg
, modesSetArg
, modesNeverArg
, modesPrefixModes
, defaultModeTypes
, defaultUmodeTypes
, splitModes
, unsplitModes
) where
import Data.Text (Text)
import qualified Data.Text as Text
import View
data ModeTypes = ModeTypes
{ ModeTypes -> [Char]
_modesLists :: [Char]
, ModeTypes -> [Char]
_modesAlwaysArg :: [Char]
, ModeTypes -> [Char]
_modesSetArg :: [Char]
, ModeTypes -> [Char]
_modesNeverArg :: [Char]
, ModeTypes -> [(Char, Char)]
_modesPrefixModes :: [(Char,Char)]
}
deriving Int -> ModeTypes -> ShowS
[ModeTypes] -> ShowS
ModeTypes -> [Char]
(Int -> ModeTypes -> ShowS)
-> (ModeTypes -> [Char])
-> ([ModeTypes] -> ShowS)
-> Show ModeTypes
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModeTypes] -> ShowS
$cshowList :: [ModeTypes] -> ShowS
show :: ModeTypes -> [Char]
$cshow :: ModeTypes -> [Char]
showsPrec :: Int -> ModeTypes -> ShowS
$cshowsPrec :: Int -> ModeTypes -> ShowS
Show
modesLists :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists :: ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists [Char] -> f [Char]
f ModeTypes
m = (\[Char]
x -> ModeTypes
m { _modesLists :: [Char]
_modesLists = [Char]
x }) ([Char] -> ModeTypes) -> f [Char] -> f ModeTypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> f [Char]
f (ModeTypes -> [Char]
_modesLists ModeTypes
m)
modesAlwaysArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesAlwaysArg :: ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesAlwaysArg [Char] -> f [Char]
f ModeTypes
m = (\[Char]
x -> ModeTypes
m { _modesAlwaysArg :: [Char]
_modesAlwaysArg = [Char]
x }) ([Char] -> ModeTypes) -> f [Char] -> f ModeTypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> f [Char]
f (ModeTypes -> [Char]
_modesAlwaysArg ModeTypes
m)
modesSetArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesSetArg :: ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesSetArg [Char] -> f [Char]
f ModeTypes
m = (\[Char]
x -> ModeTypes
m { _modesSetArg :: [Char]
_modesSetArg = [Char]
x }) ([Char] -> ModeTypes) -> f [Char] -> f ModeTypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> f [Char]
f (ModeTypes -> [Char]
_modesSetArg ModeTypes
m)
modesNeverArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesNeverArg :: ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesNeverArg [Char] -> f [Char]
f ModeTypes
m = (\[Char]
x -> ModeTypes
m { _modesNeverArg :: [Char]
_modesNeverArg = [Char]
x }) ([Char] -> ModeTypes) -> f [Char] -> f ModeTypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> f [Char]
f (ModeTypes -> [Char]
_modesNeverArg ModeTypes
m)
modesPrefixModes :: Functor f => ([(Char,Char)] -> f [(Char,Char)]) -> ModeTypes -> f ModeTypes
modesPrefixModes :: ([(Char, Char)] -> f [(Char, Char)]) -> ModeTypes -> f ModeTypes
modesPrefixModes [(Char, Char)] -> f [(Char, Char)]
f ModeTypes
m = (\[(Char, Char)]
x -> ModeTypes
m { _modesPrefixModes :: [(Char, Char)]
_modesPrefixModes = [(Char, Char)]
x }) ([(Char, Char)] -> ModeTypes) -> f [(Char, Char)] -> f ModeTypes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Char, Char)] -> f [(Char, Char)]
f (ModeTypes -> [(Char, Char)]
_modesPrefixModes ModeTypes
m)
defaultModeTypes :: ModeTypes
defaultModeTypes :: ModeTypes
defaultModeTypes = ModeTypes :: [Char] -> [Char] -> [Char] -> [Char] -> [(Char, Char)] -> ModeTypes
ModeTypes
{ _modesLists :: [Char]
_modesLists = [Char]
"eIbq"
, _modesAlwaysArg :: [Char]
_modesAlwaysArg = [Char]
"k"
, _modesSetArg :: [Char]
_modesSetArg = [Char]
"flj"
, _modesNeverArg :: [Char]
_modesNeverArg = [Char]
"CFLMPQScgimnprstz"
, _modesPrefixModes :: [(Char, Char)]
_modesPrefixModes = [(Char
'o',Char
'@'),(Char
'v',Char
'+')]
}
defaultUmodeTypes :: ModeTypes
defaultUmodeTypes :: ModeTypes
defaultUmodeTypes = ModeTypes :: [Char] -> [Char] -> [Char] -> [Char] -> [(Char, Char)] -> ModeTypes
ModeTypes
{ _modesLists :: [Char]
_modesLists = [Char]
""
, _modesAlwaysArg :: [Char]
_modesAlwaysArg = [Char]
""
, _modesSetArg :: [Char]
_modesSetArg = [Char]
"s"
, _modesNeverArg :: [Char]
_modesNeverArg = [Char]
"DQRZgiow"
, _modesPrefixModes :: [(Char, Char)]
_modesPrefixModes = []
}
splitModes ::
ModeTypes ->
Text ->
[Text] ->
Maybe [(Bool,Char,Text)]
splitModes :: ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes !ModeTypes
icm = Bool -> [Char] -> [Text] -> Maybe [(Bool, Char, Text)]
computeMode Bool
True ([Char] -> [Text] -> Maybe [(Bool, Char, Text)])
-> (Text -> [Char]) -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack
where
computeMode ::
Bool ->
[Char] ->
[Text] ->
Maybe [(Bool,Char,Text)]
computeMode :: Bool -> [Char] -> [Text] -> Maybe [(Bool, Char, Text)]
computeMode Bool
polarity [Char]
modes [Text]
args =
case [Char]
modes of
[] | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
args -> [(Bool, Char, Text)] -> Maybe [(Bool, Char, Text)]
forall a. a -> Maybe a
Just []
| Bool
otherwise -> Maybe [(Bool, Char, Text)]
forall a. Maybe a
Nothing
Char
'+':[Char]
ms -> Bool -> [Char] -> [Text] -> Maybe [(Bool, Char, Text)]
computeMode Bool
True [Char]
ms [Text]
args
Char
'-':[Char]
ms -> Bool -> [Char] -> [Text] -> Maybe [(Bool, Char, Text)]
computeMode Bool
False [Char]
ms [Text]
args
Char
m:[Char]
ms
| Char
m Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes)
-> ModeTypes -> [Char]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesAlwaysArg ModeTypes
icm
Bool -> Bool -> Bool
|| Bool
polarity Bool -> Bool -> Bool
&& Char
m Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes)
-> ModeTypes -> [Char]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesSetArg ModeTypes
icm
Bool -> Bool -> Bool
|| Char
m Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Char, Char) -> Char) -> [(Char, Char)] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Char
forall a b. (a, b) -> a
fst ((([(Char, Char)] -> Const [(Char, Char)] [(Char, Char)])
-> ModeTypes -> Const [(Char, Char)] ModeTypes)
-> ModeTypes -> [(Char, Char)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([(Char, Char)] -> Const [(Char, Char)] [(Char, Char)])
-> ModeTypes -> Const [(Char, Char)] ModeTypes
forall (f :: * -> *).
Functor f =>
([(Char, Char)] -> f [(Char, Char)]) -> ModeTypes -> f ModeTypes
modesPrefixModes ModeTypes
icm)
Bool -> Bool -> Bool
|| Char
m Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes)
-> ModeTypes -> [Char]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists ModeTypes
icm ->
let (Text
arg,[Text]
args') =
case [Text]
args of
[] -> (Text
Text.empty,[])
Text
x:[Text]
xs -> (Text
x,[Text]
xs)
in ((Bool
polarity,Char
m,Text
arg)(Bool, Char, Text) -> [(Bool, Char, Text)] -> [(Bool, Char, Text)]
forall a. a -> [a] -> [a]
:) ([(Bool, Char, Text)] -> [(Bool, Char, Text)])
-> Maybe [(Bool, Char, Text)] -> Maybe [(Bool, Char, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Char] -> [Text] -> Maybe [(Bool, Char, Text)]
computeMode Bool
polarity [Char]
ms [Text]
args'
| Bool -> Bool
not Bool
polarity Bool -> Bool -> Bool
&& Char
m Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes)
-> ModeTypes -> [Char]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesSetArg ModeTypes
icm
Bool -> Bool -> Bool
|| Char
m Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes)
-> ModeTypes -> [Char]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view ([Char] -> Const [Char] [Char])
-> ModeTypes -> Const [Char] ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesNeverArg ModeTypes
icm ->
do [(Bool, Char, Text)]
res <- Bool -> [Char] -> [Text] -> Maybe [(Bool, Char, Text)]
computeMode Bool
polarity [Char]
ms [Text]
args
[(Bool, Char, Text)] -> Maybe [(Bool, Char, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool
polarity,Char
m,Text
Text.empty) (Bool, Char, Text) -> [(Bool, Char, Text)] -> [(Bool, Char, Text)]
forall a. a -> [a] -> [a]
: [(Bool, Char, Text)]
res)
| Bool
otherwise -> Maybe [(Bool, Char, Text)]
forall a. Maybe a
Nothing
unsplitModes ::
[(Bool,Char,Text)] ->
[Text]
unsplitModes :: [(Bool, Char, Text)] -> [Text]
unsplitModes [(Bool, Char, Text)]
modes
= [Char] -> Text
Text.pack (((Bool, Char, Text) -> (Bool -> [Char]) -> Bool -> [Char])
-> (Bool -> [Char]) -> [(Bool, Char, Text)] -> Bool -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool, Char, Text) -> (Bool -> [Char]) -> Bool -> [Char]
forall c. (Bool, Char, c) -> (Bool -> [Char]) -> Bool -> [Char]
combineModeChars ([Char] -> Bool -> [Char]
forall a b. a -> b -> a
const [Char]
"") [(Bool, Char, Text)]
modes Bool
True)
Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args
where
args :: [Text]
args = [Text
arg | (Bool
_,Char
_,Text
arg) <- [(Bool, Char, Text)]
modes, Bool -> Bool
not (Text -> Bool
Text.null Text
arg)]
combineModeChars :: (Bool, Char, c) -> (Bool -> [Char]) -> Bool -> [Char]
combineModeChars (Bool
q,Char
m,c
_) Bool -> [Char]
rest Bool
p
| Bool
p Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
q = Char
m Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> [Char]
rest Bool
p
| Bool
q = Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
m Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> [Char]
rest Bool
True
| Bool
otherwise = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
m Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> [Char]
rest Bool
False