UI: WIP - Added mkRequest helper function

haskread-platform-ui/src/AppM.purs

@@ -1,5 +1,5 @@
 module AppM
-  ( AppM(..)
+  ( AppM
   , runAppM
   )
   where
@@ -9,14 +9,23 @@ import Prelude
 import Effect.Aff (Aff)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect,liftEffect)
+import Effect.Class.Console (log)
 import Halogen as H
 import Halogen.Store.Monad (class MonadStore, StoreT, runStoreT)
 import Safe.Coerce (coerce)
 import Store as Store
 import Capability.Navigate (class Navigate)
+import Capability.Resource (
+    class ManageThreads
+ )
 import Routing.Hash (setHash)
 import Routing.Duplex (print)
 import Common.Types as Route
+import Undefined (undefined)
+import Common.Utils (mkRequest,decode)
+import Common.Types (RequestOptions(..),Endpoint(..),RequestMethod(..),threadsCodec )
+import Data.Argonaut.Core (toString,fromString)
+import Data.Maybe (fromMaybe)
 
 newtype AppM a = AppM (StoreT Store.Action Store.Store Aff a)
 
@@ -38,3 +47,9 @@ derive newtype instance monadStoreAppM :: MonadStore Store.Action Store.Store Ap
 instance navigateHalogenM :: Navigate AppM where
    navigate =
      liftEffect <<< setHash <<< print Route.myRoute
+
+instance threadHalogenM :: ManageThreads AppM where
+    getThreads = do
+       mjson <- mkRequest { endpoint: Threads , method: Get }
+       liftEffect $ log $ "hi" <> fromMaybe "" (toString $ fromMaybe (fromString "{}") mjson)
+       decode threadsCodec mjson

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

@@ -0,0 +1,14 @@
+module Capability.Resource where
+
+import Halogen (HalogenM, lift)
+import Common.Types (PaginatedArray,Thread)
+import Data.Maybe (Maybe)
+
+import Prelude
+
+class Monad m <= ManageThreads m where
+  getThreads :: m (Maybe (PaginatedArray Thread))
+
+instance manageThreadHalogenM :: ManageThreads m => ManageThreads (HalogenM st act slots msg m) where
+  getThreads = lift getThreads
+

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

@@ -0,0 +1,2 @@
+module Common.Request where
+

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

@@ -1,9 +1,37 @@
 module Common.Types where
 
-import Prelude
+import Prelude hiding ((/))
 import Data.Generic.Rep (class Generic)
-import Routing.Duplex (RouteDuplex', root,path)
 import Routing.Duplex.Generic as G
+import Data.Maybe (Maybe)
+import Routing.Duplex (RouteDuplex', int, path, optional, prefix, root, segment, string)
+import Routing.Duplex.Generic (noArgs, sum)
+import Routing.Duplex.Generic.Syntax ((/), (?))
+import Data.Argonaut.Core (Json)
+import Data.Codec.Argonaut (JsonCodec)
+import Data.Codec.Argonaut.Record as CAR
+import Data.Codec ((>~>))
+import Data.Codec.Argonaut.Migration as CAM
+import Data.Codec.Argonaut as CA
+import Data.Codec.Argonaut.Common as CAC
+
+newtype BaseURL = BaseURL String
+
+data Endpoint = Threads 
+derive instance genericEndpoint :: Generic Endpoint _
+
+endpointCodec :: RouteDuplex' Endpoint
+endpointCodec = root $ prefix "api" $ sum {
+        "Threads" : "threads" / noArgs
+    }
+
+data RequestMethod = 
+    Get | Post (Maybe Json) | Put (Maybe Json) | Delete
+
+type RequestOptions =
+  { endpoint :: Endpoint
+  , method :: RequestMethod
+  }
 
 data MyRoute =
       Home
@@ -12,8 +40,44 @@ data MyRoute =
 derive instance genericRoute :: Generic MyRoute _
 derive instance eqRoute :: Eq MyRoute
 
+newtype Token = Token String
+
+derive instance eqToken :: Eq Token
+instance showToken :: Show Token where
+    show (Token _) = "TOKEN"
+
 myRoute :: RouteDuplex' MyRoute
 myRoute = root $ G.sum {
         "Home" : G.noArgs
       , "Login" : path "login" G.noArgs
     }
+
+type PaginatedArray a =
+  { total :: Int
+  , body :: Array a
+  }
+
+-- Thread
+type Thread = {
+    title :: String,
+    description :: Maybe String
+  }
+
+threadCodec :: JsonCodec Thread
+threadCodec =
+    CAR.object "Thread" {
+        title : CA.string,
+        description : CAC.maybe CA.string
+    }
+
+threadsCodec :: JsonCodec (PaginatedArray Thread)
+threadsCodec = 
+    CAM.renameField "threads" "body"
+    >~> CAM.renameField "threadsCount" "total"
+    >~> codec
+  where
+  codec =
+    CAR.object "PaginatedArray Thread"
+      { body: CA.array threadCodec
+      , total: CA.int
+      }

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

@@ -0,0 +1,61 @@
+module Common.Utils where
+
+import Prelude
+import Data.Maybe (Maybe(..)) 
+import Data.Argonaut.Core (Json)
+import Halogen.Store.Monad (class MonadStore, getStore)
+import Effect.Aff.Class (class MonadAff, liftAff)
+import Affjax.Web (request,Request)
+import Data.Bifunctor (rmap)
+import Data.Either (Either(..),hush)
+
+import Common.Types (BaseURL(..)
+    ,Token(..),RequestOptions,RequestMethod(..),endpointCodec)
+import Data.Tuple (Tuple(..))
+import Routing.Duplex (print)
+import Affjax.RequestHeader (RequestHeader(..))
+import Affjax.RequestBody as RB
+import Affjax.ResponseFormat as RF
+import Data.HTTP.Method (Method(..))
+import Store (Action,Store)
+import Data.Codec.Argonaut (JsonCodec)
+import Data.Codec.Argonaut as CA
+import Effect.Class (class MonadEffect)
+
+mkRequest
+  :: forall m
+   . MonadAff m
+  => MonadStore Action Store m
+  => RequestOptions
+  -> m (Maybe Json)
+mkRequest opts = do
+  { baseUrl } <- getStore
+  response <- liftAff $ request $ defaultRequest baseUrl Nothing opts
+  pure $ hush $ rmap _.body response
+
+defaultRequest :: BaseURL -> Maybe Token -> RequestOptions -> Request Json
+defaultRequest (BaseURL baseUrl) auth { endpoint, method } =
+  { method: Left requestMethod
+  , url: baseUrl <> print endpointCodec endpoint
+  , headers: case auth of
+      Nothing -> []
+      Just (Token t) -> [ RequestHeader "Authorization" $ "Token " <> t ]
+  , content: RB.json <$> body
+  , username: Nothing
+  , password: Nothing
+  , timeout: Nothing
+  , withCredentials: false
+  , responseFormat: RF.json
+  }
+  where
+  Tuple requestMethod body = case method of
+    Get -> Tuple GET Nothing
+    Post b -> Tuple POST b
+    Put b -> Tuple PUT b
+    Delete -> Tuple DELETE Nothing
+
+decode :: forall m a. MonadEffect m => JsonCodec a -> Maybe Json -> m (Maybe a)
+decode _ Nothing = pure Nothing
+decode codec (Just json) = case CA.decode codec json of
+  Left _ -> pure Nothing
+  Right response -> pure (Just response)

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

@@ -15,6 +15,7 @@ import Data.Either (Either(..))
 import Effect.Class.Console (log)
 import Effect.Class (class MonadEffect,liftEffect)
 import Capability.Navigate (class Navigate,navigate)
+import Capability.Resource (class ManageThreads)
 
 import Routing.Hash (getHash)
 import Type.Proxy (Proxy(..))
@@ -35,7 +36,10 @@ type ChildSlots =
   )
 
 component :: 
-    forall input m. Navigate m => MonadEffect m => H.Component Query input Void m
+    forall input m. 
+            Navigate m => 
+            ManageThreads m => 
+            MonadEffect m => H.Component Query input Void m
 component = H.mkComponent {
         initialState 
       , render

haskread-platform-ui/src/Main.purs

@@ -13,13 +13,13 @@ import Effect.Console (log)
 import Effect.Class (liftEffect)
 import Routing.Hash (matchesWith)
 import Routing.Duplex (parse)
-import Common.Types (myRoute)
 import Halogen.Aff as HA
 import Halogen as H
 import Component.Router as Router
 import Effect.Aff (launchAff_)
 import Halogen.VDom.Driver (runUI)
-import Store (LogLevel(..),BaseURL(..))
+import Store (LogLevel(..))
+import Common.Types (myRoute,BaseURL(..))
 
 main :: Effect Unit
 main = do

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

@@ -4,13 +4,39 @@ import Prelude
 import Undefined (undefined)
 import Halogen as H
 import Halogen.HTML as HH
+import Network.RemoteData (RemoteData(..),fromMaybe)
+import Common.Types (PaginatedArray,Thread)
+import Capability.Resource (class ManageThreads,getThreads)
+import Data.Maybe (Maybe(..))
 
-component :: forall query input output m. H.Component query input output m
+type State = {
+        threads :: RemoteData String (PaginatedArray Thread)
+    }
+
+data Action = Initialize | LoadThreads
+
+component :: forall query input output m. ManageThreads m => H.Component query input output m
 component = H.mkComponent {
-        initialState : identity,
+        initialState,
         render,
-        eval : H.mkEval H.defaultEval
+        eval : H.mkEval H.defaultEval {
+            initialize = Just Initialize,
+            handleAction = handleAction
+        }
     }
   where
-    render :: forall state action slots. state -> H.ComponentHTML action slots m 
+    initialState :: input -> State
+    initialState _ = { threads : NotAsked }
+
+    render :: forall state slots. state -> H.ComponentHTML Action slots m 
     render _ = HH.div_ [ HH.text "Home Page" ]
+
+    handleAction :: forall slots. Action -> H.HalogenM State Action slots output m Unit
+    handleAction = case _ of
+            Initialize -> do
+               void $ H.fork $ handleAction LoadThreads
+
+            LoadThreads -> do
+               H.modify_ _ { threads = Loading }
+               mThreadList <- getThreads
+               H.modify_ _ { threads = fromMaybe mThreadList }

haskread-platform-ui/src/Store.purs

@@ -2,13 +2,13 @@ module Store where
 
 import Prelude
 import Data.Maybe (Maybe(..))
+import Common.Types (BaseURL)
 
 data LogLevel = LogDebug | LogInfo | LogError | LogWarn
 
 derive instance eqLogLevel :: Eq LogLevel
 derive instance ordLogLevel :: Ord LogLevel
 
-newtype BaseURL = BaseURL String
 data Profile = Profile {
     userID :: Int,
     userName :: String