content: -- | 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
  