diff --git a/bower.json b/bower.json index 5fd0e6b..5d9a7c9 100644 --- a/bower.json +++ b/bower.json @@ -16,9 +16,8 @@ "!src/**/*" ], "dependencies": { - "purescript-react": "^3.0.0", - "purescript-monoid": "^3.1.0", - "purescript-strings": "^3.3.1", - "purescript-nullable": "^3.0.0" + "purescript-react": "^6.0.0", + "purescript-strings": "^4.0.0", + "purescript-nullable": "^4.0.0" } } diff --git a/src/React/Redux.purs b/src/React/Redux.purs index d7efb1e..1443387 100644 --- a/src/React/Redux.purs +++ b/src/React/Redux.purs @@ -15,11 +15,13 @@ module React.Redux import Prelude -import Control.Monad.Eff (Eff, kind Effect) -import Control.Monad.Eff.Uncurried (EffFn3, runEffFn3) +import Effect (Effect) +import Effect.Uncurried (EffectFn3, runEffectFn3) import Data.Function.Uncurried (Fn2, Fn3, Fn4, mkFn2, mkFn3, runFn4) +import Prim.Row (class Union) + import Unsafe.Coerce (unsafeCoerce) import React as React @@ -27,9 +29,7 @@ import React.Redux.Internal as Internal import React.Redux.Middleware (Middleware, MiddlewareAPI) as Redux import React.Redux.Reducer (reducerFlipped) as Redux import React.Redux.Types - ( REDUX - , ReduxEffect - , Reducer + ( Reducer , BaseDispatch , Dispatch , ReduxAction @@ -66,12 +66,12 @@ type ConnectOptions state stateProps ownProps props options -- | Redux will invoke the mapping functions whenever the connected -- | class receives updated `ownProps`. connect - :: forall eff state action stateProps dispatchProps ownProps stateDispatchProps props options options' options'' + :: forall state action stateProps dispatchProps ownProps stateDispatchProps props options options' options'' . Union stateProps dispatchProps stateDispatchProps => Union stateDispatchProps ownProps props => Union options options'' (ConnectOptions state stateProps ownProps props options') => (Record state -> Record ownProps -> Record stateProps) - -> (Redux.BaseDispatch eff action -> Record ownProps -> Record dispatchProps) + -> (Redux.BaseDispatch action -> Record ownProps -> Record dispatchProps) -> Record options -> React.ReactClass (Record props) -> ConnectClass (Record state) (Record ownProps) (Record props) action @@ -84,12 +84,12 @@ connect stateToProps dispatchToProps options = -- | Redux connect function that does not depend on `ownProps`. connect_ - :: forall eff state action stateProps dispatchProps props options options' options'' + :: forall state action stateProps dispatchProps props options options' options'' . Union stateProps dispatchProps props => Union props () props => Union options options'' (ConnectOptions state stateProps () props options') => (Record state -> Record stateProps) - -> (Redux.BaseDispatch eff action -> Record dispatchProps) + -> (Redux.BaseDispatch action -> Record dispatchProps) -> Record options -> React.ReactClass (Record props) -> ConnectClass' (Record state) (Record props) action @@ -117,9 +117,9 @@ createElement -> Array React.ReactElement -> React.ReactElement createElement reduxClass = - React.createElement reactClass + React.unsafeCreateElement reactClass where - reactClass :: React.ReactClass (Record ownProps) + reactClass :: React.ReactClass (Record (children :: React.Children | ownProps)) reactClass = unsafeCoerce reduxClass createElement_ @@ -130,62 +130,62 @@ createElement_ createElement_ reduxClass = createElement reduxClass { } createProviderElement - :: forall eff state action - . Redux.ReduxStore eff state action + :: forall state action + . Redux.ReduxStore state action -> Array React.ReactElement -> React.ReactElement createProviderElement store = React.createElement reduxProviderClass { store } applyMiddleware - :: forall eff state action result - . Array (Redux.Middleware eff state action action result) - -> Redux.ReduxStoreEnhancer eff state action + :: forall state action result + . Array (Redux.Middleware state action action result) + -> Redux.ReduxStoreEnhancer state action applyMiddleware = reduxApplyMiddleware <<< map Internal.middlewareToReduxMiddleware createStore - :: forall eff state action + :: forall state action . Redux.Reducer action state -> state - -> Redux.ReduxStoreEnhancer eff state action - -> Eff (Redux.ReduxEffect eff) (Redux.ReduxStore eff state action) -createStore reducer = runEffFn3 reduxCreateStore (Internal.reducerToReduxReducer reducer) + -> Redux.ReduxStoreEnhancer state action + -> Effect (Redux.ReduxStore state action) +createStore reducer = runEffectFn3 reduxCreateStore (Internal.reducerToReduxReducer reducer) createStore' - :: forall eff state action + :: forall state action . Redux.Reducer action state -> state - -> Eff (Redux.ReduxEffect eff) (Redux.ReduxStore eff state action) -createStore' reducer state = createStore reducer state id + -> Effect (Redux.ReduxStore state action) +createStore' reducer state = createStore reducer state identity foreign import reduxApplyMiddleware - :: forall eff state action a b - . Array (Redux.ReduxMiddleware eff state action a b) - -> Redux.ReduxStoreEnhancer eff state action + :: forall state action a b + . Array (Redux.ReduxMiddleware state action a b) + -> Redux.ReduxStoreEnhancer state action foreign import reduxCreateStore - :: forall eff state action - . EffFn3 (Redux.ReduxEffect eff) - (Redux.ReduxReducer state action) - state - (Redux.ReduxStoreEnhancer eff state action) - (Redux.ReduxStore eff state action) + :: forall state action + . EffectFn3 + (Redux.ReduxReducer state action) + state + (Redux.ReduxStoreEnhancer state action) + (Redux.ReduxStore state action) foreign import reduxProviderClass - :: forall eff state action - . React.ReactClass { store :: Redux.ReduxStore eff state action } + :: forall state action + . React.ReactClass { children :: React.Children, store :: Redux.ReduxStore state action } foreign import reduxConnect - :: forall eff state action stateProps dispatchProps ownProps props options + :: forall state action stateProps dispatchProps ownProps props options . Fn4 (Fn2 (Record state) (Record ownProps) (Record stateProps)) - (Fn2 (Redux.ReduxDispatch eff action action) (Record ownProps) (Record dispatchProps)) + (Fn2 (Redux.ReduxDispatch action action) (Record ownProps) (Record dispatchProps)) (Fn3 (Record stateProps) (Record dispatchProps) (Record ownProps) (Record props)) (Record options) (React.ReactClass (Record props) -> ConnectClass (Record state) (Record ownProps) (Record props) action) foreign import reduxConnect_ - :: forall eff state action stateProps dispatchProps props options + :: forall state action stateProps dispatchProps props options . Fn4 (Record state -> Record stateProps) - (Redux.ReduxDispatch eff action action -> Record dispatchProps) + (Redux.ReduxDispatch action action -> Record dispatchProps) (Fn3 (Record stateProps) (Record dispatchProps) { } (Record props)) (Record options) (React.ReactClass (Record props) -> ConnectClass' (Record state) (Record props) action) diff --git a/src/React/Redux/Internal.purs b/src/React/Redux/Internal.purs index 7d03a0b..abf4f18 100644 --- a/src/React/Redux/Internal.purs +++ b/src/React/Redux/Internal.purs @@ -2,7 +2,7 @@ module React.Redux.Internal where import Prelude -import Control.Monad.Eff.Uncurried (mkEffFn1, runEffFn1) +import Effect.Uncurried (mkEffectFn1, runEffectFn1) import Data.Function.Uncurried (mkFn2, runFn2) import Data.Maybe (Maybe, fromMaybe, maybe) @@ -49,32 +49,32 @@ reduxReducerToReducer reduxReducer = wrap (flip (runFn2 reduxReducer) <<< action reducerToReduxReducer :: forall state action. Reducer action state -> ReduxReducer state action reducerToReduxReducer reducer = mkFn2 \state -> maybe state (flip (unwrap reducer) state) <<< toMaybe <<< reduxActionToAction -reduxBaseDispatchToBaseDispatch :: forall eff action. ReduxBaseDispatch eff action -> BaseDispatch eff action -reduxBaseDispatchToBaseDispatch = (>>>) actionToReduxAction <<< (<<<) (map reduxActionToAction) <<< runEffFn1 +reduxBaseDispatchToBaseDispatch :: forall action. ReduxBaseDispatch action -> BaseDispatch action +reduxBaseDispatchToBaseDispatch = (>>>) actionToReduxAction <<< (<<<) (map reduxActionToAction) <<< runEffectFn1 -reduxDispatchToDispatch :: forall eff action result. ReduxDispatch eff action result -> Dispatch eff action result -reduxDispatchToDispatch = (>>>) actionToReduxAction <<< runEffFn1 +reduxDispatchToDispatch :: forall action result. ReduxDispatch action result -> Dispatch action result +reduxDispatchToDispatch = (>>>) actionToReduxAction <<< runEffectFn1 -baseDispatchToReduxBaseDispatch :: forall eff action. Dispatch eff action action -> ReduxBaseDispatch eff action -baseDispatchToReduxBaseDispatch = mkEffFn1 <<< (>>>) reduxActionToAction <<< (<<<) (map actionToReduxAction) +baseDispatchToReduxBaseDispatch :: forall action. Dispatch action action -> ReduxBaseDispatch action +baseDispatchToReduxBaseDispatch = mkEffectFn1 <<< (>>>) reduxActionToAction <<< (<<<) (map actionToReduxAction) -dispatchToReduxDispatch :: forall eff action result. Dispatch eff action result -> ReduxDispatch eff action result -dispatchToReduxDispatch = mkEffFn1 <<< (>>>) reduxActionToAction +dispatchToReduxDispatch :: forall action result. Dispatch action result -> ReduxDispatch action result +dispatchToReduxDispatch = mkEffectFn1 <<< (>>>) reduxActionToAction -reduxMiddlewareApiToMiddlewareApi :: forall eff state action. ReduxMiddlewareAPI eff state action -> MiddlewareAPI eff state action +reduxMiddlewareApiToMiddlewareApi :: forall state action. ReduxMiddlewareAPI state action -> MiddlewareAPI state action reduxMiddlewareApiToMiddlewareApi { getState, dispatch } = { getState, dispatch: reduxBaseDispatchToBaseDispatch dispatch } -middlewareApiToReduxMiddlewareApi :: forall eff state action. MiddlewareAPI eff state action -> ReduxMiddlewareAPI eff state action +middlewareApiToReduxMiddlewareApi :: forall state action. MiddlewareAPI state action -> ReduxMiddlewareAPI state action middlewareApiToReduxMiddlewareApi { getState, dispatch } = { getState, dispatch: baseDispatchToReduxBaseDispatch dispatch } -reduxMiddlewareToMiddleware :: forall eff state action a b. ReduxMiddleware eff state action a b -> Middleware eff state action a b +reduxMiddlewareToMiddleware :: forall state action a b. ReduxMiddleware state action a b -> Middleware state action a b reduxMiddlewareToMiddleware reduxMiddleware = wrap $ \middlewareApi dispatch -> reduxDispatchToDispatch (reduxMiddleware (middlewareApiToReduxMiddlewareApi middlewareApi) (dispatchToReduxDispatch dispatch)) -middlewareToReduxMiddleware :: forall eff state action a b. Middleware eff state action a b -> ReduxMiddleware eff state action a b +middlewareToReduxMiddleware :: forall state action a b. Middleware state action a b -> ReduxMiddleware state action a b middlewareToReduxMiddleware middleware reduxMiddlewareApi = reduxMiddleware where - middleware' :: Dispatch eff action a -> Dispatch eff action b + middleware' :: Dispatch action a -> Dispatch action b middleware' = unwrap middleware (reduxMiddlewareApiToMiddlewareApi reduxMiddlewareApi) - reduxMiddleware :: ReduxDispatch eff action a -> ReduxDispatch eff action b + reduxMiddleware :: ReduxDispatch action a -> ReduxDispatch action b reduxMiddleware = dispatchToReduxDispatch <<< middleware' <<< reduxDispatchToDispatch diff --git a/src/React/Redux/Middleware.purs b/src/React/Redux/Middleware.purs index ab3cf62..4767808 100644 --- a/src/React/Redux/Middleware.purs +++ b/src/React/Redux/Middleware.purs @@ -2,32 +2,31 @@ module React.Redux.Middleware where import Prelude -import Control.Monad.Eff (Eff) +import Effect (Effect) -import Data.Monoid (class Monoid, mempty) import Data.Newtype (class Newtype, unwrap) -import React.Redux.Types (ReduxEffect, Dispatch) +import React.Redux.Types (Dispatch) -type MiddlewareAPI eff state action - = { getState :: Eff (ReduxEffect eff) state - , dispatch :: Dispatch eff action action +type MiddlewareAPI state action + = { getState :: Effect state + , dispatch :: Dispatch action action } -newtype Middleware eff state action a b = Middleware (MiddlewareAPI eff state action -> Dispatch eff action a -> Dispatch eff action b) +newtype Middleware state action a b = Middleware (MiddlewareAPI state action -> Dispatch action a -> Dispatch action b) -derive instance newtypeMiddleware :: Newtype (Middleware eff state action a b) _ +derive instance newtypeMiddleware :: Newtype (Middleware state action a b) _ -instance semigroupoidMiddleware :: Semigroupoid (Middleware eff state action) where +instance semigroupoidMiddleware :: Semigroupoid (Middleware state action) where compose (Middleware f) (Middleware g) = Middleware (\api -> f api <<< g api) -instance categoryMiddleware :: Category (Middleware eff state action) where - id = Middleware (const id) +instance categoryMiddleware :: Category (Middleware state action) where + identity = Middleware (const identity) -instance functorMiddleware :: Functor (Middleware eff state action a) where +instance functorMiddleware :: Functor (Middleware state action a) where map f (Middleware g) = Middleware (\api next action -> f <$> g api next action) -instance applyMiddleware :: Apply (Middleware eff state action a) where +instance applyMiddleware :: Apply (Middleware state action a) where apply (Middleware f) (Middleware g) = Middleware $ \api next action -> do a <- g api next action @@ -36,19 +35,19 @@ instance applyMiddleware :: Apply (Middleware eff state action a) where pure (k a) -instance applicativeMiddleware :: Applicative (Middleware eff state action a) where +instance applicativeMiddleware :: Applicative (Middleware state action a) where pure a = Middleware (\_ _ _ -> pure a) -instance bindMiddleware :: Bind (Middleware eff state action a) where +instance bindMiddleware :: Bind (Middleware state action a) where bind (Middleware m) f = Middleware $ \api next action -> do a <- m api next action unwrap (f a) api next action -instance monadMiddleware :: Monad (Middleware eff state action a) +instance monadMiddleware :: Monad (Middleware state action a) -instance semigroupMiddleware :: Semigroup b => Semigroup (Middleware eff state action a b) where +instance semigroupMiddleware :: Semigroup b => Semigroup (Middleware state action a b) where append (Middleware f) (Middleware g) = Middleware $ \api next action -> do b1 <- f api next action @@ -57,5 +56,5 @@ instance semigroupMiddleware :: Semigroup b => Semigroup (Middleware eff state a pure (b1 <> b2) -instance monoidMiddleware :: Monoid b => Monoid (Middleware eff state action a b) where +instance monoidMiddleware :: Monoid b => Monoid (Middleware state action a b) where mempty = Middleware (const (const (const (pure mempty)))) diff --git a/src/React/Redux/Reducer.purs b/src/React/Redux/Reducer.purs index c945ff5..379f76a 100644 --- a/src/React/Redux/Reducer.purs +++ b/src/React/Redux/Reducer.purs @@ -2,7 +2,6 @@ module React.Redux.Reducer where import Prelude -import Data.Monoid (class Monoid, mempty) import Data.Newtype (class Newtype, wrap, unwrap) newtype Reducer action state state' = Reducer (action -> state -> state') @@ -13,7 +12,7 @@ instance semigroupoidReducer :: Semigroupoid (Reducer action) where compose (Reducer f) (Reducer g) = Reducer (\action -> f action <<< g action) instance categoryReducer :: Category (Reducer action) where - id = Reducer (const id) + identity = Reducer (const identity) instance functorReducer :: Functor (Reducer action state) where map f (Reducer g) = Reducer ((<<<) f <<< g) diff --git a/src/React/Redux/Types.purs b/src/React/Redux/Types.purs index f1268cd..3628c1a 100644 --- a/src/React/Redux/Types.purs +++ b/src/React/Redux/Types.purs @@ -2,28 +2,22 @@ module React.Redux.Types where import Prelude -import Control.Monad.Eff (kind Effect, Eff) -import Control.Monad.Eff.Uncurried (EffFn1) +import Effect (Effect) +import Effect.Uncurried (EffectFn1) import Data.Function.Uncurried (Fn2) import Data.Nullable (Nullable) import React.Redux.Reducer as Reducer --- | Effect type for Redux. -foreign import data REDUX :: Effect - --- | Convenience type alias for the Redux effect. -type ReduxEffect eff = (redux :: REDUX | eff) - -- | Reducer that does not change the type of the `state`. type Reducer action state = Reducer.Reducer action state state -- | Dispatching function that returns the action it was passed. -type BaseDispatch eff action = Dispatch eff action action +type BaseDispatch action = Dispatch action action -- | Dispatching function that returns a `result` type given an action. -type Dispatch eff action result = action -> Eff (ReduxEffect eff) result +type Dispatch action result = action -> Effect result -- | Redux actions must be a record with a `type` field. type ReduxAction r = { type :: String | r } @@ -35,30 +29,30 @@ type ReduxAction' action = ReduxAction (action :: action) type ReduxReducer state action = Fn2 state (ReduxAction' (Nullable action)) state -- | The `ReduxBaseDispatch` is the dispatching function provided to the store without any middleware. -type ReduxBaseDispatch eff action = EffFn1 (ReduxEffect eff) (ReduxAction' action) (ReduxAction' action) +type ReduxBaseDispatch action = EffectFn1 (ReduxAction' action) (ReduxAction' action) -- | Allows `ReduxMiddleware` to wrap the `ReduxBaseDispatch` function to return a different result to be passed to the next `ReduxMiddleware`. -type ReduxDispatch eff action result = EffFn1 (ReduxEffect eff) (ReduxAction' action) result +type ReduxDispatch action result = EffectFn1 (ReduxAction' action) result -- | Simplified `Store` representation passed to each middleware. -type ReduxMiddlewareAPI eff state action - = { dispatch :: ReduxBaseDispatch eff action - , getState :: Eff (ReduxEffect eff) state +type ReduxMiddlewareAPI state action + = { dispatch :: ReduxBaseDispatch action + , getState :: Effect state } -- | Function that composes dispatch functions. Purposely restricted to dispatching `action` types here. -type ReduxMiddleware eff state action a b = ReduxMiddlewareAPI eff state action -> ReduxDispatch eff action a -> ReduxDispatch eff action b +type ReduxMiddleware state action a b = ReduxMiddlewareAPI state action -> ReduxDispatch action a -> ReduxDispatch action b -- | Foreign Redux store creator function. -foreign import data ReduxStoreCreator :: # Effect -> Type -> Type -> Type +foreign import data ReduxStoreCreator :: Type -> Type -> Type -- | Type alias for a foreign Redux store enhancer, taking a `ReduxStoreCreator` and returning a `ReduxStoreCreator`. -type ReduxStoreEnhancer eff state action = ReduxStoreCreator eff state action -> ReduxStoreCreator eff state action +type ReduxStoreEnhancer state action = ReduxStoreCreator state action -> ReduxStoreCreator state action -- | Type alias for a foreign `ReduxStore` -type ReduxStore eff state action - = { dispatch :: ReduxBaseDispatch eff action - , getState :: Eff (ReduxEffect eff) state - , subscribe :: Eff (ReduxEffect eff) Unit -> Eff (ReduxEffect eff) Unit - , replaceReducer :: EffFn1 (ReduxEffect eff) (ReduxReducer state action) Unit +type ReduxStore state action + = { dispatch :: ReduxBaseDispatch action + , getState :: Effect state + , subscribe :: Effect Unit -> Effect Unit + , replaceReducer :: EffectFn1 (ReduxReducer state action) Unit }