Parse Quote links

- use parsec to parse
- since the function is pure we can use it in BodyRender
    - need to pass the model to BodyRender before we can correctly
      render the link TODO

chandlr.cabal

@@ -79,6 +79,7 @@ executable chandlr
                       Routes
                       Common.AttachmentType
                       BodyParser
+                      QuoteLinkParser
 
 
     -- LANGUAGE extensions used by modules in this package.
@@ -97,7 +98,8 @@ executable chandlr
                        bytestring,
                        filepath,
                        network-uri,
-                       containers
+                       containers,
+                       parsec
 
     -- Directories containing source files.
     hs-source-dirs:   src

src/Component/BodyRender.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Component.BodyRender where
 
@@ -15,9 +16,13 @@ import Miso
     , u_
     , em_
     , s_
+    , title_
     )
 
+import Miso.String (toMisoString, fromMisoString)
+import Text.Parsec (ParseError)
 import BodyParser (PostPart (..))
+import QuoteLinkParser
 
 {-
  - This is the inverse of parsePostBody from BodyParser except
@@ -40,8 +45,21 @@ renderPostPart (PostedUrl u) =
         , target_ "_blank"
         ]
         [ text u ]
+
 renderPostPart Skip = br_ []
-renderPostPart (Quote url) =
+
+renderPostPart (Quote url) = 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 ]

src/Component/ThreadView.hs

@@ -38,7 +38,7 @@ import qualified Network.ThreadType as Thread
 import Component.Thread.Files (files)
 import Component.Thread.Intro (intro)
 import BodyParser
-import Component.BodyRender
+import qualified Component.BodyRender as Body
 
 type PostWithBody = (Post, [ PostPart ])
 
@@ -115,7 +115,7 @@ op m op_post =
         (
             [ class_ "post op"
             , id_ "op_477700"
-            ] ++ multi
+            ] ++ multi op_post
         )
         [ intro op_post
         , div_
@@ -125,14 +125,15 @@ op m op_post =
     ]
 
     where
-        multi :: [ Attribute a ]
-        multi
-            | length (Post.attachments op_post) > 1 = [ class_ "multifile" ]
-            | otherwise = []
-
         body :: [ PostWithBody ] -> [ View a ]
         body [] = []
-        body x = render $ snd $ head x
+        body x = Body.render $ snd $ head x
+
+
+multi :: Post -> [ Attribute a ]
+multi post
+    | length (Post.attachments post) > 1 = [ class_ "multifile" ]
+    | otherwise = []
 
 
 reply :: Model -> PostWithBody -> View a
@@ -142,13 +143,15 @@ reply m (post, parts) = div_
     , textProp "data-board" "leftypol"
     ]
     [ div_
+        (
             [ class_ "post reply"
             , id_ "reply_477702"
-        ]
+            ] ++ multi post
+        )
         [ intro post
         , files (media_root m) (site m) post
         , div_
             [ class_ "body" ]
-            (render parts)
+            (Body.render parts)
         ]
     ]

src/QuoteLinkParser.hs

@@ -0,0 +1,55 @@
+module QuoteLinkParser
+    ( parseURL
+    , ParsedURL (..)
+    )
+    where
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+
+
+data ParsedURL = ParsedURL
+  { siteName    :: Maybe String
+  , boardName   :: String
+  , threadId    :: Maybe Integer
+  , postId      :: Maybe Integer
+  } deriving (Show)
+
+
+-- Parser for a segment of the path
+segment :: Parser String
+segment = many (noneOf "/#")
+
+-- Parser for an integer
+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)
+
+-- 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"