aboutsummaryrefslogtreecommitdiff
path: root/src/Parser/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parser/Utils.hs')
-rw-r--r--src/Parser/Utils.hs59
1 files changed, 0 insertions, 59 deletions
diff --git a/src/Parser/Utils.hs b/src/Parser/Utils.hs
deleted file mode 100644
index 98694bb..0000000
--- a/src/Parser/Utils.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-module Parser.Utils
- ( getTagsBefore
- , getTagsAfter
- , getTagsBetween
- , getTagAttributes
- , getTagAttribute
- , getTagTextAfter
- , hasClass
- ) where
-
-import Data.List (find, findIndex)
-import Data.Maybe (listToMaybe, catMaybes, isJust)
-import Data.Text (Text)
-import qualified Data.Text as T
-
-import Text.HTML.TagSoup
-import Text.HTML.TagSoup.Match (tagOpen)
-
-getTagsBefore :: String -> [Tag Text] -> [Tag Text]
-getTagsBefore selector = takeWhile (~/= selector)
-
-getTagsAfter :: String -> [Tag Text] -> [Tag Text]
-getTagsAfter selector = drop 1 . dropWhile (~/= selector)
-
-getTagsBetween :: String -> String -> [Tag Text] -> [Tag Text]
-getTagsBetween begin end = getTagsBefore end . getTagsAfter begin
-
-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 =
- listToMaybe
- . getTagAttributes selector attribute
-
-getTagTextAfter :: String -> [Tag Text] -> Maybe Text
-getTagTextAfter selector tags =
- case findIndex (~== 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
-
-hasClass :: Text -> Text -> Tag Text -> Bool
-hasClass selector className =
- tagOpen ((==) selector) (isJust . find matchClass)
- where matchClass (name, values) =
- ( name == (T.pack "class")
- && (isJust . find ((==) className) . T.words $ values)
- )