{-# 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' 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