--
-- | Nickname equality subsystem.
--
-- This component is responsible for deciding whether two nicknames
-- refer to the same person, for the purposes of @tell et al.  Nickname
-- equality must be monadic because it uses mutable state maintained
-- by the @link and @unlink commands.
--
-- Also provided is a concept of polynicks (by analogy to polytypes);
-- polynicks can refer to an (open) set of nicknames.  For instance '@tell
-- *lambdabot Why does X do Y' could tell a message to anyone who has
-- identified as a lambdabot maintainer.  A polynick consists of a
-- bar-separated list of (nicks or open terms); an open term is like a
-- nick but preceded with a star.

module Lambdabot.Util.NickEq
    ( Polynick
    , nickMatches
    , readPolynick
    , showPolynick
    
    , lookupMononickMap
    , mononickToPolynick
    ) where

import Lambdabot.Message
import Lambdabot.Monad
import Lambdabot.Nick

import Data.List (intercalate)
import Data.List.Split (splitOn)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)

data Polynick = Polynick [Nick] deriving (Polynick -> Polynick -> Bool
(Polynick -> Polynick -> Bool)
-> (Polynick -> Polynick -> Bool) -> Eq Polynick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Polynick -> Polynick -> Bool
$c/= :: Polynick -> Polynick -> Bool
== :: Polynick -> Polynick -> Bool
$c== :: Polynick -> Polynick -> Bool
Eq) -- for now

-- |Determine if a nick matches a polynick.  The state is read at the
-- point of binding.
nickMatches :: LB (Nick -> Polynick -> Bool)
nickMatches :: LB (Nick -> Polynick -> Bool)
nickMatches = (Nick -> Polynick -> Bool) -> LB (Nick -> Polynick -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Nick -> Polynick -> Bool
m'
    where
      m' :: Nick -> Polynick -> Bool
m' Nick
nck (Polynick [Nick]
nck2) = Nick
nck Nick -> [Nick] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Nick]
nck2

-- | Parse a read polynick.
readPolynick :: Message a => a -> String -> Polynick
readPolynick :: a -> String -> Polynick
readPolynick a
m = [Nick] -> Polynick
Polynick ([Nick] -> Polynick) -> (String -> [Nick]) -> String -> Polynick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Nick) -> [String] -> [Nick]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Nick
parseNick (a -> String
forall a. Message a => a -> String
server a
m)) ([String] -> [Nick]) -> (String -> [String]) -> String -> [Nick]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"|"

-- | Format a polynick.
showPolynick :: Message a => a -> Polynick -> String
showPolynick :: a -> Polynick -> String
showPolynick a
m (Polynick [Nick]
n) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Nick -> String) -> [Nick] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Nick -> String
fmtNick (a -> String
forall a. Message a => a -> String
server a
m)) [Nick]
n

-- | Convert a regular mononick into a polynick.
mononickToPolynick :: Nick -> Polynick
mononickToPolynick :: Nick -> Polynick
mononickToPolynick = [Nick] -> Polynick
Polynick ([Nick] -> Polynick) -> (Nick -> [Nick]) -> Nick -> Polynick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Nick -> [Nick] -> [Nick]
forall a. a -> [a] -> [a]
:[])

-- | Lookup (using a polynick) in a map keyed on mononicks.
lookupMononickMap :: LB (Polynick -> M.Map Nick a -> [(Nick,a)])
lookupMononickMap :: LB (Polynick -> Map Nick a -> [(Nick, a)])
lookupMononickMap = (Polynick -> Map Nick a -> [(Nick, a)])
-> LB (Polynick -> Map Nick a -> [(Nick, a)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Polynick -> Map Nick a -> [(Nick, a)])
 -> LB (Polynick -> Map Nick a -> [(Nick, a)]))
-> (Polynick -> Map Nick a -> [(Nick, a)])
-> LB (Polynick -> Map Nick a -> [(Nick, a)])
forall a b. (a -> b) -> a -> b
$ Polynick -> Map Nick a -> [(Nick, a)]
forall b. Polynick -> Map Nick b -> [(Nick, b)]
look'
    where look' :: Polynick -> Map Nick b -> [(Nick, b)]
look' (Polynick [Nick]
ns) Map Nick b
m = (Nick -> Maybe (Nick, b)) -> [Nick] -> [(Nick, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Nick
n -> (,) Nick
n (b -> (Nick, b)) -> Maybe b -> Maybe (Nick, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Nick -> Map Nick b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Nick
n Map Nick b
m) [Nick]
ns