Separate concur-core. Add concur-react.

.gitmodules

@@ -1,6 +1,9 @@
 [submodule "ghcjs-ffiqq"]
-	path = ghcjs-ffiqq
+	path = concur-react/ghcjs-ffiqq
 	url = https://github.com/ghcjs/ghcjs-ffiqq.git
 [submodule "ghcjs-vdom"]
-	path = ghcjs-vdom
+	path = concur-vdom/ghcjs-vdom
 	url = https://github.com/ajnsit/ghcjs-vdom.git
+[submodule "concur-vdom/ghcjs-ffiqq"]
+	path = concur-vdom/ghcjs-ffiqq
+	url = https://github.com/ghcjs/ghcjs-ffiqq.git

concur-core/LICENSE

@@ -0,0 +1,30 @@
+Copyright (C) 2017 Anupam Jain
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Anupam Jain nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

concur-core/README.md

@@ -0,0 +1 @@
+# concur-core

concur-core/concur-core.cabal

@@ -0,0 +1,36 @@
+name:                concur-core
+version:             0.1.0.0
+synopsis:            A client side web UI framework for Haskell. Core framework.
+description:         A client side web UI framework for Haskell. Core framework.
+homepage:            https://github.com/ajnsit/concur (concur-core)
+license:             BSD3
+license-file:        LICENSE
+author:              Anupam Jain
+maintainer:          [email protected]
+copyright:           2017 (C) All Rights Reserved.
+category:            Web
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  ghc-options:         -Wall -ferror-spans
+  default-language:    Haskell2010
+  hs-source-dirs:      src
+  exposed-modules:     Concur.Core
+                     , Concur.Core.Types
+                     , Concur.Core.Notify
+                     , Control.MonadSTM
+                     , Control.MonadShiftMap
+                     , Control.MonadTransMap
+                     , Control.MultiAlternative
+  build-depends:       base >= 4.7 && < 5
+                     , mtl >= 2.2
+                     , transformers >= 0.5
+                     , stm >= 2.4
+                     , free >= 4.12
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/ajnsit/concur

concur-core/src/Concur/Core.hs

@@ -0,0 +1,6 @@
+module Concur.Core
+  ( module X
+  ) where
+
+import Concur.Core.Types as X
+import Concur.Core.Notify as X

src/Concur/Notify.hs → concur-core/src/Concur/Core/Notify.hs

@@ -1,10 +1,11 @@
-module Concur.Notify
+module Concur.Core.Notify
   ( Notify (..)
   , newNotify
   , newNotifyIO
   ) where
 
-import           Control.Concurrent.STM (STM, TVar, newTVarIO, newTVar, readTVar, writeTVar, retry)
+import           Control.Concurrent.STM (STM, TVar, newTVar, newTVarIO,
+                                         readTVar, retry, writeTVar)
 import           Control.Monad          (void)
 
 -- TODO: Use Weak TVar pointers as appropriate

src/Concur/Types.hs → concur-core/src/Concur/Core/Types.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TupleSections              #-}
-module Concur.Types
+module Concur.Core.Types
   ( Widget(..)
   , continue
   , widget
@@ -19,7 +19,7 @@ module Concur.Types
   , MultiAlternative(..)
   ) where
 
-import           Concur.Notify            (await, newNotify, notify)
+import           Concur.Core.Notify       (await, newNotify, notify)
 import           Control.Applicative      (Alternative, empty, (<|>))
 import           Control.Concurrent       (forkIO)
 import           Control.Concurrent.STM   (STM, atomically, retry)

src/Control/MonadSTM.hs → concur-core/src/Control/MonadSTM.hs

@@ -1,13 +1,16 @@
 {-# LANGUAGE FlexibleInstances #-}
 module Control.MonadSTM where
 
-import           Control.Concurrent.STM (STM)
+import           Control.Concurrent.STM (STM, atomically)
 import           Control.Monad.Trans    (MonadTrans (..))
 
 -- | Like `MonadIO` but for `STM` monad
 -- `MonadBase` seemed too cumbersome for this.
 class MonadSTM m where
   liftSTM :: STM a -> m a
 
+instance MonadSTM IO where
+  liftSTM = atomically
+
 instance (MonadTrans t, Monad m, MonadSTM m) => MonadSTM (t m) where
   liftSTM = lift . liftSTM

src/Control/MonadShiftMap.hs → concur-core/src/Control/MonadShiftMap.hs

@@ -10,6 +10,7 @@ import           Control.MonadTransMap
 class MonadShiftMap s t where
   shiftMap :: (forall x. s x -> s x) -> t a -> t a
 
+-- This is the primary reason for this. This cannot be done by MonadTrans.
 instance MonadShiftMap m m where
   shiftMap = id
 

concur-core/stack-ghcjs.yaml

@@ -0,0 +1,15 @@
+resolver: lts-7.19
+packages:
+- .
+extra-deps: []
+flags: {}
+extra-package-dbs: []
+
+compiler: ghcjs-0.2.1.9007019_ghc-8.0.1
+compiler-check: match-exact
+setup-info:
+  ghcjs:
+    source:
+      ghcjs-0.2.1.9007019_ghc-8.0.1:
+           url: http://ghcjs.tolysz.org/ghc-8.0-2017-02-05-lts-7.19-9007019.tar.gz
+           sha1: d2cfc25f9cda32a25a87d9af68891b2186ee52f9

concur-core/stack.yaml

@@ -0,0 +1,9 @@
+resolver: lts-7.19
+packages:
+- .
+extra-deps: []
+flags: {}
+extra-package-dbs: []
+
+nix:
+  enable: false

concur-react/HLint.hs

@@ -0,0 +1,2 @@
+import "hint" HLint.Default
+import "hint" HLint.Builtin.All

concur-react/LICENSE

@@ -0,0 +1,30 @@
+Copyright (C) 2017 Anupam Jain
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Anupam Jain nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

concur-react/README.md

@@ -0,0 +1 @@
+# Concur - React backend

concur-react/build.sh

@@ -0,0 +1,3 @@
+#!/bin/bash
+browserify jsbits/concur.js | uglifyjs > jsbits/concur.compiled.js
+stack build --stack-yaml stack-ghcjs.yaml --no-nix

concur-react/concur-react.cabal

@@ -0,0 +1,91 @@
+name:                concur-react
+version:             0.1.0.0
+synopsis:            A client side web UI framework for Haskell. React bindings.
+description:         A client side web UI framework for Haskell. React bindings.
+homepage:            https://github.com/ajnsit/concur (concur-react)
+license:             BSD3
+license-file:        LICENSE
+author:              Anupam Jain
+maintainer:          [email protected]
+copyright:           2017 (C) All Rights Reserved.
+category:            Web
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+source-repository head
+  type:     git
+  location: https://github.com/ajnsit/concur
+
+flag warp
+    description: Build ghcjs-dom-hello-warp
+    default: True
+
+flag webkitgtk
+    description: Build ghcjs-dom-hello-webkitgtk
+    default: True
+
+flag webkit2gtk
+    description: Use WebKit2 version of WebKitGTK.
+    default: True
+
+library
+  js-sources:          jsbits/internal.js
+                     , jsbits/concur.compiled.js
+  ghc-options:         -Wall -ferror-spans
+  default-language:    Haskell2010
+  hs-source-dirs:      src
+  exposed-modules:     Concur.React
+                     , Concur.React.Attributes
+                     , Concur.React.FFI
+                     , Concur.React.Run
+                     , Concur.React.VDOM
+                     , Concur.React.Widgets
+                     , Concur.React.Internal
+  build-depends:       base >= 4.7 && < 5
+                     , mtl >= 2.2
+                     , transformers >= 0.5
+                     , stm >= 2.4
+                     , free >= 4.12
+                     , concur-core
+
+  --  build-depends:     jsaddle >=0.9.2 && <0.10
+  --                   , jsaddle-warp >=0.9.2 && <0.10
+  if impl(ghcjs)
+    build-depends:     ghcjs-base
+                     , ghcjs-prim
+                     , ghcjs-ffiqq
+
+  default-language:    Haskell2010
+
+
+executable concur-react-hello
+  ghc-options:         -Wall -ferror-spans
+  default-language:    Haskell2010
+  hs-source-dirs:      examples
+  main-is:             HiLo.hs
+  build-depends:       base >= 4.7 && < 5
+                     , mtl >= 2.2
+                     , transformers >= 0.5
+                     , stm >= 2.4
+                     , free >= 4.12
+                     , concur-core
+                     , concur-react
+                     , random
+  default-language:    Haskell2010
+
+  if impl(ghcjs)
+    build-depends:     ghcjs-base
+
+  -- Choose suitable runner
+  --if !impl(ghcjs)
+  --  if os(osx) || os(ios)
+  --    build-depends:
+  --      jsaddle-wkwebview >=0.9 && <0.10
+  --  else
+  --    if flag(webkit2gtk)
+  --      build-depends:
+  --        jsaddle-webkit2gtk >=0.9 && <0.10
+  --    else
+  --      build-depends:
+  --        jsaddle-webkitgtk >=0.9 && <0.10

concur-react/examples/HiLo.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import           Control.Applicative    ((<|>))
+import           Control.Monad          (forever)
+import           Control.Monad.IO.Class (liftIO)
+
+import           System.Random          as R
+import           Text.Read              (readMaybe)
+
+import           Concur.Core
+import           Concur.React
+
+-- Hi/Lo Game. Demonstrates simple architecture of a Concur app.
+-- Also a good demonstration of how Concur makes IO effects safe at widget transitions (the random number generation).
+main :: IO ()
+main = runWidgetInBody $ forever $ do
+  el_ "h1" [] (text "I'm thinking of a number between 1 and 100")
+  <|> (liftIO (R.randomRIO (1,100)) >>= go)
+  where
+    go :: Int -> Widget HTML ()
+    go n = do
+      guessStr <- el "div" []
+        [ text "Try to guess: "
+        , inputEnter [vattr "autoFocus" ""] -- [Attribute "autofocus" ""]
+        ]
+      case readMaybe guessStr of
+        Nothing -> go n
+        Just guess -> do
+          if | guess <  n -> el_ "div" [] (text $ show guess ++ " - Go High!") <|> go n
+             | guess >  n -> el_ "div" [] (text $ show guess ++ " - Go Low!") <|> go n
+             | otherwise  -> el_ "div" [] (text $ "You guessed it! The answer was " ++ show n)
+                 <|> (button [] (text "Play again"))

concur-react/jsbits/concur.js

@@ -0,0 +1,12 @@
+global.h$concur = {
+    React: require('react'),
+    ReactDOM: require('react-dom'),
+    makeHandler: function(action, async) {
+      var f = function(ev) {
+        return h$concurEventCallback(async, action, ev);
+      };
+      // TODO: Handle cleanup
+      f.hsAction = action;
+      return f;
+    }
+};

concur-react/jsbits/internal.js

@@ -0,0 +1,10 @@
+#include <ghcjs/rts.h>
+
+function h$concurEventCallback(async, action, ev) {
+    var a = MK_AP1(action, MK_JSVAL(ev));
+    if(async) {
+        h$run(a);
+    } else {
+        h$runSync(a, true);
+    }
+}

concur-react/package.json

@@ -0,0 +1,16 @@
+{
+  "name": "concur-react",
+  "version": "0.1.0",
+  "description": "React bindings to the Concur UI lib",
+  "main": "index.js",
+  "scripts": {
+    "test": "exit 0",
+    "build": "browserify jsbits/index.js | uglifyjs > jsbits/lib.js"
+  },
+  "author": "Anupam Jain",
+  "license": "BSD3",
+  "dependencies": {
+    "react": "^15.6.1",
+    "react-dom": "^15.6.1"
+  }
+}

concur-react/src/Concur/React.hs

@@ -0,0 +1,8 @@
+module Concur.React
+  ( module X
+  ) where
+
+import Concur.React.VDOM as X
+import Concur.React.Attributes as X
+import Concur.React.Widgets as X
+import Concur.React.Run as X