SHARE
TWEET

Untitled

a guest Oct 20th, 2019 69 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. module Main where
  2.  
  3. import Prelude
  4.  
  5. import Data.Lens
  6. import Data.List as L
  7. import Data.Maybe
  8. import Data.Tuple
  9. import Data.Either
  10. import Control.Monad.Aff (Aff)
  11. import Control.Monad.Trans.Class (lift)
  12. import React as R
  13. import React.DOM as R
  14. import React.DOM.Props as RP
  15. import Thermite hiding (defaultMain) as T
  16. import Thermite.Try as T
  17.  
  18.  
  19.  
  20.  
  21. ---- COUNTER COMPONENT ----
  22.  
  23.  
  24.  
  25.  
  26. -- STATE --
  27.  
  28.  
  29. type CounterState = Int
  30.  
  31. counterInitialState :: CounterState
  32. counterInitialState = 42
  33.  
  34.  
  35. -- ACTIONS --
  36.  
  37.  
  38. data CounterAction
  39.   = Increment
  40.   | Decrement
  41.  
  42.  
  43. -- STATE MACHINE --
  44.  
  45.  
  46. counterUpdate               :: T.PerformAction _ CounterState _ CounterAction
  47. counterUpdate Increment _ _ = void do
  48.   T.modifyState \state -> state + 1
  49. counterUpdate Decrement _ _ = void do
  50.   T.modifyState \state -> state - 1
  51.  
  52.  
  53. -- SPEC --
  54.  
  55.  
  56. counterSpec :: T.Spec _ CounterState _ CounterAction
  57. counterSpec = T.simpleSpec counterUpdate render
  58.   where
  59.  
  60.  
  61.     -- VIEW --
  62.  
  63.  
  64.     render                    :: T.Render CounterState _ CounterAction
  65.     render dispatch _ state _ =
  66.       [ R.p
  67.         [ RP.className "input-group" ]
  68.         [ R.span
  69.           [ RP.className "input-group-btn" ]
  70.           [ R.button
  71.             [ RP.className "btn btn-default"
  72.             , RP.onClick \_ -> dispatch Decrement
  73.             ]
  74.             [ R.text "-" ]
  75.           ]
  76.         , R.input
  77.           [ RP.className "form-control"
  78.           , RP._type "text"
  79.           , RP.disabled true
  80.           , RP.value (show state)
  81.           ]
  82.           []
  83.         , R.span
  84.           [ RP.className "input-group-btn" ]
  85.           [ R.button
  86.             [ RP.className "btn btn-default"
  87.             , RP.onClick \_ -> dispatch Increment
  88.             ]
  89.             [ R.text "+" ]
  90.           ]
  91.         ]
  92.       ]
  93.  
  94.  
  95.  
  96.  
  97. ---- HEADER COMPONENT ----
  98.  
  99.  
  100.  
  101.  
  102. -- STATE --
  103.  
  104.  
  105. type HeaderState = L.List CounterState
  106.  
  107. headerInitialState :: HeaderState
  108. headerInitialState = L.Nil
  109.  
  110.  
  111. -- ACTIONS --
  112.  
  113.  
  114. type CounterIndex = Int
  115. data HeaderAction
  116.   = AddCounter
  117.   | ItemAction CounterIndex CounterAction
  118.  
  119.  
  120. _ItemAction :: Prism' HeaderAction (Tuple CounterIndex CounterAction)
  121. _ItemAction = prism' (uncurry ItemAction) unwrap
  122.   where
  123.     unwrap (ItemAction i a) = Just (Tuple i a)
  124.     unwrap _                = Nothing
  125.  
  126.  
  127.  
  128. -- STATE MACHINE --
  129.  
  130.  
  131. headerUpdate                :: T.PerformAction _ HeaderState _ HeaderAction
  132. headerUpdate AddCounter _ _ = void $ T.cotransform $ flip L.snoc counterInitialState
  133. headerUpdate _ _ _          = pure unit
  134.  
  135.  
  136. -- SPEC --
  137.  
  138.  
  139. headerSpec :: T.Spec _ _ _ _
  140. headerSpec = T.simpleSpec headerUpdate render
  141.   where
  142.  
  143.  
  144.     -- VIEW --
  145.  
  146.  
  147.     render                :: T.Render HeaderState _ HeaderAction
  148.     render dispatch _ _ _ =
  149.       [ R.h1'
  150.         [ R.text "Lesson 5 - Lists" ]
  151.       , R.p'
  152.         [ R.button
  153.           [ RP.className "btn btn-success"
  154.           , RP.onClick \_ -> dispatch AddCounter
  155.           ]
  156.           [ R.text "Add Counter" ]
  157.         ]
  158.       ]
  159.  
  160.  
  161.  
  162.  
  163. ---- ROOT COMPONENT ----
  164.  
  165.  
  166.  
  167.  
  168. -- SPEC --
  169.  
  170.  
  171. spec :: T.Spec _ HeaderState _ HeaderAction
  172. spec
  173.   =  headerSpec
  174.   <> T.focus id _ItemAction (T.foreach \_ -> counterSpec)
  175.  
  176.  
  177.  
  178.  
  179. ---- MAIN ----
  180.  
  181.  
  182.  
  183.  
  184. main = T.defaultMain spec headerInitialState
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top