dictfr/ParseHtml.hs

55 lines
1.8 KiB
Haskell

module ParseHtml (printDifferentDef, differentDefTags, parseDefTags) where
import Text.HTML.TagSoup
import Prelude
import qualified Data.Text.Lazy as T
data WordDefHeader = WordDefHeader WordName WordType
data WordName = WordName String
data WordType = WordType String
printDifferentDef :: T.Text -> IO ()
printDifferentDef x = putStrLn (getDifferentDef x)
getDifferentDef :: T.Text -> String
getDifferentDef x = getDifferentDefMessages (length xs) ++ renderWordList xs
where xs = (parseDefTags . differentDefTags) x
renderWordList :: [WordDefHeader] -> String
renderWordList [] = ""
renderWordList (x:xs) = (renderString x) ++ "\n" ++ (renderWordList xs)
getDifferentDefMessages :: Int -> String
getDifferentDefMessages 0 = "Aucune définition disponible."
getDifferentDefMessages 1 = "Une définition disponible : \n"
getDifferentDefMessages _ = "Plusieurs définitions disponibles : \n"
renderString :: WordDefHeader -> String
renderString (WordDefHeader n t) = (getNameString n) ++ (getTypeString t)
getNameString :: WordName -> String
getNameString (WordName s) = s
getTypeString :: WordType -> String
getTypeString (WordType s) = s
parseDefTags :: [Tag String] -> [WordDefHeader]
parseDefTags [] = []
parseDefTags xs =
(WordDefHeader (WordName (renderTags (take 1 (fst st))))
(WordType (renderTags [(fst st) !! 1])))
: (parseDefTags (snd st))
where st = subTags xs
subTags :: [Tag String] -> ([Tag String],[Tag String])
subTags [] = ([],[])
subTags xs = if (length xs) `mod` 3 /= 0
then splitAt 2 xs
else ((take 1 xs) ++ (take 1 (drop 2 xs)) , drop 3 xs)
differentDefTags :: T.Text -> [Tag String]
differentDefTags =
filter (~== TagText "") . (takeWhile (~/= "<div id=contentbox>"))
. (dropWhile (~/= "<div id=vtoolbar>")) . parseTags . T.unpack