From 673514eb92789e60466ac1e7a4c0b37f1558fb24 Mon Sep 17 00:00:00 2001
From: Ben Ford <ben@perurbis.com>
Date: Mon, 2 Mar 2015 08:35:32 +0000
Subject: [PATCH 1/3] Start porting to haskell-ng and virtual-dom

---
 todo-mvc/default.nix        | 21 +++++++++------------
 todo-mvc/ohm-todo-mvc.cabal |  4 ++--
 todo-mvc/shell.nix          | 23 ++++++++---------------
 todo-mvc/src/Main.hs        | 22 ++++++++++++----------
 todo-mvc/src/deps.js        |  8 --------
 5 files changed, 31 insertions(+), 47 deletions(-)
 delete mode 100644 todo-mvc/src/deps.js

diff --git a/todo-mvc/default.nix b/todo-mvc/default.nix
index 3e40f9e..4fa72fb 100644
--- a/todo-mvc/default.nix
+++ b/todo-mvc/default.nix
@@ -1,20 +1,17 @@
-{ cabal, aeson, ghcjsBase, ghcjsDom, ghcjsPrim, lens, mvc, oHm
-, pipes, pipesConcurrency, profunctors, stm, time
+{ mkDerivation, aeson, base, containers, ghcjs-base, ghcjs-dom
+, ghcjs-prim, lens, mvc, oHm, pipes, pipes-concurrency, profunctors
+, stdenv, stm, text, time, transformers, virtual-dom
 }:
-
-cabal.mkDerivation (self: {
+mkDerivation {
   pname = "ohm-todo-mvc";
   version = "0.1.0.0";
   src = ./.;
   isLibrary = false;
   isExecutable = true;
   buildDepends = [
-    aeson ghcjsBase ghcjsDom ghcjsPrim lens mvc oHm pipes
-    pipesConcurrency profunctors stm time
+    aeson base containers ghcjs-base ghcjs-dom ghcjs-prim lens mvc oHm
+    pipes pipes-concurrency profunctors stm text time transformers
+    virtual-dom
   ];
-  doCheck = false;
-  meta = {
-    license = self.stdenv.lib.licenses.unfree;
-    platforms = self.ghc.meta.platforms;
-  };
-})
+  license = stdenv.lib.licenses.unfree;
+}
diff --git a/todo-mvc/ohm-todo-mvc.cabal b/todo-mvc/ohm-todo-mvc.cabal
index 126f9af..c4a9ffa 100644
--- a/todo-mvc/ohm-todo-mvc.cabal
+++ b/todo-mvc/ohm-todo-mvc.cabal
@@ -16,7 +16,7 @@ executable todo-mvc
   main-is:             Main.hs
   -- other-modules:
   other-extensions:    ForeignFunctionInterface, GeneralizedNewtypeDeriving, OverloadedStrings
-  build-depends:       base >=4.7 && <4.8
+  build-depends:       base >=4.7 && <5
                      , containers >=0.5 && <0.6
                      , lens
                      , profunctors
@@ -33,8 +33,8 @@ executable todo-mvc
                      , ghcjs-dom >=0.1.1.1
                      , ghcjs-prim >= 0.1.0.0
                      , oHm
+                     , virtual-dom
   hs-source-dirs:      src
-  js-sources:          static/deps.js
   ghcjs-options: -O3 -Wall
   cpp-options: -DGHCJS_BROWSER -DGHCJS_BUSY_YIELD=30
   default-language:    Haskell2010
diff --git a/todo-mvc/shell.nix b/todo-mvc/shell.nix
index 2cf5fce..3a3067e 100644
--- a/todo-mvc/shell.nix
+++ b/todo-mvc/shell.nix
@@ -1,18 +1,11 @@
-with import <nixpkgs> {};
-let haskellPackages = pkgs.haskellPackages_ghcjs.override {
-      extension = self: super: {
+with (import <nixpkgs> {}).pkgs;
+let
+    hsPackages = haskell-ng.packages.ghcjs.override {
+      overrides = self: super: {
+        virtual-dom = self.callPackage ./virtual-dom {};
         oHm = self.callPackage ./oHm {};
-        todo = self.callPackage ./. {};
+        todo-mvc = self.callPackage ./. {};
       };
     };
-
-in pkgs.callPackage ./. {
-     cabal = haskellPackages.cabal.override {
-       extension = self: super: {
-         buildTools = super.buildTools ++ [ haskellPackages.ghc.ghc.parent.cabalInstall ];
-       };
-     };
-     inherit (haskellPackages) aeson ghcjsBase ghcjsDom ghcjsPrim oHm lens mvc pipes
-                               pipesConcurrency profunctors stm;
-
-   }
+in
+  hsPackages.todo-mvc.env
diff --git a/todo-mvc/src/Main.hs b/todo-mvc/src/Main.hs
index 4ce5182..8a966ad 100644
--- a/todo-mvc/src/Main.hs
+++ b/todo-mvc/src/Main.hs
@@ -10,6 +10,7 @@ import Control.Applicative
 import Data.Foldable (traverse_)
 import Ohm.Component
 import Ohm.HTML
+import VirtualDom
 import Prelude hiding (div,id,span,map, filter)
 import qualified Prelude as P
                 
@@ -78,7 +79,7 @@ filterItems Completed = P.filter _completed
 
 todoView :: DOMEvent Action -> ToDo -> HTML
 todoView chan todo@(ToDo itemList _txtEntry currentFilter) =
-  with div
+  with div_
     (classes .= ["body"])
     [ titleRender, itemsRender, renderFilters chan todo]
   where
@@ -89,8 +90,8 @@ todoView chan todo@(ToDo itemList _txtEntry currentFilter) =
 
 newItem :: DOMEvent Action -> ToDo -> HTML  
 newItem chan todo =
-  with li (classes .= ["newItem"])
-    [ into form
+  with li_ (classes .= ["newItem"])
+    [ into form_
       [ with input (do
              attrs . at "placeholder" ?= "Create a new task"
              props . at "value" ?= value
@@ -105,16 +106,16 @@ newItem chan todo =
 
 renderItem :: DOMEvent Action -> (Int, Item) -> HTML
 renderItem chan (idx, (Item itemTitle complete)) =
-  into li
-    [ into form
-      [ with input (do
+  into li_
+    [ into form_
+      [ with input_ (do
           props . at "type" ?= "checkbox"
           attrs . at "title" ?= "Mark as Completed"
           props . at "checked" ?= (if complete then "checked" else "")
           onChange $ contramap (const $ SetCompleted idx (if complete then False else True)) chan
           classes .= ["completed"])
           []
-      , with span (classes .= ["description"])
+      , with span_ (classes .= ["description"])
           [text itemTitle]
       , (btn clickCancel "✖") &~ do
           classes .= ["complete"]
@@ -130,8 +131,8 @@ renderFilters chan todo =
   where
   currentFilter = (todo ^. filter)
   renderFilter f =
-    into li
-      [ with a (do
+    into li_
+      [ with a_ (do
           attrs . at "href" ?= "#"
           classes .= (if f == currentFilter then ["selected"] else [])
           onClick $ filterClick f)
@@ -149,4 +150,5 @@ modelComp :: Component () Action ToDo Action
 modelComp = Component process todoView idProcessor
 
 main :: IO ()
-main = void $ runComponent initialToDo () modelComp
+main = 
+  void $ initDomDelegator >> runComponent initialToDo () modelComp
diff --git a/todo-mvc/src/deps.js b/todo-mvc/src/deps.js
deleted file mode 100644
index 66fca22..0000000
--- a/todo-mvc/src/deps.js
+++ /dev/null
@@ -1,8 +0,0 @@
-global.Delegator = require('dom-delegator');
-global.Delegator();
-global.h = require('virtual-hyperscript');
-global.svg = require('virtual-hyperscript/svg');
-global.hook = require('virtual-hyperscript/hooks/ev-hook');
-global.diff = require('virtual-dom/diff');
-global.patch = require('virtual-dom/patch');
-global.createElement = require('virtual-dom/create-element');

From b87498323a09071f61ae4b048aa3a2c9dc2100c0 Mon Sep 17 00:00:00 2001
From: Ben Ford <ben@perurbis.com>
Date: Mon, 2 Mar 2015 20:11:28 +0000
Subject: [PATCH 2/3] Api changes for virtual-dom

---
 todo-mvc/src/Main.hs | 50 +++++++++++++++++++++++++-------------------
 1 file changed, 28 insertions(+), 22 deletions(-)

diff --git a/todo-mvc/src/Main.hs b/todo-mvc/src/Main.hs
index 8a966ad..70b5ec8 100644
--- a/todo-mvc/src/Main.hs
+++ b/todo-mvc/src/Main.hs
@@ -7,13 +7,16 @@ import Control.Lens hiding (Index, Action)
 import Pipes
 --import Prelude hiding ((.))
 import Control.Applicative
+import Control.Monad.Trans.State.Strict
 import Data.Foldable (traverse_)
 import Ohm.Component
 import Ohm.HTML
 import VirtualDom
-import Prelude hiding (div,id,span,map, filter)
-import qualified Prelude as P
+import VirtualDom.Prim (HTMLElement, _HTMLElement, HTML, text, properties, attributes)
+import VirtualDom.HTML.Attributes hiding (form_, span_)
                 
+import GHCJS.Foreign
+
 --------------------------------------------------------------------------------
 
 type Index = Int
@@ -73,9 +76,9 @@ showFilter Active = "Active"
 showFilter Completed = "Completed"
 
 filterItems :: Filter -> [Item] -> [Item]
-filterItems All = P.id
-filterItems Active = P.filter (not . _completed)
-filterItems Completed = P.filter _completed
+filterItems All = id
+filterItems Active = filter (not . _completed)
+filterItems Completed = filter _completed
 
 todoView :: DOMEvent Action -> ToDo -> HTML
 todoView chan todo@(ToDo itemList _txtEntry currentFilter) =
@@ -83,21 +86,21 @@ todoView chan todo@(ToDo itemList _txtEntry currentFilter) =
     (classes .= ["body"])
     [ titleRender, itemsRender, renderFilters chan todo]
   where
-  titleRender = with h1 (classes .= ["title"]) ["todos"]
-  itemsRender = with ul (classes .= ["items"])
-    (newItem chan todo : (P.map (renderItem chan) $ zip [0..] filteredItems))
+  titleRender = with h1_ (classes .= ["title"]) ["todos"]
+  itemsRender = with ul_ (classes .= ["items"])
+    (newItem chan todo : (map (renderItem chan) $ zip [0..] filteredItems))
   filteredItems = filterItems currentFilter itemList
 
 newItem :: DOMEvent Action -> ToDo -> HTML  
 newItem chan todo =
   with li_ (classes .= ["newItem"])
     [ into form_
-      [ with input (do
-             attrs . at "placeholder" ?= "Create a new task"
-             props . at "value" ?= value
+      [ with input_ (do
+             attributes . at "placeholder" ?= "Create a new task"
+             properties . at "value" ?= value
              onInput $ contramap SetEditText chan)
              []
-        , with (btn click "Create") (attrs . at "hidden" ?= "true") ["Create"]
+        , with (btn click "Create") (attributes . at "hidden" ?= "true") ["Create"]
       ]
     ]
   where
@@ -109,31 +112,34 @@ renderItem chan (idx, (Item itemTitle complete)) =
   into li_
     [ into form_
       [ with input_ (do
-          props . at "type" ?= "checkbox"
-          attrs . at "title" ?= "Mark as Completed"
-          props . at "checked" ?= (if complete then "checked" else "")
+          properties . at "type" ?= "checkbox"
+          attributes . at "title" ?= "Mark as Completed"
+          properties . at "checked" ?= (if complete then "checked" else "")
           onChange $ contramap (const $ SetCompleted idx (if complete then False else True)) chan
           classes .= ["completed"])
           []
       , with span_ (classes .= ["description"])
           [text itemTitle]
-      , (btn clickCancel "✖") &~ do
-          classes .= ["complete"]
-          attrs . at "title" ?= "Remove Item"
+      , cancelBtn
       ]
     ]
-  where clickCancel = const $ channel chan $ RemoveItem idx
+  where
+  clickCancel = const $ channel chan $ RemoveItem idx
+  cancelBtn = (btn clickCancel "✖") & _HTMLElement %~
+    (execState $ do
+       classes .= ["complete"]
+       attributes . at "title" ?= "Remove Item")
 
 renderFilters :: DOMEvent Action -> ToDo -> HTML
 renderFilters chan todo =
-  with ul (classes .= ["filters"])
+  with ul_ (classes .= ["filters"])
     (renderFilter <$> [All, Active, Completed])
   where
   currentFilter = (todo ^. filter)
   renderFilter f =
     into li_
       [ with a_ (do
-          attrs . at "href" ?= "#"
+          attributes . at "href" ?= "#"
           classes .= (if f == currentFilter then ["selected"] else [])
           onClick $ filterClick f)
           [text $ showFilter f]
@@ -141,7 +147,7 @@ renderFilters chan todo =
   filterClick f = DOMEvent $ const $ (channel chan) $ SetFilter f      
 
 btn :: (() -> IO ()) -> String -> HTML
-btn click txt = with button (onClick $ DOMEvent click) [text txt]         
+btn click txt = with button_ (onClick $ DOMEvent click) [text txt]         
 
 --------------------------------------------------------------------------------
 

From ed629972636ea0f3d448ca46687a1b0f980044ad Mon Sep 17 00:00:00 2001
From: Ben Ford <ben@perurbis.com>
Date: Sun, 8 Mar 2015 16:38:28 +0000
Subject: [PATCH 3/3] Add key bindings

---
 todo-mvc/build.nix          |  4 ++--
 todo-mvc/default.nix        | 21 ++++++++++++---------
 todo-mvc/ohm-todo-mvc.cabal |  6 +++---
 todo-mvc/shell.nix          | 24 ++++++++++++++++--------
 todo-mvc/src/Main.hs        | 22 +++++++++++++++-------
 todo-mvc/static/exe         |  1 +
 todo-mvc/static/index.html  |  2 +-
 todo-mvc/virtual-dom        |  1 +
 8 files changed, 51 insertions(+), 30 deletions(-)
 create mode 120000 todo-mvc/static/exe
 create mode 120000 todo-mvc/virtual-dom

diff --git a/todo-mvc/build.nix b/todo-mvc/build.nix
index 0ea8a5d..2854ca5 100644
--- a/todo-mvc/build.nix
+++ b/todo-mvc/build.nix
@@ -12,7 +12,7 @@ let haskellPackages = pkgs.haskellPackages_ghcjs.override {
     browserify = pkgs.nodePackages.browserify;
 
     client = stdenv.mkDerivation {  
-        name = "chat-client";  
+        name = "todo-mvc";  
         version = "1.0";
         src = ./.;
         buildInputs = [ ghc aeson ghcjsBase ghcjsDom ghcjsPrim
@@ -35,4 +35,4 @@ in client
   #                             oHm ohmChatServer lens pipes pipesConcurrency mvc profunctors;
   #   inherit (pkg.nodePackages)  npm browserify;
   #   closurecompiler = pkgs.closurecompiler;
-  # }
\ No newline at end of file
+  # }
diff --git a/todo-mvc/default.nix b/todo-mvc/default.nix
index 4fa72fb..1a819b3 100644
--- a/todo-mvc/default.nix
+++ b/todo-mvc/default.nix
@@ -1,17 +1,20 @@
-{ mkDerivation, aeson, base, containers, ghcjs-base, ghcjs-dom
-, ghcjs-prim, lens, mvc, oHm, pipes, pipes-concurrency, profunctors
-, stdenv, stm, text, time, transformers, virtual-dom
+{ cabal, aeson, ghcjsBase, ghcjsDom, ghcjsPrim, lens, mvc, virtualDom, oHm
+, pipes, pipesConcurrency, profunctors, stm, time
 }:
-mkDerivation {
+
+cabal.mkDerivation (self: {
   pname = "ohm-todo-mvc";
   version = "0.1.0.0";
   src = ./.;
   isLibrary = false;
   isExecutable = true;
   buildDepends = [
-    aeson base containers ghcjs-base ghcjs-dom ghcjs-prim lens mvc oHm
-    pipes pipes-concurrency profunctors stm text time transformers
-    virtual-dom
+    aeson ghcjsBase ghcjsDom ghcjsPrim lens mvc virtualDom oHm pipes
+    pipesConcurrency profunctors stm time
   ];
-  license = stdenv.lib.licenses.unfree;
-}
+  doCheck = false;
+  meta = {
+    license = self.stdenv.lib.licenses.unfree;
+    platforms = self.ghc.meta.platforms;
+  };
+})
diff --git a/todo-mvc/ohm-todo-mvc.cabal b/todo-mvc/ohm-todo-mvc.cabal
index c4a9ffa..ed4bfbf 100644
--- a/todo-mvc/ohm-todo-mvc.cabal
+++ b/todo-mvc/ohm-todo-mvc.cabal
@@ -15,7 +15,7 @@ cabal-version:       >=1.20
 executable todo-mvc
   main-is:             Main.hs
   -- other-modules:
-  other-extensions:    ForeignFunctionInterface, GeneralizedNewtypeDeriving, OverloadedStrings
+  -- other-extensions:    ForeignFunctionInterface, GeneralizedNewtypeDeriving, OverloadedStrings
   build-depends:       base >=4.7 && <5
                      , containers >=0.5 && <0.6
                      , lens
@@ -35,6 +35,6 @@ executable todo-mvc
                      , oHm
                      , virtual-dom
   hs-source-dirs:      src
-  ghcjs-options: -O3 -Wall
-  cpp-options: -DGHCJS_BROWSER -DGHCJS_BUSY_YIELD=30
+  -- ghcjs-options: -O3 -Wall
+  -- cpp-options: -DGHCJS_BROWSER -DGHCJS_BUSY_YIELD=30
   default-language:    Haskell2010
diff --git a/todo-mvc/shell.nix b/todo-mvc/shell.nix
index 3a3067e..e4d4058 100644
--- a/todo-mvc/shell.nix
+++ b/todo-mvc/shell.nix
@@ -1,11 +1,19 @@
-with (import <nixpkgs> {}).pkgs;
-let
-    hsPackages = haskell-ng.packages.ghcjs.override {
-      overrides = self: super: {
-        virtual-dom = self.callPackage ./virtual-dom {};
+with import <nixpkgs> {};
+let haskellPackages = pkgs.haskellPackages_ghcjs.override {
+      extension = self: super: {
+        virtualDom = self.callPackage ./virtual-dom {};
         oHm = self.callPackage ./oHm {};
-        todo-mvc = self.callPackage ./. {};
+        todo = self.callPackage ./. {};
       };
     };
-in
-  hsPackages.todo-mvc.env
+
+in pkgs.callPackage ./. {
+     cabal = haskellPackages.cabal.override {
+       extension = self: super: {
+         buildTools = super.buildTools ++ [ haskellPackages.ghc.ghc.parent.cabalInstall ];
+       };
+     };
+     inherit (haskellPackages) aeson ghcjsBase ghcjsDom ghcjsPrim virtualDom oHm lens mvc pipes
+                               pipesConcurrency profunctors stm;
+
+   }
diff --git a/todo-mvc/src/Main.hs b/todo-mvc/src/Main.hs
index 70b5ec8..9624d54 100644
--- a/todo-mvc/src/Main.hs
+++ b/todo-mvc/src/Main.hs
@@ -10,9 +10,12 @@ import Control.Applicative
 import Control.Monad.Trans.State.Strict
 import Data.Foldable (traverse_)
 import Ohm.Component
-import Ohm.HTML
+import Ohm.KeyMaster
+import Ohm.HTML hiding (classes)
 import VirtualDom
 import VirtualDom.Prim (HTMLElement, _HTMLElement, HTML, text, properties, attributes)
+import Prelude hiding (filter)
+import qualified Prelude as P
 import VirtualDom.HTML.Attributes hiding (form_, span_)
                 
 import GHCJS.Foreign
@@ -77,13 +80,14 @@ showFilter Completed = "Completed"
 
 filterItems :: Filter -> [Item] -> [Item]
 filterItems All = id
-filterItems Active = filter (not . _completed)
-filterItems Completed = filter _completed
+filterItems Active = P.filter (not . _completed)
+filterItems Completed = P.filter _completed
 
 todoView :: DOMEvent Action -> ToDo -> HTML
 todoView chan todo@(ToDo itemList _txtEntry currentFilter) =
-  with div_
-    (classes .= ["body"])
+  with div_ (do
+    onKeyPress $ DOMEvent print
+    classes .= ["body"])
     [ titleRender, itemsRender, renderFilters chan todo]
   where
   titleRender = with h1_ (classes .= ["title"]) ["todos"]
@@ -118,7 +122,9 @@ renderItem chan (idx, (Item itemTitle complete)) =
           onChange $ contramap (const $ SetCompleted idx (if complete then False else True)) chan
           classes .= ["completed"])
           []
-      , with span_ (classes .= ["description"])
+      , with span_ (do
+          classes .= ["description"]
+          onKeyPress $ DOMEvent print)
           [text itemTitle]
       , cancelBtn
       ]
@@ -156,5 +162,7 @@ modelComp :: Component () Action ToDo Action
 modelComp = Component process todoView idProcessor
 
 main :: IO ()
-main = 
+main = do
+  km <- initKeyMaster
+  key km "ctrl+a" $ (putStrLn "a called") 
   void $ initDomDelegator >> runComponent initialToDo () modelComp
diff --git a/todo-mvc/static/exe b/todo-mvc/static/exe
new file mode 120000
index 0000000..b7ddd75
--- /dev/null
+++ b/todo-mvc/static/exe
@@ -0,0 +1 @@
+../dist/build/todo-mvc/todo-mvc.jsexe/
\ No newline at end of file
diff --git a/todo-mvc/static/index.html b/todo-mvc/static/index.html
index 425c8a2..136e5dc 100644
--- a/todo-mvc/static/index.html
+++ b/todo-mvc/static/index.html
@@ -10,7 +10,7 @@
   <link href="style.css" rel="stylesheet" type="text/css">
 </head>
 <body>
-  <script language="javascript" src="all.js"></script>
+  <script language="javascript" src="exe/all.js"></script>
   <a href="https://github.com/paf31/purescript-thermite-todomvc"><img style="position: absolute; top: 0; right: 0; border: 0;" src="https://camo.githubusercontent.com/52760788cde945287fbb584134c4cbc2bc36f904/68747470733a2f2f73332e616d617a6f6e6177732e636f6d2f6769746875622f726962626f6e732f666f726b6d655f72696768745f77686974655f6666666666662e706e67" alt="Fork me on GitHub" data-canonical-src="https://s3.amazonaws.com/github/ribbons/forkme_right_white_ffffff.png"></a>
 </body>
 </html>
diff --git a/todo-mvc/virtual-dom b/todo-mvc/virtual-dom
new file mode 120000
index 0000000..299a662
--- /dev/null
+++ b/todo-mvc/virtual-dom
@@ -0,0 +1 @@
+../../virtual-dom
\ No newline at end of file