From ceebf6df60a2b6e708aa1b01d686b6f1e824172f Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Tue, 5 Mar 2024 21:07:54 -0500 Subject: [PATCH] Move BodyRender into Common --- chandlr.cabal | 2 +- src/Common | 2 +- src/Component/BodyRender.hs | 147 ------------------------------------ 3 files changed, 2 insertions(+), 149 deletions(-) delete mode 100644 src/Component/BodyRender.hs diff --git a/chandlr.cabal b/chandlr.cabal index bb80f36..1fb9afc 100644 --- a/chandlr.cabal +++ b/chandlr.cabal @@ -78,7 +78,7 @@ executable chandlr Component.Thread.Intro Component.Thread.Model Component.Thread.Embed - Component.BodyRender + Common.Component.BodyRender Common.FrontEnd.Routes Common.AttachmentType Parsing.BodyParser diff --git a/src/Common b/src/Common index d2bbfde..cbc894b 160000 --- a/src/Common +++ b/src/Common @@ -1 +1 @@ -Subproject commit d2bbfdeec53ad9bc6a21f838a2b30681faba1df5 +Subproject commit cbc894bcd57f6c693c0bf62df4e52fdbf076e840 diff --git a/src/Component/BodyRender.hs b/src/Component/BodyRender.hs deleted file mode 100644 index 9cc5411..0000000 --- a/src/Component/BodyRender.hs +++ /dev/null @@ -1,147 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -module Component.BodyRender where - -import Miso - ( text - , href_ - , a_ - , View - , target_ - , br_ - , span_ - , class_ - , strong_ - , u_ - , em_ - , s_ - , small_ - ) - -import Miso.String (toMisoString) -import System.FilePath (()) -import Text.Parsec (ParseError) -import GHCJS.DOM.Types (JSString) -import Data.Maybe (fromJust) - -import Parsing.BodyParser (PostPart (..)) -import Parsing.QuoteLinkParser -import qualified Component.Thread.Model as Model -import qualified Network.SiteType as Site -import qualified Network.BoardType as Board -import qualified Network.ThreadType as Thread -import qualified Network.PostType as Post - -{- - - This is the inverse of parsePostBody from BodyParser except - - that the output is a miso View and not Text. It might be - - worth trying to use quickcheck to verify the bijection between - - Text and DOM by creating random PostParts and seeing if - - ((parsePostBody . render) parts == parts) - - - - (is there an easy way to render a miso View?, that's what's missing - - a f :: View a -> Text) - -} -render :: Model.Model -> [ PostPart ] -> [ View a ] -render m = map (renderPostPart m) - -renderPostPart :: Model.Model -> PostPart -> View a -renderPostPart _ (SimpleText txt) = text txt -renderPostPart _ (PostedUrl u) = - a_ - [ href_ u - , target_ "_blank" - ] - [ text u ] - -renderPostPart _ Skip = br_ [] - -renderPostPart m (Quote parse_result) = elems parse_result - where - elems :: Either ParseError ParsedURL -> View a - elems (Left err) = - a_ - [] - [ 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) - : - if pid == op_id - then [ small_ [] [ " (OP)" ] ] - else [] - - where - linked_board = toMisoString $ boardName p - - pid = fromJust $ postId p - - post_id = toMisoString $ show pid - - current_board = toMisoString $ Board.pathpart $ head $ Site.boards (Model.site m) - - op_id = Post.board_post_id $ head $ Thread.posts $ head $ Board.threads $ 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) - -renderPostPart m (OrangeText parts) = - span_ [ class_ "orangeQuote" ] (render m parts) - -renderPostPart m (RedText parts) = - span_ [ class_ "heading" ] (render m parts) - -renderPostPart m (Spoiler parts) = - span_ [ class_ "spoiler" ] (render m parts) - -renderPostPart m (Bold parts) = - strong_ [] (render m parts) - -renderPostPart m (Underlined parts) = - u_ [] (render m parts) - -renderPostPart m (Italics parts) = - em_ [] (render m parts) - -renderPostPart m (Strikethrough parts) = - s_ [] (render m parts) -