{-# 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 = forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command Dict]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        [ (String -> Command Identity
command String
"dict-help")
            { help :: Cmd Dict ()
help = [String] -> Cmd Dict ()
getHelp []
            , process :: String -> Cmd Dict ()
process = [String] -> Cmd Dict ()
getHelp forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
            }
        ] forall a. [a] -> [a] -> [a]
++
        [ (String -> Command Identity
command String
name)
            { help :: Cmd Dict ()
help = [String] -> Cmd Dict ()
getHelp [String
name]
            , process :: String -> Cmd Dict ()
process = \String
args -> case String -> [String]
parseTerms String
args of
                [] -> [String] -> Cmd Dict ()
getHelp [String
name]
                [String
s]  -> String -> Cmd Dict LookupResult
doLookup String
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LookupResult -> Cmd Dict ()
sayResult
                [String]
_ -> 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 Dict LookupResult
doLookup  = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryConfig -> String -> String -> IO LookupResult
Dict.simpleDictLookup QueryConfig
srv String
db
              sayResult :: LookupResult -> Cmd Dict ()
sayResult = forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
"Error: " forall a. [a] -> [a] -> [a]
++) 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 = forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, (QueryConfig, String, String))]
dictTable)


-- | Print out help.

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

getHelp [String]
dicts = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *). Monad m => String -> Cmd m ()
say 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) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
dict [(String, (QueryConfig, String, String))]
dictTable
            = String -> String
pad String
dict forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
descr

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

    pad :: String -> String
pad String
xs = forall a. Int -> [a] -> [a]
take Int
padWidth (String
xs forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
'.')
    padWidth :: Int
padWidth = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
dictNames) 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 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"'\"" = forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String]
qws forall a. a -> [a] -> [a]
: [String] -> [String]
pW [String]
ws'
        | forall a. [a] -> a
last String
w forall a. Eq a => a -> a -> Bool
== Char
'\\' = let (String
w':[String]
rest) = [String] -> [String]
pW [String]
ws in forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
w, String
w'] forall a. a -> [a] -> [a]
: [String]
rest
        | Bool
otherwise      = String
w forall a. a -> [a] -> [a]
: [String] -> [String]
pW [String]
ws
        where
        ([String]
qws, [String]
ws') = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
isCloseQuotedWord (String
wforall a. a -> [a] -> [a]
:[String]
ws) of
            ([String]
qws', [])    -> (forall a. [a] -> [a]
init [String]
qws' forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [String]
qws' forall a. [a] -> [a] -> [a]
++ [Char
f]], [])
            ([String]
qw, String
w':[String]
rest) -> ([String]
qw forall a. [a] -> [a] -> [a]
++ [String
w'], [String]
rest)
        isCloseQuotedWord :: String -> Bool
isCloseQuotedWord String
xs = case forall a. [a] -> [a]
reverse String
xs of
            Char
x:Char
y:String
_ -> Char
f forall a. Eq a => a -> a -> Bool
== Char
x Bool -> Bool -> Bool
&& Char
y forall a. Eq a => a -> a -> Bool
/= Char
'\\' -- quote doesn't count if escaped
            Char
x:String
_   -> Char
f forall a. Eq a => a -> a -> Bool
== Char
x
            String
_     -> Bool
False
    pW [String]
_ = forall a. HasCallStack => String -> a
error String
"DictModule: parseTerms: can't parse"