{-# LANGUAGE PatternGuards #-}
-- | DICT (RFC 2229) Lookup Module for lambdabot IRC robot.
-- Tom Moertel <tom@moertel.com>
module Lambdabot.Plugin.Reference.Dict (dictPlugin) where

import Lambdabot.Plugin
import qualified Lambdabot.Plugin.Reference.Dict.DictLookup as Dict
import Lambdabot.Util

import Control.Monad
import Data.List

type Dict = ModuleT () LB

dictPlugin :: Module ()
dictPlugin :: Module ()
dictPlugin = Module ()
forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Command (ModuleT () LB)]
 -> ModuleT () LB [Command (ModuleT () LB)])
-> [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall a b. (a -> b) -> a -> b
$
        [ (String -> Command Identity
command String
"dict-help")
            { help :: Cmd (ModuleT () LB) ()
help = [String] -> Cmd (ModuleT () LB) ()
getHelp []
            , process :: String -> Cmd (ModuleT () LB) ()
process = [String] -> Cmd (ModuleT () LB) ()
getHelp ([String] -> Cmd (ModuleT () LB) ())
-> (String -> [String]) -> String -> Cmd (ModuleT () LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
            }
        ] [Command (ModuleT () LB)]
-> [Command (ModuleT () LB)] -> [Command (ModuleT () LB)]
forall a. [a] -> [a] -> [a]
++
        [ (String -> Command Identity
command String
name)
            { help :: Cmd (ModuleT () LB) ()
help = [String] -> Cmd (ModuleT () LB) ()
getHelp [String
name]
            , process :: String -> Cmd (ModuleT () LB) ()
process = \String
args -> case String -> [String]
parseTerms String
args of
                [] -> [String] -> Cmd (ModuleT () LB) ()
getHelp [String
name]
                [String
s]  -> String -> Cmd (ModuleT () LB) LookupResult
doLookup String
s Cmd (ModuleT () LB) LookupResult
-> (LookupResult -> Cmd (ModuleT () LB) ())
-> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LookupResult -> Cmd (ModuleT () LB) ()
sayResult
                [String]
_ -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Sorry, look up one word at a time please."
            }
        | (String
name, (QueryConfig
srv, String
db, String
_)) <- [(String, (QueryConfig, String, String))]
dictTable
        , let doLookup :: String -> Cmd (ModuleT () LB) LookupResult
doLookup  = IO LookupResult -> Cmd (ModuleT () LB) LookupResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO LookupResult -> Cmd (ModuleT () LB) LookupResult)
-> (String -> IO LookupResult)
-> String
-> Cmd (ModuleT () LB) LookupResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConfig -> String -> String -> IO LookupResult
Dict.simpleDictLookup QueryConfig
srv String
db
              sayResult :: LookupResult -> Cmd (ModuleT () LB) ()
sayResult = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT () LB) ())
-> (LookupResult -> String)
-> LookupResult
-> Cmd (ModuleT () LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> (String -> String) -> LookupResult -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
"Error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) String -> String
forall a. a -> a
id
        ]
    }

-- | Configuration.

dictTable :: [(String, (Dict.QueryConfig, String, String))]
dictTable :: [(String, (QueryConfig, String, String))]
dictTable =
    -- @command     (server  , database,       description)
    [ (String
"all-dicts", (QueryConfig
dict_org, String
"*"       ,     String
"Query all databases on dict.org"))
    , (String
"bouvier"  , (QueryConfig
dict_org, String
"bouvier",      String
"Bouvier's Law Dictionary"))
    , (String
"cide"     , (QueryConfig
dict_org, String
"gcide",        String
"The Collaborative International Dictionary of English"))
    , (String
"devils"   , (QueryConfig
dict_org, String
"devil",        String
"The Devil's Dictionary"))
    , (String
"easton"   , (QueryConfig
dict_org, String
"easton",       String
"Easton's 1897 Bible Dictionary"))
    , (String
"elements" , (QueryConfig
dict_org, String
"elements",     String
"Elements database"))
    , (String
"foldoc"   , (QueryConfig
dict_org, String
"foldoc",       String
"The Free On-line Dictionary of Computing"))
    , (String
"gazetteer", (QueryConfig
dict_org, String
"gaz2k-places", String
"U.S. Gazetteer (2000)"))
    , (String
"hitchcock", (QueryConfig
dict_org, String
"hitchcock",    String
"Hitchcock's Bible Names Dictionary (late 1800's)"))
    , (String
"jargon"   , (QueryConfig
dict_org, String
"jargon",       String
"Jargon File"))
    , (String
"thesaurus", (QueryConfig
dict_org, String
"moby-thes",    String
"Moby Thesaurus II"))
    , (String
"vera"     , (QueryConfig
dict_org, String
"vera",         String
"V.E.R.A.: Virtual Entity of Relevant Acronyms"))
    , (String
"wn"       , (QueryConfig
dict_org, String
"wn",           String
"WordNet (r) 1.7"))
    , (String
"world02"  , (QueryConfig
dict_org, String
"world02",      String
"CIA World Factbook 2002"))
    ]
    where
    dict_org :: QueryConfig
dict_org    = String -> Int -> QueryConfig
Dict.QC String
"dict.org" Int
2628

dictNames :: [String]
dictNames :: [String]
dictNames = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort (((String, (QueryConfig, String, String)) -> String)
-> [(String, (QueryConfig, String, String))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (QueryConfig, String, String)) -> String
forall a b. (a, b) -> a
fst [(String, (QueryConfig, String, String))]
dictTable)


-- | Print out help.

getHelp :: [String] -> Cmd Dict ()
getHelp :: [String] -> Cmd (ModuleT () LB) ()
getHelp []    = do
    String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String
"I perform dictionary lookups via the following "
          String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dictNames) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" commands:\n")
    [String] -> Cmd (ModuleT () LB) ()
getHelp [String]
dictNames

getHelp [String]
dicts = (String -> Cmd (ModuleT () LB) ())
-> [String] -> Cmd (ModuleT () LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT () LB) ())
-> (String -> String) -> String -> Cmd (ModuleT () LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
gH) [String]
dicts
    where
    gH :: String -> String
gH String
dict | Just (QueryConfig
_, String
_, String
descr) <- String
-> [(String, (QueryConfig, String, String))]
-> Maybe (QueryConfig, String, String)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
dict [(String, (QueryConfig, String, String))]
dictTable
            = String -> String
pad String
dict String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
descr

            | Bool
otherwise
            = String
"There is no dictionary database '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dict String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."

    pad :: String -> String
pad String
xs = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
padWidth (String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
'.')
    padWidth :: Int
padWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dictNames) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4


-- | Break a string into dictionary-query terms, handling quoting and
-- escaping along the way.  (This is ugly, and I don't particularly
-- like it.)  Given a string like the following, we want to do the
-- right thing, which is to break it into five query strings:
--
--     firefly "c'est la vie" 'pound cake' 'rock n\' roll' et\ al
--
--     (1) firefly
--     (2) "c'est la vie"
--     (3) 'pound cake'
--     (4) 'rock n\' roll'
--     (5) et\ al

parseTerms :: String -> [String]
parseTerms :: String -> [String]
parseTerms = [String] -> [String]
pW ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
    where
    pW :: [String] -> [String]
pW []  = []
    pW (w :: String
w@(Char
f:String
_):[String]
ws)
        | Char
f Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"'\"" = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String]
qws String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
pW [String]
ws'
        | String -> Char
forall a. [a] -> a
last String
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' = let (String
w':[String]
rest) = [String] -> [String]
pW [String]
ws in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
w, String
w'] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rest
        | Bool
otherwise      = String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
pW [String]
ws
        where
        ([String]
qws, [String]
ws') = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
isCloseQuotedWord (String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ws) of
            ([String]
qws', [])    -> ([String] -> [String]
forall a. [a] -> [a]
init [String]
qws' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String] -> String
forall a. [a] -> a
last [String]
qws' String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
f]], [])
            ([String]
qw, String
w':[String]
rest) -> ([String]
qw [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
w'], [String]
rest)
        isCloseQuotedWord :: String -> Bool
isCloseQuotedWord String
xs = case String -> String
forall a. [a] -> [a]
reverse String
xs of
            Char
x:Char
y:String
_ -> Char
f Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' -- quote doesn't count if escaped
            Char
x:String
_   -> Char
f Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x
            String
_     -> Bool
False
    pW [String]
_ = String -> [String]
forall a. HasCallStack => String -> a
error String
"DictModule: parseTerms: can't parse"