|
| 1 | +module Example where |
| 2 | + |
| 3 | +import Prelude |
| 4 | +import Data.Foldable (find) |
| 5 | +import Data.Maybe (Maybe(..)) |
| 6 | +import Data.Newtype (class Newtype, un) |
| 7 | +import Effect.Aff (Aff, Milliseconds(..), delay, error, message, throwError) |
| 8 | +import React.Basic.DOM as R |
| 9 | +import React.Basic.DOM.Events (capture_) |
| 10 | +import React.Basic.Events (handler_) |
| 11 | +import React.Basic.Hooks (Component, component, fragment, useState, (/\)) |
| 12 | +import React.Basic.Hooks as React |
| 13 | +import React.Basic.Hooks.Aff (useAff) |
| 14 | +import React.Basic.Hooks.ErrorBoundary (mkErrorBoundary) |
| 15 | + |
| 16 | +mkExample :: Component Unit |
| 17 | +mkExample = do |
| 18 | + errorBoundary <- mkErrorBoundary "AffExErrorBoundary" |
| 19 | + catDetails <- mkCatDetails |
| 20 | + component "AffEx" \props -> React.do |
| 21 | + catKey /\ setCatKey <- useState Nothing |
| 22 | + let |
| 23 | + reset = setCatKey \_ -> Nothing |
| 24 | + pure |
| 25 | + $ R.div_ |
| 26 | + [ R.h2_ [ R.text "Cat chooser" ] |
| 27 | + , errorBoundary \{ error, dismissError } -> case error of |
| 28 | + Just e -> renderAppError e (reset *> dismissError) |
| 29 | + Nothing -> |
| 30 | + fragment |
| 31 | + [ catKeyList catKey setCatKey |
| 32 | + , case catKey of |
| 33 | + Nothing -> mempty |
| 34 | + Just k -> catDetails k |
| 35 | + ] |
| 36 | + ] |
| 37 | + where |
| 38 | + -- This component is the main `useAff` demo. It receives a key |
| 39 | + -- as a prop and renders both the loading state and the final |
| 40 | + -- result. |
| 41 | + mkCatDetails :: Component (Key Cat) |
| 42 | + mkCatDetails = do |
| 43 | + component "CatDetails" \catKey -> React.do |
| 44 | + catState <- useAff catKey $ fetch catKey |
| 45 | + pure |
| 46 | + $ R.p_ |
| 47 | + [ case map entity catState of |
| 48 | + Nothing -> R.text "Loading..." |
| 49 | + Just (Cat { name }) -> R.text $ "A cat named " <> name |
| 50 | + ] |
| 51 | + |
| 52 | + renderAppError error resetApp = |
| 53 | + fragment |
| 54 | + [ R.p_ [ R.text "Error!" ] |
| 55 | + , R.p_ [ R.text $ message error ] |
| 56 | + , R.button |
| 57 | + { onClick: capture_ do resetApp |
| 58 | + , children: [ R.text "Reset" ] |
| 59 | + } |
| 60 | + ] |
| 61 | + |
| 62 | + catKeyList selectedCatKey setCatKey = |
| 63 | + let |
| 64 | + cats = |
| 65 | + fakeDb |
| 66 | + <> [ Entity |
| 67 | + (Key "error (choose to throw a React render error)") |
| 68 | + (Cat { name: "" }) |
| 69 | + ] |
| 70 | + |
| 71 | + catKeyRadioButton k = |
| 72 | + R.div_ |
| 73 | + [ R.label_ |
| 74 | + [ R.input |
| 75 | + { type: "radio" |
| 76 | + , name: "cat-key" |
| 77 | + , checked: Just k == selectedCatKey |
| 78 | + , onChange: |
| 79 | + handler_ do |
| 80 | + setCatKey \_ -> Just k |
| 81 | + } |
| 82 | + , R.text $ " Cat " <> un Key k |
| 83 | + ] |
| 84 | + ] |
| 85 | + in |
| 86 | + fragment $ map (catKeyRadioButton <<< key) cats |
| 87 | + |
| 88 | +-- |
| 89 | +-- The bits below this point aren't directly relevant to the example, |
| 90 | +-- just a slightly more interesting data model than returing a single |
| 91 | +-- string. |
| 92 | +-- |
| 93 | +-- |
| 94 | +-- |
| 95 | +-- Typed keys are a great way to tie entity-specific behavior |
| 96 | +-- to an ID. We can use this phantom type to write a class |
| 97 | +-- for generic, type-safe data fetching. |
| 98 | +newtype Key entity |
| 99 | + = Key String |
| 100 | + |
| 101 | +derive instance eqKey :: Eq (Key entity) |
| 102 | + |
| 103 | +derive instance ntKey :: Newtype (Key entity) _ |
| 104 | + |
| 105 | +-- An entity wrapper. In a real app this would hold other metadata |
| 106 | +-- such as create and update dates. |
| 107 | +data Entity entity |
| 108 | + = Entity (Key entity) entity |
| 109 | + |
| 110 | +key :: forall entity. Entity entity -> Key entity |
| 111 | +key (Entity k _) = k |
| 112 | + |
| 113 | +entity :: forall entity. Entity entity -> entity |
| 114 | +entity (Entity _ e) = e |
| 115 | + |
| 116 | +class Fetch entity where |
| 117 | + fetch :: Key entity -> Aff (Entity entity) |
| 118 | + |
| 119 | +-- An example entity |
| 120 | +newtype Cat |
| 121 | + = Cat { name :: String } |
| 122 | + |
| 123 | +fakeDb :: Array (Entity Cat) |
| 124 | +fakeDb = |
| 125 | + [ Entity (Key "abc") (Cat { name: "Herb" }) |
| 126 | + , Entity (Key "def") (Cat { name: "Maxi" }) |
| 127 | + , Entity (Key "ghi") (Cat { name: "Chloe" }) |
| 128 | + ] |
| 129 | + |
| 130 | +instance fetchCat :: Fetch Cat where |
| 131 | + fetch k = do |
| 132 | + delay $ Milliseconds 300.0 |
| 133 | + -- pretend this happens on the server |
| 134 | + case fakeDb # find (key >>> (_ == k)) of |
| 135 | + Nothing -> |
| 136 | + -- This should never happen in a normal application path |
| 137 | + -- if only the server can generate keys :) |
| 138 | + throwError |
| 139 | + $ error |
| 140 | + $ "DB error: Cat not found for key " |
| 141 | + <> un Key k |
| 142 | + Just e -> pure e |
0 commit comments