From 1a3ac32fb6e81298276611a7d16f3ae4c6202f38 Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Wed, 6 Mar 2024 02:05:35 -0500 Subject: [PATCH] Move CatalogGrid to Common --- chandlr.cabal | 2 +- src/Common | 2 +- src/Component/CatalogGrid.hs | 150 ----------------------------------- src/Main.hs | 2 +- 4 files changed, 3 insertions(+), 153 deletions(-) delete mode 100644 src/Component/CatalogGrid.hs diff --git a/chandlr.cabal b/chandlr.cabal index ef6fc39..29cc758 100644 --- a/chandlr.cabal +++ b/chandlr.cabal @@ -62,7 +62,7 @@ executable chandlr ghcjs-options: -dedupe -- Modules included in this executable, other than Main. - other-modules: Component.CatalogGrid + other-modules: Common.Component.CatalogGrid Common.FrontEnd.Action Network.Http Common.Network.HttpTypes diff --git a/src/Common b/src/Common index c33593e..ea0b3a2 160000 --- a/src/Common +++ b/src/Common @@ -1 +1 @@ -Subproject commit c33593ec634d42eeead0dbbad90c36efc2f5fe54 +Subproject commit ea0b3a27e320faece3400e899fb670867e49c2f7 diff --git a/src/Component/CatalogGrid.hs b/src/Component/CatalogGrid.hs deleted file mode 100644 index 1bd3f80..0000000 --- a/src/Component/CatalogGrid.hs +++ /dev/null @@ -1,150 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Component.CatalogGrid -( Model (..) -, initialModel -, Action (..) -, Interface (..) -, view -, update -) where - -import Data.Maybe (maybeToList) -import Data.Text (pack, Text) -import qualified Data.Text as T -import Data.JSString (append, JSString) -import Miso - ( View, div_ , class_ , img_ , href_ , a_ - , src_ , title_ , b_ , span_ - , p_ , id_ , Effect , noEff - , text, rawHtml, onWithOptions - , defaultOptions, preventDefault - , Attribute, emptyDecoder - ) -import Miso.String (toMisoString, MisoString) - -import Common.Network.CatalogPostType (CatalogPost) -import qualified Common.Network.CatalogPostType as CatalogPost -import Common.Parsing.EmbedParser (extractVideoId) - -data Model = Model - { display_items :: [ CatalogPost ] - , media_root :: MisoString - } deriving Eq - -initialModel :: JSString -> Model -initialModel media_root_ = Model - { display_items = [] - , media_root = toMisoString media_root_ - } - -data Action - = DisplayItems [ CatalogPost ] - -data Interface a = Interface - { passAction :: Action -> a -- We're not using this. - , threadSelected :: CatalogPost -> a - } - - --- Custom event handler with preventDefault set to True -onClick_ :: a -> Attribute a -onClick_ action = onWithOptions defaultOptions { preventDefault = True } "click" emptyDecoder (const action) - -update - :: Interface a - -> Action - -> Model - -> Effect a Model -update _ (DisplayItems xs) m = noEff (m { display_items = xs }) - -view :: Interface a -> Model -> View a -view iface model = - div_ - [ class_ "theme-catalog" ] - [ div_ - [ class_ "threads" ] - [ div_ - [ id_ "Grid" ] - (map (gridItem iface model) (display_items model)) - ] - ] - -gridItem :: Interface a -> Model -> CatalogPost -> View a -gridItem iface m post = - div_ - [ class_ "thread grid-li grid-size-small" ] - [ a_ - [ href_ thread_url - , onClick_ (threadSelected iface post) - ] - [ img_ - [ class_ "thread-image" - , src_ thumb_url - , title_ ( toMisoString $ show $ CatalogPost.bump_time post ) - ] - ] - , div_ - [ class_ "replies" ] - ( - [ div_ - [ class_ "meta" ] - [ "R: " - , b_ [][ text post_count_str ] - , "+" - ] - ] ++ (intro subject) ++ body - ) - ] - - where - subject :: [ View a ] - subject = map (text . toMisoString) $ maybeToList $ CatalogPost.subject post - - intro :: [ View a ] -> [ View a ] - intro [] = [] - intro x = (: []) $ p_ - [ class_ "intro" ] - [ span_ - [ class_ "subject" ] - x - ] - - body :: [ View a ] - body = map (rawHtml . toMisoString) $ maybeToList $ CatalogPost.body post - - post_count_str :: MisoString - post_count_str = toMisoString $ (CatalogPost.estimated_post_count post) - 1 - - embed_url :: Maybe String - embed_url = - (CatalogPost.embed post) >>= Just . (\(Right r) -> r) . extractVideoId . T.unpack - - thumb_url :: MisoString - thumb_url = - case embed_url of - Nothing -> - case mthumb_path of - -- TODO: what about embeds!? - Nothing -> "/static/default_thumbnail.png" - Just thumb_path -> (media_root m) `append` (toMisoString thumb_path) - Just u -> "https://leftychan.net/vi/" <> toMisoString u <> "/0.jpg" - - mthumb_path :: Maybe Text - mthumb_path = do - file_name <- CatalogPost.file_name post - thumb_ext <- CatalogPost.file_thumb_extension post - - return $ - "/" <> CatalogPost.site_name post - <> "/" <> CatalogPost.pathpart post - <> "/" <> (pack $ show $ CatalogPost.board_thread_id post) - <> "/thumbnail_" <> file_name - <> "." <> thumb_ext - - thread_url :: MisoString - thread_url = toMisoString $ T.intercalate "/" - [ CatalogPost.site_name post - , CatalogPost.pathpart post - , pack $ show $ CatalogPost.board_thread_id post - ] diff --git a/src/Main.hs b/src/Main.hs index 584e9b9..c1f97c1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -48,7 +48,7 @@ import Common.FrontEnd.Routes import qualified Network.Client as Client import Common.Network.CatalogPostType (CatalogPost) import qualified Common.Network.CatalogPostType as CatalogPost -import qualified Component.CatalogGrid as Grid +import qualified Common.Component.CatalogGrid as Grid import qualified Common.Component.ThreadView as Thread import qualified Common.Component.TimeControl as TC import qualified Component.Search as Search