diff options
Diffstat (limited to 'src/Parser')
-rw-r--r-- | src/Parser/Detail.hs | 14 | ||||
-rw-r--r-- | src/Parser/Resume.hs | 27 | ||||
-rw-r--r-- | src/Parser/Utils.hs | 30 |
3 files changed, 71 insertions, 0 deletions
diff --git a/src/Parser/Detail.hs b/src/Parser/Detail.hs new file mode 100644 index 0000000..031d740 --- /dev/null +++ b/src/Parser/Detail.hs @@ -0,0 +1,14 @@ +module Parser.Detail + ( parseDetail + ) where + +import Text.HTML.TagSoup + +import Model.Detail + +import Parser.Utils + +parseDetail :: [Tag String] -> Detail +parseDetail tags = + let description = getTagText "<div class=content>" tags + in Detail { description = description } diff --git a/src/Parser/Resume.hs b/src/Parser/Resume.hs new file mode 100644 index 0000000..bd73912 --- /dev/null +++ b/src/Parser/Resume.hs @@ -0,0 +1,27 @@ +module Parser.Resume + ( parseResumes + ) where + +import Data.Maybe (catMaybes) + +import Text.HTML.TagSoup + +import Model.Resume + +import Parser.Utils + +parseResumes :: String -> [Resume] +parseResumes page = + case sections (~== "<div class=list-lbc>") (parseTags page) of + [] -> + [] + sectionTags : _ -> + let lbcTags = takeWhile (~/= "<div id=alertesCartouche>") sectionTags + in catMaybes . fmap parseResume $ partitions (~== "<a>") lbcTags + +parseResume :: [Tag String] -> Maybe Resume +parseResume item = do + name <- getTagText "<h2 class=title>" item + let price = getTagText "<div class=price>" item + url <- getTagAttribute "<a>" "href" item + return Resume { name = name, price = price, url = url } diff --git a/src/Parser/Utils.hs b/src/Parser/Utils.hs new file mode 100644 index 0000000..4864e00 --- /dev/null +++ b/src/Parser/Utils.hs @@ -0,0 +1,30 @@ +module Parser.Utils + ( getTagAttribute + , getTagText + ) where + +import Data.List (find, findIndex) +import Data.Maybe (listToMaybe) + +import Text.HTML.TagSoup + +getTagAttribute :: String -> String -> [Tag String] -> Maybe String +getTagAttribute selector attribute item = + find (~== selector) item >>= maybeTagAttribute attribute + +getTagText :: String -> [Tag String] -> Maybe String +getTagText selector item = + case findIndex (~== selector) item of + Just index -> fmap trim $ safeGetAt (index + 1) item >>= maybeTagText + Nothing -> Nothing + +maybeTagAttribute :: String -> Tag String -> Maybe String +maybeTagAttribute name (TagOpen _ xs) = + fmap snd . find (\(x, _) -> x == name) $ xs +maybeTagAttribute attribute _ = Nothing + +trim :: String -> String +trim = unwords . words + +safeGetAt :: Int -> [a] -> Maybe a +safeGetAt index = listToMaybe . drop index |