{-# 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 :: Module (Map Key [Key])
quotePlugin = forall st. Module st
newModule
    { moduleSerialize :: Maybe (Serial (Map Key [Key]))
moduleSerialize = forall a. a -> Maybe a
Just Serial (Map Key [Key])
mapListPackedSerial
    , moduleDefState :: LB (Map Key [Key])
moduleDefState  = forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
M.empty
    , moduleInit :: ModuleT (Map Key [Key]) LB ()
moduleInit      = forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS (forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null))

    , moduleCmds :: ModuleT (Map Key [Key]) LB [Command Quote]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"quote")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"quote <nick>: Quote <nick> or a random person if no nick is given"
            , process :: String -> Cmd Quote ()
process = String -> Cmd Quote ()
runQuote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace
            }
        , (String -> Command Identity
command String
"remember")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"remember <nick> <quote>: Remember that <nick> said <quote>."
            , process :: String -> Cmd Quote ()
process = String -> Cmd Quote ()
runRemember forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace
            }
        , (String -> Command Identity
command String
"forget")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"forget nick quote.  Delete a quote"
            , process :: String -> Cmd Quote ()
process = String -> Cmd Quote ()
runForget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
strip Char -> Bool
isSpace
            }
        , (String -> Command Identity
command String
"ghc")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"ghc. Choice quotes from GHC."
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"ghc"])
            }
        , (String -> Command Identity
command String
"fortune")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"fortune. Provide a random fortune"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [])
            }
        , (String -> Command Identity
command String
"yow")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"yow. The zippy man."
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"zippy"])
            }
        , (String -> Command Identity
command String
"arr")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"arr. Talk to a pirate"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"arr"])
            }
        , (String -> Command Identity
command String
"yarr")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"yarr. Talk to a scurvy pirate"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"arr", String
"yarr"])
            }
        , (String -> Command Identity
command String
"keal")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"keal. Talk like Keal"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"keal"])
            }
        , (String -> Command Identity
command String
"b52s")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"b52s. Anyone noticed the b52s sound a lot like zippy?"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"b52s"])
            }
        , (String -> Command Identity
command String
"pinky")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"pinky. Pinky and the Brain"
            , process :: String -> Cmd Quote ()
process = \String
s -> [String] -> Cmd Quote ()
fortune forall a b. (a -> b) -> a -> b
$ if String
"pondering" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s
                then [String
"pinky-pondering"]
                else [String
"pinky-pondering", String
"pinky"]
            }
        , (String -> Command Identity
command String
"brain")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"brain. Pinky and the Brain"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"brain"])
            }
        , (String -> Command Identity
command String
"palomer")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"palomer. Sound a bit like palomer on a good day."
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"palomer"])
            }
        , (String -> Command Identity
command String
"girl19")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"girl19 wonders what \"discriminating hackers\" are."
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"girl19"])
            }
        , (String -> Command Identity
command String
"v")
            { aliases :: [String]
aliases = [String
"yhjulwwiefzojcbxybbruweejw"]
            , help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => Cmd m String
getCmdName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
v -> case String
v of
                String
"v" -> forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"let v = show v in v"
                String
_   -> forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"V RETURNS!"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"notoriousV"])
            }
        , (String -> Command Identity
command String
"protontorpedo")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"protontorpedo is silly"
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"protontorpedo"])
            }
        , (String -> Command Identity
command String
"nixon")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Richard Nixon's finest."
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"nixon"])
            }
        , (String -> Command Identity
command String
"farber")
            { help :: Cmd Quote ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Farberisms in the style of David Farber."
            , process :: String -> Cmd Quote ()
process = forall a b. a -> b -> a
const ([String] -> Cmd Quote ()
fortune [String
"farber"])
            }
        ]
    }

fortune :: [FilePath] -> Cmd Quote ()
fortune :: [String] -> Cmd Quote ()
fortune [String]
xs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (FortuneType -> [String] -> IO [String]
resolveFortuneFiles FortuneType
All [String]
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO String
randomFortune) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => String -> Cmd m ()
say

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

-- the @remember command stores away a quotation by a user, for future
-- use by @quote

-- error handling!
runRemember :: String -> Cmd Quote ()
runRemember :: String -> Cmd Quote ()
runRemember String
str
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Incorrect arguments to quote"
    | Bool
otherwise = do
        forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Quote)
fm LBState (Cmd Quote) -> Cmd Quote ()
writer -> do
            let ss :: [Key]
ss  = forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> Key
P.pack String
nm) LBState (Cmd Quote)
fm)
                fm' :: Map Key [Key]
fm' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> Key
P.pack String
nm) (String -> Key
P.pack String
q forall a. a -> [a] -> [a]
: [Key]
ss) LBState (Cmd Quote)
fm
            LBState (Cmd Quote) -> Cmd Quote ()
writer Map Key [Key]
fm'
        forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m String
randomSuccessMsg
    where
        (String
nm,String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
str
        q :: String
q         = forall a. Int -> [a] -> [a]
drop Int
1 String
rest

-- @forget, to remove a quote
runForget :: String -> Cmd Quote ()
runForget :: String -> Cmd Quote ()
runForget String
str
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Incorrect arguments to quote"
    | Bool
otherwise = do
        [Key]
ss <- forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd Quote)
fm LBState (Cmd Quote) -> Cmd Quote ()
writer -> do
            let ss :: [Key]
ss  = forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> Key
P.pack String
nm) LBState (Cmd Quote)
fm)
                fm' :: Map Key [Key]
fm' = case forall a. Eq a => a -> [a] -> [a]
delete (String -> Key
P.pack String
q) [Key]
ss of
                    []  -> forall k a. Ord k => k -> Map k a -> Map k a
M.delete (String -> Key
P.pack String
nm)     LBState (Cmd Quote)
fm
                    [Key]
ss' -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> Key
P.pack String
nm) [Key]
ss' LBState (Cmd Quote)
fm
            LBState (Cmd Quote) -> Cmd Quote ()
writer Map Key [Key]
fm'
            forall (m :: * -> *) a. Monad m => a -> m a
return [Key]
ss
        forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall a b. (a -> b) -> a -> b
$ if String -> Key
P.pack String
q forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
ss
            then String
"Done."
            else String
"No match."
    where
        (String
nm,String
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
str
        q :: String
q         = forall a. Int -> [a] -> [a]
drop Int
1 String
rest

--
--  the @quote command, takes a user nm to choose a random quote from
--
runQuote :: String -> Cmd Quote ()
runQuote :: String -> Cmd Quote ()
runQuote String
str =
    forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Key -> Key -> Map Key [Key] -> Cmd Quote String
search (String -> Key
P.pack String
nm) (String -> Key
P.pack String
pat) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
  where (String
nm, String
p) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
str
        pat :: String
pat     = forall a. Int -> [a] -> [a]
drop Int
1 String
p

search :: Key -> P.ByteString -> Quotes -> Cmd Quote String
search :: Key -> Key -> Map Key [Key] -> Cmd Quote String
search Key
key Key
pat Map Key [Key]
db
    | forall k a. Map k a -> Bool
M.null Map Key [Key]
db          = forall (m :: * -> *) a. Monad m => a -> m a
return String
"No quotes yet."

    | Key -> Bool
P.null Key
key         = do
        (Key
key', [Key]
qs) <- forall (m :: * -> *) a. MonadIO m => [a] -> m a
random (forall k a. Map k a -> [(k, a)]
M.toList Map Key [Key]
db) -- quote a random person
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key -> Key -> String
display Key
key') (forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [Key]
qs)

    | Key -> Bool
P.null Key
pat, Just [Key]
qs <- Maybe [Key]
mquotes =
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key -> Key -> String
display Key
key) (forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [Key]
qs)

    | Key -> Bool
P.null Key
pat         = forall {m :: * -> *} {source}.
(RegexMaker Regex CompOption ExecOption source, MonadFail m,
 MonadIO m, MonadConfig m) =>
source -> [(Key, Key)] -> m String
match' Key
key [(Key, Key)]
allquotes

    | Just [Key]
qs <- Maybe [Key]
mquotes = forall {m :: * -> *} {source}.
(RegexMaker Regex CompOption ExecOption source, MonadFail m,
 MonadIO m, MonadConfig m) =>
source -> [(Key, Key)] -> m String
match' Key
pat (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Key
key) [Key]
qs)

    | Bool
otherwise          = do
        String
r <- forall (m :: * -> *). (MonadIO m, MonadConfig m) => m String
randomFailureMsg
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No quotes for this person. " forall a. [a] -> [a] -> [a]
++ String
r

  where
    mquotes :: Maybe [Key]
mquotes   = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Key
key Map Key [Key]
db
    allquotes :: [(Key, Key)]
allquotes = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat Key
who) [Key]
qs | (Key
who, [Key]
qs) <- forall k a. Map k a -> [(k, a)]
M.assocs Map Key [Key]
db ]

    match' :: source -> [(Key, Key)] -> m String
match' source
p [(Key, Key)]
ss = do
        Regex
re <- forall regex compOpt execOpt source (m :: * -> *).
(RegexMaker regex compOpt execOpt source, MonadFail m) =>
compOpt -> execOpt -> source -> m regex
makeRegexOptsM forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt {caseSensitive :: Bool
caseSensitive = Bool
False, newSyntax :: Bool
newSyntax = Bool
True}
                             forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt {captureGroups :: Bool
captureGroups = Bool
False} source
p

        let rs :: [(Key, Key)]
rs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
re forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Key, Key)]
ss
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Key, Key)]
rs
            then do String
r <- forall (m :: * -> *). (MonadIO m, MonadConfig m) => m String
randomFailureMsg
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"No quotes match. " forall a. [a] -> [a] -> [a]
++ String
r
            else do (Key
who, Key
saying) <- forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [(Key, Key)]
rs
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Key -> String
P.unpack Key
who forall a. [a] -> [a] -> [a]
++ String
" says: " forall a. [a] -> [a] -> [a]
++ Key -> String
P.unpack Key
saying

    display :: Key -> Key -> String
display Key
k Key
msg = (if Key -> Bool
P.null Key
k then String
"  " else String
who forall a. [a] -> [a] -> [a]
++ String
" says: ") forall a. [a] -> [a] -> [a]
++ String
saying
          where saying :: String
saying = Key -> String
P.unpack Key
msg
                who :: String
who    = Key -> String
P.unpack Key
k