diff --git a/chandlr.cabal b/chandlr.cabal index b6427f1..9fdb7f1 100644 --- a/chandlr.cabal +++ b/chandlr.cabal @@ -72,6 +72,9 @@ executable chandlr Network.SiteType Network.PostType Network.ThreadType + Component.ThreadView + Component.Thread.Files + Component.Thread.Intro Routes Common.AttachmentType diff --git a/html/files.html b/html/files.html index 5fb7023..21df878 100644 --- a/html/files.html +++ b/html/files.html @@ -1 +1,19 @@ -

File (hide): 1705665213107.png ( 1.88 MB , 1200x800 , south-african-representati….png )

+
+
+

+ + File (hide) + : + + 1705665213107.png + + (1.88 MB, 1200x800, + south-african-representati….png + ) + +

+ + + +
+
diff --git a/index.html b/index.html index 4c8aced..2a1701f 100644 --- a/index.html +++ b/index.html @@ -17,6 +17,10 @@ margin-left: .2em; margin-right: .2em; } + + .post.op.multifile { + clear: both; + } diff --git a/query_postgrest.sh b/query_postgrest.sh index dec35e6..697dae8 100755 --- a/query_postgrest.sh +++ b/query_postgrest.sh @@ -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" diff --git a/src/Component/CatalogGrid.hs b/src/Component/CatalogGrid.hs index 674b086..b4ada2a 100644 --- a/src/Component/CatalogGrid.hs +++ b/src/Component/CatalogGrid.hs @@ -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 = diff --git a/src/Component/Thread/Files.hs b/src/Component/Thread/Files.hs new file mode 100644 index 0000000..1660751 --- /dev/null +++ b/src/Component/Thread/Files.hs @@ -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 + diff --git a/src/Component/Thread/Intro.hs b/src/Component/Thread/Intro.hs new file mode 100644 index 0000000..5b6bfbb --- /dev/null +++ b/src/Component/Thread/Intro.hs @@ -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 ] diff --git a/src/Component/ThreadView.hs b/src/Component/ThreadView.hs index 4c9481d..1aa40dc 100644 --- a/src/Component/ThreadView.hs +++ b/src/Component/ThreadView.hs @@ -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) diff --git a/src/Network/Client.hs b/src/Network/Client.hs index 19ae35d..b206923 100644 --- a/src/Network/Client.hs +++ b/src/Network/Client.hs @@ -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" diff --git a/src/Network/Units.hs b/src/Network/Units.hs new file mode 100644 index 0000000..7101206 --- /dev/null +++ b/src/Network/Units.hs @@ -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