content: {-# 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 = newModule
      { moduleCmds = return $
          [ (command "dict-help")
              { help = getHelp []
              , process = getHelp . words
              }
          ] ++
          [ (command name)
              { help = getHelp [name]
              , process = \args -> case parseTerms args of
                  [] -> getHelp [name]
                  [s]  -> doLookup s >>= sayResult
                  _ -> say "Sorry, look up one word at a time please."
              }
          | (name, (srv, db, _)) <- dictTable
          , let doLookup  = io . Dict.simpleDictLookup srv db
                sayResult = say . either ("Error: " ++) id
          ]
      }
  
  -- | Configuration.
  
  dictTable :: [(String, (Dict.QueryConfig, String, String))]
  dictTable =
      -- @command     (server  , database,       description)
      [ ("all-dicts", (dict_org, "*"       ,     "Query all databases on dict.org"))
      , ("bouvier"  , (dict_org, "bouvier",      "Bouvier's Law Dictionary"))
      , ("cide"     , (dict_org, "gcide",        "The Collaborative International Dictionary of English"))
      , ("devils"   , (dict_org, "devil",        "The Devil's Dictionary"))
      , ("easton"   , (dict_org, "easton",       "Easton's 1897 Bible Dictionary"))
      , ("elements" , (dict_org, "elements",     "Elements database"))
      , ("foldoc"   , (dict_org, "foldoc",       "The Free On-line Dictionary of Computing"))
      , ("gazetteer", (dict_org, "gaz2k-places", "U.S. Gazetteer (2000)"))
      , ("hitchcock", (dict_org, "hitchcock",    "Hitchcock's Bible Names Dictionary (late 1800's)"))
      , ("jargon"   , (dict_org, "jargon",       "Jargon File"))
      , ("thesaurus", (dict_org, "moby-thes",    "Moby Thesaurus II"))
      , ("vera"     , (dict_org, "vera",         "V.E.R.A.: Virtual Entity of Relevant Acronyms"))
      , ("wn"       , (dict_org, "wn",           "WordNet (r) 1.7"))
      , ("world02"  , (dict_org, "world02",      "CIA World Factbook 2002"))
      ]
      where
      dict_org    = Dict.QC "dict.org" 2628
  
  dictNames :: [String]
  dictNames = sort (map fst dictTable)
  
  
  -- | Print out help.
  
  getHelp :: [String] -> Cmd Dict ()
  getHelp []    = do
      say ("I perform dictionary lookups via the following "
            ++ show (length dictNames) ++ " commands:\n")
      getHelp dictNames
  
  getHelp dicts = mapM_ (say . gH) dicts
      where
      gH dict | Just (_, _, descr) <- lookup dict dictTable
              = pad dict ++ " " ++ descr
  
              | otherwise
              = "There is no dictionary database '" ++ dict ++ "'."
  
      pad xs = take padWidth (xs ++ " " ++ repeat '.')
      padWidth = maximum (map length dictNames) + 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 = pW . words
      where
      pW []  = []
      pW (w@(f:_):ws)
          | f `elem` "'\"" = intercalate " " qws : pW ws'
          | last w == '\\' = let (w':rest) = pW ws in intercalate " " [w, w'] : rest
          | otherwise      = w : pW ws
          where
          (qws, ws') = case break isCloseQuotedWord (w:ws) of
              (qws', [])    -> (init qws' ++ [last qws' ++ [f]], [])
              (qw, w':rest) -> (qw ++ [w'], rest)
          isCloseQuotedWord xs = case reverse xs of
              x:y:_ -> f == x && y /= '\\' -- quote doesn't count if escaped
              x:_   -> f == x
              _     -> False
      pW _ = error "DictModule: parseTerms: can't parse"
  
  