-- | Talk to hot chixxors.

-- (c) Mark Wotton
-- Serialisation (c) 2007 Don Stewart

module Lambdabot.Plugin.Novelty.Vixen (vixenPlugin) where

import Lambdabot.Plugin
import Lambdabot.Util

import Control.Arrow ((***))
import Control.Monad
import Data.Binary
import qualified Data.ByteString.Char8 as P
import qualified Data.ByteString.Lazy as L
import System.Directory
import Text.Regex.TDFA

vixenPlugin :: Module (Bool, String -> IO [Char])
vixenPlugin = newModule
    { moduleCmds = return
        [ (command "vixen")
            { help = say "vixen <phrase>. Sergeant Curry's lonely hearts club"
            , process = \txt -> say =<< io . ($ txt) . snd =<< readMS
            }
        , (command "vixen-on")
            { privileged = True
            , help = do
                me <- showNick =<< getLambdabotName
                say ("vixen-on: turn " ++ me ++ " into a chatterbot")
            , process = const $ do
                modifyMS $ \(_,r) -> (True, r)
                say "What's this channel about?"
            }
        , (command "vixen-off")
            { privileged = True
            , help = do
                me <- showNick =<< getLambdabotName
                say ("vixen-off: shut " ++ me ++ "up")
            , process = const $ do
                modifyMS $ \(_,r) -> (False, r)
                say "Bye!"
            }
        ]

    -- if vixen-chat is on, we can just respond to anything
    , contextual = \txt -> do
        (alive, k) <- readMS
        if alive then io (k txt) >>= say
                 else return ()

    , moduleDefState = return (False, const (return "<undefined>"))

    -- suck in our (read only) regex state from disk
    -- compile it, and stick it in the plugin state
    , moduleSerialize = Just $ readOnly $ \bs ->
         let st = decode (L.fromStrict bs)
             compiled = map (makeRegex *** id) (st :: [(String, WTree)])
         in  (False, vixen (mkResponses compiled))
    }

------------------------------------------------------------------------

vixen :: (String -> WTree) -> String -> IO String
vixen k key = P.unpack `fmap` randomW (k key)

randomW :: WTree -> IO P.ByteString
randomW (Leaf a)  = return a
randomW (Node ls) = random ls >>= randomW

mkResponses :: RChoice -> String -> WTree
mkResponses choices them = (\((_,wtree):_) -> wtree) $
    filter (\(reg,_) -> match reg them) choices

------------------------------------------------------------------------
-- serialisation for the vixen state
--
-- The tree of regexes and responses is written in binary form to
-- State/vixen, and we suck it in on module init, then lazily regexify it all

data WTree = Leaf !P.ByteString | Node ![WTree]
             deriving Show

instance Binary WTree where
    put (Leaf s)  = putWord8 0 >> put s
    put (Node ls) = putWord8 1 >> put ls
    get = do
        tag <- getWord8
        case tag of
            0 -> liftM Leaf get
            1 -> liftM Node get
            _ -> error "Vixen plugin error: unknown tag"

type RChoice = [(Regex, WTree)] -- compiled choices