module Network.API.GoogleDictionary
( Entry(..)
, lookupWord
, getResponse
, module Network.API.GoogleDictionary.Types
) where
import Control.Applicative ((<$>))
import Control.Lens
import Control.Monad (join)
import Control.Monad.State
import Data.Aeson (eitherDecode)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.List (dropWhileEnd)
import Data.Maybe (catMaybes)
import Data.Monoid (First(..), mconcat)
import Network.API.GoogleDictionary.Internal
import Network.API.GoogleDictionary.Types
data Entry = Entry
{ entryWord :: !String
, entryDefinition :: !String
, entryPartOfSpeech :: Maybe String
, entryPhonetic :: !String
, entrySoundUrl :: Maybe String
} deriving Show
data EntryInternal = EntryInternal
{ _eiDefinitions :: [String]
, _eiPartOfSpeech :: Maybe String
, _eiPhonetic :: !String
, _eiSoundUrl :: Maybe String
} deriving Show
makeLenses ''EntryInternal
initEntryInternal :: EntryInternal
initEntryInternal = EntryInternal
{ _eiDefinitions = []
, _eiPartOfSpeech = Nothing
, _eiPhonetic = ""
, _eiSoundUrl = Nothing
}
entryInternalToEntries :: String -> EntryInternal -> [Entry]
entryInternalToEntries word (EntryInternal defs pos phon sound) =
map (\def -> Entry word def pos phon sound) defs
lookupWord :: String -> IO [Entry]
lookupWord word = either (const []) (entryInternalToEntries word . makeEntry) <$> getResponse word
makeEntry :: Response -> EntryInternal
makeEntry response = flip execState initEntryInternal $ mapM processPrimary (responsePrimaries response)
processPrimary :: Primary -> State EntryInternal ()
processPrimary (Primary pentries terms _) = do
mapM_ processPentry pentries
mapM_ processPterm terms
processPentry :: PEntry -> State EntryInternal ()
processPentry (PEntry _ terms PEMeaning) = mapM_ processPentryTerm terms
processPentry _ = return ()
processPentryTerm :: Term -> State EntryInternal ()
processPentryTerm (Term _ _ def TText) = eiDefinitions %= (def:)
processPentryTerm _ = return ()
processPterm :: Term -> State EntryInternal ()
processPterm (Term (Just labels) _ _ TText) = processPtermLabels labels
processPterm (Term _ _ soundUrl TSound) = eiSoundUrl .= Just soundUrl
processPterm (Term _ _ phonetic TPhonetic) = eiPhonetic .= phonetic
processPterm _ = return ()
processPtermLabels :: [Label] -> State EntryInternal ()
processPtermLabels ((Label pos (Just "Part-of-speech")):_) = eiPartOfSpeech .= Just pos
processPtermLabels (_:xs) = processPtermLabels xs
processPtermLabels [] = return ()
getResponse :: String -> IO (Either String Response)
getResponse word = do
let url = "http://www.google.com/dictionary/json?callback=a&sl=en&tl=en&q=" ++ word
fmap (decodeHex . trimResponse) (getJson url) >>= maybe badContents goodContents
where
trimResponse :: String -> String
trimResponse = dropWhileEnd (/= '}') . drop 2
badContents :: IO (Either String Response)
badContents = return (Left "invalid hex code encountered")
goodContents :: String -> IO (Either String Response)
goodContents = return . eitherDecode . BS.pack