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

Parsing PostBodies seems to work okay 

- tie in parsing into the threadview update function
- that may not be the final place for it but it works for now to just
  bring out the Show instances.
- need a renderer now
This commit is contained in:
towards-a-new-leftypol 2024-02-09 09:19:32 -05:00
parent 3b1d130f41
commit 1950b45157
5 changed files with 58 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
index.html
View File

@ -3,7 +3,7 @@
<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">
<meta name="media-root" content="http://10.4.0.1:8888">
<title>Chandlr</title>
<link href="static/style.css" rel="stylesheet" />

2
src/Action.hs
View File

@ -12,6 +12,7 @@ import qualified Network.ClientTypes as C
import Network.CatalogPostType (CatalogPost)
import Network.Http (HttpResult)
import Network.SiteType (Site)
import qualified Component.ThreadView as Thread
data GetThreadArgs = GetThreadArgs
{ website :: Text
@ -26,5 +27,6 @@ data Action
| HaveLatest (HttpResult [ CatalogPost ])
| HaveThread (HttpResult [ Site ])
| forall a. (FromJSON a) => ClientAction (HttpResult a -> Action) (C.Action a)
| ThreadAction Thread.Action
| ChangeURI URI
| NoAction

24
src/BodyParser.hs
View File

@ -22,6 +22,7 @@ import GHCJS.DOM.JSFFI.Generated.Node hiding (contains)
import qualified GHCJS.DOM.JSFFI.Generated.NodeList as NodeList
import GHCJS.DOM.JSFFI.Generated.DOMTokenList (contains)
import Data.Text (Text)
import Miso (consoleLog)
data PostPart
@ -40,7 +41,7 @@ data PostPart
| Underlined [ PostPart ]
| Italics [ PostPart ]
| Strikethrough [ PostPart ]
deriving Show
deriving (Show, Eq)
nodeListToList :: NodeList -> IO [ Node ]
@ -80,13 +81,16 @@ toPostPart_ node_type node
tagName :: JSString <- getTagName element
case tagName of
"a" -> parseAnchor element
"span" -> parseSpan element
"em" -> parseEm element
"strong" -> parseStrong element
"u" -> parseU element
"s" -> parseS element
_ -> return $ SimpleText "Unsupported element"
"A" -> parseAnchor element
"SPAN" -> parseSpan element
"EM" -> parseEm element
"STRONG" -> parseStrong element
"U" -> parseU element
"S" -> parseS element
"BR" -> return Skip
_ -> do
consoleLog tagName
return $ SimpleText "Unsupported element"
| otherwise = return Skip
where
@ -124,10 +128,10 @@ parseSpan element = do
| otherwise -> return $ SimpleText "Unsupported span class"
parseNodeList :: NodeList -> IO [PostPart]
parseNodeList :: NodeList -> IO [ PostPart ]
parseNodeList nodes = nodeListToList nodes >>= mapM toPostPart
parseChildNodes :: Element -> IO [PostPart]
parseChildNodes :: Element -> IO [ PostPart ]
parseChildNodes element = getChildNodes element >>= parseNodeList
parseEm :: Element -> IO PostPart

33
src/Component/ThreadView.hs
View File

@ -6,6 +6,7 @@ module Component.ThreadView
, Action (..)
, update
, view
, Interface (..)
) where
import Miso
@ -21,9 +22,11 @@ import Miso
, h2_
, rawHtml
, Attribute
, (<#)
, consoleLog
)
import Data.Maybe (maybeToList)
import Data.Maybe (maybeToList, catMaybes)
import Miso.String (toMisoString)
import GHCJS.DOM.Types (JSString)
@ -37,21 +40,42 @@ import Component.Thread.Files (files)
import Component.Thread.Intro (intro)
import BodyParser
type PostWithBody = (Post, [ PostPart ])
data Model = Model
{ site :: Site
, media_root :: JSString
, post_bodies :: [ PostWithBody ]
} deriving Eq
initialModel :: JSString -> Site -> Model
initialModel mroot s = Model
{ site = s
, post_bodies = []
, media_root = mroot
}
data Action = RenderSite Site
data Action
= RenderSite Site
| UpdatePostBodies [ PostWithBody ]
data Interface a = Interface { passAction :: Action -> a }
update :: Interface a -> Action -> Model -> Effect a Model
update iface (RenderSite s) m = m { site = s } <# do
bodies <- mapM parsePostBody (catMaybes $ map Post.body posts)
mapM_ (consoleLog . toMisoString . show) bodies
return $ passAction iface $ UpdatePostBodies $ zip posts bodies
where
posts :: [ Post ]
posts = Thread.posts $ head $ Board.threads $ head $ Site.boards s
--update (RenderSite s) m = noEff (m { site = s })
update _ (UpdatePostBodies pwbs) m = noEff m { post_bodies = pwbs }
update :: Action -> Model -> Effect a Model
update (RenderSite s) m = noEff (m { site = s })
view :: Model -> View a
view m =
@ -109,6 +133,7 @@ op m op_post =
| length (Post.attachments op_post) > 1 = [ class_ "multifile" ]
| otherwise = []
reply :: Model -> Post -> View a
reply m post = div_
[ class_ "postcontainer"

14
src/Main.hs
View File

@ -6,7 +6,7 @@
module Main where
import Data.Proxy
import Data.Maybe (maybe)
import Data.Maybe (maybe, fromJust)
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (uriPath)
@ -180,7 +180,7 @@ mainUpdate (HaveThread Client.Error) m = m <# do
mainUpdate (HaveThread (Client.HttpResponse {..})) m = new_model <# do
consoleLog "Have Thread!"
return NoAction
return $ ThreadAction $ Thread.RenderSite $ Thread.site $ fromJust $ thread_model new_model
where
new_model = m
@ -217,6 +217,13 @@ mainUpdate (ClientAction action ca) m =
Client.update (iClient action) ca (client_model m)
>>= \cm -> noEff (m { client_model = cm })
mainUpdate (ThreadAction ta) model = do
tm :: Maybe Thread.Model <- case thread_model model of
Nothing -> noEff Nothing
Just m -> Thread.update iThread ta m >>= return . Just
noEff model { thread_model = tm }
iGrid :: Grid.Interface Action
iGrid = Grid.Interface
@ -238,6 +245,9 @@ iClient action = Client.Interface
, Client.returnResult = action
}
iThread :: Thread.Interface Action
iThread = Thread.Interface { Thread.passAction = ThreadAction }
{-
- TODO:
- - Create the thread view