content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE PatternGuards #-}
  {-# LANGUAGE FlexibleContexts #-}
  -- | Support for quotes
  module Lambdabot.Plugin.Novelty.Quote (quotePlugin) where
  
  import Lambdabot.Plugin
  import Lambdabot.Util
  
  import qualified Data.ByteString.Char8 as P
  import Data.Char
  import Data.Fortune
  import Data.List
  import qualified Data.Map as M
  import Data.Maybe
  import Text.Regex.TDFA
  
  type Key    = P.ByteString
  type Quotes = M.Map Key [P.ByteString]
  type Quote  = ModuleT Quotes LB
  
  quotePlugin :: Module (M.Map P.ByteString [P.ByteString])
  quotePlugin = newModule
      { moduleSerialize = Just mapListPackedSerial
      , moduleDefState  = return M.empty
      , moduleInit      = modifyMS (M.filter (not . null))
  
      , moduleCmds = return
          [ (command "quote")
              { help = say "quote <nick>: Quote <nick> or a random person if no nick is given"
              , process = runQuote . strip isSpace
              }
          , (command "remember")
              { help = say "remember <nick> <quote>: Remember that <nick> said <quote>."
              , process = runRemember . strip isSpace
              }
          , (command "forget")
              { help = say "forget nick quote.  Delete a quote"
              , process = runForget . strip isSpace
              }
          , (command "ghc")
              { help = say "ghc. Choice quotes from GHC."
              , process = const (fortune ["ghc"])
              }
          , (command "fortune")
              { help = say "fortune. Provide a random fortune"
              , process = const (fortune [])
              }
          , (command "yow")
              { help = say "yow. The zippy man."
              , process = const (fortune ["zippy"])
              }
          , (command "arr")
              { help = say "arr. Talk to a pirate"
              , process = const (fortune ["arr"])
              }
          , (command "yarr")
              { help = say "yarr. Talk to a scurvy pirate"
              , process = const (fortune ["arr", "yarr"])
              }
          , (command "keal")
              { help = say "keal. Talk like Keal"
              , process = const (fortune ["keal"])
              }
          , (command "b52s")
              { help = say "b52s. Anyone noticed the b52s sound a lot like zippy?"
              , process = const (fortune ["b52s"])
              }
          , (command "pinky")
              { help = say "pinky. Pinky and the Brain"
              , process = \s -> fortune $ if "pondering" `isInfixOf` s
                  then ["pinky-pondering"]
                  else ["pinky-pondering", "pinky"]
              }
          , (command "brain")
              { help = say "brain. Pinky and the Brain"
              , process = const (fortune ["brain"])
              }
          , (command "palomer")
              { help = say "palomer. Sound a bit like palomer on a good day."
              , process = const (fortune ["palomer"])
              }
          , (command "girl19")
              { help = say "girl19 wonders what \"discriminating hackers\" are."
              , process = const (fortune ["girl19"])
              }
          , (command "v")
              { aliases = ["yhjulwwiefzojcbxybbruweejw"]
              , help = getCmdName >>= \v -> case v of
                  "v" -> say "let v = show v in v"
                  _   -> say "V RETURNS!"
              , process = const (fortune ["notoriousV"])
              }
          , (command "protontorpedo")
              { help = say "protontorpedo is silly"
              , process = const (fortune ["protontorpedo"])
              }
          , (command "nixon")
              { help = say "Richard Nixon's finest."
              , process = const (fortune ["nixon"])
              }
          , (command "farber")
              { help = say "Farberisms in the style of David Farber."
              , process = const (fortune ["farber"])
              }
          ]
      }
  
  fortune :: [FilePath] -> Cmd Quote ()
  fortune xs = io (resolveFortuneFiles All xs >>= randomFortune) >>= say
  
  ------------------------------------------------------------------------
  
  -- the @remember command stores away a quotation by a user, for future
  -- use by @quote
  
  -- error handling!
  runRemember :: String -> Cmd Quote ()
  runRemember str
      | null rest = say "Incorrect arguments to quote"
      | otherwise = do
          withMS $ \fm writer -> do
              let ss  = fromMaybe [] (M.lookup (P.pack nm) fm)
                  fm' = M.insert (P.pack nm) (P.pack q : ss) fm
              writer fm'
          say =<< randomSuccessMsg
      where
          (nm,rest) = break isSpace str
          q         = drop 1 rest
  
  -- @forget, to remove a quote
  runForget :: String -> Cmd Quote ()
  runForget str
      | null rest = say "Incorrect arguments to quote"
      | otherwise = do
          ss <- withMS $ \fm writer -> do
              let ss  = fromMaybe [] (M.lookup (P.pack nm) fm)
                  fm' = case delete (P.pack q) ss of
                      []  -> M.delete (P.pack nm)     fm
                      ss' -> M.insert (P.pack nm) ss' fm
              writer fm'
              return ss
          say $ if P.pack q `elem` ss
              then "Done."
              else "No match."
      where
          (nm,rest) = break isSpace str
          q         = drop 1 rest
  
  --
  --  the @quote command, takes a user nm to choose a random quote from
  --
  runQuote :: String -> Cmd Quote ()
  runQuote str =
      say =<< search (P.pack nm) (P.pack pat) =<< readMS
    where (nm, p) = break isSpace str
          pat     = drop 1 p
  
  search :: Key -> P.ByteString -> Quotes -> Cmd Quote String
  search key pat db
      | M.null db          = return "No quotes yet."
  
      | P.null key         = do
          (key', qs) <- random (M.toList db) -- quote a random person
          fmap (display key') (random qs)
  
      | P.null pat, Just qs <- mquotes =
          fmap (display key) (random qs)
  
      | P.null pat         = match' key allquotes
  
      | Just qs <- mquotes = match' pat (zip (repeat key) qs)
  
      | otherwise          = do
          r <- randomFailureMsg
          return $ "No quotes for this person. " ++ r
  
    where
      mquotes   = M.lookup key db
      allquotes = concat [ zip (repeat who) qs | (who, qs) <- M.assocs db ]
  
      match' :: RegexMaker Regex CompOption ExecOption source => source -> [(P.ByteString, P.ByteString)] -> Cmd Quote String
      match' p ss = do
          re <- makeRegexOptsM defaultCompOpt {caseSensitive = False, newSyntax = True}
                               defaultExecOpt {captureGroups = False} p
  
          let rs = filter (match re . snd) ss
          if null rs
              then do r <- randomFailureMsg
                      return $ "No quotes match. " ++ r
              else do (who, saying) <- random rs
                      return $ P.unpack who ++ " says: " ++ P.unpack saying
  
      display k msg = (if P.null k then "  " else who ++ " says: ") ++ saying
            where saying = P.unpack msg
                  who    = P.unpack k
  