    {-# 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 = return $
            [ (command "dict-help")
                { help = getHelp []
                , process = getHelp . words
                }
            ] ++
            [ (command name)
                { help = getHelp [name]
                , 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 Cmd Dict LookupResult
    -> (LookupResult -> Cmd Dict ()) -> Cmd Dict ()
    forall a b. Cmd Dict a -> (a -> Cmd Dict b) -> Cmd Dict b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= LookupResult -> Cmd Dict ()
    sayResult
                    [String]
    _ -> String -> Cmd Dict ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Sorry, look up one word at a time please."
                }
            | (name, (srv, db, _)) <- dictTable
            , let doLookup  = IO LookupResult -> Cmd Dict LookupResult
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO LookupResult -> Cmd Dict LookupResult)
    -> (String -> IO LookupResult) -> String -> Cmd Dict LookupResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QueryConfig -> String -> String -> IO LookupResult
    Dict.simpleDictLookup QueryConfig
    srv String
    db
                  sayResult = String -> Cmd Dict ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say (String -> Cmd Dict ())
    -> (LookupResult -> String) -> LookupResult -> Cmd Dict ()
    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 Dict ()
    getHelp []    = do
        String -> Cmd Dict ()
    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 a. [a] -> 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 Dict ()
    getHelp [String]
    dictNames

    getHelp [String]
    dicts = (String -> Cmd Dict ()) -> [String] -> Cmd Dict ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (String -> Cmd Dict ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say (String -> Cmd Dict ())
    -> (String -> String) -> String -> Cmd Dict ()
    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 a. Ord a => [a] -> a
    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 a. [a] -> 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 a. Eq a => a -> [a] -> 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. HasCallStack => [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. HasCallStack => [a] -> [a]
    init [String]
    qws' [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [[String] -> String
    forall a. HasCallStack => [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"