Remove unsafeCoerce hacks! Fixes #15

package.json

@@ -12,7 +12,7 @@
   "scripts": {
     "test": "echo \"Error: no test specified\" && exit 1",
     "clean": "rimraf output && rimraf .pulp-cache && rimraf temp",
-    "build": "pulp build -- --censor-lib --strict",
+    "build": "pulp build -I examples -- --censor-lib --strict",
     "dev": "rimraf temp && bower install && pulp build -I examples && parcel build index.html",
     "prod": "rimraf temp && bower install && mkdir temp && pulp build --to temp/index.prod.js -I examples && java -jar closure-compiler/closure-compiler-v20190301.jar --js temp/index.prod.js --js_output_file temp/index.prod.minified.js && cp index.prod.html temp && parcel build temp/index.prod.html && rimraf temp",
     "prod1": "rimraf temp && bower install && mkdir temp && pulp build --to temp/index.prod.js -I examples && java -jar closure-compiler/closure-compiler-v20190301.jar --compilation_level ADVANCED_OPTIMIZATIONS --js temp/index.prod.js --js_output_file temp/index.prod.minified.js && cp index.prod.html temp && parcel build temp/index.prod.html && rimraf temp",

src/Concur/Core/Types.purs

@@ -68,7 +68,7 @@ instance widgetMonad :: Monad (Widget v)
 derive newtype instance widgetMonadRec :: MonadRec (Widget v)
 
 instance widgetShiftMap :: ShiftMap (Widget v) (Widget v) where
-  shiftMap = identity
+  shiftMap f = f identity
 
 -- Util
 flipEither ::

src/Concur/React.purs

@@ -14,7 +14,6 @@ import Data.Tuple (Tuple(..))
 import Effect.Console (log)
 import React as R
 import React.DOM.Props as P
-import Unsafe.Coerce (unsafeCoerce)
 
 type HTML
   = Array R.ReactElement
@@ -28,7 +27,6 @@ type NodeTag
 type LeafTag
   = Array P.Props -> R.ReactElement
 
--- BIG HACK! We use UnsafeCoerce to allow this to typecheck. This MIGHT cause RUNTIME errors! Verify!
 -- | Wrap a widget with a node that can have eventHandlers attached
 el ::
   forall m a.
@@ -37,8 +35,8 @@ el ::
   Array (Props a) ->
   m a ->
   m a
-el e props = shiftMap (wrapViewEvent \h v ->
-  [e (map (mkProp h) (unsafeCoerce props)) v])
+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 ::
@@ -48,7 +46,7 @@ elLeaf ::
   Array (Props a) ->
   m a
 elLeaf e props = liftWidget $ mkLeafWidget \h ->
-  [e (map (mkProp h) (unsafeCoerce props))]
+  [e (map (mkProp h) props)]
 
 -- | Wrap some widgets with a node that can have eventHandlers attached
 el' ::

src/Control/Cofree.purs

@@ -21,19 +21,18 @@ import Concur.Core.Types (Widget)
 import Control.Alternative (class Alternative, (<|>), empty)
 import Control.Comonad (class Comonad, extract)
 import Control.Extend (class Extend)
+import Control.Lazy as Z
 import Control.Monad.Free (Free, runFreeM)
 import Control.Monad.Rec.Class (class MonadRec)
 import Control.Monad.State (State, StateT(..), runState, runStateT, state)
 import Control.ShiftMap (class ShiftMap)
 import Data.Eq (class Eq1, eq1)
 import Data.Foldable (class Foldable, foldr, foldl, foldMap)
-import Data.Lazy (Lazy, force, defer)
+import Data.Lazy (Lazy, defer, force)
 import Data.Ord (class Ord1, compare1)
 import Data.Traversable (class Traversable, traverse)
 import Data.Tuple (Tuple(..), fst, snd)
 
-import Control.Lazy as Z
-
 -- | The `Cofree` `Comonad` for a functor.
 -- |
 -- | A value of type `Cofree f a` consists of an `f`-branching
@@ -221,5 +220,7 @@ instance lazyCofree :: Z.Lazy (Cofree f a) where
     let (Cofree t) = k unit
     in force t)
 
-instance shiftMapCofree :: ShiftMap (Widget v) (Cofree (Widget v)) where
-  shiftMap = hoistCofree
+instance shiftMapCofree :: Monoid v => ShiftMap (Widget v) (Cofree (Widget v)) where
+  shiftMap f (Cofree l) = deferCofree \_ ->
+    let Tuple a rest = force l
+    in Tuple a (f pure rest)

src/Control/ShiftMap.purs

@@ -2,28 +2,32 @@ module Control.ShiftMap where
 
 import Prelude
 
-import Control.Monad.Except (ExceptT, mapExceptT)
-import Control.Monad.RWS (RWST, mapRWST)
-import Control.Monad.Reader (ReaderT, mapReaderT)
-import Control.Monad.State (StateT, mapStateT)
-import Control.Monad.Writer (WriterT, mapWriterT)
-
--- | Mapping between Endo Natural Transformations
+import Control.Monad.Except.Trans (ExceptT(..))
+import Control.Monad.RWS.Trans (RWSResult(..), RWST(..))
+import Control.Monad.Reader.Trans (ReaderT(..))
+import Control.Monad.State.Trans (StateT(..))
+import Control.Monad.Writer.Trans (WriterT(..))
+import Data.Either (Either(..))
+import Data.Tuple (Tuple(..))
+
+-- | Avoiding monad-control for as long as possible
 class ShiftMap s t where
-  shiftMap :: (s ~> s) -> (t ~> t)
+  shiftMap :: forall a. (forall b. (a -> b) -> s b -> s b) -> t a -> t a
 
 -- Instances for common transformers
+-- It's not possible to use the `map*` functions anymore
+
 instance exceptShiftMap :: ShiftMap m (ExceptT e m) where
-  shiftMap = mapExceptT
+  shiftMap f (ExceptT m) = ExceptT do f Right m
 
-instance rwsShiftMap :: ShiftMap m (RWST r w s m) where
-  shiftMap = mapRWST
+instance rwsShiftMap :: Monoid w => ShiftMap m (RWST r w s m) where
+  shiftMap f (RWST g) = RWST \r s -> f (\a -> RWSResult s a mempty) (g r s)
 
 instance readerShiftMap :: ShiftMap m (ReaderT r m) where
-  shiftMap = mapReaderT
+  shiftMap f (ReaderT m) = ReaderT \r -> f identity (m r)
 
-instance stateShiftMap :: ShiftMap m (StateT s m) where
-  shiftMap = mapStateT
+instance stateShiftMap :: Monad m => ShiftMap m (StateT s m) where
+  shiftMap f (StateT g) = StateT \s -> f (\a -> Tuple a s) (g s)
 
-instance writerShiftMap :: ShiftMap m (WriterT s m) where
-  shiftMap = mapWriterT
+instance writerShiftMap :: Monoid w => ShiftMap m (WriterT w m) where
+  shiftMap f (WriterT m) = WriterT do f (\a -> Tuple a mempty) m