aboutsummaryrefslogtreecommitdiff
path: root/src/lib/haskell/Parser/Utils.hs
blob: 47683274f4708702975b541e4c9eb61dcf8ccf13 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
module Parser.Utils
  ( getTagsBefore
  , getTagsAfter
  , getTagsBetween
  , getTagAttributes
  , getTagAttribute
  , getTagTextAfter
  ) where

import           Data.List         (find, findIndex)
import           Data.Maybe        (catMaybes, listToMaybe)
import           Data.Text         (Text)
import qualified Data.Text         as T
import           Text.HTML.TagSoup

getTagsBefore :: Text -> [Tag Text] -> [Tag Text]
getTagsBefore selector = takeWhile (~/= (T.unpack selector))

getTagsAfter :: Text -> [Tag Text] -> [Tag Text]
getTagsAfter selector = drop 1 . dropWhile (~/= (T.unpack selector))

getTagsBetween :: Text -> Text -> [Tag Text] -> [Tag Text]
getTagsBetween begin end = getTagsBefore end . getTagsAfter begin

getTagAttributes :: Text -> Text -> [Tag Text] -> [Text]
getTagAttributes selector attribute =
  catMaybes
  . fmap (maybeTagAttribute attribute)
  . filter (~== (T.unpack selector))

getTagAttribute :: Text -> Text -> [Tag Text] -> Maybe Text
getTagAttribute selector attribute =
  listToMaybe
  . getTagAttributes selector attribute

getTagTextAfter :: Text -> [Tag Text] -> Maybe Text
getTagTextAfter selector tags =
  case findIndex (~== (T.unpack selector)) tags of
    Just index -> fmap T.strip $ safeGetAt (index + 1) tags >>= maybeTagText
    Nothing    -> Nothing

maybeTagAttribute :: Text -> Tag Text -> Maybe Text
maybeTagAttribute name (TagOpen _ xs) =
  fmap snd . find (\(x, _) -> x == name) $ xs
maybeTagAttribute _ _ = Nothing

safeGetAt :: Int -> [a] -> Maybe a
safeGetAt index = listToMaybe . drop index