UI: WIP, creating view-thread page

haskread-platform-be/src/Platform/API.hs

@@ -379,4 +379,4 @@ type FetchCommentsByThreadAPI =
     :> "thread"
     :> "comment"
     :> Capture "ThreadID" ThreadID
-    :> Get '[JSON] [NestedComment]
+    :> Get '[JSON] FetchCommentsResponse

haskread-platform-be/src/Platform/Comment/Handler.hs

@@ -206,8 +206,9 @@ updateVoteComment cID uID vote = do
     Left e -> throw400Err $ BSL.pack $ show e
     Right _ -> return $ VoteCommentResponse "Vote updated successfully!"
 
-fetchCommentsByThreadH :: (MonadUnliftIO m) => ThreadID -> AppM m [NestedComment]
+fetchCommentsByThreadH :: (MonadUnliftIO m) => ThreadID -> AppM m FetchCommentsResponse
 fetchCommentsByThreadH threadID = do
   checkIfThreadExists threadID
   commentInfoList <- queryWrapper $ fetchCommentsByThreadQ threadID
-  pure $ buildNestedComments commentInfoList
+  let res = buildNestedComments commentInfoList
+  pure $ FetchCommentsResponse (length res) res

haskread-platform-be/src/Platform/Comment/Types.hs

@@ -10,6 +10,7 @@ module Platform.Comment.Types
     UpdateCommentReqBody (..),
     UpdateCommentResponse (..),
     VoteCommentResponse (..),
+    FetchCommentsResponse (..),
   )
 where
 
@@ -46,3 +47,9 @@ newtype VoteCommentResponse = VoteCommentResponse
   { voteCommentResponseMsg :: Text
   }
   deriving newtype (Show, Eq, Ord, ToJSON, FromJSON, FromHttpApiData)
+
+data FetchCommentsResponse = FetchCommentsResponse
+  { commentsCount :: Int,
+    comments :: [NestedComment]
+  }
+  deriving (Show, Eq, Generic, ToJSON)

haskread-platform-be/src/Platform/Common/Utils.hs

@@ -18,7 +18,6 @@ module Platform.Common.Utils
     queryWrapper,
     redirects,
     genRandomUserName,
-    threadToThreadInfo,
   )
 where
 
@@ -212,13 +211,3 @@ genRandomUserName = do
                 head $
                   results (responseBody jsonRes :: RandomUserNameApiResponse)
         pure $ Right (T.pack res0)
-
-threadToThreadInfo :: ThreadRead -> ThreadInfo
-threadToThreadInfo Thread {..} =
-  ThreadInfo
-    { threadIDForThreadInfo = threadID,
-      title = threadTitle,
-      description = threadDescription,
-      communityIDForThreadInfo = threadCommunityID,
-      userIDForThreadInfo = threadUserID
-    }

haskread-platform-be/src/Platform/User/Thread/Handler.hs

@@ -120,9 +120,5 @@ fetchAllThreadsH = do
   threadInfoList <- queryWrapper fetchThreadInfoQ
   return $ FetchAllThreadsResponse (length threadInfoList) threadInfoList
 
-fetchThreadH :: (MonadUnliftIO m) => ThreadID -> AppM m ThreadInfo
-fetchThreadH threadID0 = do
-  mThreadRead <- queryWrapper $ fetchThreadByIDQ threadID0
-  case mThreadRead of
-    Nothing -> throw400Err "Thread not found"
-    Just threadRead0 -> pure $ threadToThreadInfo threadRead0
+fetchThreadH :: ThreadID -> AppM m ThreadInfo
+fetchThreadH _ = undefined -- TODO: Add fetch thread query by threadID

haskread-platform-ui/src/AppM.purs

@@ -5,7 +5,12 @@ module AppM
 
 import Prelude
 
-import Capability.Resource (class ManageThreads, class ManageUser, class Navigate)
+import Capability.Resource (
+    class ManageThreads
+  , class ManageUser
+  , class Navigate
+  , class ManageComments
+  )
 import Common.Types (Endpoint(..), RequestMethod(..), threadsCodec)
 import Common.Types as Route
 import Common.Utils
@@ -21,6 +26,7 @@ import Common.Utils
   , deleteUser
   , getThread
   , updateThread
+  , getCommentsByThreadID
   )
 import Effect.Aff (Aff)
 import Effect.Aff.Class (class MonadAff)
@@ -58,6 +64,7 @@ instance threadHalogenM :: ManageThreads AppM where
   getThreads = do
     mjson <- mkRequest { endpoint: Threads, method: Get }
     decode threadsCodec mjson
+
   createThread = createThread
   deleteThread = deleteThread
   getThread = getThread
@@ -69,3 +76,6 @@ instance manageUserAppM :: ManageUser AppM where
   verifyOtp = verifyOtp
   changePassword = changePassword
   deleteUser = deleteUser
+
+instance commentsHalogenM :: ManageComments AppM where
+    getCommentsByThreadID = getCommentsByThreadID 

haskread-platform-ui/src/Capability/Resource.purs

@@ -13,6 +13,7 @@ import Common.Types
   , DeleteUserFields
   , UpdateThreadFields
   , MyRoute
+  , NestedComment
   )
 import Data.Maybe (Maybe)
 import Data.Either (Either)
@@ -57,5 +58,9 @@ instance navigateHalogenM ::
   navigate = lift <<< navigate
 
 class Monad m <= ManageComments m where
-    getCommentsByThreadID :: Int -> m (Maybe (PaginatedArray Comment))
+    getCommentsByThreadID :: Int -> m (Maybe (PaginatedArray NestedComment))
+
+instance manageCommentsHalogenM :: ManageComments m 
+    => ManageComments (HalogenM st act slots msg m) where
+  getCommentsByThreadID = lift <<< getCommentsByThreadID
 

haskread-platform-ui/src/Common/Types.purs

@@ -28,10 +28,14 @@ module Common.Types
   , UpdateThreadFields
   , ThreadRep
   , ThreadInfo(..)
+  , CommentInfo(..)
+  , NestedComment(..)
+  , nestedCommentsCodec
   ) where
 
 import Prelude hiding ((/))
 
+import Undefined (undefined)
 import Data.Argonaut.Core (Json)
 import Data.Codec ((>~>))
 import Data.Codec.Argonaut (JsonCodec)
@@ -45,6 +49,9 @@ import Routing.Duplex (RouteDuplex', path, root, int, segment)
 import Routing.Duplex.Generic (noArgs, sum)
 import Routing.Duplex.Generic as G
 import Routing.Duplex.Generic.Syntax ((/))
+-- import Control.Lazy (fix)
+import Data.Newtype (class Newtype)
+import Data.Profunctor (wrapIso)
 
 newtype BaseURL = BaseURL String
 
@@ -60,6 +67,7 @@ data Endpoint
   | DeleteUser0
   | UpdateThread0
   | GetThreadByID0 Int
+  | Comments Int
 
 derive instance genericEndpoint :: Generic Endpoint _
 
@@ -76,6 +84,7 @@ endpointCodec = root $ sum
   , "DeleteUser0": "api" / "v1" / "user" / "profile" / "delete-account" / noArgs
   , "UpdateThread0": "api" / "v1" / "user" / "thread" / "update" / noArgs
   , "GetThreadByID0": "api" / "v1" / "thread" / (int segment)
+  , "Comments" : "api" / "v1" / "thread" / "comment" / (int segment)
   }
 
 data RequestMethod
@@ -194,10 +203,23 @@ type UpdateThreadFields =
   , threadCommunityIDForUpdate :: Int
   }
 
-type Comment = {
-
+type CommentInfo = {
+    commentIDForCommentInfo :: Int,
+    commentContentForCommentInfo :: String,
+    userIDForCommentInfo :: Int,
+    userNameForCommentInfo :: String,
+    threadIDForCommentInfo :: Int,
+    createdAtForCommentInfo :: String,
+    parentCommentIDForCommentInfo :: Maybe Int
+}
+
+newtype NestedComment = NestedComment {
+    mainComment :: CommentInfo
+  , children :: Array NestedComment
  }
 
+derive instance newtypeNestedComment ∷ Newtype NestedComment _
+
 profileCodec :: JsonCodec Profile
 profileCodec =
   CAM.renameField "userIDForUPR" "userID"
@@ -284,3 +306,36 @@ updateThreadCodec =
     , threadDescriptionForUpdate: CA.string
     , threadCommunityIDForUpdate: CA.int
     }
+
+commentCodec :: JsonCodec CommentInfo
+commentCodec = 
+    CAR.object "commmentInfo" {
+        commentIDForCommentInfo : CA.int,
+        commentContentForCommentInfo : CA.string,
+        userIDForCommentInfo : CA.int,
+        userNameForCommentInfo : CA.string,
+        threadIDForCommentInfo : CA.int,
+        createdAtForCommentInfo : CA.string,
+        parentCommentIDForCommentInfo : CAC.maybe CA.int
+    }
+
+nestedCommentCodec :: JsonCodec NestedComment
+nestedCommentCodec =
+    CA.fix \e ->
+      wrapIso NestedComment $
+        CAR.object "NestedComment" {
+        mainComment : commentCodec
+            , children : CA.array e
+          }
+
+nestedCommentsCodec :: JsonCodec (PaginatedArray NestedComment) 
+nestedCommentsCodec = 
+    CAM.renameField "comments" "body"
+        >~> CAM.renameField "commentsCount" "total"
+        >~> codec
+  where
+    codec =
+        CAR.object "Paginated NestedComment"
+            { body : CA.array nestedCommentCodec
+             , total: CA.int
+            }

haskread-platform-ui/src/Common/Utils.purs

@@ -328,3 +328,13 @@ toThreadInfo_ thread = do
       , age: toString <$> mAge
       }
   pure threadInfo
+
+getCommentsByThreadID :: 
+      forall m. 
+     MonadStore Action Store m
+  => MonadAff m
+  => Int -> m (Maybe (PaginatedArray NestedComment))
+getCommentsByThreadID threadID = do
+    let method = Get
+    mJson <- mkRequest { endpoint : Comments threadID, method}
+    decode nestedCommentsCodec mJson

haskread-platform-ui/src/Component/Router.purs

@@ -11,7 +11,13 @@ import Routing.Duplex as RD
 import Data.Either (Either(..))
 import Effect.Class.Console (log)
 import Effect.Class (class MonadEffect, liftEffect)
-import Capability.Resource (class ManageThreads, class ManageUser, class Navigate, navigate)
+import Capability.Resource (
+    class ManageThreads
+    , class ManageUser
+    , class Navigate
+    , class ManageComments
+    , navigate
+    )
 import Effect.Aff.Class (class MonadAff)
 import Routing.Hash (getHash)
 import Type.Proxy (Proxy(..))
@@ -62,6 +68,7 @@ component
   => ManageThreads m
   => MonadAff m
   => ManageUser m
+  => ManageComments m
   => MonadEffect m
   => H.Component Query Unit Void m
 component = connect (selectEq _.currentUser) $ H.mkComponent

haskread-platform-ui/src/Page/ViewThread.purs

@@ -3,24 +3,31 @@ module Page.ViewThread where
 import Prelude
 import Halogen as H
 import Halogen.HTML as HH
-import Common.Types (Profile,ThreadInfo)
+import Common.Types (Profile,ThreadInfo,PaginatedArray,NestedComment)
 import Data.Maybe (Maybe(..))
 import Network.RemoteData (RemoteData(..), fromMaybe)
 import Effect.Aff.Class (class MonadAff)
 import Halogen.Store.Connect (connect)
 import Halogen.Store.Select (selectEq)
-import Capability.Resource (class ManageThreads,getThread)
+import Capability.Resource ( 
+      class ManageThreads
+    , getThread
+    , class ManageComments
+    , getCommentsByThreadID
+  )
 import Halogen.Store.Monad (class MonadStore)
 import Store as Store
 import Undefined (undefined)
 import Common.Utils (toThreadInfo_)
 import Effect.Class (liftEffect)
+import Data.Newtype (unwrap)
 
 type Input = { threadID :: Int }
 
 type State = {
     currentUser :: Maybe Profile
   , thread :: RemoteData String ThreadInfo
+  , nestedComments :: RemoteData String (PaginatedArray NestedComment)
   , threadID :: Int
  }
 
@@ -31,6 +38,7 @@ data Action = Initialize
 component :: forall query output m.
     MonadAff m =>
     ManageThreads m =>
+    ManageComments m =>
     MonadStore Store.Action Store.Store m =>
     H.Component query Input output m
 component = connect (selectEq _.currentUser) $ H.mkComponent {
@@ -46,6 +54,7 @@ component = connect (selectEq _.currentUser) $ H.mkComponent {
                thread: NotAsked
              , currentUser 
              , threadID : threadID
+             , nestedComments : NotAsked
             }
 
   handleAction :: forall slots. Action -> H.HalogenM State Action slots output m Unit
@@ -67,11 +76,36 @@ component = connect (selectEq _.currentUser) $ H.mkComponent {
                   H.modify_ _ { thread = Failure "Get thread info failed" }
 
         LoadComments threadID -> do
-            -- H.modify_ _ {  }
-            undefined
+            H.modify_ _ { nestedComments = Loading }
+            mNestedComments <- getCommentsByThreadID threadID
+            H.modify_ _ { nestedComments = fromMaybe mNestedComments }
 
   render :: forall slots. State -> H.ComponentHTML Action slots m
-  render { currentUser } = 
+  render { thread, nestedComments } = 
       HH.div_ [
         HH.text "View Thread"
+        , threadView thread
+        , commentList nestedComments
       ]
+
+  threadView :: forall props act. RemoteData String ThreadInfo -> HH.HTML props act
+  threadView = 
+      case _ of
+          NotAsked -> HH.div_ []
+          Loading -> HH.div_ [ HH.text "Loading..." ]
+          Failure _ -> HH.div_ [ HH.text "failed to load Thread" ]
+          Success t -> HH.div_ [ 
+                    HH.text t.title,
+                    HH.text $ show t.threadIDForThreadInfo]
+
+  commentList :: forall props act. RemoteData String (PaginatedArray NestedComment) ->
+                    HH.HTML props act
+  commentList =
+      case _ of
+        NotAsked -> HH.div_ []
+        Loading -> HH.div_ [ HH.text "Loading..." ]
+        Failure _ -> HH.div_ [ HH.text "failed to load comments" ]
+        Success cs -> HH.div_ [
+           HH.text $ show $ (\c -> (show (unwrap c).mainComment)) `map` cs.body
+        ]
+