-- |
-- Module    : Where
-- Copyright : 2003 Shae Erisson
--
-- License:     lGPL
--
-- Slightly specialised version of Where for associating projects with their urls.
-- Code almost all copied.
module Lambdabot.Plugin.Reference.Where (wherePlugin) where

import Lambdabot.Plugin
import Lambdabot.Util
import qualified Data.ByteString.Char8 as P
import Data.Char
import qualified Data.Map as M

type WhereState         = M.Map P.ByteString P.ByteString
type WhereWriter        = WhereState -> Cmd Where ()
type Where              = ModuleT WhereState LB

wherePlugin :: Module (M.Map P.ByteString P.ByteString)
wherePlugin :: Module (Map ByteString ByteString)
wherePlugin = Module (Map ByteString ByteString)
forall st. Module st
newModule
    { 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
    , 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)
mapPackedSerial

    , 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
"where")
            { help :: Cmd (ModuleT (Map ByteString ByteString) LB) ()
help = String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"where <key>. Return element associated with key"
            , process :: String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
process = String -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
doCmd String
"where"
            }
        , (String -> Command Identity
command String
"url")
            { help :: Cmd (ModuleT (Map ByteString ByteString) LB) ()
help = String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"url <key>. Return element associated with key"
            , process :: String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
process = String -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
doCmd String
"url"
            }
        , (String -> Command Identity
command String
"what")
            { help :: Cmd (ModuleT (Map ByteString ByteString) LB) ()
help = String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"what <key>. Return element associated with key"
            , process :: String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
process = String -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
doCmd String
"what"
            }
        , (String -> Command Identity
command String
"where+")
            { help :: Cmd (ModuleT (Map ByteString ByteString) LB) ()
help = String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"where+ <key> <elem>. Define an association"
            , process :: String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
process = String -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
doCmd String
"where+"
            }
        ]
    }

doCmd :: String -> String -> Cmd Where ()
doCmd :: String -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
doCmd String
cmd String
rest = (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
 -> Cmd (ModuleT (Map ByteString ByteString) LB) ())
-> ((Map ByteString ByteString
     -> WhereWriter
     -> Cmd (ModuleT (Map ByteString ByteString) LB) String)
    -> Cmd (ModuleT (Map ByteString ByteString) LB) String)
-> (Map ByteString ByteString
    -> WhereWriter
    -> Cmd (ModuleT (Map ByteString ByteString) LB) String)
-> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ByteString ByteString
 -> WhereWriter
 -> Cmd (ModuleT (Map ByteString ByteString) LB) String)
-> Cmd (ModuleT (Map ByteString ByteString) LB) String
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((Map ByteString ByteString
  -> WhereWriter
  -> Cmd (ModuleT (Map ByteString ByteString) LB) String)
 -> Cmd (ModuleT (Map ByteString ByteString) LB) ())
-> (Map ByteString ByteString
    -> WhereWriter
    -> Cmd (ModuleT (Map ByteString ByteString) LB) String)
-> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall a b. (a -> b) -> a -> b
$ \Map ByteString ByteString
factFM WhereWriter
writer ->
    case String -> [String]
words String
rest of
        []         -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"@where <key>, return element associated with key"
        (String
fact:[String]
dat) -> Map ByteString ByteString
-> WhereWriter
-> String
-> String
-> String
-> Cmd (ModuleT (Map ByteString ByteString) LB) String
processCommand Map ByteString ByteString
factFM WhereWriter
writer
                            ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fact) String
cmd ([String] -> String
unwords [String]
dat)

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

processCommand :: WhereState -> WhereWriter
               -> String -> String -> String -> Cmd Where String

processCommand :: Map ByteString ByteString
-> WhereWriter
-> String
-> String
-> String
-> Cmd (ModuleT (Map ByteString ByteString) LB) String
processCommand Map ByteString ByteString
factFM WhereWriter
writer String
fact String
cmd String
dat = case String
cmd of
        String
"where"     -> 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
$ Map ByteString ByteString -> String -> String
getWhere Map ByteString ByteString
factFM String
fact
        String
"what"      -> 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
$ Map ByteString ByteString -> String -> String
getWhere Map ByteString ByteString
factFM String
fact -- an alias
        String
"url"       -> 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
$ Map ByteString ByteString -> String -> String
getWhere Map ByteString ByteString
factFM String
fact -- an alias
        String
"where+"    -> Bool
-> Map ByteString ByteString
-> WhereWriter
-> String
-> String
-> Cmd (ModuleT (Map ByteString ByteString) LB) String
updateWhere Bool
True Map ByteString ByteString
factFM WhereWriter
writer String
fact String
dat
        String
_           -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Unknown command."

getWhere :: WhereState -> String -> String
getWhere :: Map ByteString ByteString -> String -> String
getWhere Map ByteString ByteString
fm String
fact =
    case ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> ByteString
P.pack String
fact) Map ByteString ByteString
fm of
        Maybe ByteString
Nothing -> String
"I know nothing about " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fact String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
        Just ByteString
x  -> ByteString -> String
P.unpack ByteString
x

updateWhere :: Bool -> WhereState -> WhereWriter -> String -> String -> Cmd Where String
updateWhere :: Bool
-> Map ByteString ByteString
-> WhereWriter
-> String
-> String
-> Cmd (ModuleT (Map ByteString ByteString) LB) String
updateWhere Bool
_guard Map ByteString ByteString
factFM WhereWriter
writer String
fact String
dat
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dat = do
        WhereWriter
writer WhereWriter -> WhereWriter
forall a b. (a -> b) -> a -> b
$ 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
fact) Map ByteString ByteString
factFM
        String -> Cmd (ModuleT (Map ByteString ByteString) LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"It is forgotten."
    | Bool
otherwise = do
        WhereWriter
writer WhereWriter -> WhereWriter
forall a b. (a -> b) -> a -> b
$ 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
fact) (String -> ByteString
P.pack String
dat) Map ByteString ByteString
factFM
        Cmd (ModuleT (Map ByteString ByteString) LB) String
forall (m :: * -> *). MonadIO m => m String
randomSuccessMsg