Move quotedPosts and collectBacklinks into Common.PostBodyUtils

This commit is contained in:
towards-a-new-leftypol 2024-03-06 00:37:48 -05:00
parent 0468c6ee10
commit 0b1c8b0fd0
2 changed files with 2 additions and 25 deletions

@ -1 +1 @@
Subproject commit 738f76cb9a56cc397a7b9c1efc844fbf6622dea8 Subproject commit 7e0cfd57269bb631417a9bcf9f9f071520000a88

View File

@ -12,7 +12,6 @@ module Parsing.BodyParser
) where ) where
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import qualified Data.Map as Map
import GHCJS.DOM (currentDocument) import GHCJS.DOM (currentDocument)
import GHCJS.DOM.Types import GHCJS.DOM.Types
( Element (..) ( Element (..)
@ -28,10 +27,10 @@ import GHCJS.DOM.JSFFI.Generated.DOMTokenList (contains)
import Data.Text (Text) import Data.Text (Text)
import Miso (consoleLog) import Miso (consoleLog)
import Miso.String (fromMisoString) import Miso.String (fromMisoString)
import Common.Component.Thread.Model (PostWithBody)
import Common.Parsing.PostPartType import Common.Parsing.PostPartType
import Common.Parsing.QuoteLinkParser import Common.Parsing.QuoteLinkParser
import Common.Parsing.PostBodyUtils
nodeListToList :: NodeList -> IO [ Node ] nodeListToList :: NodeList -> IO [ Node ]
@ -143,25 +142,3 @@ parseS :: Element -> IO PostPart
parseS element parseS element
= parseChildNodes element = parseChildNodes element
>>= return . Strikethrough >>= return . Strikethrough
collectBacklinks :: [PostWithBody] -> Backlinks
collectBacklinks xs = foldr insertElement Map.empty xs
where
insertElement :: PostWithBody -> Backlinks -> Backlinks
insertElement (post, body) acc = foldr insertPost acc (quotedPosts body)
where
insertPost postId = Map.insertWith (++) postId [post]
quotedPosts :: [ PostPart ] -> [ Integer ]
quotedPosts [] = []
quotedPosts (Quote (Right (ParsedURL { postId = Just p })) : xs) = [p] ++ quotedPosts xs
quotedPosts ((GreenText xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts ((OrangeText xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts ((RedText xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts ((Spoiler xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts ((Bold xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts ((Underlined xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts ((Italics xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts ((Strikethrough xs) : xxs) = quotedPosts xs ++ quotedPosts xxs
quotedPosts _ = []