{-# 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 = 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 "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 = \args :: String
args -> case String -> [String]
parseTerms String
args of
[] -> [String] -> Cmd (ModuleT () LB) ()
getHelp [String
name]
[s :: 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 -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "Sorry, look up one word at a time please."
}
| (name :: String
name, (srv :: QueryConfig
srv, db :: String
db, _)) <- [(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 ("Error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++) String -> String
forall a. a -> a
id
]
}
dictTable :: [(String, (Dict.QueryConfig, String, String))]
dictTable :: [(String, (QueryConfig, String, String))]
dictTable =
[ ("all-dicts", (QueryConfig
dict_org, "*" , "Query all databases on dict.org"))
, ("bouvier" , (QueryConfig
dict_org, "bouvier", "Bouvier's Law Dictionary"))
, ("cide" , (QueryConfig
dict_org, "gcide", "The Collaborative International Dictionary of English"))
, ("devils" , (QueryConfig
dict_org, "devil", "The Devil's Dictionary"))
, ("easton" , (QueryConfig
dict_org, "easton", "Easton's 1897 Bible Dictionary"))
, ("elements" , (QueryConfig
dict_org, "elements", "Elements database"))
, ("foldoc" , (QueryConfig
dict_org, "foldoc", "The Free On-line Dictionary of Computing"))
, ("gazetteer", (QueryConfig
dict_org, "gaz2k-places", "U.S. Gazetteer (2000)"))
, ("hitchcock", (QueryConfig
dict_org, "hitchcock", "Hitchcock's Bible Names Dictionary (late 1800's)"))
, ("jargon" , (QueryConfig
dict_org, "jargon", "Jargon File"))
, ("thesaurus", (QueryConfig
dict_org, "moby-thes", "Moby Thesaurus II"))
, ("vera" , (QueryConfig
dict_org, "vera", "V.E.R.A.: Virtual Entity of Relevant Acronyms"))
, ("wn" , (QueryConfig
dict_org, "wn", "WordNet (r) 1.7"))
, ("world02" , (QueryConfig
dict_org, "world02", "CIA World Factbook 2002"))
]
where
dict_org :: QueryConfig
dict_org = String -> Int -> QueryConfig
Dict.QC "dict.org" 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)
getHelp :: [String] -> Cmd Dict ()
getHelp :: [String] -> Cmd (ModuleT () LB) ()
getHelp [] = do
String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say ("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]
++ " commands:\n")
[String] -> Cmd (ModuleT () LB) ()
getHelp [String]
dictNames
getHelp dicts :: [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 dict :: String
dict | Just (_, _, descr :: 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
forall a. [a] -> [a] -> [a]
++ String
descr
| Bool
otherwise
= "There is no dictionary database '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dict String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'."
pad :: String -> String
pad xs :: 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
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat '.')
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
+ 4
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@(f :: Char
f:_):ws :: [String]
ws)
| Char
f Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "'\"" = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [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
== '\\' = let (w' :: String
w':rest :: [String]
rest) = [String] -> [String]
pW [String]
ws in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [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
(qws :: [String]
qws, ws' :: [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
(qws' :: [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]], [])
(qw :: [String]
qw, w' :: String
w':rest :: [String]
rest) -> ([String]
qw [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
w'], [String]
rest)
isCloseQuotedWord :: String -> Bool
isCloseQuotedWord xs :: String
xs = case String -> String
forall a. [a] -> [a]
reverse String
xs of
x :: Char
x:y :: Char
y:_ -> 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
'\\'
x :: Char
x:_ -> Char
f Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x
_ -> Bool
False
pW _ = String -> [String]
forall a. HasCallStack => String -> a
error "DictModule: parseTerms: can't parse"