chandlr-server/app/Parsing/BodyParser.hs

41 lines
1.0 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Parsing.BodyParser
( PostPart (..)
, parsePostBody
, collectBacklinks
, Backlinks
) where
import Data.Text (Text, unpack)
import Common.Parsing.PostPartType
import Common.Parsing.PostBodyUtils
import Common.Parsing.QuoteLinkParser
tagsToPostParts :: [ Tag Text ] -> [ PostPart ]
tagsToPostParts = concatMap tagToPostPart
tagToPostPart :: Tag Text -> [ PostPart ]
tagToPostPart (TagText t) = SimpleText t : []
tagToPostPart (TagOpen "a" attrs) = parseAnchor attrs : []
tagToPostPart (TagOpen "span" attrs) = parseSpan attrs : []
parseAnchor :: [ Attribute Text ] -> PostPart
parseAnchor attrs =
case lookup "href" attrs of
Nothing -> SimpleText "Anchor without href"
Just href ->
case lookup "target" attrs of
Just "_blank" -> PostedUrl href
_ -> Quote $ parseURL $ unpack href
parseSpan :: [ Attribute Text ] -> PostPart
parsePostBody :: Text -> IO [ PostPart ]
parsePostBody html =
return $ tagsToPostParts $ parseTags html