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
Network.Http
Network.Client
Network.CatalogPostType
Routes
Common.PostsType
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:

11
index.html
View File

@ -3,11 +3,20 @@
<head>
<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-fetch-count" content="1000">
<meta name="postgrest-fetch-count" content="200">
<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/lib.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>
<body>
</body>

5
src/Action.hs
View File

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

93
src/Component/CatalogGrid.hs
View File

@ -3,37 +3,34 @@
module Component.CatalogGrid
( Model
, initialModel
, Action
, Action (..)
, Interface (..)
, view
, update
) where
import Data.List (intercalate)
import Data.Maybe (maybeToList)
import Data.JSString (append)
import Miso
( View
, div_
, class_
, img_
, href_
, a_
, src_
, alt_
, title_
, strong_
, span_
, p_
, br_
, id_
, Effect
, noEff
( View , div_ , class_ , img_ , href_ , a_
, src_ , alt_ , title_ , strong_ , span_
, p_ , br_ , id_ , Effect , noEff
, text, rawHtml
)
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 = ()
initialModel = Model { displayItems = [] }
type Action = ()
data Action = DisplayItems [ CatalogPost ]
data Interface a = Interface
{ passAction :: Action -> a
@ -45,43 +42,63 @@ update
-> Action
-> 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 iface model =
div_
[ class_ "threads" ]
[ class_ "theme-catalog" ]
[ div_
[ id_ "Grid" ]
[ gridItem | _ <- [0..10] :: [ Int ] ]
[ class_ "threads" ]
[ div_
[ id_ "Grid" ]
(map gridItem (displayItems model))
]
]
gridItem :: View a
gridItem =
gridItem :: CatalogPost -> View a
gridItem post =
div_
[ class_ "mix" ]
[ div_
[ class_ "thread grid-li grid-size-small" ]
[ a_
[ href_ "/a/res/1.html" ]
[ href_ thread_url ]
[ img_
[ class_ "thread-image"
, src_ "/a/thumb/1111111111111.png"
, alt_ "Opening post image"
, title_ "Dec 18 23:12"
, title_ ( toMisoString $ show $ CatalogPost.bump_time post )
]
]
, div_
[ class_ "replies" ]
[ strong_ [][ "R: 517 / I: 204" ]
, p_
[ class_ "intro" ]
[ span_
[ class_ "subject" ][ "This is the thread subject, usually a brief description." ]
]
, "Hello World"
, br_ []
, "Hello World2"
]
(
[ strong_ [][ text post_count_str ]
, p_
[ class_ "intro" ]
[ span_
[ class_ "subject" ]subject
]
] ++ body
)
]
]
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!"
return NoAction
mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <# do
mainUpdate (HaveLatest (Client.HttpResponse {..})) m = m <#
case body of
Nothing -> do
consoleLog "Didn't get anything back from API"
return NoAction
Just posts -> do
mapM_ (consoleLog . toJSString . show) posts
return NoAction
return $ GridAction $ Grid.DisplayItems posts
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 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
{ passAction :: Action -> a
, returnResult :: Http.HttpResult [Post] -> a
, returnResult :: Http.HttpResult [CatalogPost] -> a
}
data Model = Model
@ -50,7 +50,7 @@ update
-> Effect a Model
update iface (Connect (abort, resultVar)) m = effectSub m $
\sink -> void $ forkIO $ do
result :: Http.HttpResult [Post] <- takeMVar resultVar
result :: Http.HttpResult [CatalogPost] <- takeMVar resultVar
sink $ (returnResult iface) result
data FetchCatalogArgs = FetchCatalogArgs

2003
static/style.css Normal file
View File

File diff suppressed because it is too large Load Diff