Put Model into separate module

- pass model to BodyRender
    - so we can render the quotelinks better (TODO)

chandlr.cabal

@@ -75,6 +75,7 @@ executable chandlr
                       Component.ThreadView
                       Component.Thread.Files
                       Component.Thread.Intro
+                      Component.Thread.Model
                       Component.BodyRender
                       Routes
                       Common.AttachmentType

src/Component/BodyRender.hs

@@ -23,6 +23,9 @@ import Miso.String (toMisoString, fromMisoString)
 import Text.Parsec (ParseError)
 import BodyParser (PostPart (..))
 import QuoteLinkParser
+import qualified Component.Thread.Model as Model
+import qualified Network.SiteType as Site
+import qualified Network.ThreadType as Thread
 
 {-
  - This is the inverse of parsePostBody from BodyParser except
@@ -34,21 +37,21 @@ import QuoteLinkParser
  - (is there an easy way to render a miso View?, that's what's missing
  - a f :: View a -> Text)
  -}
-render :: [ PostPart ] -> [ View a ]
-render = map renderPostPart
+render :: Model.Model -> [ PostPart ] -> [ View a ]
+render m = map (renderPostPart m)
 
-renderPostPart :: PostPart -> View a
-renderPostPart (SimpleText txt) = text txt
-renderPostPart (PostedUrl u) =
+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 _ Skip = br_ []
 
-renderPostPart (Quote url) = elems parse_result
+renderPostPart m (Quote url) = elems parse_result
     where
         parse_result = parseURL $ fromMisoString url
 
@@ -64,27 +67,27 @@ renderPostPart (Quote url) = elems parse_result
                 [ href_ url ]
                 [ text url ]
 
-renderPostPart (GreenText parts) =
-    span_ [ class_ "quote" ] (render parts)
+renderPostPart m (GreenText parts) =
+    span_ [ class_ "quote" ] (render m parts)
 
-renderPostPart (OrangeText parts) =
-    span_ [ class_ "orangeQuote" ] (render parts)
+renderPostPart m (OrangeText parts) =
+    span_ [ class_ "orangeQuote" ] (render m parts)
 
-renderPostPart (RedText parts) =
-    span_ [ class_ "heading" ] (render parts)
+renderPostPart m (RedText parts) =
+    span_ [ class_ "heading" ] (render m parts)
 
-renderPostPart (Spoiler parts) =
-    span_ [ class_ "spoiler" ] (render parts)
+renderPostPart m (Spoiler parts) =
+    span_ [ class_ "spoiler" ] (render m parts)
 
-renderPostPart (Bold parts) =
-    strong_ [] (render parts)
+renderPostPart m (Bold parts) =
+    strong_ [] (render m parts)
 
-renderPostPart (Underlined parts) =
-    u_ [] (render parts)
+renderPostPart m (Underlined parts) =
+    u_ [] (render m parts)
 
-renderPostPart (Italics parts) =
-    em_ [] (render parts)
+renderPostPart m (Italics parts) =
+    em_ [] (render m parts)
 
-renderPostPart (Strikethrough parts) =
-    s_ [] (render parts)
+renderPostPart m (Strikethrough parts) =
+    s_ [] (render m parts)
 

src/Component/Thread/Model.hs

@@ -0,0 +1,15 @@
+module Component.Thread.Model where
+
+import GHCJS.DOM.Types (JSString)
+import Network.SiteType (Site)
+import Network.PostType (Post)
+import BodyParser (PostPart)
+
+type PostWithBody = (Post, [ PostPart ])
+
+data Model = Model
+  { site :: Site
+  , media_root :: JSString
+  , post_bodies :: [ PostWithBody ]
+  } deriving Eq
+

src/Component/ThreadView.hs

@@ -37,17 +37,10 @@ import qualified Network.BoardType as Board
 import qualified Network.ThreadType as Thread
 import Component.Thread.Files (files)
 import Component.Thread.Intro (intro)
+import Component.Thread.Model
 import BodyParser
 import qualified Component.BodyRender as Body
 
-type PostWithBody = (Post, [ PostPart ])
-
-data Model = Model
-  { site :: Site
-  , media_root :: JSString
-  , post_bodies :: [ PostWithBody ]
-  } deriving Eq
-
 initialModel :: JSString -> Site -> Model
 initialModel mroot s = Model
     { site = s
@@ -127,7 +120,7 @@ op m op_post =
     where
         body :: [ PostWithBody ] -> [ View a ]
         body [] = []
-        body x = Body.render $ snd $ head x
+        body x = Body.render m $ snd $ head x
 
 
 multi :: Post -> [ Attribute a ]
@@ -143,6 +136,9 @@ reply m (post, parts) = div_
     , textProp "data-board" "leftypol"
     ]
     [ div_
+        [ class_ "sidearrows" ]
+        [ text ">>" ]
+    , div_
         (
             [ class_ "post reply"
             , id_ "reply_477702"
@@ -152,6 +148,6 @@ reply m (post, parts) = div_
         , files (media_root m) (site m) post
         , div_
             [ class_ "body" ]
-            (Body.render parts)
+            (Body.render m parts)
         ]
     ]