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

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

fortune :: [FilePath] -> Cmd Quote ()
fortune :: [String] -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
fortune [String]
xs = IO String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO String
randomFortune) Cmd (ModuleT (Map ByteString [ByteString]) LB) String
-> (String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
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 (ModuleT (Map ByteString [ByteString]) LB) ()
runRemember String
str
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Incorrect arguments to quote"
    | Bool
otherwise = do
        (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
 -> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
     -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
 -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
  -> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
      -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
  -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
 -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
-> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
    -> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
        -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
    -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
writer -> do
            let ss :: [ByteString]
ss  = [ByteString] -> Maybe [ByteString] -> [ByteString]
forall a. a -> Maybe a -> a
fromMaybe [] (ByteString -> Map ByteString [ByteString] -> Maybe [ByteString]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
nm) Map ByteString [ByteString]
LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm)
                fm' :: Map ByteString [ByteString]
fm' = ByteString
-> [ByteString]
-> Map ByteString [ByteString]
-> Map ByteString [ByteString]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> ByteString
P.pack String
nm) (String -> ByteString
P.pack String
q ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
ss) Map ByteString [ByteString]
LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm
            LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
writer Map ByteString [ByteString]
LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm'
        String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) String
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT (Map ByteString [ByteString]) LB) 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 (ModuleT (Map ByteString [ByteString]) LB) ()
runForget String
str
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest = String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Incorrect arguments to quote"
    | Bool
otherwise = do
        [ByteString]
ss <- (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
 -> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
     -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
 -> Cmd (ModuleT (Map ByteString [ByteString]) LB) [ByteString])
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) [ByteString]
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
  -> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
      -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
  -> Cmd (ModuleT (Map ByteString [ByteString]) LB) [ByteString])
 -> Cmd (ModuleT (Map ByteString [ByteString]) LB) [ByteString])
-> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
    -> (LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
        -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
    -> Cmd (ModuleT (Map ByteString [ByteString]) LB) [ByteString])
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) [ByteString]
forall a b. (a -> b) -> a -> b
$ \LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
writer -> do
            let ss :: [ByteString]
ss  = [ByteString] -> Maybe [ByteString] -> [ByteString]
forall a. a -> Maybe a -> a
fromMaybe [] (ByteString -> Map ByteString [ByteString] -> Maybe [ByteString]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
nm) Map ByteString [ByteString]
LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm)
                fm' :: Map ByteString [ByteString]
fm' = case ByteString -> [ByteString] -> [ByteString]
forall a. Eq a => a -> [a] -> [a]
delete (String -> ByteString
P.pack String
q) [ByteString]
ss of
                    []  -> ByteString
-> Map ByteString [ByteString] -> Map ByteString [ByteString]
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (String -> ByteString
P.pack String
nm)     Map ByteString [ByteString]
LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm
                    [ByteString]
ss' -> ByteString
-> [ByteString]
-> Map ByteString [ByteString]
-> Map ByteString [ByteString]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> ByteString
P.pack String
nm) [ByteString]
ss' Map ByteString [ByteString]
LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm
            LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
writer Map ByteString [ByteString]
LBState (Cmd (ModuleT (Map ByteString [ByteString]) LB))
fm'
            [ByteString]
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
ss
        String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
-> String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall a b. (a -> b) -> a -> b
$ if String -> ByteString
P.pack String
q ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
ss
            then String
"Done."
            else String
"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 (ModuleT (Map ByteString [ByteString]) LB) ()
runQuote String
str =
    String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) ())
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) String
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString
-> ByteString
-> Map ByteString [ByteString]
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) String
search (String -> ByteString
P.pack String
nm) (String -> ByteString
P.pack String
pat) (Map ByteString [ByteString]
 -> Cmd (ModuleT (Map ByteString [ByteString]) LB) String)
-> Cmd
     (ModuleT (Map ByteString [ByteString]) LB)
     (Map ByteString [ByteString])
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd
  (ModuleT (Map ByteString [ByteString]) LB)
  (Map ByteString [ByteString])
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 :: ByteString
-> ByteString
-> Map ByteString [ByteString]
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) String
search ByteString
key ByteString
pat Map ByteString [ByteString]
db
    | Map ByteString [ByteString] -> Bool
forall k a. Map k a -> Bool
M.null Map ByteString [ByteString]
db          = String -> Cmd (ModuleT (Map ByteString [ByteString]) LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"No quotes yet."

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

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

    | ByteString -> Bool
P.null ByteString
pat         = ByteString
-> [(ByteString, ByteString)]
-> Cmd (ModuleT (Map ByteString [ByteString]) LB) String
forall (m :: * -> *) source.
(RegexMaker Regex CompOption ExecOption source, MonadFail m,
 MonadIO m, MonadConfig m) =>
source -> [(ByteString, ByteString)] -> m String
match' ByteString
key [(ByteString, ByteString)]
allquotes

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

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

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

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

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

    display :: ByteString -> ByteString -> String
display ByteString
k ByteString
msg = (if ByteString -> Bool
P.null ByteString
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 = ByteString -> String
P.unpack ByteString
msg
                who :: String
who    = ByteString -> String
P.unpack ByteString
k