Move ThreadView Component into Common
This commit is contained in:
parent
01b36caec8
commit
89ccf78c60
|
|
@ -73,7 +73,7 @@ executable chandlr
|
||||||
Network.SiteType
|
Network.SiteType
|
||||||
Network.PostType
|
Network.PostType
|
||||||
Network.ThreadType
|
Network.ThreadType
|
||||||
Component.ThreadView
|
Common.Component.ThreadView
|
||||||
Component.Thread.Files
|
Component.Thread.Files
|
||||||
Component.Thread.Intro
|
Component.Thread.Intro
|
||||||
Component.Thread.Model
|
Component.Thread.Model
|
||||||
|
|
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit a86310c33167d3cc5e5e6908c33abb9daefdaab5
|
Subproject commit d2bbfdeec53ad9bc6a21f838a2b30681faba1df5
|
||||||
|
|
@ -1,198 +0,0 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Component.ThreadView
|
|
||||||
( Model (..)
|
|
||||||
, initialModel
|
|
||||||
, Action (..)
|
|
||||||
, update
|
|
||||||
, view
|
|
||||||
, Interface (..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Miso
|
|
||||||
( View
|
|
||||||
, Effect
|
|
||||||
, div_
|
|
||||||
, text
|
|
||||||
, h1_
|
|
||||||
, noEff
|
|
||||||
, class_
|
|
||||||
, id_
|
|
||||||
, h2_
|
|
||||||
, Attribute
|
|
||||||
, (<#)
|
|
||||||
, consoleLog
|
|
||||||
)
|
|
||||||
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Miso.String (toMisoString)
|
|
||||||
import GHCJS.DOM.Types (JSString)
|
|
||||||
import Data.Time.Clock (UTCTime (..), secondsToDiffTime, getCurrentTime)
|
|
||||||
import Data.Time.Calendar (Day (..))
|
|
||||||
|
|
||||||
import Network.SiteType (Site)
|
|
||||||
import qualified Network.SiteType as Site
|
|
||||||
import Network.PostType (Post)
|
|
||||||
import qualified Network.PostType as Post
|
|
||||||
import qualified Network.BoardType as Board
|
|
||||||
import Network.BoardType (Board)
|
|
||||||
import qualified Network.ThreadType as Thread
|
|
||||||
import Network.ThreadType (Thread)
|
|
||||||
import Component.Thread.Files (files)
|
|
||||||
import Component.Thread.Intro (intro)
|
|
||||||
import Component.Thread.Embed (embed)
|
|
||||||
import Component.Thread.Model
|
|
||||||
import Parsing.BodyParser
|
|
||||||
import qualified Component.BodyRender as Body
|
|
||||||
|
|
||||||
initialModel :: JSString -> Site -> Model
|
|
||||||
initialModel mroot s = Model
|
|
||||||
{ site = s
|
|
||||||
, post_bodies = []
|
|
||||||
, media_root = mroot
|
|
||||||
, current_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0)
|
|
||||||
}
|
|
||||||
|
|
||||||
data Action
|
|
||||||
= RenderSite Site
|
|
||||||
| UpdatePostBodies UTCTime [ PostWithBody ]
|
|
||||||
|
|
||||||
data Interface a = Interface { passAction :: Action -> a }
|
|
||||||
|
|
||||||
update :: Interface a -> Action -> Model -> Effect a Model
|
|
||||||
update iface (RenderSite s) m = m { site = s } <# do
|
|
||||||
bodies <- mapM getBody (map Post.body posts)
|
|
||||||
|
|
||||||
mapM_ (consoleLog . toMisoString . show) bodies
|
|
||||||
|
|
||||||
now <- getCurrentTime
|
|
||||||
|
|
||||||
return $ passAction iface $ UpdatePostBodies now $ zip posts bodies
|
|
||||||
|
|
||||||
where
|
|
||||||
getBody :: Maybe Text -> IO [ PostPart ]
|
|
||||||
getBody Nothing = return []
|
|
||||||
getBody (Just b) = parsePostBody b
|
|
||||||
|
|
||||||
posts :: [ Post ]
|
|
||||||
posts = Thread.posts $ head $ Board.threads $ head $ Site.boards s
|
|
||||||
--update (RenderSite s) m = noEff (m { site = s })
|
|
||||||
|
|
||||||
update _ (UpdatePostBodies t pwbs) m = noEff m { post_bodies = pwbs, current_time = t }
|
|
||||||
|
|
||||||
|
|
||||||
view :: Model -> View a
|
|
||||||
view m =
|
|
||||||
div_
|
|
||||||
[]
|
|
||||||
(
|
|
||||||
[ h1_ [] [ text title ]
|
|
||||||
, div_
|
|
||||||
[ class_ "thread" ]
|
|
||||||
( (op_post thread_posts)
|
|
||||||
++ map (reply m backlinks) (drop 1 (post_bodies m))
|
|
||||||
)
|
|
||||||
]
|
|
||||||
)
|
|
||||||
|
|
||||||
where
|
|
||||||
thread_posts :: [ Post ]
|
|
||||||
thread_posts =
|
|
||||||
concatMap (Thread.posts) $
|
|
||||||
concatMap (Board.threads) $
|
|
||||||
Site.boards (site m)
|
|
||||||
|
|
||||||
backlinks :: Backlinks
|
|
||||||
backlinks = collectBacklinks (post_bodies m)
|
|
||||||
|
|
||||||
op_post :: [ Post ] -> [ View a ]
|
|
||||||
op_post [] = [ h2_ [] [ "There's nothing here" ] ]
|
|
||||||
op_post (x:_) = op m x backlinks
|
|
||||||
|
|
||||||
title :: JSString
|
|
||||||
title = toMisoString $ (Site.name $ site m) <> " /" <> board <> "/"
|
|
||||||
|
|
||||||
board = Board.pathpart $ head $ Site.boards (site m)
|
|
||||||
|
|
||||||
|
|
||||||
op :: Model -> Post -> Backlinks -> [ View a ]
|
|
||||||
op m op_post backlinks =
|
|
||||||
[ files_or_embed_view
|
|
||||||
, div_
|
|
||||||
(
|
|
||||||
[ class_ "post op"
|
|
||||||
, id_ $ toMisoString $ show $ Post.board_post_id op_post
|
|
||||||
] ++ multi op_post
|
|
||||||
)
|
|
||||||
[ intro site_ board thread op_post backlinks $ current_time m
|
|
||||||
, div_
|
|
||||||
[ class_ "body" ]
|
|
||||||
(body $ post_bodies m)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
where
|
|
||||||
files_or_embed_view :: View a
|
|
||||||
files_or_embed_view =
|
|
||||||
case (Post.embed op_post) of
|
|
||||||
Just _ -> embed op_post
|
|
||||||
Nothing -> files (media_root m) site_ op_post
|
|
||||||
|
|
||||||
|
|
||||||
site_ :: Site
|
|
||||||
site_ = site m
|
|
||||||
|
|
||||||
board :: Board
|
|
||||||
board = head $ Site.boards site_
|
|
||||||
|
|
||||||
thread :: Thread
|
|
||||||
thread = head $ Board.threads board
|
|
||||||
|
|
||||||
body :: [ PostWithBody ] -> [ View a ]
|
|
||||||
body [] = []
|
|
||||||
body x = Body.render m $ snd $ head x
|
|
||||||
|
|
||||||
|
|
||||||
multi :: Post -> [ Attribute a ]
|
|
||||||
multi post
|
|
||||||
| length (Post.attachments post) > 1 = [ class_ "multifile" ]
|
|
||||||
| otherwise = []
|
|
||||||
|
|
||||||
|
|
||||||
reply :: Model -> Backlinks -> PostWithBody -> View a
|
|
||||||
reply m backlinks (post, parts) = div_
|
|
||||||
[ class_ "postcontainer"
|
|
||||||
, id_ $ toMisoString $ show $ Post.board_post_id post
|
|
||||||
]
|
|
||||||
[ div_
|
|
||||||
[ class_ "sidearrows" ]
|
|
||||||
[ text ">>" ]
|
|
||||||
, div_
|
|
||||||
(
|
|
||||||
[ class_ "post reply"
|
|
||||||
] ++ multi post
|
|
||||||
)
|
|
||||||
[ intro site_ board thread post backlinks $ current_time m
|
|
||||||
, files_or_embed_view
|
|
||||||
, div_
|
|
||||||
[ class_ "body" ]
|
|
||||||
(Body.render m parts)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
where
|
|
||||||
files_or_embed_view :: View a
|
|
||||||
files_or_embed_view =
|
|
||||||
case (Post.embed post) of
|
|
||||||
Just _ -> embed post
|
|
||||||
Nothing -> files (media_root m) site_ post
|
|
||||||
|
|
||||||
site_ :: Site
|
|
||||||
site_ = site m
|
|
||||||
|
|
||||||
board :: Board
|
|
||||||
board = head $ Site.boards site_
|
|
||||||
|
|
||||||
thread :: Thread
|
|
||||||
thread = head $ Board.threads board
|
|
||||||
|
|
||||||
|
|
@ -49,10 +49,9 @@ import qualified Network.Client as Client
|
||||||
import Common.Network.CatalogPostType (CatalogPost)
|
import Common.Network.CatalogPostType (CatalogPost)
|
||||||
import qualified Common.Network.CatalogPostType as CatalogPost
|
import qualified Common.Network.CatalogPostType as CatalogPost
|
||||||
import qualified Component.CatalogGrid as Grid
|
import qualified Component.CatalogGrid as Grid
|
||||||
import qualified Component.ThreadView as Thread
|
import qualified Common.Component.ThreadView as Thread
|
||||||
import qualified Common.Component.TimeControl as TC
|
import qualified Common.Component.TimeControl as TC
|
||||||
import qualified Component.Search as Search
|
import qualified Component.Search as Search
|
||||||
import qualified Common.Component.Search.SearchTypes as Search
|
|
||||||
|
|
||||||
|
|
||||||
data Model = Model
|
data Model = Model
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue