Liberate el functions from React

Author: ajnsit

src/Concur/Core.purs

@@ -6,6 +6,8 @@ module Concur.Core
 )
 where
 
+import Prelude (class Monoid, Unit, bind, map, pure, show, void, ($), (<<<), (<>))
+
 import Concur.Core.Discharge (discharge)
 import Concur.Core.Types (Widget(..), WidgetStep(..), resume, unWidget)
 import Concur.Core.LiftWidget (class LiftWidget, liftWidget)
@@ -20,7 +22,6 @@ import Effect.AVar (empty, tryPut) as EVar
 import Effect.Aff.AVar (take) as AVar
 import Effect.Aff.Class (liftAff)
 import Effect.Console (log)
-import Prelude (class Monoid, Unit, bind, map, pure, show, void, ($), (<<<), (<>))
 
 -- Helpers for some very common use of unsafe blocking io
 

src/Concur/Core/DOM.purs

@@ -0,0 +1,40 @@
+module Concur.Core.DOM where
+
+import Concur.Core (mkLeafWidget, wrapViewEvent)
+import Concur.Core.LiftWidget (class LiftWidget, liftWidget)
+import Concur.Core.Props (Props, mkProp)
+import Concur.Core.Types (Widget)
+import Control.MultiAlternative (class MultiAlternative, orr)
+import Control.ShiftMap (class ShiftMap, shiftMap)
+import Data.Function (($), (<<<))
+import Data.Functor (map)
+
+-- | Wrap a single widget with a node that can have eventHandlers attached
+el
+  :: forall m a p v
+  .  ShiftMap (Widget (Array v)) m
+  => (Array p -> Array v -> Array v)
+  -> Array (Props p a)
+  -> m a
+  -> m a
+el e props = shiftMap (\f w -> wrapViewEvent (\h v -> (e (map (mkProp h <<< map f) props) v)) w)
+
+-- | Promote a leaf node to a widget
+elLeaf
+  :: forall p v m a
+  .  LiftWidget (Array v) m
+  => (Array p -> Array v)
+  -> Array (Props p a)
+  -> m a
+elLeaf e props = liftWidget $ mkLeafWidget \h -> e (map (mkProp h) props)
+
+-- | Wrap some widgets with a node that can have eventHandlers attached
+el'
+  :: forall m a p v
+  .  ShiftMap (Widget (Array v)) m
+  => MultiAlternative m
+  => (Array p -> Array v -> Array v)
+  -> Array (Props p a)
+  -> Array (m a)
+  -> m a
+el' e props = el e props <<< orr

src/Concur/React.purs

@@ -2,64 +2,16 @@ module Concur.React where
 
 import Prelude
 
-import Concur.Core (mkLeafWidget, wrapViewEvent)
 import Concur.Core.Discharge (discharge, dischargePartialEffect)
-import Concur.Core.LiftWidget (class LiftWidget, liftWidget)
-import Concur.Core.Props (mkProp)
 import Concur.Core.Types (Widget)
-import Concur.React.Props (ReactProps)
-import Control.MultiAlternative (class MultiAlternative, orr)
-import Control.ShiftMap (class ShiftMap, shiftMap)
 import Data.Either (Either(..))
 import Data.Tuple (Tuple(..))
 import Effect.Console (log)
 import React as R
-import React.DOM.Props as P
 
 type HTML
   = Array R.ReactElement
 
-type NodeName
-  = Array R.ReactElement -> R.ReactElement
-
-type NodeTag
-  = Array P.Props -> Array R.ReactElement -> R.ReactElement
-
-type LeafTag
-  = Array P.Props -> R.ReactElement
-
--- | Wrap a widget with a node that can have eventHandlers attached
-el ::
-  forall m a.
-  ShiftMap (Widget HTML) m =>
-  NodeTag ->
-  Array (ReactProps a) ->
-  m a ->
-  m a
-el e props = shiftMap (\f w -> wrapViewEvent (\h v ->
-  [e (map (mkProp h <<< map f) props) v]) w)
-
--- | Promote a leaf node to a widget
-elLeaf ::
-  forall m a.
-  LiftWidget HTML m =>
-  LeafTag ->
-  Array (ReactProps a) ->
-  m a
-elLeaf e props = liftWidget $ mkLeafWidget \h ->
-  [e (map (mkProp h) props)]
-
--- | Wrap some widgets with a node that can have eventHandlers attached
-el' ::
-  forall m a.
-  ShiftMap (Widget HTML) m =>
-  MultiAlternative m =>
-  NodeTag ->
-  Array (ReactProps a) ->
-  Array (m a) ->
-  m a
-el' e props = el e props <<< orr
-
 -- React apparently requires wrapping state inside an object
 type ComponentState
   = {view :: HTML}

src/Concur/React/DOM.purs

@@ -2,14 +2,50 @@ module Concur.React.DOM where
 
 import Prelude hiding (div,map,sub)
 
+import Concur.Core.DOM (el, el', elLeaf) as CD
 import Concur.Core.LiftWidget (class LiftWidget, liftWidget)
+import Concur.Core.Props (Props)
 import Concur.Core.Types (Widget, display)
-import Concur.React (HTML, el, el', elLeaf)
+import Concur.React (HTML)
 import Concur.React.Props (ReactProps)
 import Control.MultiAlternative (class MultiAlternative)
 import Control.ShiftMap (class ShiftMap)
 import React.DOM as D
 
+-- The signature of el, el', and elLeaf changed recently
+viewAdapter
+  :: forall ps vs res
+  .  (ps -> vs -> res)
+  -> (ps -> vs -> Array res)
+viewAdapter f = \ps vs -> [f ps vs]
+
+el
+  :: forall m a p v
+  .  ShiftMap (Widget (Array v)) m
+  => (Array p -> Array v -> v)
+  -> Array (Props p a)
+  -> m a
+  -> m a
+el f = CD.el (viewAdapter f)
+
+el'
+  :: forall m a p v
+  .  ShiftMap (Widget (Array v)) m
+  => MultiAlternative m
+  => (Array p -> Array v -> v)
+  -> Array (Props p a)
+  -> Array (m a)
+  -> m a
+el' f = CD.el' (viewAdapter f)
+
+elLeaf
+  :: forall p v m a
+  .  LiftWidget (Array v) m
+  => (Array p -> v)
+  -> Array (Props p a)
+  -> m a
+elLeaf f = CD.elLeaf (pure <<< f)
+
 -- Wrappers for all DOM elements from purescript-react
 -- TODO: Generate these mechanically somehow
 type El1

src/Concur/React/SVG.purs

@@ -1,15 +1,12 @@
 module Concur.React.SVG where
 
-import Prelude hiding (div, map, sub)
-
-import Concur.React (el')
-import Concur.React.DOM (El, El')
+import Prelude hiding (div,map,sub)
 
+import Concur.React.DOM (El, El', el')
 import React.DOM.SVG as S
 
 -------------------------------------------------------------------------------------------------------------------
-circle ::
-  El
+circle :: El
 circle = el' S.circle
 
 circle' :: El'