render thread
This commit is contained in:
parent
831c0ba096
commit
9269448477
|
|
@ -72,6 +72,9 @@ executable chandlr
|
|||
Network.SiteType
|
||||
Network.PostType
|
||||
Network.ThreadType
|
||||
Component.ThreadView
|
||||
Component.Thread.Files
|
||||
Component.Thread.Intro
|
||||
Routes
|
||||
Common.AttachmentType
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +1,19 @@
|
|||
<div class="files"> <div class="file"> <p class="fileinfo"><span>File <small>(<a class="hide-image-link" href="javascript:void(0)" style="">hide</a>)</small>: </span><a href="/leftypol/src/1705665213107.png" target="_blank">1705665213107.png</a> <span class="details"> ( 1.88 MB , 1200x800 , <a download="south-african-representatives-at-the-international-court-of-justice.png" href="javascript:void(0)" title="Save as original filename (south-african-representatives-at-the-international-court-of-justice.png)">south-african-representati….png</a> ) </span></p> <a href="/leftypol/src/1705665213107.png" target="_blank"><img class="post-image" loading="lazy" src="https://leftychan.net/leftypol/thumb/1705665213107.png" style="width:255px;height:170px" alt=""></a> </div> </div>
|
||||
<div class="files">
|
||||
<div class="file">
|
||||
<p class="fileinfo">
|
||||
<span>
|
||||
File <small>(<a class="hide-image-link" href="javascript:void(0)" style="">hide</a>)</small>
|
||||
:
|
||||
</span>
|
||||
<a href="/leftypol/src/1705665213107.png" target="_blank">1705665213107.png</a>
|
||||
<span class="details">
|
||||
(1.88 MB, 1200x800,
|
||||
<a download="south-african-representatives-at-the-international-court-of-justice.png" href="javascript:void(0)" title="Save as original filename (south-african-representatives-at-the-international-court-of-justice.png)">south-african-representati….png</a>
|
||||
)
|
||||
</span>
|
||||
</p>
|
||||
<a href="/leftypol/src/1705665213107.png" target="_blank">
|
||||
<img class="post-image" loading="lazy" src="https://leftychan.net/leftypol/thumb/1705665213107.png" style="width:255px;height:170px" alt="">
|
||||
</a>
|
||||
</div>
|
||||
</div>
|
||||
|
|
|
|||
|
|
@ -17,6 +17,10 @@
|
|||
margin-left: .2em;
|
||||
margin-right: .2em;
|
||||
}
|
||||
|
||||
.post.op.multifile {
|
||||
clear: both;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
|
|
|
|||
|
|
@ -1,2 +1,2 @@
|
|||
curl -v 'http://localhost:3000/sites?select=*,boards(*,threads(*,posts(*,attachments(*))))&name=eq.leftychan&boards.pathpart=eq.ga&boards.threads.board_thread_id=eq.11787' \
|
||||
curl -v 'http://localhost:3000/sites?select=*,boards(*,threads(*,posts(*,attachments(*))))&name=eq.leftychan&boards.pathpart=eq.ga&boards.threads.board_thread_id=eq.11787&boards.threads.posts.order=board_post_id.asc' \
|
||||
-H "Content-Type: application/json"
|
||||
|
|
|
|||
|
|
@ -108,7 +108,7 @@ gridItem iface m post =
|
|||
body = map (rawHtml . toMisoString) $ maybeToList $ CatalogPost.body post
|
||||
|
||||
post_count_str :: MisoString
|
||||
post_count_str = "R: " `append` (toMisoString $ CatalogPost.estimated_post_count post) `append` "+"
|
||||
post_count_str = "R: " `append` (toMisoString $ (CatalogPost.estimated_post_count post) - 1) `append` "+"
|
||||
|
||||
thumb_url :: MisoString
|
||||
thumb_url =
|
||||
|
|
|
|||
|
|
@ -0,0 +1,176 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Component.Thread.Files where
|
||||
|
||||
import Miso
|
||||
( View
|
||||
, div_
|
||||
, href_
|
||||
, a_
|
||||
, class_
|
||||
, title_
|
||||
, alt_
|
||||
, src_
|
||||
, style_
|
||||
, img_
|
||||
, span_
|
||||
, loading_
|
||||
, download_
|
||||
, p_
|
||||
, Attribute
|
||||
, text
|
||||
)
|
||||
|
||||
import Data.Foldable (toList)
|
||||
import qualified Data.Text as Text
|
||||
import Miso.String (append, toMisoString)
|
||||
import qualified Data.Map as Map
|
||||
import GHCJS.DOM.Types (JSString)
|
||||
import Network.SiteType (Site)
|
||||
import qualified Network.SiteType as Site
|
||||
import qualified Network.BoardType as Board
|
||||
import qualified Network.ThreadType as Thread
|
||||
import qualified Network.PostType as Post
|
||||
import Network.PostType (Post)
|
||||
import Common.AttachmentType (Attachment, Dimension (..))
|
||||
import qualified Common.AttachmentType as Attachment
|
||||
import Network.Units (bytesToHumanReadable)
|
||||
|
||||
max_thumbnail_width :: Int
|
||||
max_thumbnail_width = 255
|
||||
|
||||
max_thumbnail_height :: Int
|
||||
max_thumbnail_height = 255
|
||||
|
||||
max_original_filename_display_length :: Int
|
||||
max_original_filename_display_length = 25
|
||||
|
||||
files :: JSString -> Site -> Post -> View a
|
||||
files media_root site post = div_
|
||||
[ class_ "files" ]
|
||||
( map (file media_root site multi) as )
|
||||
|
||||
where
|
||||
multi = length as > 1
|
||||
|
||||
as = Post.attachments post
|
||||
|
||||
file :: JSString -> Site -> Bool -> Attachment -> View a
|
||||
file media_root site multifile a = div_
|
||||
( [ class_ "file" ] ++
|
||||
if multifile then
|
||||
[ class_ "multifile" ] ++ file_elem_size_attr
|
||||
else []
|
||||
)
|
||||
[ p_
|
||||
[ class_ "fileinfo" ]
|
||||
[ span_ [] [ "File: " ]
|
||||
, a_
|
||||
[ href_ file_url
|
||||
][ text $ toMisoString board_filename]
|
||||
, text " "
|
||||
, span_
|
||||
[ class_ "details" ]
|
||||
[ text $ "(" `append` size `append` ", 1280x720, "
|
||||
, a_
|
||||
[ download_ orig_file_name
|
||||
, href_ file_url
|
||||
, title_ $ "Save as original filename (" `append` orig_file_name `append` ")"
|
||||
][ text filename_text ]
|
||||
, ")"
|
||||
]
|
||||
]
|
||||
, a_
|
||||
[ href_ file_url
|
||||
]
|
||||
[ img_
|
||||
(
|
||||
[ class_ "post-image"
|
||||
, loading_ "lazy"
|
||||
, src_ thumb_url
|
||||
, alt_ ""
|
||||
] ++ size_style_attr
|
||||
)
|
||||
]
|
||||
]
|
||||
|
||||
where
|
||||
orig_file_name :: JSString
|
||||
orig_file_name = toMisoString fname
|
||||
|
||||
size :: JSString
|
||||
size = toMisoString $
|
||||
bytesToHumanReadable (Attachment.file_size_bytes a) True
|
||||
|
||||
filename_text :: JSString
|
||||
filename_text
|
||||
| Text.length fname > max_original_filename_display_length =
|
||||
toMisoString (Text.take max_original_filename_display_length fname)
|
||||
`append` "…" `append` toMisoString file_ext
|
||||
| otherwise = toMisoString fname
|
||||
|
||||
fname :: Text.Text
|
||||
fname = maybe board_filename id $ Attachment.original_filename a
|
||||
|
||||
file_ext :: Text.Text
|
||||
file_ext = maybe "" ((<>) ".") $ Attachment.file_extension a
|
||||
|
||||
board_filename :: Text.Text
|
||||
board_filename = Attachment.board_filename a <> file_ext
|
||||
|
||||
thumb_url :: JSString
|
||||
thumb_url = img_url_path
|
||||
`append` "/thumbnail_" `append` toMisoString (Attachment.board_filename a)
|
||||
`append` toMisoString (maybe "" ((<>) ".") $ Attachment.thumb_extension a)
|
||||
|
||||
file_url :: JSString
|
||||
file_url = img_url_path
|
||||
`append` "/" `append` toMisoString (Attachment.board_filename a)
|
||||
`append` toMisoString file_ext
|
||||
|
||||
img_url_path :: JSString
|
||||
img_url_path
|
||||
= media_root
|
||||
`append` "/" `append` toMisoString (Site.name site)
|
||||
`append` "/" `append` toMisoString (Board.pathpart board)
|
||||
`append` "/" `append` toMisoString
|
||||
(show $ Thread.board_thread_id
|
||||
(head (Board.threads board)))
|
||||
|
||||
board :: Board.Board
|
||||
board = head $ Site.boards site
|
||||
|
||||
size_style_attr :: [ Attribute a ]
|
||||
size_style_attr = map (mk_size_style_attr . thumb_dimensions) $ toList $ Attachment.resolution a
|
||||
|
||||
file_elem_size_attr :: [ Attribute a ]
|
||||
file_elem_size_attr = map (mk_file_elem_width_style . thumb_dimensions) $ toList $ Attachment.resolution a
|
||||
|
||||
mk_file_elem_width_style :: Dimension -> Attribute a
|
||||
mk_file_elem_width_style Dimension {..} =
|
||||
style_ $ Map.singleton "width" $ toPx (width + 40)
|
||||
|
||||
mk_size_style_attr :: Dimension -> Attribute a
|
||||
mk_size_style_attr Dimension {..} = style_ $ Map.fromList
|
||||
[
|
||||
( "width"
|
||||
, toPx width
|
||||
)
|
||||
,
|
||||
( "height"
|
||||
, toPx height
|
||||
)
|
||||
]
|
||||
|
||||
toPx :: Int -> JSString
|
||||
toPx i = (toMisoString $ show i) `append` "px"
|
||||
|
||||
thumb_dimensions :: Dimension -> Dimension
|
||||
thumb_dimensions Dimension {..}
|
||||
| width > height = Dimension mw (round $ fromIntegral mw / fromIntegral width * (fromIntegral height :: Double))
|
||||
| otherwise = Dimension (round $ fromIntegral mh / fromIntegral height * (fromIntegral width :: Double)) mh
|
||||
where
|
||||
mw = min max_thumbnail_width width
|
||||
mh = min max_thumbnail_height height
|
||||
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Component.Thread.Intro where
|
||||
|
||||
import Miso
|
||||
( View
|
||||
, text
|
||||
, href_
|
||||
, a_
|
||||
, class_
|
||||
, id_
|
||||
, textProp
|
||||
, title_
|
||||
, span_
|
||||
, time_
|
||||
)
|
||||
|
||||
import GHCJS.DOM.Types (JSString)
|
||||
import Data.Foldable (toList)
|
||||
import Miso.String (toMisoString)
|
||||
|
||||
import Network.PostType (Post)
|
||||
import qualified Network.PostType as Post
|
||||
|
||||
intro :: Post -> View a
|
||||
intro post = span_
|
||||
[ class_ "intro" ]
|
||||
( subject ++
|
||||
[ span_
|
||||
[ class_ "name" ][ "Anonymous" ]
|
||||
-- TODO: Add flags (don't have that data in the db yet)
|
||||
, time_
|
||||
[ textProp "datetime" "2024-01-19T11:53:33Z"
|
||||
, textProp "data-local" "true"
|
||||
, title_ "14 days ago"
|
||||
][ "2024-01-19 (Fri) 06:53:33" ]
|
||||
, " "
|
||||
, a_
|
||||
[ class_ "post_no"
|
||||
, id_ "post_no_477700"
|
||||
, href_ "/leftypol/res/477700.html#477700"
|
||||
][ "No." ]
|
||||
, a_
|
||||
[ class_ "post_no"
|
||||
, href_ "/leftypol/res/477700.html#q477700"
|
||||
][ "477700" ]
|
||||
]
|
||||
)
|
||||
|
||||
where
|
||||
subject :: [ View a ]
|
||||
subject = map (mkSubject . toMisoString) $ toList $ Post.subject post
|
||||
|
||||
mkSubject :: JSString -> View a
|
||||
mkSubject s = span_
|
||||
[ class_ "subject" ]
|
||||
[ text s ]
|
||||
|
|
@ -15,30 +15,15 @@ import Miso
|
|||
, text
|
||||
, h1_
|
||||
, noEff
|
||||
, href_
|
||||
, a_
|
||||
, class_
|
||||
, id_
|
||||
, textProp
|
||||
, title_
|
||||
, alt_
|
||||
, src_
|
||||
, style_
|
||||
, img_
|
||||
, span_
|
||||
, time_
|
||||
, h2_
|
||||
, rawHtml
|
||||
, loading_
|
||||
, download_
|
||||
, small_
|
||||
, p_
|
||||
, for_
|
||||
, label_
|
||||
, Attribute
|
||||
)
|
||||
|
||||
import Data.Maybe (maybeToList)
|
||||
import qualified Data.Map as Map
|
||||
import Miso.String (toMisoString)
|
||||
import GHCJS.DOM.Types (JSString)
|
||||
|
||||
|
|
@ -48,6 +33,8 @@ import Network.PostType (Post)
|
|||
import qualified Network.PostType as Post
|
||||
import qualified Network.BoardType as Board
|
||||
import qualified Network.ThreadType as Thread
|
||||
import Component.Thread.Files (files)
|
||||
import Component.Thread.Intro (intro)
|
||||
|
||||
data Model = Model
|
||||
{ site :: Site
|
||||
|
|
@ -70,10 +57,13 @@ view m =
|
|||
div_
|
||||
[]
|
||||
(
|
||||
[ h1_ [] [ text $ toMisoString $ Site.name $ site m ]
|
||||
, op_post thread_posts
|
||||
[ h1_ [] [ text title ]
|
||||
, div_
|
||||
[ class_ "thread" ]
|
||||
( (op_post thread_posts)
|
||||
++ map (reply m) (drop 1 thread_posts)
|
||||
)
|
||||
]
|
||||
++ map reply (drop 1 thread_posts)
|
||||
)
|
||||
|
||||
where
|
||||
|
|
@ -83,64 +73,43 @@ view m =
|
|||
concatMap (Board.threads) $
|
||||
Site.boards (site m)
|
||||
|
||||
op_post :: [ Post ] -> View a
|
||||
op_post [] = h2_ [] [ "There's nothing here" ]
|
||||
op_post (x:_) = op x
|
||||
op_post :: [ Post ] -> [ View a ]
|
||||
op_post [] = [ h2_ [] [ "There's nothing here" ] ]
|
||||
op_post (x:_) = op m x
|
||||
|
||||
title :: JSString
|
||||
title = toMisoString $ (Site.name $ site m) <> " /" <> board <> "/"
|
||||
|
||||
board = Board.pathpart $ head $ Site.boards (site m)
|
||||
|
||||
|
||||
body :: Post -> [ View a ]
|
||||
body post = map (rawHtml . toMisoString) $ maybeToList $ Post.body post
|
||||
|
||||
op :: Post -> View a
|
||||
op op_post = div_
|
||||
[ class_ "post op"
|
||||
, id_ "op_477700"
|
||||
]
|
||||
[ span_
|
||||
[ class_ "intro" ]
|
||||
[ span_
|
||||
[ class_ "subject" ][ "Israel 'at war' as Hamas gunmen launch surprise attack from Gaza Thread Pt. II" ]
|
||||
, span_
|
||||
[ class_ "name" ][ "Anonymous" ]
|
||||
, img_
|
||||
[ style_ $ Map.fromList
|
||||
[
|
||||
( "max-height"
|
||||
, "16px"
|
||||
)
|
||||
,
|
||||
( "width"
|
||||
, "auto"
|
||||
)
|
||||
]
|
||||
, class_ "flag"
|
||||
, src_ "/static/flags/acceleration.png"
|
||||
, alt_ "Acceleration"
|
||||
, title_ "Acceleration"
|
||||
]
|
||||
, time_
|
||||
[ textProp "datetime" "2024-01-19T11:53:33Z"
|
||||
, textProp "data-local" "true"
|
||||
, title_ "14 days ago"
|
||||
][ "2024-01-19 (Fri) 06:53:33" ]
|
||||
]
|
||||
, " "
|
||||
, a_
|
||||
[ class_ "post_no"
|
||||
, id_ "post_no_477700"
|
||||
, href_ "/leftypol/res/477700.html#477700"
|
||||
][ "No." ]
|
||||
, a_
|
||||
[ class_ "post_no"
|
||||
, href_ "/leftypol/res/477700.html#q477700"
|
||||
][ "477700" ]
|
||||
op :: Model -> Post -> [ View a ]
|
||||
op m op_post =
|
||||
[ files (media_root m) (site m) op_post
|
||||
, div_
|
||||
[ class_ "body" ]
|
||||
(body op_post)
|
||||
(
|
||||
[ class_ "post op"
|
||||
, id_ "op_477700"
|
||||
] ++ multi
|
||||
)
|
||||
[ intro op_post
|
||||
, div_
|
||||
[ class_ "body" ]
|
||||
(body op_post)
|
||||
]
|
||||
]
|
||||
|
||||
reply :: Post -> View a
|
||||
reply post = div_
|
||||
where
|
||||
multi :: [ Attribute a ]
|
||||
multi
|
||||
| length (Post.attachments op_post) > 1 = [ class_ "multifile" ]
|
||||
| otherwise = []
|
||||
|
||||
reply :: Model -> Post -> View a
|
||||
reply m post = div_
|
||||
[ class_ "postcontainer"
|
||||
, id_ "pc477702"
|
||||
, textProp "data-board" "leftypol"
|
||||
|
|
@ -149,93 +118,8 @@ reply post = div_
|
|||
[ class_ "post reply"
|
||||
, id_ "reply_477702"
|
||||
]
|
||||
[ p_
|
||||
[ class_ "intro" ]
|
||||
[ label_
|
||||
[ for_ "delete_477702" ]
|
||||
[ span_
|
||||
[ class_ "name" ][ "Anonymous" ]
|
||||
, time_
|
||||
[ textProp "datetime" "2024-01-19T11:58:26Z"
|
||||
, textProp "data-local" "true"
|
||||
, title_ "17 days ago"
|
||||
][ "2024-01-19 (Fri) 06:58:26" ]
|
||||
]
|
||||
, " "
|
||||
, a_
|
||||
[ class_ "post_no"
|
||||
, id_ "post_no_477702"
|
||||
-- , onclick_ "highlightReply(477702)"
|
||||
, href_ "/leftypol/res/477700.html#477702"
|
||||
][ "No." ]
|
||||
, a_
|
||||
[ class_ "post_no"
|
||||
-- , onclick_ "citeReply(477702)"
|
||||
, href_ "/leftypol/res/477700.html#q477702"
|
||||
][ "477702" ]
|
||||
, span_
|
||||
[ class_ "mentioned unimportant" ]
|
||||
[ a_
|
||||
[ class_ "mentioned-477703"
|
||||
-- , onclick_ "highlightReply('477703');"
|
||||
, href_ "#477703"
|
||||
][ ">>477703" ]
|
||||
]
|
||||
]
|
||||
, div_
|
||||
[ class_ "files" ]
|
||||
[ div_
|
||||
[ class_ "file" ]
|
||||
[ p_
|
||||
[ class_ "fileinfo" ]
|
||||
[ span_ []
|
||||
[ "File"
|
||||
, small_ []
|
||||
[ "("
|
||||
, a_
|
||||
[ class_ "hide-image-link"
|
||||
, href_ "javascript:void(0)"
|
||||
][ "hide" ]
|
||||
, ")"
|
||||
]
|
||||
, ":"
|
||||
]
|
||||
, a_
|
||||
[ href_ "/leftypol/src/1705665505794.jpeg"
|
||||
][ "1705665505794.jpeg" ]
|
||||
, span_
|
||||
[ class_ "details" ]
|
||||
[ "( 403.8 KB, 1280x720,"
|
||||
, a_
|
||||
[ download_ "Aerial-shot-Washington-DC-Palestine.jpeg"
|
||||
, href_ "javascript:void(0)"
|
||||
, title_ "Save as original filename (Aerial-shot-Washington-DC-Palestine.jpeg)"
|
||||
][ "Aerial-shot-Washington-DC….jpeg" ]
|
||||
, ")"
|
||||
]
|
||||
]
|
||||
, a_
|
||||
[ href_ "/leftypol/src/1705665505794.jpeg"
|
||||
]
|
||||
[ img_
|
||||
[ style_ $ Map.fromList
|
||||
[
|
||||
( "height"
|
||||
, "143px"
|
||||
)
|
||||
,
|
||||
( "width"
|
||||
, "255px"
|
||||
)
|
||||
]
|
||||
, class_ "post-image"
|
||||
, loading_ "lazy"
|
||||
, src_ "/leftypol/thumb/1705665505794.png"
|
||||
, alt_ ""
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
[ intro post
|
||||
, files (media_root m) (site m) post
|
||||
, div_
|
||||
[ class_ "body" ]
|
||||
(body post)
|
||||
|
|
|
|||
|
|
@ -90,3 +90,4 @@ getThread m iface A.GetThreadArgs {..} =
|
|||
<> "&name=eq." <> toMisoString website
|
||||
<> "&boards.pathpart=eq." <> toMisoString board_pathpart
|
||||
<> "&boards.threads.board_thread_id=eq." <> toMisoString (show board_thread_id)
|
||||
<> "&boards.threads.posts.order=board_post_id.asc"
|
||||
|
|
|
|||
|
|
@ -0,0 +1,19 @@
|
|||
module Network.Units where
|
||||
|
||||
import Text.Printf (printf)
|
||||
|
||||
data Unit = KiB | MiB | GiB | TiB | PiB | EiB | ZiB | YiB
|
||||
| KB | MB | GB | TB | PB | EB | ZB | YB
|
||||
deriving (Enum, Show, Bounded)
|
||||
|
||||
bytesToHumanReadable :: Integral a => a -> Bool -> String
|
||||
bytesToHumanReadable bytes binaryPrefix = printf "%.2f %s" size (show unit)
|
||||
where
|
||||
(factor, units) = if binaryPrefix
|
||||
then (1024.0, enumFrom KiB) -- Binary prefix, 1024 base, explicitly Double
|
||||
else (1000.0, enumFrom KB) -- Decimal prefix, 1000 base, explicitly Double
|
||||
(size, unit) = foldl (\(accSize, accUnit) u ->
|
||||
if accSize < factor then (accSize, accUnit)
|
||||
else (accSize / factor, u))
|
||||
(fromIntegral bytes :: Double, if binaryPrefix then KiB else KB) -- Explicitly Double
|
||||
units
|
||||
Loading…
Reference in New Issue