{-# LANGUAGE ConstraintKinds, RankNTypes, FlexibleContexts, IncoherentInstances #-}
module Network.Anticiv.Modules.Base (initBase,listBase) where

import Control.Monad
import Data.Char
import Data.Chatty.Atoms
import Data.Chatty.AVL
import Data.Chatty.Hetero
import Network.Anticiv.Convenience
import Network.Anticiv.Masks
import Network.Anticiv.Monad
import Text.Printf

initBase :: Packciv (Packciv [String])
initBase = do
  regPriorityChanmsg $ msg False addressfl
  regPriorityQuerymsg $ msg True privatefl
  return listBase

listBase :: Packciv [String]
listBase = return ["hello", "about", "echo", "translate","reauth"]

msg :: Bool -> Speaker -> HandlerA -> UserA -> String -> Anticiv Bool
msg p speak _ u s = do
  pref <- bprefix
  s & pref :-: LocalT u "hello" :-: ChannelUser #-> (\t -> speak t "Hello" . userNick =<< getAtom t)
   .|| pref :-: LocalT u "about" :-: ChannelUser #-> (getAtom >=> \t -> speak u "About" (userNick t) (show t))
   .|| pref :-: LocalT u "echo" :-: Remaining #-> (\t -> speak u "Id" $ dropWhile isSpace t)
   .|| pref :-: LocalT u "translate" :-: Remaining #-> translate p speak u
   .|| pref :-: LocalT u "reauth" :-: CatchInt :-: CatchInt :-: Remaining #-> \(ai,t,_) -> reauth speak u (Atom ai) t

translate :: Bool -> Speaker -> UserA -> String -> Anticiv ()
translate False speak u li = do
  bmodify $ \b -> b{botLingua=dropWhile isSpace li}
  globalfl "Speaks"
translate True speak u li = do
  bmodify $ \b -> b{linguaOverride=avlInsert (u,dropWhile isSpace li) $ linguaOverride b}
  speak u "Speaks"

reauth :: Speaker -> UserA -> UserA -> Int -> Anticiv ()
reauth speak u ai t = do
  cus <- bgets channelUsers
  case ai `elem` cus of
    False -> speak u "ReauthFail"
    _ -> do
      u' <- getAtom u
      i' <- getAtom ai
      if reauthId i' /= t
         then speak u "ReauthFail"
         else do
           putAtom u i'{reauthId = reauthId u'}
           putAtom ai u'{reauthId = reauthId i'}
           speak ai "Reauthed"