Move Embed, Files, Intro modules to Common.Component.Thread
This commit is contained in:
parent
0b1c8b0fd0
commit
c1d966e0cd
|
|
@ -74,10 +74,10 @@ executable chandlr
|
||||||
Common.Network.PostType
|
Common.Network.PostType
|
||||||
Common.Network.ThreadType
|
Common.Network.ThreadType
|
||||||
Common.Component.ThreadView
|
Common.Component.ThreadView
|
||||||
Component.Thread.Files
|
Common.Component.Thread.Files
|
||||||
Component.Thread.Intro
|
Common.Component.Thread.Intro
|
||||||
Common.Component.Thread.Model
|
Common.Component.Thread.Model
|
||||||
Component.Thread.Embed
|
Common.Component.Thread.Embed
|
||||||
Common.Component.BodyRender
|
Common.Component.BodyRender
|
||||||
Common.FrontEnd.Routes
|
Common.FrontEnd.Routes
|
||||||
Common.AttachmentType
|
Common.AttachmentType
|
||||||
|
|
|
||||||
|
|
@ -1 +1 @@
|
||||||
Subproject commit 7e0cfd57269bb631417a9bcf9f9f071520000a88
|
Subproject commit 5ca701e30861498565fd4927ea1c9ea3ea105b8c
|
||||||
|
|
@ -1,56 +0,0 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Component.Thread.Embed where
|
|
||||||
|
|
||||||
import Miso
|
|
||||||
( View
|
|
||||||
, div_
|
|
||||||
, class_
|
|
||||||
, a_
|
|
||||||
, href_
|
|
||||||
, target_
|
|
||||||
, img_
|
|
||||||
, style_
|
|
||||||
, src_
|
|
||||||
, span_
|
|
||||||
)
|
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
|
||||||
import Data.Maybe (fromJust)
|
|
||||||
import Data.Text (unpack)
|
|
||||||
import Data.JSString (JSString, pack)
|
|
||||||
|
|
||||||
import qualified Common.Network.PostType as Post
|
|
||||||
import Common.Network.PostType (Post)
|
|
||||||
import Parsing.EmbedParser (extractVideoId)
|
|
||||||
|
|
||||||
embed :: Post -> View a
|
|
||||||
embed post = div_
|
|
||||||
[ class_ "video-container" ]
|
|
||||||
[ a_
|
|
||||||
[ href_ $ "https://youtu.be/" <> video_id
|
|
||||||
, target_ "_blank"
|
|
||||||
, class_ "file"
|
|
||||||
]
|
|
||||||
[ img_
|
|
||||||
[ style_ $ Map.fromList
|
|
||||||
[
|
|
||||||
( "height"
|
|
||||||
, "190px"
|
|
||||||
)
|
|
||||||
,
|
|
||||||
( "width"
|
|
||||||
, "255px"
|
|
||||||
)
|
|
||||||
]
|
|
||||||
, src_ ("https://leftychan.net/vi/" <> video_id <> "/0.jpg")
|
|
||||||
, class_ "post-image"
|
|
||||||
]
|
|
||||||
]
|
|
||||||
, span_ [][ "[Embed]" ]
|
|
||||||
]
|
|
||||||
|
|
||||||
where
|
|
||||||
video_id :: JSString
|
|
||||||
video_id = pack $ fromJust $
|
|
||||||
(Post.embed post) >>= Just . (\(Right r) -> r) . extractVideoId . unpack
|
|
||||||
|
|
@ -1,185 +0,0 @@
|
||||||
{-# 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
|
|
||||||
, target_
|
|
||||||
)
|
|
||||||
|
|
||||||
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 Common.Network.SiteType (Site)
|
|
||||||
import qualified Common.Network.SiteType as Site
|
|
||||||
import qualified Common.Network.BoardType as Board
|
|
||||||
import qualified Common.Network.ThreadType as Thread
|
|
||||||
import qualified Common.Network.PostType as Post
|
|
||||||
import Common.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` res_str
|
|
||||||
, 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
|
|
||||||
, target_ "blank_"
|
|
||||||
]
|
|
||||||
[ 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
|
|
||||||
|
|
||||||
res_str :: JSString
|
|
||||||
res_str = maybe "" show_dimension $ Attachment.resolution a
|
|
||||||
|
|
||||||
show_dimension :: Attachment.Dimension -> JSString
|
|
||||||
show_dimension Attachment.Dimension {..} = toMisoString $
|
|
||||||
", " ++ show width ++ "x" ++ show height ++ ", "
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
|
|
@ -1,136 +0,0 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Component.Thread.Intro where
|
|
||||||
|
|
||||||
import Miso
|
|
||||||
( View
|
|
||||||
, text
|
|
||||||
, href_
|
|
||||||
, a_
|
|
||||||
, class_
|
|
||||||
, textProp
|
|
||||||
, title_
|
|
||||||
, span_
|
|
||||||
, time_
|
|
||||||
)
|
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
|
||||||
import Data.Text (Text, pack)
|
|
||||||
import GHCJS.DOM.Types (JSString)
|
|
||||||
import Data.Foldable (toList)
|
|
||||||
import Miso.String (toMisoString)
|
|
||||||
import Data.Time.Clock (UTCTime, diffUTCTime)
|
|
||||||
import Data.Time.Format (formatTime, defaultTimeLocale)
|
|
||||||
|
|
||||||
import Common.Network.PostType (Post)
|
|
||||||
import qualified Common.Network.PostType as Post
|
|
||||||
import Common.Network.SiteType (Site)
|
|
||||||
import qualified Common.Network.SiteType as Site
|
|
||||||
import Common.Network.BoardType (Board)
|
|
||||||
import qualified Common.Network.BoardType as Board
|
|
||||||
import qualified Common.Network.ThreadType as Thread
|
|
||||||
import Common.Network.ThreadType (Thread)
|
|
||||||
import Parsing.BodyParser (Backlinks)
|
|
||||||
|
|
||||||
|
|
||||||
formatUTC :: UTCTime -> JSString
|
|
||||||
formatUTC time = toMisoString $
|
|
||||||
formatTime defaultTimeLocale "%Y-%m-%d (%a) %T" time
|
|
||||||
|
|
||||||
|
|
||||||
intro :: Site -> Board -> Thread -> Post -> Backlinks -> UTCTime -> View a
|
|
||||||
intro site board thread post backlinks current_time = span_
|
|
||||||
[ class_ "intro" ]
|
|
||||||
( subject ++
|
|
||||||
[ " "
|
|
||||||
, span_
|
|
||||||
[ class_ "name" ][ text name ]
|
|
||||||
-- TODO: Add flags (don't have that data in the db yet)
|
|
||||||
, " "
|
|
||||||
, time_
|
|
||||||
[ textProp "datetime" $ toMisoString $ show $ creation_time
|
|
||||||
, title_ $ toMisoString $ timeAgo current_time creation_time
|
|
||||||
][ text $ formatUTC creation_time ]
|
|
||||||
, " "
|
|
||||||
, a_
|
|
||||||
[ class_ "post_no"
|
|
||||||
, href_ $ toMisoString $ post_url <> "#" <> b_post_id
|
|
||||||
][ "No." ]
|
|
||||||
, a_
|
|
||||||
[ class_ "post_no"
|
|
||||||
, href_ $ toMisoString $ post_url <> "#q" <> b_post_id
|
|
||||||
][ text $ toMisoString $ b_post_id ]
|
|
||||||
]
|
|
||||||
++ mentions
|
|
||||||
)
|
|
||||||
|
|
||||||
where
|
|
||||||
post_url :: Text
|
|
||||||
post_url
|
|
||||||
= "/" <> Site.name site
|
|
||||||
<> "/" <> Board.pathpart board
|
|
||||||
<> "/" <> pack (show $ Thread.board_thread_id thread)
|
|
||||||
|
|
||||||
creation_time :: UTCTime
|
|
||||||
creation_time = Post.creation_time post
|
|
||||||
|
|
||||||
subject :: [ View a ]
|
|
||||||
subject = map (mkSubject . toMisoString) $ toList $ Post.subject post
|
|
||||||
|
|
||||||
name :: JSString
|
|
||||||
name = maybe "Anonymous" toMisoString $ Post.name post
|
|
||||||
|
|
||||||
mkSubject :: JSString -> View a
|
|
||||||
mkSubject s = span_
|
|
||||||
[ class_ "subject" ]
|
|
||||||
[ text s ]
|
|
||||||
|
|
||||||
b_post_id :: Text
|
|
||||||
b_post_id = pack $ show $ Post.board_post_id post
|
|
||||||
|
|
||||||
mentions :: [ View a ]
|
|
||||||
mentions =
|
|
||||||
case Map.lookup (Post.board_post_id post) backlinks of
|
|
||||||
Nothing -> []
|
|
||||||
Just [] -> []
|
|
||||||
Just xs -> span_
|
|
||||||
[ class_ "mentioned unimportant" ]
|
|
||||||
(map mention xs)
|
|
||||||
: []
|
|
||||||
|
|
||||||
mention :: Post -> View a
|
|
||||||
mention p =
|
|
||||||
a_
|
|
||||||
[ href_ $ "#" <> bpid
|
|
||||||
]
|
|
||||||
[ text $ ">>" <> bpid ]
|
|
||||||
|
|
||||||
where
|
|
||||||
bpid :: JSString
|
|
||||||
bpid = toMisoString $ show $ Post.board_post_id p
|
|
||||||
|
|
||||||
|
|
||||||
-- Convert UTCTime to a human-readable string
|
|
||||||
timeAgo :: UTCTime -> UTCTime -> String
|
|
||||||
timeAgo currentTime pastTime =
|
|
||||||
let diff = realToFrac $ diffUTCTime currentTime pastTime
|
|
||||||
in humanReadableTimeDiff diff
|
|
||||||
|
|
||||||
|
|
||||||
-- Helper function to correctly format singular and plural units
|
|
||||||
formatTimeUnit :: (Integral a, Show a) => a -> String -> String
|
|
||||||
formatTimeUnit value unit
|
|
||||||
| value == 1 = show value ++ " " ++ unit ++ " ago"
|
|
||||||
| otherwise = show value ++ " " ++ unit ++ "s ago"
|
|
||||||
|
|
||||||
|
|
||||||
-- Convert time difference in seconds to a human-readable format
|
|
||||||
humanReadableTimeDiff :: Double -> String
|
|
||||||
humanReadableTimeDiff diff
|
|
||||||
| diff < 60 = "Just now"
|
|
||||||
| diff < 3600 = formatTimeUnit (truncate (diff / 60) :: Int) "minute"
|
|
||||||
| diff < 86400 = formatTimeUnit (truncate (diff / 3600) :: Int) "hour"
|
|
||||||
| diff < 604800 = formatTimeUnit (truncate (diff / 86400) :: Int) "day"
|
|
||||||
| diff < 2592000 = formatTimeUnit (truncate (diff / 604800) :: Int) "week"
|
|
||||||
| diff < 31536000 = formatTimeUnit (truncate (diff / 2592000) :: Int) "month"
|
|
||||||
| otherwise = formatTimeUnit (truncate (diff / 31536000) :: Int) "year"
|
|
||||||
Loading…
Reference in New Issue