0
/
chandler-miso
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Display most recent catalog

This commit is contained in:
towards-a-new-leftypol 2024-01-15 15:40:52 -05:00
parent 77a319fa8e
commit 013a04a7d2
8 changed files with 2107 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
chandlr.cabal
View File

@ -66,8 +66,8 @@ executable chandlr
Action Action
Network.Http Network.Http
Network.Client Network.Client
Network.CatalogPostType
Routes Routes
Common.PostsType
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:

11
index.html
View File

@ -3,11 +3,20 @@
<head> <head>
<meta name="viewport" content="width=device-width, initial-scale=1.0"> <meta name="viewport" content="width=device-width, initial-scale=1.0">
<meta name="postgrest-root" content="http://10.4.0.96:3000"> <meta name="postgrest-root" content="http://10.4.0.96:3000">
<meta name="postgrest-fetch-count" content="1000"> <meta name="postgrest-fetch-count" content="200">
<title>Chandlr</title> <title>Chandlr</title>
<link href="static/style.css" rel="stylesheet" />
<script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/rts.js"></script> <script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/rts.js"></script>
<script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/lib.js"></script> <script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/lib.js"></script>
<script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/out.js"></script> <script language="javascript" src="./dist/build/chandlr/chandlr.jsexe/out.js"></script>
<style>
.theme-catalog div.thread {
margin-top: .2em;
margin-bottom: .2em;
margin-left: .2em;
margin-right: .2em;
}
</style>
</head> </head>
<body> <body>
</body> </body>

5
src/Action.hs
View File

@ -2,9 +2,8 @@ module Action where
import Component.CatalogGrid as Grid import Component.CatalogGrid as Grid
import Network.Client as Client import Network.Client as Client
import Data.Text (Text)
import Common.PostsType (Post) import Network.CatalogPostType (CatalogPost)
data Action data Action
= GridAction Grid.Action = GridAction Grid.Action
@ -14,6 +13,6 @@ data Action
, board :: String , board :: String
, board_thread_id :: Int , board_thread_id :: Int
} }
| HaveLatest (Client.HttpResult [Post]) | HaveLatest (Client.HttpResult [CatalogPost])
| ClientAction Client.Action | ClientAction Client.Action
| NoAction | NoAction

93
src/Component/CatalogGrid.hs
View File

@ -3,37 +3,34 @@
module Component.CatalogGrid module Component.CatalogGrid
( Model ( Model
, initialModel , initialModel
, Action , Action (..)
, Interface (..) , Interface (..)
, view , view
, update , update
) where ) where
import Data.List (intercalate)
import Data.Maybe (maybeToList)
import Data.JSString (append)
import Miso import Miso
( View ( View , div_ , class_ , img_ , href_ , a_
, div_ , src_ , alt_ , title_ , strong_ , span_
, class_ , p_ , br_ , id_ , Effect , noEff
, img_ , text, rawHtml
, href_
, a_
, src_
, alt_
, title_
, strong_
, span_
, p_
, br_
, id_
, Effect
, noEff
) )
type Model = () import Network.CatalogPostType (CatalogPost)
import qualified Network.CatalogPostType as CatalogPost
import Miso.String (toMisoString, MisoString)
data Model = Model
{ displayItems :: [ CatalogPost ]
} deriving Eq
initialModel :: Model initialModel :: Model
initialModel = () initialModel = Model { displayItems = [] }
type Action = () data Action = DisplayItems [ CatalogPost ]
data Interface a = Interface data Interface a = Interface
{ passAction :: Action -> a { passAction :: Action -> a
@ -45,43 +42,63 @@ update
-> Action -> Action
-> Model -> Model
-> Effect a Model -> Effect a Model
update = const $ const noEff update _ (DisplayItems xs) m = noEff (m { displayItems = xs })
update _ _ m = noEff m
view :: Interface a -> Model -> View a view :: Interface a -> Model -> View a
view iface model = view iface model =
div_ div_
[ class_ "threads" ] [ class_ "theme-catalog" ]
[ div_ [ div_
[ id_ "Grid" ] [ class_ "threads" ]
[ gridItem | _ <- [0..10] :: [ Int ] ] [ div_
[ id_ "Grid" ]
(map gridItem (displayItems model))
]
] ]
gridItem :: View a gridItem :: CatalogPost -> View a
gridItem = gridItem post =
div_ div_
[ class_ "mix" ] [ class_ "mix" ]
[ div_ [ div_
[ class_ "thread grid-li grid-size-small" ] [ class_ "thread grid-li grid-size-small" ]
[ a_ [ a_
[ href_ "/a/res/1.html" ] [ href_ thread_url ]
[ img_ [ img_
[ class_ "thread-image" [ class_ "thread-image"
, src_ "/a/thumb/1111111111111.png" , src_ "/a/thumb/1111111111111.png"
, alt_ "Opening post image" , alt_ "Opening post image"
, title_ "Dec 18 23:12" , title_ ( toMisoString $ show $ CatalogPost.bump_time post )
] ]
] ]
, div_ , div_
[ class_ "replies" ] [ class_ "replies" ]
[ strong_ [][ "R: 517 / I: 204" ] (
, p_ [ strong_ [][ text post_count_str ]
[ class_ "intro" ] , p_
[ span_ [ class_ "intro" ]
[ class_ "subject" ][ "This is the thread subject, usually a brief description." ] [ span_
] [ class_ "subject" ]subject
, "Hello World" ]
, br_ [] ] ++ body
, "Hello World2" )
]
] ]
] ]
where
subject :: [ View a ]
subject = map (text . toMisoString) $ maybeToList $ CatalogPost.subject post
body :: [ View a ]
body = map (rawHtml . toMisoString) $ maybeToList $ CatalogPost.body post
post_count_str :: MisoString
post_count_str = "R: " `append` (toMisoString $ CatalogPost.post_count post)
thread_url :: MisoString
thread_url = toMisoString $ intercalate "/"
[ CatalogPost.site_name post
, CatalogPost.pathpart post
, show $ CatalogPost.board_thread_id post
]

6
src/Main.hs
View File

@ -127,14 +127,14 @@ mainUpdate (HaveLatest Client.Error) m = m <# do
consoleLog "Getting Latest failed!" consoleLog "Getting Latest failed!"
return NoAction return NoAction
mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <# do mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <#
case body of case body of
Nothing -> do Nothing -> do
consoleLog "Didn't get anything back from API" consoleLog "Didn't get anything back from API"
return NoAction
Just posts -> do Just posts -> do
mapM_ (consoleLog . toJSString . show) posts mapM_ (consoleLog . toJSString . show) posts
return $ GridAction $ Grid.DisplayItems posts
return NoAction
mainUpdate GetLatest m = m <# Client.fetchLatest (clientModel m) iClient mainUpdate GetLatest m = m <# Client.fetchLatest (clientModel m) iClient

29
src/Network/CatalogPostType.hs Normal file
View File

@ -0,0 +1,29 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Network.CatalogPostType
( CatalogPost (..) )
where
import GHC.Generics
import Data.Aeson (FromJSON, ToJSON)
import Data.Time.Clock (UTCTime) -- Required for timestamp with time zone
import Data.Int (Int64)
import Data.Text (Text)
data CatalogPost = CatalogPost
{ post_id :: Maybe Int64
, board_post_id :: Int64
, board_thread_id :: Int64
, creation_time :: UTCTime
, bump_time :: UTCTime
, body :: Maybe Text
, name :: Maybe Text
, subject :: Maybe Text
, email :: Maybe Text
, thread_id :: Int
, post_count :: Int
, site_name :: String
, pathpart :: String
--, site_id :: Int
} deriving (Show, Generic, FromJSON, ToJSON, Eq)

8
src/Network/Client.hs
View File

@ -26,15 +26,15 @@ import GHCJS.DOM.Types (JSString)
import Miso (effectSub, Effect) import Miso (effectSub, Effect)
import qualified Network.Http as Http import qualified Network.Http as Http
import Common.PostsType (Post) import Network.CatalogPostType (CatalogPost)
data Action = Connect (Http.HttpActionResult [Post]) data Action = Connect (Http.HttpActionResult [CatalogPost])
data Interface a = Interface data Interface a = Interface
{ passAction :: Action -> a { passAction :: Action -> a
, returnResult :: Http.HttpResult [Post] -> a , returnResult :: Http.HttpResult [CatalogPost] -> a
} }
data Model = Model data Model = Model
@ -50,7 +50,7 @@ update
-> Effect a Model -> Effect a Model
update iface (Connect (abort, resultVar)) m = effectSub m $ update iface (Connect (abort, resultVar)) m = effectSub m $
\sink -> void $ forkIO $ do \sink -> void $ forkIO $ do
result :: Http.HttpResult [Post] <- takeMVar resultVar result :: Http.HttpResult [CatalogPost] <- takeMVar resultVar
sink $ (returnResult iface) result sink $ (returnResult iface) result
data FetchCatalogArgs = FetchCatalogArgs data FetchCatalogArgs = FetchCatalogArgs

2003
static/style.css Normal file
View File

File diff suppressed because it is too large Load Diff