diff options
-rw-r--r-- | src/Model/Detail.hs | 3 | ||||
-rw-r--r-- | src/Parser/Detail.hs | 22 | ||||
-rw-r--r-- | src/Parser/Utils.hs | 14 | ||||
-rw-r--r-- | src/View/Ad.hs | 19 |
4 files changed, 45 insertions, 13 deletions
diff --git a/src/Model/Detail.hs b/src/Model/Detail.hs index 952cb7a..a170ca6 100644 --- a/src/Model/Detail.hs +++ b/src/Model/Detail.hs @@ -4,6 +4,9 @@ module Model.Detail import Data.Text +import Model.URL + data Detail = Detail { description :: Maybe Text + , images :: [URL] } deriving (Eq, Read, Show) diff --git a/src/Parser/Detail.hs b/src/Parser/Detail.hs index 4144964..3a91ac2 100644 --- a/src/Parser/Detail.hs +++ b/src/Parser/Detail.hs @@ -14,12 +14,16 @@ import Parser.Utils parseDetail :: Text -> Detail parseDetail page = let tags = parseTags page - descriptionTags = getTagsBetween "<div itemprop=description>" "</div>" tags - description = - if null descriptionTags - then - Nothing - else - let replaceBr = map (\tag -> if tag ~== "<br>" then TagText (T.pack "\n") else tag) - in Just . T.strip . renderTags . replaceBr $ descriptionTags - in Detail { description = description } + description = parseDescription tags + images = getTagAttributes "<meta itemprop=image>" (T.pack "content") tags + in Detail { description = description, images = images } + +parseDescription :: [Tag Text] -> Maybe Text +parseDescription tags = + let descriptionTags = getTagsBetween "<div itemprop=description>" "</div>" tags + in if null descriptionTags + then + Nothing + else + let replaceBr = map (\tag -> if tag ~== "<br>" then TagText (T.pack "\n") else tag) + in Just . T.strip . renderTags . replaceBr $ descriptionTags diff --git a/src/Parser/Utils.hs b/src/Parser/Utils.hs index 16fe3d2..c03ab03 100644 --- a/src/Parser/Utils.hs +++ b/src/Parser/Utils.hs @@ -1,11 +1,12 @@ module Parser.Utils ( getTagsBetween + , getTagAttributes , getTagAttribute , getTagTextAfter ) where import Data.List (find, findIndex) -import Data.Maybe (listToMaybe) +import Data.Maybe (listToMaybe, catMaybes) import Data.Text (Text) import qualified Data.Text as T @@ -17,9 +18,16 @@ getTagsBetween beginSelector endSelector = . drop 1 . dropWhile (~/= beginSelector) +getTagAttributes :: String -> Text -> [Tag Text] -> [Text] +getTagAttributes selector attribute = + catMaybes + . fmap (maybeTagAttribute attribute) + . filter (~== selector) + getTagAttribute :: String -> Text -> [Tag Text] -> Maybe Text -getTagAttribute selector attribute tags = - find (~== selector) tags >>= maybeTagAttribute attribute +getTagAttribute selector attribute = + listToMaybe + . getTagAttributes selector attribute getTagTextAfter :: String -> [Tag Text] -> Maybe Text getTagTextAfter selector tags = diff --git a/src/View/Ad.hs b/src/View/Ad.hs index 5ab08e6..ec5da2d 100644 --- a/src/View/Ad.hs +++ b/src/View/Ad.hs @@ -7,16 +7,21 @@ module View.Ad import Data.List (intersperse) import Data.Maybe (fromMaybe) + import Data.Text (Text) import qualified Data.Text as T import Model.Ad (Ad(..)) import qualified Model.Ad as Ad + import Model.Resume (Resume(..)) import qualified Model.Resume as Resume + import Model.Detail (Detail(..)) import qualified Model.Detail as Detail +import Model.URL + renderConsoleAds :: Text -> [Ad] -> Text renderConsoleAds time ads = let (title, message) = renderAds ads @@ -72,4 +77,16 @@ renderResume resume = renderDetail :: Detail -> Text renderDetail detail = - fromMaybe "−" (Detail.description detail) + T.concat + [ fromMaybe "−" (Detail.description detail) + , renderURLs "\n\nImages" (Detail.images detail) + ] + +renderURLs :: Text -> [URL] -> Text +renderURLs title [] = "" +renderURLs title urls = + T.concat + [ title + , "\n\n" + , T.intercalate "\n" urls + ] |