{-# LANGUAGE PatternGuards #-}
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
]
}
dictTable :: [(String, (Dict.QueryConfig, String, String))]
dictTable :: [(String, (QueryConfig, String, String))]
dictTable =
[ (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)
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
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
'\\'
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"