    {-# 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 = Module (Map Key [Key])
    forall st. Module st
    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 = \String
    s -> [String] -> Cmd Quote ()
    fortune ([String] -> Cmd Quote ()) -> [String] -> Cmd Quote ()
    forall a b. (a -> b) -> a -> b
    $ if String
    "pondering" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    s
                    then [String
    "pinky-pondering"]
                    else [String
    "pinky-pondering", String
    "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 >>= \String
    v -> case String
    v of
                    String
    "v" -> String -> Cmd Quote ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "let v = show v in v"
                    String
    _   -> String -> Cmd Quote ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "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 :: [String] -> Cmd Quote ()
    fortune [String]
    xs = IO String -> Cmd Quote String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (FortuneType -> [String] -> IO [String]
    resolveFortuneFiles FortuneType
    All [String]
    xs IO [String] -> ([String] -> IO String) -> IO String
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [String] -> IO String
    randomFortune) Cmd Quote String -> (String -> Cmd Quote ()) -> Cmd Quote ()
    forall a b. Cmd Quote a -> (a -> Cmd Quote b) -> Cmd Quote b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Cmd Quote ()
    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
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest = String -> Cmd Quote ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Incorrect arguments to quote"
        | Bool
    otherwise = do
            (LBState (Cmd Quote)
     -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote ())
    -> Cmd Quote ()
    forall a.
    (LBState (Cmd Quote)
     -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote a)
    -> Cmd Quote a
    forall (m :: * -> *) a.
    MonadLBState m =>
    (LBState m -> (LBState m -> m ()) -> m a) -> m a
    withMS ((LBState (Cmd Quote)
      -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote ())
     -> Cmd Quote ())
    -> (LBState (Cmd Quote)
        -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote ())
    -> Cmd Quote ()
    forall a b. (a -> b) -> a -> b
    $ \LBState (Cmd Quote)
    fm LBState (Cmd Quote) -> Cmd Quote ()
    writer -> do
                let ss :: [Key]
    ss  = [Key] -> Maybe [Key] -> [Key]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Key -> Map Key [Key] -> Maybe [Key]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (String -> Key
    P.pack String
    nm) Map Key [Key]
    LBState (Cmd Quote)
    fm)
                    fm' :: Map Key [Key]
    fm' = Key -> [Key] -> Map Key [Key] -> Map Key [Key]
    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 Key -> [Key] -> [Key]
    forall a. a -> [a] -> [a]
    : [Key]
    ss) Map Key [Key]
    LBState (Cmd Quote)
    fm
                LBState (Cmd Quote) -> Cmd Quote ()
    writer Map Key [Key]
    LBState (Cmd Quote)
    fm'
            String -> Cmd Quote ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say (String -> Cmd Quote ()) -> Cmd Quote String -> Cmd Quote ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Cmd Quote String
    forall (m :: * -> *). MonadIO m => m String
    randomSuccessMsg
        where
            (String
    nm,String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace String
    str
            q :: String
    q         = Int -> String -> String
    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
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest = String -> Cmd Quote ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Incorrect arguments to quote"
        | Bool
    otherwise = do
            ss <- (LBState (Cmd Quote)
     -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote [Key])
    -> Cmd Quote [Key]
    forall a.
    (LBState (Cmd Quote)
     -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote a)
    -> Cmd Quote a
    forall (m :: * -> *) a.
    MonadLBState m =>
    (LBState m -> (LBState m -> m ()) -> m a) -> m a
    withMS ((LBState (Cmd Quote)
      -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote [Key])
     -> Cmd Quote [Key])
    -> (LBState (Cmd Quote)
        -> (LBState (Cmd Quote) -> Cmd Quote ()) -> Cmd Quote [Key])
    -> Cmd Quote [Key]
    forall a b. (a -> b) -> a -> b
    $ \LBState (Cmd Quote)
    fm LBState (Cmd Quote) -> Cmd Quote ()
    writer -> do
                let ss :: [Key]
    ss  = [Key] -> Maybe [Key] -> [Key]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Key -> Map Key [Key] -> Maybe [Key]
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (String -> Key
    P.pack String
    nm) Map Key [Key]
    LBState (Cmd Quote)
    fm)
                    fm' :: Map Key [Key]
    fm' = case Key -> [Key] -> [Key]
    forall a. Eq a => a -> [a] -> [a]
    delete (String -> Key
    P.pack String
    q) [Key]
    ss of
                        []  -> Key -> Map Key [Key] -> Map Key [Key]
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete (String -> Key
    P.pack String
    nm)     Map Key [Key]
    LBState (Cmd Quote)
    fm
                        [Key]
    ss' -> Key -> [Key] -> Map Key [Key] -> Map Key [Key]
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert (String -> Key
    P.pack String
    nm) [Key]
    ss' Map Key [Key]
    LBState (Cmd Quote)
    fm
                LBState (Cmd Quote) -> Cmd Quote ()
    writer Map Key [Key]
    LBState (Cmd Quote)
    fm'
                [Key] -> Cmd Quote [Key]
    forall a. a -> Cmd Quote a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Key]
    ss
            say $ if P.pack q `elem` ss
                then "Done."
                else "No match."
        where
            (String
    nm,String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace String
    str
            q :: String
    q         = Int -> String -> String
    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 =
        String -> Cmd Quote ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say (String -> Cmd Quote ()) -> Cmd Quote String -> Cmd Quote ()
    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) (Map Key [Key] -> Cmd Quote String)
    -> Cmd Quote (Map Key [Key]) -> Cmd Quote String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Cmd Quote (Map Key [Key])
    Cmd Quote (LBState (Cmd Quote))
    forall (m :: * -> *). MonadLBState m => m (LBState m)
    readMS
      where (String
    nm, String
    p) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace String
    str
            pat :: String
    pat     = Int -> String -> String
    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
        | Map Key [Key] -> Bool
    forall k a. Map k a -> Bool
    M.null Map Key [Key]
    db          = String -> Cmd Quote String
    forall a. a -> Cmd Quote a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "No quotes yet."

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

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

        | Key -> Bool
    P.null Key
    pat         = Key -> [(Key, Key)] -> Cmd Quote String
    forall source.
    RegexMaker Regex CompOption ExecOption source =>
    source -> [(Key, Key)] -> Cmd Quote String
    match' Key
    key [(Key, Key)]
    allquotes

        | Just [Key]
    qs <- Maybe [Key]
    mquotes = Key -> [(Key, Key)] -> Cmd Quote String
    forall source.
    RegexMaker Regex CompOption ExecOption source =>
    source -> [(Key, Key)] -> Cmd Quote String
    match' Key
    pat ([Key] -> [Key] -> [(Key, Key)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Key -> [Key]
    forall a. a -> [a]
    repeat Key
    key) [Key]
    qs)

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

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

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

            let rs = ((Key, Key) -> Bool) -> [(Key, Key)] -> [(Key, Key)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Regex -> Key -> Bool
    forall regex source target.
    RegexContext regex source target =>
    regex -> source -> target
    match Regex
    re (Key -> Bool) -> ((Key, Key) -> Key) -> (Key, Key) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Key, Key) -> Key
    forall a b. (a, b) -> b
    snd) [(Key, Key)]
    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 :: Key -> Key -> String
    display Key
    k Key
    msg = (if Key -> Bool
    P.null Key
    k then String
    "  " else String
    who String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " says: ") String -> String -> String
    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