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.ThreadType
|
||||
Common.Component.ThreadView
|
||||
Component.Thread.Files
|
||||
Component.Thread.Intro
|
||||
Common.Component.Thread.Files
|
||||
Common.Component.Thread.Intro
|
||||
Common.Component.Thread.Model
|
||||
Component.Thread.Embed
|
||||
Common.Component.Thread.Embed
|
||||
Common.Component.BodyRender
|
||||
Common.FrontEnd.Routes
|
||||
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