Tidying and refactoring (#4)

Author: robertdp

spago.dhall

@@ -6,7 +6,7 @@ You can edit this file as you like.
 , license = "BSD-3-Clause"
 , repository = "https://github.com/robertdp/purescript-react-halo.git"
 , dependencies =
-  [ "aff", "free", "freeap", "react-basic-hooks", "wire" ]
+  [ "aff", "free", "freeap", "react-basic-hooks", "refs", "wire" ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs" ]
 }

src/React/Halo/Internal/Control.purs

@@ -11,7 +11,6 @@ import Control.Monad.Trans.Class (class MonadTrans, lift)
 import Control.Monad.Writer (class MonadTell, tell)
 import Control.Parallel (class Parallel)
 import Data.Bifunctor (lmap)
-import Data.Newtype (class Newtype, over)
 import Data.Tuple (Tuple)
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
@@ -90,13 +89,13 @@ instance monadRecHaloM :: MonadRec (HaloM props state action m) where
           Done y -> pure y
 
 instance monadAskHaloM :: MonadAsk r m => MonadAsk r (HaloM props state action m) where
-  ask = HaloM $ liftF $ Lift ask
+  ask = lift ask
 
 instance monadTellHaloM :: MonadTell w m => MonadTell w (HaloM props state action m) where
-  tell = HaloM <<< liftF <<< Lift <<< tell
+  tell = lift <<< tell
 
 instance monadThrowHaloM :: MonadThrow e m => MonadThrow e (HaloM props state action m) where
-  throwError = HaloM <<< liftF <<< Lift <<< throwError
+  throwError = lift <<< throwError
 
 -- | The Halo parallel evaluation applicative. It lifts `HaloM` into a free applicative.
 -- |
@@ -108,8 +107,6 @@ instance monadThrowHaloM :: MonadThrow e m => MonadThrow e (HaloM props state ac
 newtype HaloAp props state action m a
   = HaloAp (FreeAp (HaloM props state action m) a)
 
-derive instance newtypeHaloAp :: Newtype (HaloAp props state action m a) _
-
 derive newtype instance functorHaloAp :: Functor (HaloAp props state action m)
 
 derive newtype instance applyHaloAp :: Apply (HaloAp props state action m)
@@ -131,10 +128,14 @@ hoist nat (HaloM component) = HaloM (hoistFree go component)
     Subscribe event k -> Subscribe event k
     Unsubscribe sid a -> Unsubscribe sid a
     Lift m -> Lift (nat m)
-    Par par -> Par (over HaloAp (hoistFreeAp (hoist nat)) par)
+    Par par -> Par (hoistAp nat par)
     Fork m k -> Fork (hoist nat m) k
     Kill fid a -> Kill fid a
 
+-- | Hoist (transform) the base applicative of a `HaloAp` expression.
+hoistAp :: forall props state action m m'. Functor m => (m ~> m') -> HaloAp props state action m ~> HaloAp props state action m'
+hoistAp nat (HaloAp component) = HaloAp (hoistFreeAp (hoist nat) component)
+
 -- | Read the current props.
 props :: forall props m action state. HaloM props state action m props
 props = HaloM (liftF (Props identity))

src/React/Halo/Internal/Eval.purs

@@ -1,17 +1,16 @@
 module React.Halo.Internal.Eval where
 
 import Prelude
-import Control.Applicative.Free (hoistFreeAp, retractFreeAp)
+import Control.Applicative.Free (foldFreeAp)
 import Control.Monad.Free (foldFree)
 import Data.Either (either)
 import Data.Foldable (sequence_, traverse_)
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
-import Effect.Aff (Aff, finally, parallel, sequential, throwError)
+import Effect.Aff (Aff, ParAff, finally, parallel, sequential, throwError)
 import Effect.Aff as Aff
-import Effect.Aff.Class (liftAff)
 import Effect.Class (liftEffect)
 import Effect.Ref as Ref
 import React.Halo.Internal.Control (HaloAp(..), HaloF(..), HaloM(..))
@@ -21,9 +20,13 @@ import React.Halo.Internal.Types (ForkId(..), Lifecycle(..), SubscriptionId(..))
 import Unsafe.Reference (unsafeRefEq)
 import Wire.Event as Event
 
--- | Interprets `HaloM` into the base monad `Aff`.
+-- | Interprets `HaloM` into the base monad `Aff` for asynchronous effects.
 evalHaloM :: forall props state action. HaloState props state action -> HaloM props state action Aff ~> Aff
-evalHaloM hs@(HaloState s) (HaloM halo) = foldFree (evalHaloF hs) halo
+evalHaloM hs (HaloM halo) = foldFree (evalHaloF hs) halo
+
+-- | Interprets `HaloAp` into the base applicative `ParAff` for parallel effects.
+evalHaloAp :: forall props state action. HaloState props state action -> HaloAp props state action Aff ~> ParAff
+evalHaloAp hs (HaloAp halo) = foldFreeAp (parallel <<< evalHaloM hs) halo
 
 -- | Interprets `HaloF` into the base monad `Aff`, keeping track of state in `HaloState`.
 evalHaloF :: forall props state action. HaloState props state action -> HaloF props state action Aff ~> Aff
@@ -54,8 +57,8 @@ evalHaloF hs@(HaloState s) = case _ of
       canceller <- Map.lookup sid <$> Ref.read s.subscriptions
       sequence_ canceller
       pure a
-  Lift m -> liftAff m
-  Par (HaloAp p) -> sequential $ retractFreeAp $ hoistFreeAp (parallel <<< evalHaloM hs) p
+  Lift m -> m
+  Par p -> sequential (evalHaloAp hs p)
   Fork fh k ->
     liftEffect do
       fid <- State.fresh ForkId hs

test/Main.purs

@@ -52,7 +52,7 @@ runPropsTests = do
         initialProps = { value: "" }
 
         expect x = liftEffect (Ref.read count) >>= shouldEqual x
-      state <- State.createInitialState { props: initialProps, initialState: unit, eval, update: mempty }
+      state <- State.createInitialState { props: initialProps, state: unit, eval, update: mempty }
       Eval.runInitialize state
       pure { state, initialProps, expect }
 
@@ -88,7 +88,7 @@ runStateTests = do
         eval = case _ of
           Halo.Action f -> Halo.modify_ f
           _ -> pure unit
-      state <- State.createInitialState { props: unit, initialState, eval, update }
+      state <- State.createInitialState { props: unit, state: initialState, eval, update }
       Eval.runInitialize state
       let
         modify = liftEffect <<< Eval.handleAction state
@@ -106,7 +106,7 @@ runParallelismTests = do
         state <-
           State.createInitialState
             { props: unit
-            , initialState: 0
+            , state: 0
             , update: \x -> Ref.write (Just x) internalState
             , eval:
                 \_ -> do