From 57776a1110ec03b04cd7cd2e7d8da52235c7711c Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Tue, 13 Feb 2024 06:19:27 -0500 Subject: [PATCH] Render quote links properly --- src/BodyParser.hs | 8 +++-- src/Component/BodyRender.hs | 70 +++++++++++++++++++++++++++++-------- src/Component/ThreadView.hs | 6 ++-- src/QuoteLinkParser.hs | 50 +++++++++++++++----------- 4 files changed, 93 insertions(+), 41 deletions(-) diff --git a/src/BodyParser.hs b/src/BodyParser.hs index f087750..848e388 100644 --- a/src/BodyParser.hs +++ b/src/BodyParser.hs @@ -23,13 +23,17 @@ import qualified GHCJS.DOM.JSFFI.Generated.NodeList as NodeList import GHCJS.DOM.JSFFI.Generated.DOMTokenList (contains) import Data.Text (Text) import Miso (consoleLog) +import Miso.String (fromMisoString) +import Text.Parsec (ParseError) + +import QuoteLinkParser data PostPart = SimpleText JSString | PostedUrl JSString | Skip - | Quote JSString + | Quote (Either ParseError ParsedURL) -- Quotes don't seem to be able to be spoilered -- board links (which appear as quotes but start with >>>) break the tag | GreenText [ PostPart ] @@ -109,7 +113,7 @@ parseAnchor element = do case target of Just ("_blank" :: JSString) -> return $ PostedUrl href - _ -> return $ Quote href + _ -> return $ Quote $ parseURL $ fromMisoString href parseSpan :: Element -> IO PostPart diff --git a/src/Component/BodyRender.hs b/src/Component/BodyRender.hs index b634485..9f527a1 100644 --- a/src/Component/BodyRender.hs +++ b/src/Component/BodyRender.hs @@ -16,16 +16,19 @@ import Miso , u_ , em_ , s_ - , title_ ) -import Miso.String (toMisoString, fromMisoString) +import Miso.String (toMisoString) +import System.FilePath (()) import Text.Parsec (ParseError) +import GHCJS.DOM.Types (JSString) +import Data.Maybe (fromJust) + import BodyParser (PostPart (..)) import QuoteLinkParser import qualified Component.Thread.Model as Model import qualified Network.SiteType as Site -import qualified Network.ThreadType as Thread +import qualified Network.BoardType as Board {- - This is the inverse of parsePostBody from BodyParser except @@ -51,21 +54,60 @@ renderPostPart _ (PostedUrl u) = renderPostPart _ Skip = br_ [] -renderPostPart m (Quote url) = elems parse_result +renderPostPart m (Quote parse_result) = elems parse_result where - parse_result = parseURL $ fromMisoString url - elems :: Either ParseError ParsedURL -> View a elems (Left err) = a_ - [ href_ url - , title_ $ toMisoString $ show err - ] - [ text url ] - elems (Right ParsedURL {..}) = - a_ - [ href_ url ] - [ text url ] + [] + [ text $ toMisoString $ show err ] + elems (Right p) = + case full_url p of + Nothing -> + a_ + [ href_ $ "/" <> site_name <> "/" <> linked_board <> "/" ] + [ text $ ">>>/" <> linked_board <> "/" ] + + Just u -> + if current_board /= linked_board + then + a_ + [ href_ u ] + [ text $ ">>>/" <> linked_board <> "/" <> post_id ] + else + a_ + [ href_ u ] + [ text $ ">>" <> post_id ] + + where + linked_board = toMisoString $ boardName p + + post_id = toMisoString $ show $ fromJust $ postId p + + current_board = toMisoString $ Board.pathpart $ head $ Site.boards (Model.site m) + + + full_url :: ParsedURL -> Maybe JSString + full_url ParsedURL {..} = do + tid <- threadId + pid <- postId + + return $ "/" <> site_name <> "/" <> (toMisoString $ boardName show tid ++ "#" ++ show pid) + + site_name = toMisoString $ Site.name $ Model.site m + + -- cases of urls: + -- url: + -- /b/res/1.html#2 + -- if on different board: + -- >>/b/2 + -- if on same board or same thread: + -- >>2 + -- + -- url: + -- /b/index.html + -- if only board: + -- >>>/b/ renderPostPart m (GreenText parts) = span_ [ class_ "quote" ] (render m parts) diff --git a/src/Component/ThreadView.hs b/src/Component/ThreadView.hs index 95e5689..8fb52de 100644 --- a/src/Component/ThreadView.hs +++ b/src/Component/ThreadView.hs @@ -18,7 +18,6 @@ import Miso , noEff , class_ , id_ - , textProp , h2_ , Attribute , (<#) @@ -107,7 +106,7 @@ op m op_post = , div_ ( [ class_ "post op" - , id_ "op_477700" + , id_ $ toMisoString $ show $ Post.board_post_id op_post ] ++ multi op_post ) [ intro op_post @@ -132,8 +131,7 @@ multi post reply :: Model -> PostWithBody -> View a reply m (post, parts) = div_ [ class_ "postcontainer" - , id_ "pc477702" - , textProp "data-board" "leftypol" + , id_ $ toMisoString $ show $ Post.board_post_id post ] [ div_ [ class_ "sidearrows" ] diff --git a/src/QuoteLinkParser.hs b/src/QuoteLinkParser.hs index 690cecd..04d422e 100644 --- a/src/QuoteLinkParser.hs +++ b/src/QuoteLinkParser.hs @@ -7,14 +7,12 @@ module QuoteLinkParser import Text.Parsec import Text.Parsec.String (Parser) - +-- Define a data type to hold the extracted components data ParsedURL = ParsedURL - { siteName :: Maybe String - , boardName :: String + { boardName :: String , threadId :: Maybe Integer , postId :: Maybe Integer - } deriving (Show) - + } deriving (Show, Eq) -- Parser for a segment of the path segment :: Parser String @@ -24,32 +22,42 @@ segment = many (noneOf "/#") integer :: Parser Integer integer = read <$> many1 digit --- Parser for the site name -siteNameParser :: Parser (Maybe String) -siteNameParser = optionMaybe $ char '/' >> segment - -- Parser for the board name boardNameParser :: Parser String boardNameParser = char '/' >> segment -- Optional parser for the thread number threadNumberParser :: Parser (Maybe Integer) -threadNumberParser = optionMaybe $ try (char '/' >> string "res/" >> integer) +threadNumberParser = optionMaybe $ try $ do + _ <- char '/' >> string "res/" + tId <- integer + _ <- string ".html" + return tId + +-- Parser for index.html, returning Nothing for threadId and postId +indexParser :: Parser (Maybe Integer, Maybe Integer) +indexParser = try $ do + _ <- string "/index.html" + return (Nothing, Nothing) + +-- Combined URL parser +urlParser :: Parser ParsedURL +urlParser = do + bName <- boardNameParser + + (tId, pId) <- try threadNumberParser >>= \mTid -> + case mTid of + Just tId -> do + pId <- postIdParser + return (Just tId, pId) + Nothing -> indexParser + eof -- Expect the end of input + return $ ParsedURL bName tId pId -- Optional parser for the post ID postIdParser :: Parser (Maybe Integer) postIdParser = optionMaybe $ char '#' >> integer --- Combined URL parser -urlParser :: Parser ParsedURL -urlParser = do - sName <- siteNameParser - bName <- boardNameParser - tId <- threadNumberParser - pId <- postIdParser - eof -- Expect the end of input - return $ ParsedURL sName bName tId pId - -- Function to run the parser parseURL :: String -> Either ParseError ParsedURL -parseURL = parse urlParser "chan" +parseURL = parse urlParser ""