    {-# Language BangPatterns #-}

    {-|
    Module      : Irc.Modes
    Description : Operations for interpreting mode changes
    Copyright   : (c) Eric Mertens, 2016
    License     : ISC
    Maintainer  : emertens@gmail.com

    This module provides support for interpreting the modes changed by
    a MODE command.

    -}
    module Irc.Modes
      (
      -- * Interpretation of modes
        ModeTypes(..)
      , modesLists
      , modesAlwaysArg
      , modesSetArg
      , modesNeverArg
      , modesPrefixModes
      , defaultModeTypes
      , defaultUmodeTypes

      -- * Operations for working with MODE command parameters
      , splitModes
      , unsplitModes
      ) where

    import           Data.Text (Text)
    import qualified Data.Text as Text
    import           View

    -- | Settings that describe how to interpret channel modes
    data ModeTypes = ModeTypes
      { ModeTypes -> [Char]
    _modesLists       :: [Char] -- ^ modes for channel lists (e.g. ban)
      , ModeTypes -> [Char]
    _modesAlwaysArg   :: [Char] -- ^ modes that always have an argument
      , ModeTypes -> [Char]
    _modesSetArg      :: [Char] -- ^ modes that have an argument when set
      , ModeTypes -> [Char]
    _modesNeverArg    :: [Char] -- ^ modes that never have arguments
      , ModeTypes -> [(Char, Char)]
    _modesPrefixModes :: [(Char,Char)] -- ^ modes requiring a nickname argument (mode,sigil)
      }
      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
    $cshowsPrec :: Int -> ModeTypes -> ShowS
    showsPrec :: Int -> ModeTypes -> ShowS
    $cshow :: ModeTypes -> [Char]
    show :: ModeTypes -> [Char]
    $cshowList :: [ModeTypes] -> ShowS
    showList :: [ModeTypes] -> ShowS
    Show

    -- | Lens for '_modesList'
    modesLists :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesLists :: forall (f :: * -> *).
    Functor f =>
    ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesLists [Char] -> f [Char]
    f ModeTypes
    m = (\[Char]
    x -> ModeTypes
    m { _modesLists = 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)

    -- | Lens for '_modesAlwaysArg'
    modesAlwaysArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesAlwaysArg :: forall (f :: * -> *).
    Functor f =>
    ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesAlwaysArg [Char] -> f [Char]
    f ModeTypes
    m = (\[Char]
    x -> ModeTypes
    m { _modesAlwaysArg = 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)

    -- | Lens for '_modesSetArg'
    modesSetArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesSetArg :: forall (f :: * -> *).
    Functor f =>
    ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesSetArg [Char] -> f [Char]
    f ModeTypes
    m = (\[Char]
    x -> ModeTypes
    m { _modesSetArg = 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)

    -- | Lens for '_modesNeverArg'
    modesNeverArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesNeverArg :: forall (f :: * -> *).
    Functor f =>
    ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
    modesNeverArg [Char] -> f [Char]
    f ModeTypes
    m = (\[Char]
    x -> ModeTypes
    m { _modesNeverArg = 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)

    -- | Lens for '_modesPrefixModes'
    modesPrefixModes :: Functor f => ([(Char,Char)] -> f [(Char,Char)]) -> ModeTypes -> f ModeTypes
    modesPrefixModes :: forall (f :: * -> *).
    Functor f =>
    ([(Char, Char)] -> f [(Char, Char)]) -> ModeTypes -> f ModeTypes
    modesPrefixModes [(Char, Char)] -> f [(Char, Char)]
    f ModeTypes
    m = (\[(Char, Char)]
    x -> ModeTypes
    m { _modesPrefixModes = 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)

    -- | The channel modes used by Solanum
    defaultModeTypes :: ModeTypes
    defaultModeTypes :: ModeTypes
    defaultModeTypes = 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
    '+')]
      }

    -- | The default UMODE used by Solanum
    defaultUmodeTypes :: ModeTypes
    defaultUmodeTypes :: ModeTypes
    defaultUmodeTypes = ModeTypes
      { _modesLists :: [Char]
    _modesLists     = [Char]
    ""
      , _modesAlwaysArg :: [Char]
    _modesAlwaysArg = [Char]
    ""
      , _modesSetArg :: [Char]
    _modesSetArg    = [Char]
    "s"
      , _modesNeverArg :: [Char]
    _modesNeverArg  = [Char]
    "DQRZgiow"
      , _modesPrefixModes :: [(Char, Char)]
    _modesPrefixModes = []
      }

    -- | Split up a mode change command and arguments into individual changes
    -- given a configuration.
    splitModes ::
      ModeTypes {- ^ mode interpretation -} ->
      Text      {- ^ modes               -} ->
      [Text]    {- ^ arguments           -} ->
      Maybe [(Bool,Char,Text)] {- ^ (set, mode, parameter) -}
    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   {- current polarity -} ->
        [Char] {- remaining modes -} ->
        [Text] {- remaining arguments -} ->
        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 a. [a] -> 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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 res <- Bool -> [Char] -> [Text] -> Maybe [(Bool, Char, Text)]
    computeMode Bool
    polarity [Char]
    ms [Text]
    args
                  return ((polarity,m,Text.empty) : res)

            | Bool
    otherwise -> Maybe [(Bool, Char, Text)]
    forall a. Maybe a
    Nothing

    -- | Construct the arguments to a MODE command corresponding to the given
    -- mode changes.
    unsplitModes ::
      [(Bool,Char,Text)] {- ^ (set,mode,parameter) -} ->
      [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 a b. (a -> b -> b) -> b -> [a] -> b
    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