├── .gitattributes
├── .gitignore
├── LICENSE
├── Setup.hs
├── apps
    ├── mvc-todo-auto.hs
    └── mvc-todo.hs
├── index.html
├── mvc-todo.cabal
├── other
    ├── header.md
    ├── index.md
    ├── mvc-todo-auto.html
    ├── mvc-todo-auto.js
    ├── mvc-todo.html
    ├── mvc-todo.js
    └── node_modules
    │   ├── todomvc-app-css
    │       └── index.css
    │   └── todomvc-common
    │       ├── base.css
    │       └── base.js
├── readme.md
├── src
    └── Todo
    │   ├── Arbitrary.hs
    │   ├── Controllers.hs
    │   ├── Model.hs
    │   ├── Vanilla.hs
    │   └── Views.hs
└── stack.yaml


/.gitattributes:
--------------------------------------------------------------------------------
1 | other/* linguist-documentation
2 | index.html linguist-documentation
3 | *.html linguist-documentation
4 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | /.stack-work/
2 | TAGS
3 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright Tony Day (c) 2017
 2 | 
 3 | All rights reserved.
 4 | 
 5 | Redistribution and use in source and binary forms, with or without
 6 | modification, are permitted provided that the following conditions are met:
 7 | 
 8 |     * Redistributions of source code must retain the above copyright
 9 |       notice, this list of conditions and the following disclaimer.
10 | 
11 |     * Redistributions in binary form must reproduce the above
12 |       copyright notice, this list of conditions and the following
13 |       disclaimer in the documentation and/or other materials provided
14 |       with the distribution.
15 | 
16 |     * Neither the name of Tony Day nor the names of other
17 |       contributors may be used to endorse or promote products derived
18 |       from this software without specific prior written permission.
19 | 
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 | 


--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 | 


--------------------------------------------------------------------------------
/apps/mvc-todo-auto.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE RankNTypes #-}
  2 | {-# OPTIONS_GHC -fno-warn-type-defaults #-}
  3 | {-# LANGUAGE OverloadedStrings #-}
  4 | {-# LANGUAGE TemplateHaskell #-}
  5 | 
  6 | module Main where
  7 | 
  8 | import Control.Concurrent (threadDelay)
  9 | import Control.Lens
 10 | import Control.Monad.Trans.State.Strict (State, StateT)
 11 | import Data.IORef
 12 | import MVC hiding ((<>))
 13 | import MVC.Prelude as MVC
 14 | import Protolude hiding (State, StateT, on)
 15 | import Test.QuickCheck
 16 | import Todo.Arbitrary ()
 17 | import Todo.Controllers (controllers)
 18 | import Todo.Model (Todos(..), Action(..), ItemStatus(..), Item(..), ItemId(..), apply)
 19 | import Todo.Vanilla
 20 | import Todo.Views (render)
 21 | import qualified Data.Map as Map
 22 | 
 23 | data Auto = Manual
 24 |           | Automatic
 25 |   deriving (Show, Eq)
 26 | 
 27 | toggle :: Auto -> Auto
 28 | toggle Manual = Automatic
 29 | toggle Automatic = Manual
 30 | 
 31 | data In = AutoIn Auto
 32 |         | ActionIn Action
 33 |   deriving (Eq, Show)
 34 | 
 35 | data Out
 36 |   = TodosOut Todos
 37 |   | InOut In
 38 |   | AutoOut Auto
 39 |   deriving (Show, Eq)
 40 | 
 41 | data StateAuto = StateAuto { _sTodos :: Todos, _sAuto :: Auto } deriving (Show, Eq)
 42 | 
 43 | makeClassy  ''StateAuto
 44 | 
 45 | makePrisms ''In
 46 | makePrisms ''Out
 47 | 
 48 | initialState :: StateAuto
 49 | initialState = StateAuto
 50 |   (Todos "" Nothing (ItemId 3) Nothing
 51 |     (Map.fromList $
 52 |        zip (ItemId <$> [0 ..]) 
 53 |        [ Item Completed "learn functional programming"
 54 |        , Item Completed "invent ADTs"
 55 |        , Item Completed "discover algebra between ADTs"
 56 |        , Item Active "automate everything else"
 57 |        ]))
 58 |   Manual
 59 | 
 60 | ctlAuto :: Output Auto -> IO ()
 61 | ctlAuto o = do
 62 |   toggleAuto <- docElement ".toggle-auto"
 63 |   on toggleAuto "click" (\el _ -> do
 64 |                             ch <- checked el
 65 |                             -- print ch
 66 |                             let auto = if ch then Automatic else Manual
 67 |                             void $ atomically $ send o auto)
 68 | 
 69 | modifyState :: In -> ListT (State StateAuto) Out
 70 | modifyState i = case i of
 71 |   (AutoIn auto) -> lift (modify (set sAuto auto)) >> pure (AutoOut auto)
 72 |   (ActionIn NoAction) -> mzero
 73 |   (ActionIn action) -> do
 74 |     s <- lift get
 75 |     let tds = view sTodos s
 76 |     let tds' = apply action tds
 77 |     lift $ put $ set sTodos tds' s
 78 |     pure (TodosOut tds')
 79 | 
 80 | model' :: In -> ListT (State StateAuto) Out
 81 | model' i =
 82 |   (modifyState i) `mappend` (InOut <$> pure i)
 83 | 
 84 | run :: IO StateAuto
 85 | run = do
 86 |   print "running auto ..."
 87 |   (o, i) <- spawn unbounded
 88 |   (oAuto, iAuto) <- spawn unbounded
 89 |   doAuto <- newIORef (view sAuto initialState)
 90 |   controllers o
 91 |   ctlAuto oAuto
 92 |   print initialState
 93 |   runMVC initialState (asPipe $ loop model')
 94 |     ((,) <$> pure (asSink (render' doAuto)) <*> pure (cAuto iAuto) `mappend` (fmap ActionIn <$> cAction i doAuto))
 95 | 
 96 | render' :: IORef Auto -> Out -> IO ()
 97 | render' _ (InOut i) = print i
 98 | render' _ (TodosOut tds) = do
 99 |   print tds
100 |   render tds
101 | render' ref (AutoOut auto) = do
102 |   modifyIORef ref toggle
103 |   renderAuto auto
104 | 
105 | renderAuto :: Auto -> IO ()
106 | renderAuto auto = do
107 |   print auto
108 |   el <- docElement ".toggle-auto"
109 |   case auto of
110 |     Automatic -> setValue el "on"
111 |     Manual -> setValue el "off"
112 | 
113 | cAuto :: Input Auto -> Controller In
114 | cAuto iAuto = AutoIn <$> asInput iAuto
115 | 
116 | cAction :: Input Action -> IORef Auto -> Managed (Controller Action)
117 | cAction iAction doAuto =
118 |   (pure (asInput iAction) `mappend`
119 |    producer unbounded (yield Refresh) `mappend`
120 |    producer unbounded
121 |      (forever $ do
122 |         lift (threadDelay (1000000 * 3))
123 |         ref <- lift $ readIORef doAuto
124 |         when (ref == Automatic) $ do
125 |           x <- lift (generate arbitrary)
126 |           yield x))
127 | 
128 | main :: IO ()
129 | main = onload (void run)
130 | 


--------------------------------------------------------------------------------
/apps/mvc-todo.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | 
 3 | module Main where
 4 | 
 5 | import Control.Monad.Trans.State.Strict (State, StateT)
 6 | import MVC hiding ((<>))
 7 | import MVC.Prelude as MVC
 8 | import Protolude hiding (State, StateT, loop)
 9 | import Todo.Controllers (controllers)
10 | import Todo.Model
11 | import Todo.Vanilla (onload)
12 | import Todo.Views (render)
13 | import qualified Data.Map as Map
14 | 
15 | main :: IO ()
16 | main = onload (void run)
17 | 
18 | initialState :: Todos
19 | initialState =
20 |   Todos "" Nothing (ItemId 3) Nothing
21 |     (Map.fromList $ 
22 |      zip (ItemId <$> [0 ..])
23 |      [ Item Active "write view"
24 |      , Item Active "write controllers"
25 |      , Item Completed "render a todo list"
26 |      ])
27 | 
28 | run :: IO Todos
29 | run = do
30 |   (o, i) <- spawn unbounded
31 |   controllers o
32 |   runMVC initialState (asPipe $ MVC.loop model)
33 |     ((,) <$> 
34 |      pure (asSink render_) <*> 
35 |      ( pure (asInput i) `mappend`
36 |        producer unbounded (yield Refresh)))
37 | 
38 | render_ :: Out -> IO ()
39 | render_ (ActionOut action) = print action
40 | render_ (StateOut tds) = render tds
41 | 


--------------------------------------------------------------------------------
/index.html:
--------------------------------------------------------------------------------
 1 | <p><meta charset="utf-8"> <link rel="stylesheet" href="https://tonyday567.github.io/other/lhs.css"></p>
 2 | <h1 id="haskell-todomvc-example">Haskell TodoMVC Example</h1>
 3 | <blockquote>
 4 | <p>Haskell is a strongly-typed, lazily-evaluated, functional programming language.</p>
 5 | </blockquote>
 6 | <ul class="incremental">
 7 | <li><p><a href="other/mvc-todo.html">live demo</a></p></li>
 8 | <li><p>with <a href="other/mvc-todo-auto.html">automation</a></p></li>
 9 | </ul>
10 | <p>This example demonstrates an idiomatic haskell approach to the TodoMVC problem domain involving:</p>
11 | <ul class="incremental">
12 | <li>compilation of haskell to javascript using <a href="https://github.com/ghcjs/ghcjs">ghcjs</a>.</li>
13 | <li>The specification of a <code>Model</code> representing the problem domain, consisting of</li>
14 | <li>specification of Abstract Data Types (ADTs) for inputs, state and outputs.</li>
15 | <li>an algebra between state and actions.</li>
16 | <li>Use of the <a href="https://hackage.haskell.org/package/mvc">mvc</a> library for specification, asynchronicity and separation of model, view and controllers.</li>
17 | <li>The creation of <code>View</code>s that consume model outputs, by using vanilla javascript effects.</li>
18 | <li>The creation of <code>Controller</code>s that produce model inputs, by listening for Dom events using vanilla javascript.</li>
19 | </ul>
20 | <h1 id="recipe">recipe</h1>
21 | <p>The recipe below handles the bits and bobs you need to do every re-compile. This includes a compression step via <a href="http://dl.google.com/closure-compiler">closure</a>.</p>
22 | <pre>
23 |   <code style="white-space: pre-wrap;">
24 | stack build --exec "pandoc -f markdown -i other/index.md -t html -o index.html --filter pandoc-include" --exec "java -jar $(stack path --local-bin)/closure-compiler-v20170124.jar --js_output_file=other/mvc-todo-auto.js $(stack path --local-install-root)/bin/mvc-todo-auto.jsexe/all.js" --exec "java -jar $(stack path --local-bin)/closure-compiler-v20170124.jar --js_output_file=other/mvc-todo.js $(stack path --local-install-root)/bin/mvc-todo.jsexe/all.js"
25 |   </code>
26 | </pre>
27 | 


--------------------------------------------------------------------------------
/mvc-todo.cabal:
--------------------------------------------------------------------------------
  1 | name:
  2 |   mvc-todo
  3 | version:
  4 |   1.0.0
  5 | synopsis:
  6 |   See readme.lhs
  7 | description:
  8 |   See readme.lhs for description.
  9 | category:
 10 |   project
 11 | homepage:
 12 |   https://github.com/tonyday567/mvc-todo
 13 | license:
 14 |   BSD3
 15 | license-file:
 16 |   LICENSE
 17 | author:
 18 |   Tony Day
 19 | maintainer:
 20 |   tonyday567@gmail.com
 21 | copyright:
 22 |   Tony Day
 23 | build-type:
 24 |   Simple
 25 | cabal-version:
 26 |   >=1.14
 27 | extra-source-files:
 28 |   stack.yaml
 29 | library
 30 |   default-language:
 31 |     Haskell2010
 32 |   ghc-options:
 33 |   hs-source-dirs:      
 34 |     src
 35 |   exposed-modules:
 36 |     Todo.Vanilla,
 37 |     Todo.Arbitrary,
 38 |     Todo.Controllers,
 39 |     Todo.Model,
 40 |     Todo.Views
 41 |   build-depends:
 42 |     base >= 4.7 && < 5,
 43 |     protolude,
 44 |     clay,
 45 |     text,
 46 |     lucid,
 47 |     lens,
 48 |     mtl,
 49 |     data-default,
 50 |     containers,
 51 |     pipes,
 52 |     QuickCheck,
 53 |     errors,
 54 |     mmorph,
 55 |     either,
 56 |     mvc,
 57 |     ghcjs-base,
 58 |     transformers
 59 |   default-extensions:
 60 |     NoImplicitPrelude,
 61 |     UnicodeSyntax,
 62 |     BangPatterns,
 63 |     BinaryLiterals,
 64 |     DeriveFoldable,
 65 |     DeriveFunctor,
 66 |     DeriveGeneric,
 67 |     DeriveTraversable,
 68 |     DisambiguateRecordFields,
 69 |     EmptyCase,
 70 |     FlexibleContexts,
 71 |     FlexibleInstances,
 72 |     FunctionalDependencies,
 73 |     GADTSyntax,
 74 |     InstanceSigs,
 75 |     KindSignatures,
 76 |     LambdaCase,
 77 |     MonadComprehensions,
 78 |     MultiParamTypeClasses,
 79 |     MultiWayIf,
 80 |     NegativeLiterals,
 81 |     OverloadedStrings,
 82 |     ParallelListComp,
 83 |     PartialTypeSignatures,
 84 |     PatternSynonyms,
 85 |     RankNTypes,
 86 |     RecordWildCards,
 87 |     RecursiveDo,
 88 |     ScopedTypeVariables,
 89 |     TupleSections,
 90 |     TypeFamilies,
 91 |     TypeOperators
 92 | 
 93 | executable mvc-todo
 94 |   default-language:
 95 |     Haskell2010
 96 |   ghc-options:
 97 |     -funbox-strict-fields
 98 |     -fforce-recomp
 99 |     -threaded
100 |     -rtsopts
101 |     -with-rtsopts=-N
102 |   hs-source-dirs:
103 |     apps
104 |   main-is:
105 |     mvc-todo.hs
106 |   build-depends:
107 |     base >= 4.7 && < 5,
108 |     protolude,
109 |     mvc-todo,
110 |     ghcjs-base,
111 |     containers,
112 |     mvc,
113 |     transformers
114 |   default-extensions:
115 |     NoImplicitPrelude,
116 |     UnicodeSyntax,
117 |     BangPatterns,
118 |     BinaryLiterals,
119 |     DeriveFoldable,
120 |     DeriveFunctor,
121 |     DeriveGeneric,
122 |     DeriveTraversable,
123 |     DisambiguateRecordFields,
124 |     EmptyCase,
125 |     FlexibleContexts,
126 |     FlexibleInstances,
127 |     FunctionalDependencies,
128 |     GADTSyntax,
129 |     InstanceSigs,
130 |     KindSignatures,
131 |     LambdaCase,
132 |     MonadComprehensions,
133 |     MultiParamTypeClasses,
134 |     MultiWayIf,
135 |     NegativeLiterals,
136 |     OverloadedStrings,
137 |     ParallelListComp,
138 |     PartialTypeSignatures,
139 |     PatternSynonyms,
140 |     RankNTypes,
141 |     RecordWildCards,
142 |     RecursiveDo,
143 |     ScopedTypeVariables,
144 |     TupleSections,
145 |     TypeFamilies,
146 |     TypeOperators
147 | 
148 | executable mvc-todo-auto
149 |   default-language:
150 |     Haskell2010
151 |   ghc-options:
152 |     -funbox-strict-fields
153 |     -fforce-recomp
154 |     -threaded
155 |     -rtsopts
156 |     -with-rtsopts=-N
157 |   hs-source-dirs:
158 |     apps
159 |   main-is:
160 |     mvc-todo-auto.hs
161 |   build-depends:
162 |     base >= 4.7 && < 5,
163 |     protolude,
164 |     mvc-todo,
165 |     ghcjs-base,
166 |     containers,
167 |     mvc,
168 |     transformers,
169 |     lens,
170 |     QuickCheck
171 |   default-extensions:
172 |     NoImplicitPrelude,
173 |     UnicodeSyntax,
174 |     BangPatterns,
175 |     BinaryLiterals,
176 |     DeriveFoldable,
177 |     DeriveFunctor,
178 |     DeriveGeneric,
179 |     DeriveTraversable,
180 |     DisambiguateRecordFields,
181 |     EmptyCase,
182 |     FlexibleContexts,
183 |     FlexibleInstances,
184 |     FunctionalDependencies,
185 |     GADTSyntax,
186 |     InstanceSigs,
187 |     KindSignatures,
188 |     LambdaCase,
189 |     MonadComprehensions,
190 |     MultiParamTypeClasses,
191 |     MultiWayIf,
192 |     NegativeLiterals,
193 |     OverloadedStrings,
194 |     ParallelListComp,
195 |     PartialTypeSignatures,
196 |     PatternSynonyms,
197 |     RankNTypes,
198 |     RecordWildCards,
199 |     RecursiveDo,
200 |     ScopedTypeVariables,
201 |     TupleSections,
202 |     TypeFamilies,
203 |     TypeOperators
204 | 
205 | source-repository head
206 |   type:
207 |     git
208 |   location:
209 |     https://github.com/tonyday567/ghcjs-testing
210 | 


--------------------------------------------------------------------------------
/other/header.md:
--------------------------------------------------------------------------------
1 | <meta charset="utf-8">
2 | <link rel="stylesheet" href="https://tonyday567.github.io/other/lhs.css">
3 | 
4 | 


--------------------------------------------------------------------------------
/other/index.md:
--------------------------------------------------------------------------------
 1 | ~~~ include
 2 | other/header.md
 3 | ~~~
 4 | 
 5 | 
 6 | Haskell TodoMVC Example
 7 | ===
 8 | 
 9 | > Haskell is a strongly-typed, lazily-evaluated, functional programming language.
10 | 
11 | - [live demo](other/mvc-todo.html)
12 | 
13 | - with [automation](other/mvc-todo-auto.html)
14 | 
15 | This example demonstrates an idiomatic haskell approach to the TodoMVC problem domain involving:
16 | 
17 | - compilation of haskell to javascript using [ghcjs][ghcjs].
18 | - The specification of a `Model` representing the problem domain, consisting of
19 |   - specification of Abstract Data Types (ADTs) for inputs, state and outputs.
20 |   - an algebra between state and actions.
21 | - Use of the [mvc][mvc] library for specification, asynchronicity and separation of model, view and controllers.
22 | - The creation of `View`s that consume model outputs, by using vanilla javascript effects.
23 | - The creation of `Controller`s that produce model inputs, by listening for Dom events using vanilla javascript.
24 | 
25 | recipe
26 | ===
27 | 
28 | The recipe below handles the bits and bobs you need to do every re-compile.  This includes a compression step via [closure](http://dl.google.com/closure-compiler).
29 | 
30 | <pre>
31 |   <code style="white-space: pre-wrap;">
32 | stack build --exec "pandoc -f markdown -i other/index.md -t html -o index.html --filter pandoc-include" --exec "java -jar $(stack path --local-bin)/closure-compiler-v20170124.jar --js_output_file=other/mvc-todo-auto.js $(stack path --local-install-root)/bin/mvc-todo-auto.jsexe/all.js" --exec "java -jar $(stack path --local-bin)/closure-compiler-v20170124.jar --js_output_file=other/mvc-todo.js $(stack path --local-install-root)/bin/mvc-todo.jsexe/all.js"
33 |   </code>
34 | </pre>
35 | 
36 | [mvc]: https://hackage.haskell.org/package/mvc
37 | [lens]: https://hackage.haskell.org/package/lens
38 | [ghcjs]: https://github.com/ghcjs/ghcjs
39 | 
40 | 


--------------------------------------------------------------------------------
/other/mvc-todo-auto.html:
--------------------------------------------------------------------------------
 1 | <!doctype html>
 2 | <html lang="en">
 3 | 	<head>
 4 | 		<meta charset="utf-8">
 5 | 		<meta name="viewport" content="width=device-width, initial-scale=1">
 6 | 		<title>Haskell • TodoMVC</title>
 7 | 		<link rel="stylesheet" href="./node_modules/todomvc-app-css/index.css">
 8 | 	</head>
 9 | 	<body>
10 | 		<section class="todoapp">
11 | 			<header class="header">
12 | 				<h1>auto-todos</h1>
13 | 				<input class="new-todo" placeholder="What needs to be done?" autofocus>
14 | 			</header>
15 | 			<section class="main">
16 | 				<input class="toggle-all" type="checkbox">
17 | 				<label for="toggle-all">Mark all as complete</label>
18 | 				<ul class="todo-list">
19 | 				</ul>
20 | 			</section>
21 | 			<footer class="footer">
22 | 				<span class="todo-count"><strong>0</strong> items left</span>
23 | 				<ul class="filters">
24 | 					<li>
25 | 						<a class="selected" href="#/">All</a>
26 | 					</li>
27 | 					<li>
28 | 						<a href="#/active">Active</a>
29 | 					</li>
30 | 					<li>
31 | 						<a href="#/completed">Completed</a>
32 | 					</li>
33 | 				</ul>
34 | 				<button class="clear-completed">Clear completed</button>
35 | 			</footer>
36 | 		</section>
37 | 		<footer class="info">
38 |                   <input class="toggle-auto" type="checkbox">
39 | 		  <label for="toggle-auto">Let haskell do the work</label>
40 | 			<p>Double-click to edit a todo</p>
41 | 			<p>Created by <a href="http://github.com/tonyday567">Tony Day</a></p>
42 | 			<p>Part of <a href="http://todomvc.com">TodoMVC</a></p>
43 | 		</footer>
44 | 		<!-- todomvc scripts. -->
45 | 		<script src="node_modules/todomvc-common/base.js"></script>
46 |     <!-- GHCJS scripts. -->
47 |     <script language="javascript" src="./mvc-todo-auto.js"></script>
48 | 	</body>
49 | </html>
50 | 


--------------------------------------------------------------------------------
/other/mvc-todo.html:
--------------------------------------------------------------------------------
 1 | <!doctype html>
 2 | <html lang="en">
 3 | 	<head>
 4 | 		<meta charset="utf-8">
 5 | 		<meta name="viewport" content="width=device-width, initial-scale=1">
 6 | 		<title>Haskell • TodoMVC</title>
 7 | 		<link rel="stylesheet" href="./node_modules/todomvc-app-css/index.css">
 8 | 	</head>
 9 | 	<body>
10 | 		<section class="todoapp">
11 | 			<header class="header">
12 | 				<h1>todos</h1>
13 | 				<input class="new-todo" placeholder="What needs to be done?" autofocus>
14 | 			</header>
15 | 			<section class="main">
16 | 				<input class="toggle-all" type="checkbox">
17 | 				<label for="toggle-all">Mark all as complete</label>
18 | 				<ul class="todo-list">
19 | 				</ul>
20 | 			</section>
21 | 			<footer class="footer">
22 | 				<span class="todo-count"><strong>0</strong> items left</span>
23 | 				<ul class="filters">
24 | 					<li>
25 | 						<a class="selected" href="#/">All</a>
26 | 					</li>
27 | 					<li>
28 | 						<a href="#/active">Active</a>
29 | 					</li>
30 | 					<li>
31 | 						<a href="#/completed">Completed</a>
32 | 					</li>
33 | 				</ul>
34 | 				<button class="clear-completed">Clear completed</button>
35 | 			</footer>
36 | 		</section>
37 | 		<footer class="info">
38 | 			<p>Double-click to edit a todo</p>
39 | 			<p>Created by <a href="http://github.com/tonyday567">Tony Day</a></p>
40 | 			<p>Part of <a href="http://todomvc.com">TodoMVC</a></p>
41 | 		</footer>
42 | 		<!-- todomvc scripts. -->
43 | 		<script src="node_modules/todomvc-common/base.js"></script>
44 |     <!-- GHCJS scripts. -->
45 |     <script language="javascript" src="./mvc-todo.js"></script>
46 | 		<script src="js/app.js"></script>
47 | 	</body>
48 | </html>
49 | 


--------------------------------------------------------------------------------
/other/node_modules/todomvc-app-css/index.css:
--------------------------------------------------------------------------------
  1 | html,
  2 | body {
  3 | 	margin: 0;
  4 | 	padding: 0;
  5 | }
  6 | 
  7 | button {
  8 | 	margin: 0;
  9 | 	padding: 0;
 10 | 	border: 0;
 11 | 	background: none;
 12 | 	font-size: 100%;
 13 | 	vertical-align: baseline;
 14 | 	font-family: inherit;
 15 | 	font-weight: inherit;
 16 | 	color: inherit;
 17 | 	-webkit-appearance: none;
 18 | 	appearance: none;
 19 | 	-webkit-font-smoothing: antialiased;
 20 | 	-moz-font-smoothing: antialiased;
 21 | 	font-smoothing: antialiased;
 22 | }
 23 | 
 24 | body {
 25 | 	font: 14px 'Helvetica Neue', Helvetica, Arial, sans-serif;
 26 | 	line-height: 1.4em;
 27 | 	background: #f5f5f5;
 28 | 	color: #4d4d4d;
 29 | 	min-width: 230px;
 30 | 	max-width: 550px;
 31 | 	margin: 0 auto;
 32 | 	-webkit-font-smoothing: antialiased;
 33 | 	-moz-font-smoothing: antialiased;
 34 | 	font-smoothing: antialiased;
 35 | 	font-weight: 300;
 36 | }
 37 | 
 38 | button,
 39 | input[type="checkbox"] {
 40 | 	outline: none;
 41 | }
 42 | 
 43 | .hidden {
 44 | 	display: none;
 45 | }
 46 | 
 47 | .todoapp {
 48 | 	background: #fff;
 49 | 	margin: 130px 0 40px 0;
 50 | 	position: relative;
 51 | 	box-shadow: 0 2px 4px 0 rgba(0, 0, 0, 0.2),
 52 | 	            0 25px 50px 0 rgba(0, 0, 0, 0.1);
 53 | }
 54 | 
 55 | .todoapp input::-webkit-input-placeholder {
 56 | 	font-style: italic;
 57 | 	font-weight: 300;
 58 | 	color: #e6e6e6;
 59 | }
 60 | 
 61 | .todoapp input::-moz-placeholder {
 62 | 	font-style: italic;
 63 | 	font-weight: 300;
 64 | 	color: #e6e6e6;
 65 | }
 66 | 
 67 | .todoapp input::input-placeholder {
 68 | 	font-style: italic;
 69 | 	font-weight: 300;
 70 | 	color: #e6e6e6;
 71 | }
 72 | 
 73 | .todoapp h1 {
 74 | 	position: absolute;
 75 | 	top: -155px;
 76 | 	width: 100%;
 77 | 	font-size: 100px;
 78 | 	font-weight: 100;
 79 | 	text-align: center;
 80 | 	color: rgba(175, 47, 47, 0.15);
 81 | 	-webkit-text-rendering: optimizeLegibility;
 82 | 	-moz-text-rendering: optimizeLegibility;
 83 | 	text-rendering: optimizeLegibility;
 84 | }
 85 | 
 86 | .new-todo,
 87 | .edit {
 88 | 	position: relative;
 89 | 	margin: 0;
 90 | 	width: 100%;
 91 | 	font-size: 24px;
 92 | 	font-family: inherit;
 93 | 	font-weight: inherit;
 94 | 	line-height: 1.4em;
 95 | 	border: 0;
 96 | 	outline: none;
 97 | 	color: inherit;
 98 | 	padding: 6px;
 99 | 	border: 1px solid #999;
100 | 	box-shadow: inset 0 -1px 5px 0 rgba(0, 0, 0, 0.2);
101 | 	box-sizing: border-box;
102 | 	-webkit-font-smoothing: antialiased;
103 | 	-moz-font-smoothing: antialiased;
104 | 	font-smoothing: antialiased;
105 | }
106 | 
107 | .new-todo {
108 | 	padding: 16px 16px 16px 60px;
109 | 	border: none;
110 | 	background: rgba(0, 0, 0, 0.003);
111 | 	box-shadow: inset 0 -2px 1px rgba(0,0,0,0.03);
112 | }
113 | 
114 | .main {
115 | 	position: relative;
116 | 	z-index: 2;
117 | 	border-top: 1px solid #e6e6e6;
118 | }
119 | 
120 | label[for='toggle-all'] {
121 | 	display: none;
122 | }
123 | 
124 | .toggle-all {
125 | 	position: absolute;
126 | 	top: -55px;
127 | 	left: -12px;
128 | 	width: 60px;
129 | 	height: 34px;
130 | 	text-align: center;
131 | 	border: none; /* Mobile Safari */
132 | }
133 | 
134 | .toggle-all:before {
135 | 	content: '❯';
136 | 	font-size: 22px;
137 | 	color: #e6e6e6;
138 | 	padding: 10px 27px 10px 27px;
139 | }
140 | 
141 | .toggle-all:checked:before {
142 | 	color: #737373;
143 | }
144 | 
145 | .todo-list {
146 | 	margin: 0;
147 | 	padding: 0;
148 | 	list-style: none;
149 | }
150 | 
151 | .todo-list li {
152 | 	position: relative;
153 | 	font-size: 24px;
154 | 	border-bottom: 1px solid #ededed;
155 | }
156 | 
157 | .todo-list li:last-child {
158 | 	border-bottom: none;
159 | }
160 | 
161 | .todo-list li.editing {
162 | 	border-bottom: none;
163 | 	padding: 0;
164 | }
165 | 
166 | .todo-list li.editing .edit {
167 | 	display: block;
168 | 	width: 506px;
169 | 	padding: 13px 17px 12px 17px;
170 | 	margin: 0 0 0 43px;
171 | }
172 | 
173 | .todo-list li.editing .view {
174 | 	display: none;
175 | }
176 | 
177 | .todo-list li .toggle {
178 | 	text-align: center;
179 | 	width: 40px;
180 | 	/* auto, since non-WebKit browsers doesn't support input styling */
181 | 	height: auto;
182 | 	position: absolute;
183 | 	top: 0;
184 | 	bottom: 0;
185 | 	margin: auto 0;
186 | 	border: none; /* Mobile Safari */
187 | 	-webkit-appearance: none;
188 | 	appearance: none;
189 | }
190 | 
191 | .todo-list li .toggle:after {
192 | 	content: url('data:image/svg+xml;utf8,<svg xmlns="http://www.w3.org/2000/svg" width="40" height="40" viewBox="-10 -18 100 135"><circle cx="50" cy="50" r="50" fill="none" stroke="#ededed" stroke-width="3"/></svg>');
193 | }
194 | 
195 | .todo-list li .toggle:checked:after {
196 | 	content: url('data:image/svg+xml;utf8,<svg xmlns="http://www.w3.org/2000/svg" width="40" height="40" viewBox="-10 -18 100 135"><circle cx="50" cy="50" r="50" fill="none" stroke="#bddad5" stroke-width="3"/><path fill="#5dc2af" d="M72 25L42 71 27 56l-4 4 20 20 34-52z"/></svg>');
197 | }
198 | 
199 | .todo-list li label {
200 | 	white-space: pre-line;
201 | 	word-break: break-all;
202 | 	padding: 15px 60px 15px 15px;
203 | 	margin-left: 45px;
204 | 	display: block;
205 | 	line-height: 1.2;
206 | 	transition: color 0.4s;
207 | }
208 | 
209 | .todo-list li.completed label {
210 | 	color: #d9d9d9;
211 | 	text-decoration: line-through;
212 | }
213 | 
214 | .todo-list li .destroy {
215 | 	display: none;
216 | 	position: absolute;
217 | 	top: 0;
218 | 	right: 10px;
219 | 	bottom: 0;
220 | 	width: 40px;
221 | 	height: 40px;
222 | 	margin: auto 0;
223 | 	font-size: 30px;
224 | 	color: #cc9a9a;
225 | 	margin-bottom: 11px;
226 | 	transition: color 0.2s ease-out;
227 | }
228 | 
229 | .todo-list li .destroy:hover {
230 | 	color: #af5b5e;
231 | }
232 | 
233 | .todo-list li .destroy:after {
234 | 	content: '×';
235 | }
236 | 
237 | .todo-list li:hover .destroy {
238 | 	display: block;
239 | }
240 | 
241 | .todo-list li .edit {
242 | 	display: none;
243 | }
244 | 
245 | .todo-list li.editing:last-child {
246 | 	margin-bottom: -1px;
247 | }
248 | 
249 | .footer {
250 | 	color: #777;
251 | 	padding: 10px 15px;
252 | 	height: 20px;
253 | 	text-align: center;
254 | 	border-top: 1px solid #e6e6e6;
255 | }
256 | 
257 | .footer:before {
258 | 	content: '';
259 | 	position: absolute;
260 | 	right: 0;
261 | 	bottom: 0;
262 | 	left: 0;
263 | 	height: 50px;
264 | 	overflow: hidden;
265 | 	box-shadow: 0 1px 1px rgba(0, 0, 0, 0.2),
266 | 	            0 8px 0 -3px #f6f6f6,
267 | 	            0 9px 1px -3px rgba(0, 0, 0, 0.2),
268 | 	            0 16px 0 -6px #f6f6f6,
269 | 	            0 17px 2px -6px rgba(0, 0, 0, 0.2);
270 | }
271 | 
272 | .todo-count {
273 | 	float: left;
274 | 	text-align: left;
275 | }
276 | 
277 | .todo-count strong {
278 | 	font-weight: 300;
279 | }
280 | 
281 | .filters {
282 | 	margin: 0;
283 | 	padding: 0;
284 | 	list-style: none;
285 | 	position: absolute;
286 | 	right: 0;
287 | 	left: 0;
288 | }
289 | 
290 | .filters li {
291 | 	display: inline;
292 | }
293 | 
294 | .filters li a {
295 | 	color: inherit;
296 | 	margin: 3px;
297 | 	padding: 3px 7px;
298 | 	text-decoration: none;
299 | 	border: 1px solid transparent;
300 | 	border-radius: 3px;
301 | }
302 | 
303 | .filters li a.selected,
304 | .filters li a:hover {
305 | 	border-color: rgba(175, 47, 47, 0.1);
306 | }
307 | 
308 | .filters li a.selected {
309 | 	border-color: rgba(175, 47, 47, 0.2);
310 | }
311 | 
312 | .clear-completed,
313 | html .clear-completed:active {
314 | 	float: right;
315 | 	position: relative;
316 | 	line-height: 20px;
317 | 	text-decoration: none;
318 | 	cursor: pointer;
319 | 	position: relative;
320 | }
321 | 
322 | .clear-completed:hover {
323 | 	text-decoration: underline;
324 | }
325 | 
326 | .info {
327 | 	margin: 65px auto 0;
328 | 	color: #bfbfbf;
329 | 	font-size: 10px;
330 | 	text-shadow: 0 1px 0 rgba(255, 255, 255, 0.5);
331 | 	text-align: center;
332 | }
333 | 
334 | .info p {
335 | 	line-height: 1;
336 | }
337 | 
338 | .info a {
339 | 	color: inherit;
340 | 	text-decoration: none;
341 | 	font-weight: 400;
342 | }
343 | 
344 | .info a:hover {
345 | 	text-decoration: underline;
346 | }
347 | 
348 | /*
349 | 	Hack to remove background from Mobile Safari.
350 | 	Can't use it globally since it destroys checkboxes in Firefox
351 | */
352 | @media screen and (-webkit-min-device-pixel-ratio:0) {
353 | 	.toggle-all,
354 | 	.todo-list li .toggle {
355 | 		background: none;
356 | 	}
357 | 
358 | 	.todo-list li .toggle {
359 | 		height: 40px;
360 | 	}
361 | 
362 | 	.toggle-all {
363 | 		-webkit-transform: rotate(90deg);
364 | 		transform: rotate(90deg);
365 | 		-webkit-appearance: none;
366 | 		appearance: none;
367 | 	}
368 | }
369 | 
370 | @media (max-width: 430px) {
371 | 	.footer {
372 | 		height: 50px;
373 | 	}
374 | 
375 | 	.filters {
376 | 		bottom: 10px;
377 | 	}
378 | }
379 | 


--------------------------------------------------------------------------------
/other/node_modules/todomvc-common/base.css:
--------------------------------------------------------------------------------
  1 | hr {
  2 | 	margin: 20px 0;
  3 | 	border: 0;
  4 | 	border-top: 1px dashed #c5c5c5;
  5 | 	border-bottom: 1px dashed #f7f7f7;
  6 | }
  7 | 
  8 | .learn a {
  9 | 	font-weight: normal;
 10 | 	text-decoration: none;
 11 | 	color: #b83f45;
 12 | }
 13 | 
 14 | .learn a:hover {
 15 | 	text-decoration: underline;
 16 | 	color: #787e7e;
 17 | }
 18 | 
 19 | .learn h3,
 20 | .learn h4,
 21 | .learn h5 {
 22 | 	margin: 10px 0;
 23 | 	font-weight: 500;
 24 | 	line-height: 1.2;
 25 | 	color: #000;
 26 | }
 27 | 
 28 | .learn h3 {
 29 | 	font-size: 24px;
 30 | }
 31 | 
 32 | .learn h4 {
 33 | 	font-size: 18px;
 34 | }
 35 | 
 36 | .learn h5 {
 37 | 	margin-bottom: 0;
 38 | 	font-size: 14px;
 39 | }
 40 | 
 41 | .learn ul {
 42 | 	padding: 0;
 43 | 	margin: 0 0 30px 25px;
 44 | }
 45 | 
 46 | .learn li {
 47 | 	line-height: 20px;
 48 | }
 49 | 
 50 | .learn p {
 51 | 	font-size: 15px;
 52 | 	font-weight: 300;
 53 | 	line-height: 1.3;
 54 | 	margin-top: 0;
 55 | 	margin-bottom: 0;
 56 | }
 57 | 
 58 | #issue-count {
 59 | 	display: none;
 60 | }
 61 | 
 62 | .quote {
 63 | 	border: none;
 64 | 	margin: 20px 0 60px 0;
 65 | }
 66 | 
 67 | .quote p {
 68 | 	font-style: italic;
 69 | }
 70 | 
 71 | .quote p:before {
 72 | 	content: '“';
 73 | 	font-size: 50px;
 74 | 	opacity: .15;
 75 | 	position: absolute;
 76 | 	top: -20px;
 77 | 	left: 3px;
 78 | }
 79 | 
 80 | .quote p:after {
 81 | 	content: '”';
 82 | 	font-size: 50px;
 83 | 	opacity: .15;
 84 | 	position: absolute;
 85 | 	bottom: -42px;
 86 | 	right: 3px;
 87 | }
 88 | 
 89 | .quote footer {
 90 | 	position: absolute;
 91 | 	bottom: -40px;
 92 | 	right: 0;
 93 | }
 94 | 
 95 | .quote footer img {
 96 | 	border-radius: 3px;
 97 | }
 98 | 
 99 | .quote footer a {
100 | 	margin-left: 5px;
101 | 	vertical-align: middle;
102 | }
103 | 
104 | .speech-bubble {
105 | 	position: relative;
106 | 	padding: 10px;
107 | 	background: rgba(0, 0, 0, .04);
108 | 	border-radius: 5px;
109 | }
110 | 
111 | .speech-bubble:after {
112 | 	content: '';
113 | 	position: absolute;
114 | 	top: 100%;
115 | 	right: 30px;
116 | 	border: 13px solid transparent;
117 | 	border-top-color: rgba(0, 0, 0, .04);
118 | }
119 | 
120 | .learn-bar > .learn {
121 | 	position: absolute;
122 | 	width: 272px;
123 | 	top: 8px;
124 | 	left: -300px;
125 | 	padding: 10px;
126 | 	border-radius: 5px;
127 | 	background-color: rgba(255, 255, 255, .6);
128 | 	transition-property: left;
129 | 	transition-duration: 500ms;
130 | }
131 | 
132 | @media (min-width: 899px) {
133 | 	.learn-bar {
134 | 		width: auto;
135 | 		padding-left: 300px;
136 | 	}
137 | 
138 | 	.learn-bar > .learn {
139 | 		left: 8px;
140 | 	}
141 | }
142 | 


--------------------------------------------------------------------------------
/other/node_modules/todomvc-common/base.js:
--------------------------------------------------------------------------------
  1 | /* global _ */
  2 | (function () {
  3 | 	'use strict';
  4 | 
  5 | 	/* jshint ignore:start */
  6 | 	// Underscore's Template Module
  7 | 	// Courtesy of underscorejs.org
  8 | 	var _ = (function (_) {
  9 | 		_.defaults = function (object) {
 10 | 			if (!object) {
 11 | 				return object;
 12 | 			}
 13 | 			for (var argsIndex = 1, argsLength = arguments.length; argsIndex < argsLength; argsIndex++) {
 14 | 				var iterable = arguments[argsIndex];
 15 | 				if (iterable) {
 16 | 					for (var key in iterable) {
 17 | 						if (object[key] == null) {
 18 | 							object[key] = iterable[key];
 19 | 						}
 20 | 					}
 21 | 				}
 22 | 			}
 23 | 			return object;
 24 | 		}
 25 | 
 26 | 		// By default, Underscore uses ERB-style template delimiters, change the
 27 | 		// following template settings to use alternative delimiters.
 28 | 		_.templateSettings = {
 29 | 			evaluate    : /<%([\s\S]+?)%>/g,
 30 | 			interpolate : /<%=([\s\S]+?)%>/g,
 31 | 			escape      : /<%-([\s\S]+?)%>/g
 32 | 		};
 33 | 
 34 | 		// When customizing `templateSettings`, if you don't want to define an
 35 | 		// interpolation, evaluation or escaping regex, we need one that is
 36 | 		// guaranteed not to match.
 37 | 		var noMatch = /(.)^/;
 38 | 
 39 | 		// Certain characters need to be escaped so that they can be put into a
 40 | 		// string literal.
 41 | 		var escapes = {
 42 | 			"'":      "'",
 43 | 			'\\':     '\\',
 44 | 			'\r':     'r',
 45 | 			'\n':     'n',
 46 | 			'\t':     't',
 47 | 			'\u2028': 'u2028',
 48 | 			'\u2029': 'u2029'
 49 | 		};
 50 | 
 51 | 		var escaper = /\\|'|\r|\n|\t|\u2028|\u2029/g;
 52 | 
 53 | 		// JavaScript micro-templating, similar to John Resig's implementation.
 54 | 		// Underscore templating handles arbitrary delimiters, preserves whitespace,
 55 | 		// and correctly escapes quotes within interpolated code.
 56 | 		_.template = function(text, data, settings) {
 57 | 			var render;
 58 | 			settings = _.defaults({}, settings, _.templateSettings);
 59 | 
 60 | 			// Combine delimiters into one regular expression via alternation.
 61 | 			var matcher = new RegExp([
 62 | 				(settings.escape || noMatch).source,
 63 | 				(settings.interpolate || noMatch).source,
 64 | 				(settings.evaluate || noMatch).source
 65 | 			].join('|') + '|$', 'g');
 66 | 
 67 | 			// Compile the template source, escaping string literals appropriately.
 68 | 			var index = 0;
 69 | 			var source = "__p+='";
 70 | 			text.replace(matcher, function(match, escape, interpolate, evaluate, offset) {
 71 | 				source += text.slice(index, offset)
 72 | 					.replace(escaper, function(match) { return '\\' + escapes[match]; });
 73 | 
 74 | 				if (escape) {
 75 | 					source += "'+\n((__t=(" + escape + "))==null?'':_.escape(__t))+\n'";
 76 | 				}
 77 | 				if (interpolate) {
 78 | 					source += "'+\n((__t=(" + interpolate + "))==null?'':__t)+\n'";
 79 | 				}
 80 | 				if (evaluate) {
 81 | 					source += "';\n" + evaluate + "\n__p+='";
 82 | 				}
 83 | 				index = offset + match.length;
 84 | 				return match;
 85 | 			});
 86 | 			source += "';\n";
 87 | 
 88 | 			// If a variable is not specified, place data values in local scope.
 89 | 			if (!settings.variable) source = 'with(obj||{}){\n' + source + '}\n';
 90 | 
 91 | 			source = "var __t,__p='',__j=Array.prototype.join," +
 92 | 				"print=function(){__p+=__j.call(arguments,'');};\n" +
 93 | 				source + "return __p;\n";
 94 | 
 95 | 			try {
 96 | 				render = new Function(settings.variable || 'obj', '_', source);
 97 | 			} catch (e) {
 98 | 				e.source = source;
 99 | 				throw e;
100 | 			}
101 | 
102 | 			if (data) return render(data, _);
103 | 			var template = function(data) {
104 | 				return render.call(this, data, _);
105 | 			};
106 | 
107 | 			// Provide the compiled function source as a convenience for precompilation.
108 | 			template.source = 'function(' + (settings.variable || 'obj') + '){\n' + source + '}';
109 | 
110 | 			return template;
111 | 		};
112 | 
113 | 		return _;
114 | 	})({});
115 | 
116 | 	if (location.hostname === 'todomvc.com') {
117 | 		(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
118 | 		(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
119 | 		m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
120 | 		})(window,document,'script','https://www.google-analytics.com/analytics.js','ga');
121 | 		ga('create', 'UA-31081062-1', 'auto');
122 | 		ga('send', 'pageview');
123 | 	}
124 | 	/* jshint ignore:end */
125 | 
126 | 	function redirect() {
127 | 		if (location.hostname === 'tastejs.github.io') {
128 | 			location.href = location.href.replace('tastejs.github.io/todomvc', 'todomvc.com');
129 | 		}
130 | 	}
131 | 
132 | 	function findRoot() {
133 | 		var base = location.href.indexOf('examples/');
134 | 		return location.href.substr(0, base);
135 | 	}
136 | 
137 | 	function getFile(file, callback) {
138 | 		if (!location.host) {
139 | 			return console.info('Miss the info bar? Run TodoMVC from a server to avoid a cross-origin error.');
140 | 		}
141 | 
142 | 		var xhr = new XMLHttpRequest();
143 | 
144 | 		xhr.open('GET', findRoot() + file, true);
145 | 		xhr.send();
146 | 
147 | 		xhr.onload = function () {
148 | 			if (xhr.status === 200 && callback) {
149 | 				callback(xhr.responseText);
150 | 			}
151 | 		};
152 | 	}
153 | 
154 | 	function Learn(learnJSON, config) {
155 | 		if (!(this instanceof Learn)) {
156 | 			return new Learn(learnJSON, config);
157 | 		}
158 | 
159 | 		var template, framework;
160 | 
161 | 		if (typeof learnJSON !== 'object') {
162 | 			try {
163 | 				learnJSON = JSON.parse(learnJSON);
164 | 			} catch (e) {
165 | 				return;
166 | 			}
167 | 		}
168 | 
169 | 		if (config) {
170 | 			template = config.template;
171 | 			framework = config.framework;
172 | 		}
173 | 
174 | 		if (!template && learnJSON.templates) {
175 | 			template = learnJSON.templates.todomvc;
176 | 		}
177 | 
178 | 		if (!framework && document.querySelector('[data-framework]')) {
179 | 			framework = document.querySelector('[data-framework]').dataset.framework;
180 | 		}
181 | 
182 | 		this.template = template;
183 | 
184 | 		if (learnJSON.backend) {
185 | 			this.frameworkJSON = learnJSON.backend;
186 | 			this.frameworkJSON.issueLabel = framework;
187 | 			this.append({
188 | 				backend: true
189 | 			});
190 | 		} else if (learnJSON[framework]) {
191 | 			this.frameworkJSON = learnJSON[framework];
192 | 			this.frameworkJSON.issueLabel = framework;
193 | 			this.append();
194 | 		}
195 | 
196 | 		this.fetchIssueCount();
197 | 	}
198 | 
199 | 	Learn.prototype.append = function (opts) {
200 | 		var aside = document.createElement('aside');
201 | 		aside.innerHTML = _.template(this.template, this.frameworkJSON);
202 | 		aside.className = 'learn';
203 | 
204 | 		if (opts && opts.backend) {
205 | 			// Remove demo link
206 | 			var sourceLinks = aside.querySelector('.source-links');
207 | 			var heading = sourceLinks.firstElementChild;
208 | 			var sourceLink = sourceLinks.lastElementChild;
209 | 			// Correct link path
210 | 			var href = sourceLink.getAttribute('href');
211 | 			sourceLink.setAttribute('href', href.substr(href.lastIndexOf('http')));
212 | 			sourceLinks.innerHTML = heading.outerHTML + sourceLink.outerHTML;
213 | 		} else {
214 | 			// Localize demo links
215 | 			var demoLinks = aside.querySelectorAll('.demo-link');
216 | 			Array.prototype.forEach.call(demoLinks, function (demoLink) {
217 | 				if (demoLink.getAttribute('href').substr(0, 4) !== 'http') {
218 | 					demoLink.setAttribute('href', findRoot() + demoLink.getAttribute('href'));
219 | 				}
220 | 			});
221 | 		}
222 | 
223 | 		document.body.className = (document.body.className + ' learn-bar').trim();
224 | 		document.body.insertAdjacentHTML('afterBegin', aside.outerHTML);
225 | 	};
226 | 
227 | 	Learn.prototype.fetchIssueCount = function () {
228 | 		var issueLink = document.getElementById('issue-count-link');
229 | 		if (issueLink) {
230 | 			var url = issueLink.href.replace('https://github.com', 'https://api.github.com/repos');
231 | 			var xhr = new XMLHttpRequest();
232 | 			xhr.open('GET', url, true);
233 | 			xhr.onload = function (e) {
234 | 				var parsedResponse = JSON.parse(e.target.responseText);
235 | 				if (parsedResponse instanceof Array) {
236 | 					var count = parsedResponse.length;
237 | 					if (count !== 0) {
238 | 						issueLink.innerHTML = 'This app has ' + count + ' open issues';
239 | 						document.getElementById('issue-count').style.display = 'inline';
240 | 					}
241 | 				}
242 | 			};
243 | 			xhr.send();
244 | 		}
245 | 	};
246 | 
247 | 	redirect();
248 | 	getFile('learn.json', Learn);
249 | })();
250 | 


--------------------------------------------------------------------------------
/readme.md:
--------------------------------------------------------------------------------
 1 | <meta charset="utf-8">
 2 | <link rel="stylesheet" href="https://tonyday567.github.io/other/lhs.css">
 3 | 
 4 | Haskell TodoMVC Example
 5 | =======================
 6 | 
 7 | > Haskell is a strongly-typed, lazily-evaluated, functional programming
 8 | > language.
 9 | 
10 | -   [live demo](other/mvc-todo.html)
11 | 
12 | -   with [automation](other/mvc-todo-auto.html)
13 | 
14 | This example demonstrates an idiomatic haskell approach to the TodoMVC
15 | problem domain involving:
16 | 
17 | -   compilation of haskell to javascript using
18 |     [ghcjs](https://github.com/ghcjs/ghcjs).
19 | -   The specification of a `Model` representing the problem domain,
20 |     consisting of
21 | -   specification of Abstract Data Types (ADTs) for inputs, state and
22 |     outputs.
23 | -   an algebra between state and actions.
24 | -   Use of the [mvc](https://hackage.haskell.org/package/mvc) library
25 |     for specification, asynchronicity and separation of model, view and
26 |     controllers.
27 | -   The creation of `View`s that consume model outputs, by using vanilla
28 |     javascript effects.
29 | -   The creation of `Controller`s that produce model inputs, by
30 |     listening for Dom events using vanilla javascript.
31 | 
32 | recipe
33 | ======
34 | 
35 | The recipe below handles the bits and bobs you need to do every
36 | re-compile. This includes a compression step via
37 | [closure](http://dl.google.com/closure-compiler).
38 | 
39 | <pre>
40 |   <code style="white-space: pre-wrap;">
41 | stack build --exec "pandoc -f markdown -i other/index.md -t html -o index.html --filter pandoc-include" --exec "java -jar $(stack path --local-bin)/closure-compiler-v20170124.jar --js_output_file=other/mvc-todo-auto.js $(stack path --local-install-root)/bin/mvc-todo-auto.jsexe/all.js" --exec "java -jar $(stack path --local-bin)/closure-compiler-v20170124.jar --js_output_file=other/mvc-todo.js $(stack path --local-install-root)/bin/mvc-todo.jsexe/all.js"
42 |   </code>
43 | </pre>
44 | 
45 | 


--------------------------------------------------------------------------------
/src/Todo/Arbitrary.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE OverloadedStrings #-}
  2 | {-# LANGUAGE FlexibleInstances #-}
  3 | {-# OPTIONS_GHC -fno-warn-unused-imports #-}
  4 | {-# OPTIONS_GHC -fno-warn-type-defaults #-}
  5 | {-# OPTIONS_GHC -fno-warn-orphans #-}
  6 | 
  7 | module Todo.Arbitrary where
  8 | 
  9 | import Todo.Model
 10 | 
 11 | import Protolude hiding (Show(..), show)
 12 | import           Control.Applicative
 13 | import           Control.Monad
 14 | -- import Data.Monoid
 15 | import Data.Default (def)
 16 | import Test.QuickCheck
 17 | import qualified Data.Map as Map
 18 | import Data.String
 19 | import Data.List (nub)
 20 | import Prelude (Show(..))
 21 | import Data.Text (pack)
 22 | 
 23 | 
 24 | instance Arbitrary ItemStatus where
 25 |   arbitrary = 
 26 |     elements 
 27 |     [ Active
 28 |     , Completed
 29 |     ]
 30 | 
 31 | instance Arbitrary ItemId where
 32 |   arbitrary = do
 33 |     let maxI = 10
 34 |     ItemId <$> choose (0,maxI)
 35 | 
 36 | instance Arbitrary Item where
 37 |   arbitrary = Item <$> arbitrary <*> (pack . show <$> (arbitrary :: Gen TodoStatement))
 38 | 
 39 | instance Arbitrary Todos where
 40 |   arbitrary = 
 41 |     Todos <$> 
 42 |     (pack . show <$> (arbitrary :: Gen HaskellVerb)) <*> 
 43 |     frequency
 44 |     [ (8, pure Nothing)
 45 |     , (2, Just <$> arbitrary)
 46 |     ] <*>
 47 |     arbitrary <*>
 48 |     frequency
 49 |     [ (6, pure Nothing)
 50 |     , (4, Just <$> arbitrary)
 51 |     ] <*>
 52 |     (Map.fromList <$> (: []) <$> ((,) <$> arbitrary <*> arbitrary))
 53 | 
 54 | instance Arbitrary Action where
 55 |   arbitrary = frequency
 56 |     [ (10, Toggle <$> arbitrary)
 57 |     , (2,  pure ToggleAll)
 58 |     , (6,  NewItem <$> (pack . show <$> (arbitrary :: Gen TodoStatement)))
 59 |     , (6,  EditItem <$> arbitrary)
 60 |     , (6,  EditItemCancel <$> arbitrary)
 61 |     , (6,  EditItemDone <$> arbitrary <*> (pack . show <$> (arbitrary :: Gen TodoStatement)))
 62 |     , (2,  Filter <$> arbitrary)
 63 |     , (4,  DeleteItem <$> arbitrary)
 64 |     , (1,  pure ClearCompleted)
 65 |     ]
 66 | 
 67 | testApply :: IO [Todos]
 68 | testApply = 
 69 |   zipWith apply <$> 
 70 |   sample' arbitrary <*> 
 71 |   sample' arbitrary
 72 | 
 73 | data TodoStatement = TodoStatement HaskellVerb HaskellNoun
 74 | 
 75 | instance Show TodoStatement where
 76 |   show (TodoStatement verb noun) = show verb <> " " <> show noun
 77 | 
 78 | newtype HaskellVerb = HaskellVerb { unVerb :: Text } deriving (Show, Eq)
 79 | 
 80 | instance IsString HaskellVerb where
 81 |   fromString = HaskellVerb . fromString
 82 | 
 83 | newtype HaskellPrefix = HaskellPrefix { unPrefix :: Text } deriving (Show, Eq)
 84 | newtype Haskellism    = Haskellism    { unHaskellism :: Text }
 85 |     deriving (Show, Eq)
 86 | newtype HaskellSuffix = HaskellSuffix { unSuffix :: Text } deriving (Show, Eq)
 87 | data HaskellNoun = HaskellNoun [HaskellPrefix] Haskellism [HaskellSuffix]
 88 | 
 89 | instance Show HaskellNoun where
 90 |   show (HaskellNoun ps h ss) = show $ mconcat (unPrefix <$> ps) <> unHaskellism h <> mconcat (unSuffix <$> ss)
 91 | 
 92 | instance IsString HaskellNoun where
 93 |   fromString s = HaskellNoun [] (Haskellism (pack s)) []
 94 | 
 95 | instance IsString Haskellism where
 96 |   fromString = Haskellism . fromString
 97 | 
 98 | instance Arbitrary (TodoStatement) where
 99 |   arbitrary = TodoStatement <$> arbitrary <*> arbitrary
100 | 
101 | instance Arbitrary (HaskellNoun) where
102 |   arbitrary = frequency $ 
103 |     [ (20, HaskellNoun <$> ((take 2 . nub) <$> arbitrary) <*> arbitrary <*> ((take 1) <$> arbitrary)) 
104 |     , (1, pure "cabal hell")
105 |     , (1, pure "ADTs")
106 |     , (1, pure "everything")
107 |     , (5, HaskellNoun <$> pure [] <*> arbitrary <*> pure [])
108 |     ]
109 | 
110 | instance Arbitrary (HaskellVerb) where
111 |   arbitrary = frequency $ (\(x,y) -> (x, pure y)) <$>
112 |     [ (3, "invent")
113 |     , (3, "ponder")
114 |     , (5, "code")
115 |     , (1, "beta-reduce")
116 |     , (1, "lambdify")
117 |     , (3, "refactor")
118 |     , (2, "reduce")
119 |     , (1, "DeBruijnize")
120 |     , (2, "curry")
121 |     , (1, "howard-curry")
122 |     , (1, "simplify")
123 |     , (1, "complexificate")
124 |     , (2, "git the")
125 |     , (1, "build")
126 |     , (1, "prettify")
127 |     , (1, "compile")
128 |     , (1, "generalize")
129 |     , (1, "abstract")
130 |     , (1, "ignore")
131 |     , (1, "saturate")
132 |     -- , (3, show <$> (arbitrary :: Gen Haskellism))
133 |     ]
134 | 
135 | instance Arbitrary (HaskellPrefix) where
136 |   arbitrary = frequency $ (\(x,y) -> (x, pure (HaskellPrefix y))) <$>
137 |     [ (1, "homo-")
138 |     , (1, "functo-")
139 |     , (2, "contra-")
140 |     , (2, "bi-")
141 |     , (3, "iso-")
142 |     , (2, "pro-")
143 |     , (4, "co-")
144 |     , (4, "free-")
145 |     , (1, "endo-")
146 |     , (1, "morphic-")
147 |     , (10, "")
148 |     ]
149 | 
150 | instance Arbitrary (HaskellSuffix) where
151 |   arbitrary = frequency $ (\(x,y) -> (x, pure (HaskellSuffix y))) <$>
152 |     [ (1, "-ism")
153 |     , (1, "-orial")
154 |     , (1, "-ic")
155 |     , (12, "")
156 |     ]
157 | 
158 | instance Arbitrary (Haskellism) where
159 |   arbitrary = frequency $ (\(x,y) -> (x, pure (Haskellism y))) <$>
160 |     [ (6, "functor")
161 |     , (4, "monoid")
162 |     , (1, "dimap")
163 |     , (3, "applicative")
164 |     , (2, "arrow")
165 |     , (3, "monad")
166 |     , (1, "something")
167 |     ]
168 | 
169 | 
170 | 
171 | 
172 | 
173 | 
174 | 
175 | 


--------------------------------------------------------------------------------
/src/Todo/Controllers.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | {-# LANGUAGE TemplateHaskell #-}
 3 | {-# OPTIONS_GHC -fno-warn-type-defaults#-}
 4 | 
 5 | module Todo.Controllers where
 6 | 
 7 | import Todo.Vanilla
 8 |     ( docElement
 9 |     , onWindow
10 |     , on
11 |     , delegate
12 |     , Element(..)
13 |     , keyCode
14 |     , itemId
15 |     , getHash
16 |     , elementOf
17 |     , getValue
18 |     , JSVal
19 |     , toJSVal)
20 | 
21 | import MVC hiding ((<>))
22 | import Todo.Model
23 | import Protolude hiding (on)
24 | 
25 | data Keys = Escape | Enter | SomethingElse deriving (Eq)
26 | 
27 | toKeys :: Int -> Keys
28 | toKeys n = case n of
29 |   13 -> Enter
30 |   27 -> Escape
31 |   _  -> SomethingElse
32 | 
33 | sendAction :: a -> Output a -> IO ()
34 | sendAction action o = void $ atomically $ send o action
35 | 
36 | controllers :: Output Action -> IO ()
37 | controllers o = do
38 |   toggleAll <- docElement ".toggle-all"
39 |   clearCompleted <- docElement ".clear-completed"
40 |   newTodo <- docElement ".new-todo"
41 |   todos' <- docElement ".todo-list"
42 |   onWindow "load" (const $ sendAction Refresh o)
43 |   onWindow "hashchange" (const $ ctlHash o)
44 |   on toggleAll "click" (const $ const $ sendAction ToggleAll o)
45 |   on clearCompleted "click" (const $ const $ sendAction ClearCompleted o)
46 |   on newTodo "keyup" (ctlNewItem o)
47 |   delegate todos' ".destroy" "click" (\el _ -> ctlId DeleteItem o el)
48 |   delegate todos' ".toggle" "change" (\el _ -> ctlId Toggle o el)
49 |   delegate todos' "label" "dblclick" (\el _ -> ctlId EditItem o el)
50 |   delegate todos' ".edit" "blur" (ctlEditItemDone o)
51 |   delegate todos' ".edit" "keyup" (ctlEditKeyup o)
52 | 
53 | ctlId :: (ItemId -> Action) -> Output Action -> Element -> IO ()
54 | ctlId action o el = do
55 |     a_ <- idTagged action el
56 |     sendAction a_ o
57 | 
58 | idTagged :: (ItemId -> Action) -> Element -> IO Action
59 | idTagged action el = do
60 |   id' <- itemId el
61 |   case id' of
62 |     Nothing -> pure NoAction
63 |     Just x -> pure (action (ItemId x))
64 | 
65 | ctlEditKeyup :: Output Action -> Element -> JSVal -> IO ()
66 | ctlEditKeyup o el ev = do
67 |   code <- keyCode ev
68 |   case toKeys code of
69 |     Enter -> ctlEditItemDone o el ev
70 |     Escape -> ctlId EditItemCancel o el
71 |     _ -> pure ()
72 | 
73 | ctlEditItemDone :: Output Action -> Element -> JSVal -> IO ()
74 | ctlEditItemDone o el _ = do
75 |   box <- elementOf el ".edit"
76 |   value <- getValue (Element box)
77 |   a_ <- idTagged (\x -> EditItemDone x value) el
78 |   sendAction a_ o
79 |   
80 | ctlHash :: Output Action -> IO ()
81 | ctlHash o = do
82 |   hash <- getHash
83 |   let path = takeWhile (not . (== '/')) . drop 1 . dropWhile (not . (== '/')) $ (show hash)
84 |   let path_ =
85 |           case path of
86 |                   "completed" -> Just Completed
87 |                   "active"    -> Just Active
88 |                   _           -> Nothing
89 |   sendAction (Filter path_) o
90 | 
91 | ctlNewItem :: Output Action -> Element -> JSVal -> IO ()
92 | ctlNewItem o el ev = do
93 |   code <- keyCode ev
94 |   value <- getValue el
95 |   if toKeys code == Enter && value /= mempty
96 |     then (sendAction (NewItem value) o)
97 |     else pure ()
98 | 


--------------------------------------------------------------------------------
/src/Todo/Model.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE DeriveDataTypeable #-}
  2 | {-# LANGUAGE DeriveFoldable #-}
  3 | {-# LANGUAGE DeriveGeneric #-}
  4 | {-# LANGUAGE DeriveTraversable #-}
  5 | {-# LANGUAGE FlexibleContexts #-}
  6 | {-# LANGUAGE FlexibleInstances #-}
  7 | {-# LANGUAGE FunctionalDependencies #-}
  8 | {-# LANGUAGE MultiParamTypeClasses #-}
  9 | {-# LANGUAGE OverloadedStrings #-}
 10 | {-# LANGUAGE TemplateHaskell #-}
 11 | {-# OPTIONS_GHC-fno-warn-type-defaults#-}
 12 | 
 13 | module Todo.Model 
 14 |   ( Todos(..)
 15 |   , HasTodos(..)
 16 |   , Action(..)
 17 |   , Out(..)
 18 |   , _StateOut
 19 |   , _ActionOut
 20 |   , Item(..)
 21 |   , HasItem(..)
 22 |   , ItemId(..)
 23 |   , ItemStatus(..)
 24 |   , toggleStatus
 25 |   , apply
 26 |   , model
 27 |   ) where
 28 | 
 29 | import Control.Lens
 30 | import Control.Monad.Trans.State.Strict (State, StateT)
 31 | import Data.Default
 32 | import Pipes
 33 | import Protolude hiding (State, StateT, loop)
 34 | 
 35 | import qualified Data.Map as Map
 36 | 
 37 | -- * ADTs
 38 | data ItemStatus 
 39 |   = Active
 40 |   | Completed
 41 |   deriving (Show, Eq)
 42 | 
 43 | toggleStatus :: ItemStatus -> ItemStatus
 44 | toggleStatus Active = Completed
 45 | toggleStatus Completed = Active
 46 | 
 47 | newtype ItemId = ItemId { unItemId :: Int }
 48 |   deriving (Show, Eq, Ord)
 49 | 
 50 | data Item = Item { _itemStatus :: ItemStatus, _itemText :: Text }
 51 |   deriving (Show, Eq)
 52 | 
 53 | data Todos =
 54 |   Todos
 55 |     { _todosNewItem :: Text                     -- drafted new todo item
 56 |     , _todosEditing :: Maybe ItemId             -- a todo item is being edited
 57 |     , _todosNextId  :: ItemId                   -- an item id source
 58 |     , _todosFilter  :: Maybe ItemStatus         -- maybe a filter is in place
 59 |     , _todosItems   :: Map.Map ItemId Item      -- the todo items
 60 |     }
 61 |   deriving (Show, Eq)
 62 | 
 63 | makeClassy ''Item
 64 | 
 65 | makeClassy ''Todos
 66 | 
 67 | instance Default Todos where
 68 |   def = Todos mempty Nothing (ItemId 0) Nothing Map.empty
 69 | 
 70 | data Action
 71 |   = ClearCompleted
 72 |   | DeleteItem ItemId
 73 |   | EditItem ItemId
 74 |   | EditItemCancel ItemId
 75 |   | EditItemDone ItemId Text
 76 |   | Filter (Maybe ItemStatus)
 77 |   | NewItem Text
 78 |   | NoAction
 79 |   | Refresh
 80 |   | Toggle ItemId
 81 |   | ToggleAll
 82 |   deriving (Show, Eq)
 83 | 
 84 | -- * algebra | apply an action to the todo model
 85 | apply :: Action -> Todos -> Todos
 86 | apply ClearCompleted tds =
 87 |   over todosItems (Map.filter (\x -> view itemStatus x /= Completed)) tds
 88 | apply (DeleteItem x) tds = over todosItems (Map.delete x) tds
 89 | apply (EditItem x) tds = set todosEditing (Just x) tds
 90 | apply (EditItemCancel _) tds = set todosEditing Nothing tds
 91 | apply (EditItemDone x t) tds = over todosItems adjustOrDelete $ set todosEditing Nothing tds
 92 |   where
 93 |     adjustOrDelete = 
 94 |       if t == mempty
 95 |         then Map.delete x
 96 |         else Map.adjust (set itemText t) x
 97 | apply (Filter f) tds = set todosFilter f tds
 98 | apply (NewItem t) tds =
 99 |   if t == mempty
100 |     then tds
101 |     else 
102 |       over todosItems
103 |       (Map.insert (view todosNextId tds) (Item Active t)) $ 
104 |       over todosNextId (\(ItemId x) -> (ItemId (x + 1))) $ 
105 |       set todosNewItem mempty tds
106 | apply NoAction tds = tds
107 | apply Refresh tds = tds
108 | apply (Toggle x) tds =
109 |   over todosItems (Map.adjust (over itemStatus toggleStatus) x) tds
110 | apply ToggleAll tds =
111 |   over todosItems (over (traverse . itemStatus) toggleStatus) tds
112 | 
113 | modifyState :: Action -> ListT (State Todos) Todos
114 | modifyState action = case action of
115 |   NoAction -> mzero
116 |   _ -> do
117 |     tds <- lift get
118 |     let tds' = apply action tds
119 |     lift $ put tds'
120 |     pure tds'
121 | 
122 | data Out
123 |   = StateOut Todos
124 |   | ActionOut Action
125 |   deriving (Show, Eq)
126 | 
127 | makePrisms ''Out
128 | 
129 | -- | apply the incoming action to state and pass through the action (just so it can be console logged)
130 | model :: Action -> ListT (State Todos) Out
131 | model action =
132 |   (StateOut <$> modifyState action) `mappend` (ActionOut <$> pure action)
133 | 
134 | 


--------------------------------------------------------------------------------
/src/Todo/Vanilla.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE CPP #-}
  2 | {-# LANGUAGE TypeSynonymInstances #-}
  3 | {-# LANGUAGE FlexibleInstances #-}
  4 | {-# OPTIONS_GHC -fno-warn-orphans #-}
  5 | {-# LANGUAGE OverloadedStrings #-}
  6 | {-# OPTIONS_GHC -fno-warn-type-defaults #-}
  7 | 
  8 | module Todo.Vanilla
  9 |   ( Element(..)
 10 |   , Selector
 11 |   , consoleLog
 12 |   , alert
 13 |   , onload
 14 |   , addClass
 15 |   , removeClass
 16 |   , setHtml
 17 |   , docElement
 18 |   , elementsOf
 19 |   , elementOf
 20 |   , getValue
 21 |   , setValue
 22 |   , itemId
 23 |   , focus
 24 |   , checked
 25 |   , keyCode
 26 |   , getHash
 27 |   , on
 28 |   , onWindow
 29 |   , delegate
 30 |   , JSVal
 31 |   , toJSVal
 32 |   ) where
 33 | 
 34 | import Clay.Render (renderSelector)
 35 | import Clay.Selector (Selector)
 36 | import Data.Char
 37 | import Data.Foldable
 38 | import Data.Maybe (fromJust)
 39 | import Data.Typeable
 40 | import Lucid
 41 | import Protolude hiding (Selector, on)
 42 | import Unsafe.Coerce (unsafeCoerce)
 43 | 
 44 | import qualified Data.Text.Lazy as LText
 45 | import qualified Text.Read as Text
 46 | 
 47 | import GHCJS.Types
 48 | import GHCJS.Marshal
 49 | import GHCJS.Foreign
 50 | import GHCJS.Foreign.Callback
 51 | import GHCJS.Nullable (maybeToNullable, nullableToMaybe, Nullable)
 52 | import Data.JSString.Text (textToJSString, textFromJSString, lazyTextToJSString, lazyTextFromJSString)
 53 | 
 54 | data Element = Element JSVal
 55 | 
 56 | fromHtml = lazyTextToJSString . renderText
 57 | 
 58 | fromSel = lazyTextToJSString . renderSelector
 59 | 
 60 | -- * the big 3
 61 | -- | console.log
 62 | foreign import javascript unsafe
 63 |     "console.log($1)"
 64 |     js_consoleLog :: JSString -> IO ()
 65 | 
 66 | consoleLog :: Text -> IO ()
 67 | consoleLog a = js_consoleLog (textToJSString a)
 68 | 
 69 | foreign import javascript unsafe
 70 |   "alert($1)" js_alert :: JSString -> IO ()
 71 | 
 72 | alert :: Text -> IO ()
 73 | alert t = js_alert (textToJSString t)
 74 | 
 75 | foreign import javascript unsafe "window.onload = $1"
 76 |   js_onload :: Callback (IO ()) -> IO ()
 77 | 
 78 | onload :: IO () -> IO ()
 79 | onload f = do
 80 |     f_ <- asyncCallback f
 81 |     js_onload f_
 82 | 
 83 | 
 84 | -- * element manipulation
 85 | foreign import javascript unsafe
 86 |     "$1.classList.add($2)"
 87 |     js_classListAdd :: JSVal -> JSString -> IO ()
 88 | 
 89 | addClass :: Element -> Selector -> IO ()
 90 | addClass (Element el) sel =
 91 |     js_classListAdd el (fromSel sel)
 92 | 
 93 | foreign import javascript unsafe
 94 |     "$1.classList.remove($2)"
 95 |     js_classListRemove :: JSVal -> JSString -> IO ()
 96 | 
 97 | removeClass :: Element -> Selector -> IO ()
 98 | removeClass (Element el) sel =
 99 |     js_classListRemove el (fromSel sel)
100 | 
101 | foreign import javascript unsafe
102 |     "$1.innerHTML = $2"
103 |     js_innerHtml :: JSVal -> JSString -> IO ()
104 | 
105 | setHtml :: Element -> Html () -> IO ()
106 | setHtml (Element el) html =
107 |     js_innerHtml el (fromHtml html)
108 | 
109 | foreign import javascript unsafe
110 |     "document.querySelector($1)"
111 |     js_docQuerySelector :: JSString -> IO JSVal
112 | 
113 | -- | element selection
114 | docElement :: Selector -> IO Element
115 | docElement sel =
116 |     Element <$> js_docQuerySelector (fromSel sel)
117 | 
118 | foreign import javascript unsafe
119 |     "$1.querySelectorAll($2)"
120 |     js_querySelectorAll :: JSVal -> JSString -> IO JSVal
121 | 
122 | elementsOf :: Element -> Selector -> IO JSVal
123 | elementsOf (Element el) sel = js_querySelectorAll el (fromSel sel)
124 | 
125 | foreign import javascript unsafe
126 |     "$1.querySelector($2)"
127 |     js_querySelector :: JSVal -> JSString -> IO JSVal
128 | 
129 | elementOf :: Element -> Selector -> IO JSVal
130 | elementOf (Element el) sel = js_querySelector el (fromSel sel)
131 | 
132 | foreign import javascript unsafe
133 |     "$1.value"
134 |     js_getValue :: JSVal -> IO JSString
135 | 
136 | getValue :: Element -> IO Text
137 | getValue (Element el) = textFromJSString <$> js_getValue el
138 | 
139 | foreign import javascript unsafe
140 |     "$1.value = $2"
141 |     js_setValue :: JSVal -> JSString -> IO ()
142 | 
143 | setValue :: Element -> Text -> IO ()
144 | setValue (Element el) val = js_setValue el (textToJSString val)
145 | 
146 | foreign import javascript unsafe
147 |     "$1.dataset.id"
148 |     js_getDatasetId :: JSVal -> IO JSString
149 | 
150 | itemId :: Element -> IO (Maybe Int)
151 | itemId (Element el) = do
152 |     i <- js_getDatasetId el
153 |     pure $ readMaybe (LText.unpack $ lazyTextFromJSString i)
154 | 
155 | foreign import javascript unsafe
156 |     "$1.focus()"
157 |     js_focus :: JSVal -> IO ()
158 | 
159 | focus :: Element -> IO ()
160 | focus (Element el) = js_focus el
161 | 
162 | foreign import javascript unsafe
163 |     "$1.item($2)"
164 |     js_getItem :: JSVal -> Int -> IO (Nullable JSVal)
165 | 
166 | -- getItem :: NodeList -> Int -> IO (Maybe Node)
167 | getItem :: JSVal -> Int -> IO (Maybe JSVal)
168 | getItem list n =
169 |   nullableToMaybe <$> js_getItem list n
170 | 
171 | foreign import javascript unsafe
172 |     "$1.keyCode"
173 |     js_keyCode :: JSVal -> IO Int
174 | 
175 | keyCode :: JSVal -> IO Int
176 | keyCode ev = js_keyCode ev
177 | 
178 | foreign import javascript unsafe
179 |     "document.location.hash"
180 |     js_getHash :: IO JSString
181 | 
182 | getHash :: IO JSString
183 | getHash = js_getHash
184 | 
185 | foreign import javascript unsafe
186 |     "$1.checked"
187 |     js_checked :: JSVal -> IO Bool
188 | 
189 | checked :: Element -> IO Bool
190 | checked (Element el) = js_checked el
191 | 
192 | -- * event listening
193 | foreign import javascript unsafe
194 |     "$1.addEventListener($2,$3,$4)"
195 |     js_addEventListener :: JSVal -> JSString -> Callback (JSVal -> IO ()) -> Bool -> IO ()
196 | 
197 | on :: Element -> Text -> (Element -> JSVal -> IO ()) -> IO () 
198 | on (Element el) uiAction handler = do
199 |   handler' <- asyncCallback1 (handler (Element el))
200 |   js_addEventListener el (textToJSString uiAction) handler' False
201 | 
202 | foreign import javascript unsafe
203 |     "window.addEventListener($1,$2,$3)"
204 |     jsWindowAddEventListener :: JSString -> Callback (JSVal -> IO ()) -> Bool -> IO ()
205 | 
206 | -- null = maybeToNullable Nothing
207 | 
208 | onWindow :: LText.Text -> (JSVal -> IO ()) -> IO ()
209 | onWindow uiAction handler = do
210 |   handler' <- asyncCallback1 handler
211 |   jsWindowAddEventListener
212 |     (lazyTextToJSString uiAction)
213 |     handler'
214 |     False
215 | 
216 | delegate :: Element -> Selector -> Text -> (Element -> JSVal -> IO ()) -> IO ()
217 | delegate (Element base) pattern0 ev action = do
218 |   let useCapture = ev == "blur" || ev == "focus"
219 |   dispatch <- asyncCallback1 $ applyIn (Element base) pattern0 action 
220 |   js_addEventListener base (textToJSString ev) dispatch useCapture
221 | 
222 | foreign import javascript unsafe
223 |     "$1.target"
224 |     js_target :: JSVal -> IO JSVal
225 | 
226 | foreign import javascript unsafe
227 |     "$1===$2"
228 |     js_eq :: JSVal -> JSVal -> IO Bool
229 | 
230 | foreign import javascript unsafe
231 |     "$1.length"
232 |     js_length :: JSVal -> IO Int
233 | 
234 | applyIn :: Element -> Selector -> (Element -> JSVal -> IO ()) -> JSVal -> IO ()
235 | applyIn base pattern0 action ev = do
236 |   t <- js_target ev
237 |   p <- elementsOf base pattern0
238 |   n <- js_length p
239 |   elem' <- findM
240 |            (\x -> do
241 |                item <- getItem p x
242 |                case item of
243 |                  Nothing -> pure False
244 |                  Just item' -> js_eq t item') [0..n]
245 |   case elem' of
246 |     Nothing -> pure ()
247 |     Just iElem -> do
248 |       eitem <- getItem p iElem
249 |       case eitem of
250 |         Nothing -> pure ()
251 |         Just eitem' -> do
252 |             li <- findUp (Element eitem') "li"
253 |             case li of
254 |               Nothing -> print "no li parent???"
255 |               Just li' -> action li' ev
256 | 
257 | foreign import javascript unsafe
258 |     "$1.parentElement"
259 |     js_parentElement :: JSVal -> IO (Nullable JSVal)
260 | 
261 | foreign import javascript unsafe
262 |     "$1.tagName"
263 |     js_tagName :: JSVal -> IO JSString
264 | 
265 | -- | go up the tree and find an element, if it exists
266 | findUp :: Element -> LText.Text -> IO (Maybe Element)
267 | findUp (Element base) sel = do
268 |   parent <- nullableToMaybe <$> js_parentElement base
269 |   case parent of
270 |     Nothing -> pure Nothing
271 |     Just parent' -> do
272 |       name <- js_tagName parent'
273 |       if (LText.toLower $ lazyTextFromJSString name) == (LText.toLower sel)
274 |         then pure $ Just (Element parent')
275 |         else findUp (Element parent') sel
276 | 
277 | findM :: (Monad m, Traversable t) => (a -> m Bool) -> t a -> m (Maybe a)
278 | findM p = fmap (getFirst . fold) . mapM 
279 |        (fmap First . (\x -> do
280 |            p' <- p x
281 |            pure $ if p' then Just x else Nothing))
282 | 


--------------------------------------------------------------------------------
/src/Todo/Views.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE OverloadedStrings #-}
  2 | {-# OPTIONS_GHC-fno-warn-type-defaults#-}
  3 | 
  4 | module Todo.Views 
  5 |   ( render
  6 |   ) where
  7 | 
  8 | import Todo.Vanilla
  9 |     ( Element(..)
 10 |     , docElement
 11 |     , addClass
 12 |     , removeClass
 13 |     , Selector
 14 |     , setValue
 15 |     , setHtml
 16 |     , focus
 17 |     , elementOf
 18 |     )
 19 | 
 20 | import Control.Lens hiding (element, elementOf, itemText, itemStatus)
 21 | import Control.Monad (join)
 22 | import Data.Foldable (sequenceA_)
 23 | import Data.Text (pack)
 24 | import Lucid hiding (for_)
 25 | import Protolude hiding (on, Selector)
 26 | import Todo.Model
 27 | import qualified Clay.Selector as Clay
 28 | import qualified Data.Map as Map
 29 | 
 30 | render :: Todos -> IO ()
 31 | render = sequenceRenderers renderers
 32 | 
 33 | sequenceRenderers :: [Todos -> IO ()] -> Todos -> IO ()
 34 | sequenceRenderers rs tds = sequenceA_ $ ($) <$> rs <*> pure tds
 35 | 
 36 | renderers :: [Todos -> IO ()]
 37 | renderers =
 38 |   [ renderClearCompleted
 39 |   , renderFilter
 40 |   , renderHideStuff
 41 |   , renderNewItem
 42 |   , renderTodoCount
 43 |   , renderTodoList
 44 |   , renderFocus
 45 |   ]
 46 | 
 47 | renderClearCompleted :: Todos -> IO ()
 48 | renderClearCompleted tds = do
 49 |     el <- docElement ".clear-completed"
 50 |     action el hidden
 51 |   where
 52 |     hidden = "hidden" :: Selector
 53 |     numCompleted =
 54 |       getSum $ 
 55 |       foldMap
 56 |       (\x -> Sum (if view itemStatus x == Completed then 1 else 0))
 57 |       (view todosItems tds)
 58 |     action = if numCompleted == 0
 59 |                then addClass
 60 |                else removeClass
 61 | 
 62 | renderFilter :: Todos -> IO ()
 63 | renderFilter tds = do
 64 |   el <- docElement ".filters .selected"
 65 |   removeClass el selected
 66 |   newSelection <- docElement
 67 |       (Clay.element $ ".filters [href='#/" <> currentPage <> "']")
 68 |   addClass newSelection selected
 69 |   where
 70 |     selected = "selected" :: Selector
 71 |     currentPage =
 72 |       case view todosFilter tds of
 73 |         Nothing        -> ""
 74 |         Just Active    -> "active"
 75 |         Just Completed -> "completed"
 76 | 
 77 | renderHideStuff :: Todos -> IO ()
 78 | renderHideStuff tds = do
 79 |   main <- docElement ".main"
 80 |   foot <- docElement ".footer"
 81 |   action main hidden
 82 |   action foot hidden
 83 |   where
 84 |     hidden = "hidden" :: Selector
 85 |     action =
 86 |       if null (view todosItems tds)
 87 |         then addClass
 88 |         else removeClass
 89 | 
 90 | renderNewItem :: Todos -> IO ()
 91 | renderNewItem tds = do
 92 |     el <- docElement ".new-todo"
 93 |     setValue el (tds^.todosNewItem)
 94 | 
 95 | renderTodoCount :: Todos -> IO ()
 96 | renderTodoCount tds = do
 97 |     el <- docElement ".todo-count"
 98 |     setHtml el itemsLeft
 99 |   where
100 |     itemsLeft = strong_ (toHtml $ (show n :: Text)) <> " item" <> s <> " left"
101 |     n = getSum $
102 |         foldMap
103 |         (\x -> Sum (if view itemStatus x == Active then 1 else 0))
104 |         (view todosItems tds) :: Integer
105 |     s = if n == 1
106 |           then ""
107 |           else "s"
108 | 
109 | renderTodoList :: Todos -> IO ()
110 | renderTodoList tds = do
111 |     el <- docElement ".todo-list"
112 |     setHtml el (htmlItems tds)
113 | 
114 | renderFocus :: Todos -> IO ()
115 | renderFocus tds =
116 |   case view todosEditing tds of
117 |     Nothing -> pure ()
118 |     Just _ -> do
119 |       el <- docElement ".todo-list"
120 |       elEditing <- elementOf el ".editing .edit"
121 |       focus (Element elEditing)
122 | 
123 | htmlItems :: Todos -> Html ()
124 | htmlItems tds =
125 |   mconcat $ 
126 |   fmap
127 |   (\(ItemId id', item') ->
128 |     htmlItem item' id' (editing == Just (ItemId id')) (visible item'))
129 |   items
130 |   where
131 |     items = Map.toAscList (view todosItems tds)
132 |     editing = view todosEditing tds
133 |     visible item' =
134 |       case view todosFilter tds of
135 |         Nothing        -> True
136 |         Just Active    -> view itemStatus item' == Active
137 |         Just Completed -> view itemStatus item' == Completed
138 | 
139 | htmlItem :: Item -> Int -> Bool -> Bool -> Html ()
140 | htmlItem item' id' editing visible =
141 |   li_ (liClass <> [data_ "id" (pack $ show id')])
142 |     (div_ itemClass 
143 |      (input_ ([class_ "toggle", type_ "checkbox"] ++ checked)
144 |       <> label_ (toHtml (view itemText item')) 
145 |       <> button_ [class_ "destroy"] mempty)
146 |      <> input_ [class_ "edit", value_ (view itemText item')])
147 |   where
148 |     liClass
149 |       | editing && (view itemStatus item' == Completed) =
150 |           [class_ "editing completed"]
151 |       | editing = [class_ "editing"]
152 |       | view itemStatus item' == Completed = [class_ "completed"]
153 |       | otherwise = []
154 |     itemClass =
155 |       if visible
156 |         then [class_ "view"]
157 |         else [class_ "hidden"]
158 |     checked =
159 |       case view itemStatus item' of
160 |         Completed -> [checked_]
161 |         Active    -> []
162 | 


--------------------------------------------------------------------------------
/stack.yaml:
--------------------------------------------------------------------------------
 1 | resolver: lts-7.15
 2 | 
 3 | packages:
 4 | - '.'
 5 | 
 6 | extra-deps:
 7 | - ghcjs-dom-0.7.0.4
 8 | - ghcjs-dom-jsffi-0.7.0.4
 9 | - mvc-1.1.3
10 | 
11 | flags: {}
12 | extra-package-dbs: []
13 | 
14 | # compiler: ghcjs-0.1.0.20150924_ghc-7.10.2
15 | # compiler: ghcjs
16 | 
17 | compiler: ghcjs-0.2.1.9007015_ghc-8.0.1
18 | compiler-check: match-exact
19 | 
20 | setup-info:
21 |   ghcjs:
22 |     source:
23 |       ghcjs-0.2.1.9007015_ghc-8.0.1:
24 |            url: http://ghcjs.tolysz.org/ghc-8.0-2017-01-11-lts-7.15-9007015.tar.gz
25 |            sha1: 30d34e9d704bdb799066387dfa1ba98b8884d932
26 | 


--------------------------------------------------------------------------------