-
Notifications
You must be signed in to change notification settings - Fork 3
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
UI: WIP: Added Endpoint,Resource and State for Home Page
- Loading branch information
Showing
12 changed files
with
435 additions
and
9 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,21 @@ | ||
module Api.Endpoint where | ||
|
||
import Prelude hiding ((/)) | ||
|
||
import Data.Generic.Rep (class Generic) | ||
import Routing.Duplex (RouteDuplex', prefix, root) | ||
import Routing.Duplex.Generic (noArgs,sum) | ||
import Routing.Duplex.Generic.Syntax ((/)) | ||
|
||
|
||
data Endpoint | ||
= Login | ||
| Threads | ||
|
||
derive instance genericEndpoint :: Generic Endpoint _ | ||
|
||
endpointCodec :: RouteDuplex' Endpoint | ||
endpointCodec = root $ prefix "api" $ sum | ||
{ "Login" : "users" / "auth" / "login" / noArgs | ||
, "Threads" : "threads" / noArgs | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,11 +1,56 @@ | ||
module Api.Request where | ||
|
||
import Data.HTTP.Method | ||
import Prelude | ||
|
||
import Affjax.RequestHeader (RequestHeader(..)) | ||
import Affjax.Web (Request) | ||
import Api.Endpoint (Endpoint, endpointCodec) | ||
import Data.Argonaut.Core (Json) | ||
import Data.Either (Either(..)) | ||
import Data.Maybe (Maybe(..)) | ||
import Data.Tuple (Tuple(..)) | ||
import Halogen.HTML.Properties (method) | ||
import Routing.Duplex (print) | ||
import Affjax.RequestBody as RB | ||
import Affjax.ResponseFormat as RF | ||
|
||
newtype Token = Token String | ||
|
||
derive instance eqToken :: Eq Token | ||
instance showToken :: Show Token where | ||
show (Token _) = "Token {- token -}" | ||
show (Token _) = "Token {- token -}" | ||
|
||
newtype BaseURL = BaseURL String | ||
|
||
type RequestOptions = | ||
{ endpoint :: Endpoint | ||
, method :: RequestMethod | ||
} | ||
|
||
data RequestMethod | ||
= Get | ||
| Post (Maybe Json) | ||
| Put (Maybe Json) | ||
| Delete | ||
|
||
newtype BaseURL = BaseURL String | ||
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,45 @@ | ||
module Api.Utils where | ||
|
||
import Prelude | ||
|
||
import Affjax.Web (request) | ||
import Api.Request (RequestOptions, defaultRequest) | ||
import Data.Argonaut.Core (Json) | ||
import Data.Bifunctor (rmap) | ||
import Data.Codec.Argonaut (JsonCodec) | ||
import Data.Codec.Argonaut as CA | ||
import Data.Either (Either(..), hush) | ||
import Data.Maybe (Maybe(..)) | ||
import Data.Profile (UserName) | ||
import Effect.Aff.Class (class MonadAff, liftAff) | ||
import Effect.Class (class MonadEffect) | ||
import Halogen.Store.Monad (class MonadStore, getStore) | ||
import Store (Action, Store) | ||
|
||
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 | ||
|
||
-- TODO: Add logs upon receving errors | ||
decode :: forall a. JsonCodec a -> Maybe Json -> Maybe a | ||
decode _ Nothing = Nothing | ||
decode codec (Just json) = case CA.decode codec json of | ||
Left _ -> Nothing | ||
Right response -> (Just response) | ||
|
||
decodeWithUser | ||
:: forall m a. | ||
MonadEffect m | ||
=> MonadStore Action Store m | ||
=> (Maybe UserName -> JsonCodec a) | ||
-> Maybe Json | ||
-> m (Maybe a) | ||
decodeWithUser codec json = do | ||
{currentUser} <- getStore | ||
pure $ decode (codec (_.userName <$> currentUser)) json |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,15 @@ | ||
module Capability.Navigate where | ||
|
||
import Prelude | ||
|
||
import Data.Route (Route) | ||
import Control.Monad.Trans.Class (lift) | ||
import Halogen (HalogenM) | ||
|
||
class Monad m <= Navigate m where | ||
navigate :: Route -> m Unit | ||
logout :: m Unit | ||
|
||
instance navigateHalogenM :: Navigate m => Navigate (HalogenM st act slots msg m) where | ||
navigate = lift <<< navigate | ||
logout = lift logout |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,13 @@ | ||
module Capability.Resource.Thread where | ||
|
||
import Prelude | ||
|
||
import Data.Maybe (Maybe) | ||
import Data.Thread (Thread, PaginatedArray) | ||
import Halogen (HalogenM, lift) | ||
|
||
class Monad m <= ManageThread m where | ||
getThreads :: m (Maybe (PaginatedArray Thread)) | ||
|
||
instance manageThreadHalogenM :: ManageThread m => ManageThread (HalogenM st act slots msg m) where | ||
getThreads = lift getThreads |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,7 +1,95 @@ | ||
module Component.Router | ||
( component) | ||
where | ||
|
||
import Data.Route | ||
import Prelude | ||
|
||
import Capability.Navigate (class Navigate, navigate) | ||
import Capability.Resource.Thread (class ManageThread) | ||
import Data.Array (elem) | ||
import Data.Either (hush) | ||
import Data.Maybe (Maybe(..), fromMaybe, isJust) | ||
import Data.Profile (Profile) | ||
import Effect.Aff.Class (class MonadAff) | ||
import Effect.Class.Console (log) | ||
import Halogen (liftEffect) | ||
import Halogen as H | ||
import Halogen.HTML as HH | ||
import Halogen.Store.Connect (Connected, connect) | ||
import Halogen.Store.Monad (class MonadStore) | ||
import Halogen.Store.Select (selectEq) | ||
import Page.Home as Home | ||
import Routing.Duplex as RD | ||
import Routing.Hash (getHash) | ||
import Store as Store | ||
import Type.Proxy (Proxy(..)) | ||
import Undefined (undefined) | ||
|
||
component = undefined | ||
|
||
data Query a = Navigate Route a | ||
|
||
type State = { | ||
route :: Maybe Route, | ||
currentUser :: Maybe Profile | ||
} | ||
|
||
data Action = Initialize | Receive (Connected (Maybe Profile) Unit) | ||
|
||
type OpaqueSlot slot = forall query. H.Slot query Void slot | ||
|
||
type ChildSlots = | ||
( home :: OpaqueSlot Unit | ||
, login :: OpaqueSlot Unit | ||
, signup :: OpaqueSlot Unit | ||
) | ||
|
||
component :: | ||
forall m. | ||
MonadAff m => | ||
MonadStore Store.Action Store.Store m => | ||
ManageThread m => | ||
Navigate m => | ||
H.Component Query Unit Void m | ||
component = connect (selectEq _.currentUser) $ H.mkComponent | ||
{ initialState: \{context : currentUser} -> { route : Nothing ,currentUser } | ||
, render | ||
, eval: H.mkEval H.defaultEval { | ||
handleQuery = handleQuery, | ||
handleAction = handleAction, | ||
receive = Just <<< Receive, | ||
initialize = Just Initialize | ||
} | ||
} | ||
where | ||
handleAction :: Action -> H.HalogenM State Action ChildSlots Void m Unit | ||
handleAction = case _ of | ||
Initialize -> do | ||
log "Here!" | ||
initialRoute <- hush <<< (RD.parse routeCodec) <$> liftEffect getHash | ||
log $ "here as well" <> show initialRoute | ||
navigate $ fromMaybe Home initialRoute | ||
Receive { context : currentUser } -> | ||
H.modify_ _ { currentUser = currentUser } | ||
|
||
handleQuery :: forall a. Query a -> H.HalogenM State Action ChildSlots Void m (Maybe a) | ||
handleQuery = case _ of | ||
Navigate dest a -> do | ||
log "reacheddd" | ||
{ route , currentUser } <- H.get | ||
H.modify_ _ { route = Just dest } | ||
pure (Just a) | ||
_ -> log "not reachging Navigate" *> pure Nothing | ||
|
||
-- authorize :: Maybe Profile -> H.ComponentHTML Action ChildSlots m -> H.ComponentHTML Action ChildSlots m | ||
-- authorize mbProfile html = case mbProfile of | ||
-- Nothing -> | ||
-- undefined --HH.slot (Proxy :: _ "login") unit Login.component { redirect: false } absurd | ||
-- Just _ -> | ||
-- html | ||
|
||
render :: State -> H.ComponentHTML Action ChildSlots m | ||
render {route,currentUser} = case route of | ||
Just r -> case r of | ||
Home -> HH.slot_ (Proxy :: _ "home") unit Home.component unit | ||
_ -> HH.div_ [ HH.text "Oh no! That " ] | ||
Nothing -> HH.div_ [ HH.text "Oh no!! That page wasn't found." ] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,34 @@ | ||
module Data.Route where | ||
|
||
import Prelude hiding ((/)) | ||
|
||
import Data.Generic.Rep (class Generic) | ||
import Routing.Duplex (RouteDuplex', as, root) | ||
import Routing.Duplex.Generic (noArgs, sum) | ||
import Routing.Duplex.Generic.Syntax ((/)) | ||
import Slug (Slug) | ||
import Slug as Slug | ||
import Data.Either (note) | ||
|
||
data Route = Home | ||
| Login | ||
| Signup | ||
|
||
derive instance genericRoute :: Generic Route _ | ||
derive instance eqRoute :: Eq Route | ||
derive instance ordRoute :: Ord Route | ||
|
||
instance showRoute :: Show Route where | ||
show Home = "Home" | ||
show Login = "Home" | ||
show Signup = "Home" | ||
|
||
routeCodec :: RouteDuplex' Route | ||
routeCodec = root $ sum { | ||
"Home" : noArgs, | ||
"Login" : "login" / noArgs, | ||
"Signup" : "signup" / noArgs | ||
} | ||
|
||
slug :: RouteDuplex' String -> RouteDuplex' Slug | ||
slug = as Slug.toString (Slug.parse >>> note "Bad slug") |
Oops, something went wrong.