diff --git a/index.html b/index.html index 548e927..e0c9c79 100644 --- a/index.html +++ b/index.html @@ -1,13 +1,24 @@ - - - - Document + + + Template • TodoMVC + + +
+ + + + - \ No newline at end of file + diff --git a/package-lock.json b/package-lock.json index b4511f2..c46732e 100644 --- a/package-lock.json +++ b/package-lock.json @@ -6850,6 +6850,16 @@ "repeat-string": "^1.6.1" } }, + "todomvc-app-css": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/todomvc-app-css/-/todomvc-app-css-2.2.0.tgz", + "integrity": "sha512-H03oc3QOxiGXv+MqnotcduZIwoGX8A8QbSx9J4U2Z5R96LrK+dvQmRDTgeCc0nlkPBhd3nUL4EbfS7l0TccM5g==" + }, + "todomvc-common": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/todomvc-common/-/todomvc-common-1.0.5.tgz", + "integrity": "sha512-D8kEJmxVMQIWwztEdH+WeiAfXRbbSCpgXq4NkYi+gduJ2tr8CNq7sYLfJvjpQ10KD9QxJwig57rvMbV2QAESwQ==" + }, "tough-cookie": { "version": "2.5.0", "resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.5.0.tgz", diff --git a/package.json b/package.json index f87c944..ec35ed7 100644 --- a/package.json +++ b/package.json @@ -7,7 +7,9 @@ }, "dependencies": { "react": "^16.8.6", - "react-dom": "^16.8.6" + "react-dom": "^16.8.6", + "todomvc-app-css": "^2.2.0", + "todomvc-common": "^1.0.5" }, "devDependencies": { "parcel-bundler": "^1.12.3", diff --git a/packages.dhall b/packages.dhall index 55d086b..03fc9c5 100644 --- a/packages.dhall +++ b/packages.dhall @@ -109,18 +109,18 @@ let additions = -} let mkPackage = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.3-20190330/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190626/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 let upstream = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.3-20190330/src/packages.dhall sha256:cb0cdde5926cfdff5bd17bb2508a85b5eee794088f253f59f884766828ba722c + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190626/src/packages.dhall sha256:9905f07c9c3bd62fb3205e2108515811a89d55cff24f4341652f61ddacfcf148 let overrides = {=} let additions = { record-optics-extra = let manifest = - https://raw.githubusercontent.com/masaeedu/purescript-record-optics-extra/master/spago.dhall sha256:cbffbd747560d338124c5d41e2df6e9efcffce1cfef787474ffddfa78b1ca3b8 - + https://raw.githubusercontent.com/masaeedu/purescript-record-optics-extra/master/spago.dhall sha256:bba75d2ecde08251b3ae35c647d316bc51bb0aa98a04bd8d58573e77ea55977d + in mkPackage manifest.dependencies "https://github.com/masaeedu/purescript-record-optics-extra.git" diff --git a/spago.dhall b/spago.dhall index 823ccb2..fc7b144 100644 --- a/spago.dhall +++ b/spago.dhall @@ -5,7 +5,7 @@ You can edit this file as you like. { name = "my-project" , dependencies = - [ "effect", "console", "profunctor-lenses", "react", "react-basic", "avar", "variant", "typelevel-prelude", "heterogeneous", "const", "record", "record-optics-extra", "filterable" ] + [ "effect", "console", "profunctor-lenses", "react", "react-basic", "avar", "variant", "typelevel-prelude", "heterogeneous", "const", "record", "record-optics-extra", "filterable", "debug" ] , packages = ./packages.dhall } diff --git a/src/Data/Profunctor/Optics.purs b/src/Data/Profunctor/Optics.purs index 163ce11..e495293 100644 --- a/src/Data/Profunctor/Optics.purs +++ b/src/Data/Profunctor/Optics.purs @@ -3,11 +3,14 @@ module Data.Profunctor.Optics where import Prelude import Control.Monad.State (evalState, get, put) +import Data.Array (zipWith) import Data.Bifoldable (bifoldMap) import Data.Bifunctor (bimap, lmap) as B import Data.Either (Either(..), either) -import Data.Foldable (class Foldable, and) -import Data.Lens (Lens, Lens', Optic', first, left, lens) +import Data.Filterable (class Filterable, filter) +import Data.Foldable (class Foldable, and, length) +import Data.Lens (Lens, Lens', Optic', first, left, lens, set, view) +import Data.List (List(..), catMaybes) import Data.List as L import Data.Maybe (Maybe(..)) import Data.Profunctor (class Profunctor, dimap, lcmap, rmap) @@ -248,13 +251,21 @@ pt2lt :: forall s t a b. PTraversal s t a b -> LTraversal s t a b pt2lt f = runLTraversal' $ f $ LTraversal' single where -- Ideally we'd have type information that witnesses `pure` produces a one element list but whatever - single = { contents: pure, fill: (const <<< unsafeHead) } + single = + { contents: pure + , fill: const <<< unsafeHead + } -- Again we repeat all the bullshit to get the reverse direction for 2... pmt2lmt :: forall s a. PMonoTraversal s a -> LMonoTraversal s a pmt2lmt f = runLTraversal' $ f $ LTraversal' single where - single = { contents: pure, fill: (const <<< unsafeHead) } + single = + { contents: pure + , fill: case _ of + Nil -> identity + Cons x _ -> const x + } -- Et voila! Now we can write a little traversal in concrete form, transform it to a profunctor traversal, -- and apply it straight to a component! @@ -294,15 +305,15 @@ overwriteWitherable l = flip evalState l <<< wither step L.Nil -> pure Nothing L.Cons x xs' -> Just x <$ put xs' -withered :: forall t a b. Witherable t => PTraversal (t a) (t b) a b -withered = lt2pt +iterated :: forall t a b. Witherable t => PTraversal (t a) (t b) a b +iterated = lt2pt { contents: L.fromFoldable , fill: overwriteWitherable } -withered' :: forall t a. Witherable t => PMonoTraversal (t a) a -withered' = lmt2pmt +iterated' :: forall t a. Witherable t => PMonoTraversal (t a) a +iterated' = lmt2pmt { contents: L.fromFoldable , fill: overwriteWitherable } @@ -317,8 +328,28 @@ partsOf' t = lens contents (flip fill) where { contents, fill } = pmt2lmt t +withered :: forall t a b. Witherable t => PTraversal (t a) (t b) a (Maybe b) +withered = lt2pt { contents, fill } + where + contents = L.fromFoldable + fill = catMaybes >>> overwriteWitherable + +withered' :: forall t a. Witherable t => PMonoTraversal (t a) (Maybe a) +withered' = lmt2pmt { contents, fill } + where + contents = L.fromFoldable <<< map Just + fill = catMaybes >>> overwriteWitherable + by :: forall p a. Profunctor p => (a -> Boolean) -> Optic' p a (Either a a) by f = dimap (\v -> if f v then Left v else Right v) (either identity identity) all :: forall t a. Functor t => Foldable t => HeytingAlgebra a => Eq a => Lens' (t a) a all = lens and (\s b -> if and s == b then s else b <$ s) + +overArray :: forall s t a b. Lens s t a b -> Lens (Array s) (Array t) (Array a) (Array b) +overArray l = lens (map $ view l) (zipWith $ flip (set l)) + +type Getter s a = forall p x. Profunctor p => p a x -> p s x + +countBy :: forall f x. Filterable f => Foldable f => (x -> Boolean) -> Getter (f x) Int +countBy p = lcmap (filter p >>> length) diff --git a/src/Main.purs b/src/Main.purs index 1dc36b1..54c804a 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -2,7 +2,6 @@ module Main where import Prelude -import Data.Array (replicate) import Data.Maybe (maybe) import Effect (Effect) import Effect.Aff (error, launchAff_) @@ -13,23 +12,13 @@ import Effect.Ref as Ref import Snap (snap) import Snap.React (reactTarget, refSnapper) import Snap.SYTC.Component (contraHoist) -import TodoMVC (App, app) +import TodoMVC (app, initialState) import Web.DOM (Element) import Web.DOM.NonElementParentNode (getElementById) import Web.HTML (window) import Web.HTML.HTMLDocument (toNonElementParentNode) import Web.HTML.Window (document) --- Initial application state consists of three components -state :: App -state = replicate 3 s - where - s = { done: true - , hovered: false - , editing: false - , value: "Test value pls ignore" - } - -- Finding the DOM element we're going to render everything onto element :: Effect Element element = do @@ -40,7 +29,7 @@ main :: Effect Unit main = do -- Find the DOM element and create an Ref to hold the application state e <- element - ref <- liftEffect $ Ref.new state + ref <- liftEffect $ Ref.new initialState launchAff_ $ do av <- AVar.empty -- Create the state manager and target from the resources above diff --git a/src/Snap/Component.purs b/src/Snap/Component.purs index 7e64de6..c0ef9bc 100644 --- a/src/Snap/Component.purs +++ b/src/Snap/Component.purs @@ -87,12 +87,12 @@ instance monoidalMonoComponent :: Monoid v => MonoidalMono (PComponent m v) wher focus :: forall m v s u x y. Newtype x y => (PComponent m v s u -> x) -> Cmp m v s u -> y focus = under ρ -infixl 8 focus as $! +infixl 1 focus as $! flippedFocus :: forall m v s u x y. Newtype x y => Cmp m v s u -> (PComponent m v s u -> x) -> y flippedFocus = flip focus -infixr 8 flippedFocus as #! +infixl 1 flippedFocus as #! -- Monad wrapper newtype MComponent s u m v diff --git a/src/Snap/React/Component.js b/src/Snap/React/Component.js deleted file mode 100644 index 308b46d..0000000 --- a/src/Snap/React/Component.js +++ /dev/null @@ -1,70 +0,0 @@ -"use strict"; - -var React = require("react"); - -function Input(props) { - React.Component.constructor.call(this); - var self = this; - - self.set = function(v) { - self.setState( - function() { - return v; - }, - function() { - props.set(v)(); - } - ); - }; - - self.state = props.s; -} - -Input.prototype = Object.create(React.Component.prototype); - -function enforceFocus() { - var self = this; - - if (self.node) { - if (self.state.focused) { - self.node.focus(); - } else { - self.node.blur(); - } - } -} - -Input.prototype.componentDidMount = enforceFocus; -Input.prototype.componentDidUpdate = enforceFocus; - -Input.prototype.render = function() { - var self = this; - return React.createElement("input", { - ref: function(r) { - self.node = r; - }, - value: self.state.value, - onChange: function(e) { - var v = e.target.value; - self.set(Object.assign({}, self.state, { value: v })); - }, - onFocus: function() { - if (!self.state.focused) { - self.set(Object.assign({}, self.state, { focused: true })); - } - }, - onBlur: function() { - if (self.state.focused) { - self.set(Object.assign({}, self.state, { focused: false })); - } - } - }); -}; - -var focusedInputComponent = function(set) { - return function(s) { - return React.createElement(Input, { set: set, s: s }); - }; -}; - -exports.focusedInputComponent = focusedInputComponent; diff --git a/src/Snap/React/Component.purs b/src/Snap/React/Component.purs index 5865900..14ec3d9 100644 --- a/src/Snap/React/Component.purs +++ b/src/Snap/React/Component.purs @@ -1,86 +1,100 @@ module Snap.React.Component where +import Prelude + +import Data.Functor.Variant (SProxy(..)) +import Data.Lens.Record (prop) +import Data.Maybe (maybe) import Effect (Effect) -import Effect.Aff.Compat (EffectFn1) -import Prelude (identity, (<<<), not, (+), (-), const, ($), mempty, class Show, show, Unit, unit) import Prim.Row (class Union) import React.Basic (JSX) as R -import React.Basic.DOM (Props_button, Props_input, Props_img) import React.Basic.DOM (button, div, img, input, text) as R -import React.Basic.DOM.Internal (SharedProps) -import React.Basic.Events (SyntheticEvent) -import React.Basic.Events (handler_) as R +import React.Basic.DOM.Events (key, targetChecked, targetValue) +import React.Basic.Events (handler, handler_) as R +import Record as RD import Record.Builder (build, union) -import Snap.SYTC.Component (Cmp, Cmp', apply, handle, map, pure) -import Snap.SYTC.Component (lcmap) as C +import Snap.Component ((#!)) +import Snap.SYTC.Component (Cmp, Cmp', (<*>!)) +import Snap.SYTC.Component as C -- Some convenience things -unionPropsWith :: forall p q r. Union p q r => Record q -> Record p -> Record r -unionPropsWith = (build <<< union) +unionWith :: forall p q r. Union p q r => Record q -> Record p -> Record r +unionWith = (build <<< union) + +setProps :: forall p q r x. Union p q r => (Record r -> x) -> Record q -> (Record p -> x) +setProps f v = f <<< unionWith v + +infixl 7 setProps as |= setChildren :: forall x. ({ children :: Array R.JSX } -> x) -> Array R.JSX -> x setChildren f cs = f { children: cs } -infixl 3 setChildren as |< +infixr 6 setChildren as |< + +setChild :: forall x. ({ children :: Array R.JSX } -> x) -> R.JSX -> x +setChild f c = setChildren f [c] -button :: - forall s x y z. - Union y z (SharedProps Props_button) => - Union x ( onClick :: EffectFn1 SyntheticEvent Unit ) y => - Cmp Effect (Record x -> R.JSX) s Unit -button set _ = - R.button - <<< unionPropsWith { onClick } +infixr 6 setChild as |- + +hoverability set _ j = j |= { onMouseOver, onMouseLeave } + where + onMouseOver = R.handler_ $ set true + onMouseLeave = R.handler_ $ set false + +clickability set _ j = j |= { onClick } where onClick = R.handler_ $ set unit +button = clickability <*>! C.pure R.button + counter :: Cmp' Effect R.JSX Int -counter = ado - inc <- handle (const (_ + 1)) button - dec <- handle (const (_ - 1)) button - txt <- C.lcmap show text - in - R.div |< - [ inc |< [ R.text "+" ] - , txt - , dec |< [ R.text "-" ] - ] +counter = C.ado + inc <- button # C.handle_ (_ + 1) + dec <- button # C.handle_ (_ - 1) + txt <- text # C.lcmap show + in R.div + |< [ inc |- R.text "+" + , txt + , dec |- R.text "-" + ] + +focusability set s j = j |= { onFocus, onBlur } + where + onFocus = R.handler_ $ set true + onBlur = R.handler_ $ set false + +changeability p e set s j = j |= RD.insert p s { onChange } + where + onChange = R.handler e $ maybe (pure unit) set type InputState = { focused :: Boolean, value :: String } -foreign import focusedInputComponent :: (InputState -> Effect Unit) -> InputState -> R.JSX +input = C.ado + focus <- focusability #! prop _focused + change <- changeability _value targetValue #! prop _value + in R.input # change # focus + where + _focused = SProxy :: _ "focused" + _value = SProxy :: _ "value" -input :: Cmp' Effect R.JSX InputState -input = focusedInputComponent +checkbox = C.ado + change <- changeability _checked targetChecked + in R.input |= { type: "checkbox" } # change + where + _checked = SProxy :: _ "checked" -checkbox :: - forall x y z. - Union y z (SharedProps Props_input) => - Union x ( checked :: Boolean, onChange :: EffectFn1 SyntheticEvent Unit, type :: String ) y => - Cmp' Effect ({ | x } -> R.JSX) Boolean -checkbox set s = - R.input - <<< unionPropsWith - { type: "checkbox" - , checked: s - , onChange: R.handler_ $ set (not s) - } +keypressability set _ j = j |= { onKeyPress } + where + onKeyPress = R.handler key $ maybe (pure unit) set text :: forall m u. Cmp m R.JSX String u text _ = R.text -img :: - forall u x y z. - Union y z (SharedProps Props_img) => - Union x ( src :: String ) y => - Cmp Effect ({ | x } -> R.JSX) String u -img _ s = R.img <<< unionPropsWith { src: s } +img _ src = R.img |= { src } conditional :: forall m u. Cmp m (R.JSX -> R.JSX) Boolean u -conditional _ = bool identity (const mempty) - where - bool x y b = if b then x else y +conditional _ = if _ then identity else const mempty debug :: forall m s u. Show s => Cmp m R.JSX s u debug = C.lcmap show text diff --git a/src/Snap/SYTC/Component.purs b/src/Snap/SYTC/Component.purs index 495cc6e..0063840 100644 --- a/src/Snap/SYTC/Component.purs +++ b/src/Snap/SYTC/Component.purs @@ -103,6 +103,8 @@ lift2 f c1 c2 = un Compose $ A.lift2 f (Compose c1) (Compose c2) bind :: forall m s u a b. Cmp m a s u -> (a -> Cmp m b s u) -> Cmp m b s u bind c f = curry $ (uncurry c) >>= (f >>> uncurry) +infixl 1 bind as >>=! + identity :: forall m s u c x. Category c => Cmp m (c x x) s u identity = pure P.identity @@ -118,3 +120,6 @@ infixr 9 composeFlipped as >>>! handle :: forall m v s u. (u -> s -> s) -> Cmp m v s u -> Cmp' m v s handle f c set s = c (flip f s >>> set) s + +handle_ :: forall m v s u. (s -> s) -> Cmp m v s u -> Cmp' m v s +handle_ f c set s = c ((const $ f s) >>> set) s diff --git a/src/TodoMVC.purs b/src/TodoMVC.purs index ce27b43..4b08d05 100644 --- a/src/TodoMVC.purs +++ b/src/TodoMVC.purs @@ -2,22 +2,38 @@ module TodoMVC where import Prelude hiding (map,apply) -import Data.Array (singleton) +import Data.Array (filter, length, replicate, snoc) +import Data.Eq (class Eq) import Data.Functor.Variant (SProxy(..)) +import Data.Lens (Lens', _Just) import Data.Lens.Record (prop) -import Data.Lens.Record.Extra (extracted, remapped) +import Data.Lens.Record.Extra (extractedBy, remappedBy) +import Data.Maybe (Maybe(..), maybe) import Data.Profunctor (lcmap) -import Data.Profunctor.Optics (all, by, partsOf', traversed') +import Data.Profunctor.Optics (all, by, partsOf', traversed', withered', overArray, countBy) +import Data.String (trim) +import Debug.Trace (spy) import Effect (Effect) import React.Basic (JSX) -import React.Basic.DOM (div, text) as R +import React.Basic.DOM as R import React.Basic.Events (handler_) as R import Snap.Component (($!), (#!)) +import Snap.React.Component (InputState, (|-), (|<), (|=)) import Snap.React.Component as S -import Snap.SYTC.Component (Cmp', apply, map, switch, (<$>!)) +import Snap.SYTC.Component (Cmp, Cmp', (<#>!), (<$>!), (>>=!)) +import Snap.SYTC.Component as C +import Unsafe.Coerce (unsafeCoerce) -σ :: forall s. SProxy s -σ = SProxy +_done = SProxy :: _ "done" +_hovered = SProxy :: _ "hovered" +_editing = SProxy :: _ "editing" +_value = SProxy :: _ "value" +_focused = SProxy :: _ "focused" +_newTodo = SProxy :: _ "newTodo" +_todos = SProxy :: _ "todos" +_filter = SProxy :: _ "filter" + +-- #### STATE -- The state corresponding to a todo item type Todo = @@ -27,52 +43,210 @@ type Todo = , value :: String } +type Todos = Array Todo + +data Filter = All | Active | Completed +derive instance eqFilter :: Eq Filter + +instance showFilter :: Show Filter where + show All = "All" + show Active = "Active" + show Completed = "Completed" + +type App = + { newTodo :: InputState + , todos :: Todos + , filter :: Filter + } + +-- Create a new todo +createTodo :: String -> Todo +createTodo = + { value: _ + , done: false + , hovered: false + , editing: false + } + +defaultNewTodo :: InputState +defaultNewTodo = { focused: true, value: "" } + +-- Initial application state consists of three components +initialState :: App +initialState = { newTodo: defaultNewTodo, todos: [], filter: All } + +-- #### UI + +-- TODO: Handle escape button press +-- TODO: Destroy input if value is empty -- The editor for todo items editor :: Cmp' Effect JSX Todo -editor = remapped scheme >>> extracted scheme $! S.input - where - scheme = { editing: focused, value } - focused = SProxy :: _ "focused" - value = SProxy :: _ "value" - --- The renderer for todo items -viewer :: Cmp' Effect JSX Todo -viewer = ado - done <- S.checkbox #! prop (σ :: _ "done") - text <- S.text #! prop (σ :: _ "value") - toggle <- S.conditional #! lcmap (_.hovered) - div <- container - in div [done {}, text, toggle $ R.text "hovering"] +editor = subpart $! C.ado + kp <- S.keypressability + # C.handle keyHandler + #! prop _focused + input <- S.input + in kp input { className: "edit" } where - container set s children = - R.div - { children - , onClick: R.handler_ $ set $ s { editing = true } - } + subpart = extractedBy scheme <<< remappedBy scheme + scheme = { editing: _focused, value: _value } + keyHandler k | k == "Enter" = const false + | otherwise = identity -wrapInDiv :: JSX -> JSX -wrapInDiv = R.div <<< { children: _ } <<< singleton +-- The renderer for todo items. Accepts some conditionally +-- rendered content that will be shown when hovering the todo +viewer :: Cmp' Effect (JSX -> JSX) Todo +viewer = C.ado + chk <- S.checkbox #! prop _done + txt <- S.text #! prop _value + veil <- S.conditional #! lcmap _.hovered + ckbl <- S.clickability # C.handle_ \s -> s { editing = true, hovered = true } + hvbl <- S.hoverability #! prop _hovered + in + \extra -> + hvbl R.div + |= { className: "view" } + |< [ chk { className: "toggle" } + , ckbl R.label |- txt + , veil extra + ] -- A todo item -- Depending on the value of the "editing" field, shows an --- editor or a renderer -todo :: Cmp' Effect JSX Todo -todo = switch editor viewer #! by _.editing # map wrapInDiv +-- editor or a renderer. +todo :: Cmp' Effect JSX (Maybe Todo) +todo = C.ado + ev <- editview #! _Just + del <- S.button # C.handle_ (const Nothing) + in ev $ del { className: "destroy" } + where + editor' = const <$>! editor + editview = C.switch editor' viewer #! by _.editing -type Todos = Array Todo +shouldHide :: Filter -> Todo -> Boolean +shouldHide All = const false +shouldHide Active = _.done +shouldHide Completed = not _.done + +listItem :: forall u u'. Cmp Effect (JSX -> Cmp Effect JSX (Maybe Todo) u') Filter u +listItem _ f v _ Nothing = mempty +listItem _ f v _ (Just t) = R.li |= { className } |- v + where + className = + (if t.editing then " editing " else "") + <> (if t.done then " completed " else "") + <> (if (shouldHide f t) then " hidden " else "") + +-- A list of todos, which can delete themselves from the list +todos :: Cmp' Effect JSX App +todos = C.do + li <- listItem #! prop _filter + tds <- (todo >>=! li) #! prop _todos <<< withered' + C.pure $ R.ul + |= { className: "todo-list" } + |- tds -- A checkbox to control the state of all todo items -allDone :: Cmp' Effect JSX (Array Todo) -allDone = S.checkbox #! all >>> partsOf' (traversed' <<< prop (σ :: _ "done")) # map (_ $ {}) +allDone :: Cmp' Effect JSX Todos +allDone = C.ado + chk <- S.checkbox #! all >>> partsOf' (traversed' <<< prop _done) + in chk { id: "toggle-all", className: "toggle-all" } + <> R.label + |= { htmlFor: "toggle-all" } + |- R.text "Mark all as complete" -type App = Todos +-- The header for the todo list +header :: Cmp' Effect JSX App +header = C.ado + key <- S.keypressability + # C.handle \k -> if k == "Enter" + then addTodo + else identity + inp <- S.input #! prop _newTodo + in R.header + |= { className: "header" } + |< [ R.h1 |- R.text "todos" + , key inp { className: "new-todo", placeholder: "What needs to be done?" } + ] + where + addTodo s = + let v = trim s.newTodo.value + in if v == "" + then s + else s { todos = s.todos `snoc` createTodo v, newTodo = defaultNewTodo } --- The application consists of a bunch of todos, a --- checkbox to control all of their "done" values, --- and a text element showing the overall application --- state -app :: Cmp' Effect JSX App -app = todos <> (wrapInDiv <$>! allDone) <> (wrapInDiv <$>! debug) +itemCount :: forall u. Cmp Effect JSX Int u +itemCount _ = go where - todos = todo #! traversed' - debug = S.text #! lcmap show + wrap n s = R.strong |- R.text n <> R.text s + go 0 = wrap "no" " items left" + go 1 = wrap "one" " item left" + go n = wrap (show n) " items left" + +url :: Filter -> String +url All = "#/" +url Active = "#/active" +url Completed = "#/completed" + +anchor :: forall u. Cmp Effect (Filter -> JSX) Filter u +anchor _ s f = a |= { href: url f } |- R.text (show f) + where + a | s == f = R.a |= { className: "selected" } + | otherwise = R.a + +filters :: Cmp' Effect JSX Filter +filters = C.ado + a <- anchor + all <- S.clickability # C.handle_ (const All) + act <- S.clickability # C.handle_ (const Active) + com <- S.clickability # C.handle_ (const Completed) + in R.ul + |= { className: "filters" } + |< [ all R.li |- a All + , act R.li |- a Active + , com R.li |- a Completed + ] + +footer :: Cmp' Effect JSX App +footer = C.ado + count <- itemCount #! prop _todos <<< countBy (not _.done) + veil <- S.conditional #! prop _todos <<< countBy _.done <<< lcmap (_ > 0) + fltrs <- filters #! prop _filter + clear <- S.button + # C.handle_ (_ <#> const false) + #! prop _todos <<< overArray (prop _done) + in R.footer + |= { className: "footer" } + |< [ R.span + |= { className: "todo-count" } + |- count + , fltrs + , veil + $ clear + |= { className: "clear-completed" } + |- R.text "Clear completed" + ] + +-- The overall application +app :: Cmp' Effect JSX App +app = C.ado + veil <- S.conditional + #! prop _todos <<< + countBy (const true) <<< + lcmap (_ > 0) + hdr <- header + tds <- todos + tgl <- allDone #! prop _todos + ftr <- footer + dbg <- S.debug + in R.section + |= { className: "todoapp" } + |< [ hdr + , veil $ R.section + |= { className: "main" } + |< [ tgl + , tds + ] + , veil $ ftr + ] + <> dbg