Redux bindings for PureScript

Redux.js

"use strict";

exports.baseStore = Redux.createStore.bind(Redux);

exports.getState = function getState(store) {
  return store.getState();
};

exports.mkReducer = function mkReducer(actionDict) {
  return function (f) {
    return function (state, envelopedAction) {
      if (envelopedAction.type === actionDict.actionType) {
        return f(state)(envelopedAction.payload);
      }
      else {
        return state;
      }
    };
  };
};

exports.captureFunctorDict = function captureFunctorDict(dict) {
  return function (proxy) {
    return dict;
  };
};

exports.focusReducerImpl =
  function focusReducerImpl(identityDict, lens, f) {

  return function (globalState, envelopedAction) {
    return lens
      (identityDict)
      (function (state) { return f(state, envelopedAction); })
      (globalState);
  };
};

exports.idReducer = function idReducer(state, envelopedAction) {
  return state;
};

exports.appendReducerImpl = function appendReducerImpl(f, g) {
  return function (state, envelopedAction) {
    return f(g(state, envelopedAction), envelopedAction);
  };
};

exports.connectImpl = function connectImpl(f, klass) {
  return ReactRedux.connect(
    function mapStateToProps(state, outerProps) {
      return state;
    },

    function mapDispatchToProps(dispatch, outerProps) {
      return { dispatch: dispatch };
    },

    function mergeProps(state, dispatch, outerProps) {
      return f(state)(tagAndDispatchWith(dispatch.dispatch))(outerProps);
    })(klass);
};

function tagAndDispatchWith(dispatch) {
  return function (actionDict) {
    return function (action) {
      return function () {
        dispatch({
          type: actionDict.actionType,
          payload: action
        });
      };
    };
  };
}

exports.liftDispatchEff = identity;

exports.liftDispatchAff = identity;

function identity(x) {
  return x;
}

exports.provideImpl = function provideImpl(store, e) {
  return React.createElement(ReactRedux.Provider, { store: store }, e);
};

exports.withMiddleware = Redux.applyMiddleware;

Redux.purs

module X.Redux
  ( Store
  , StoreCreator
  , createStore
  , baseStore

  , getState

  , Reducer
  , mkReducer
  , focusReducer

  , class Action
  , actionType

  , connect
  , connected
  , Dispatcher (..)
  , dispatchWith
  , liftDispatchEff
  , liftDispatchAff

  , WithReduxDispatch
  , ReduxDispatch
  , WithReduxReadState
  , ReduxReadState
  , WithReduxEffs

  , provide

  , Middleware
  , withMiddleware
  ) where

import X.Data.Tagged           (Tagged)
import X.FFI                   (Dict)
import X.React                 as R

import Control.Monad.Aff       (Aff)
import Control.Monad.Eff       (Eff)
import Data.Function.Uncurried as Fn.U
import Data.Identity           (Identity (..))
import Data.Monoid             (class Monoid)
import Optic.Core              (Lens')
import Prelude

foreign import data Store :: * -> *

type StoreCreator globalState
  = Fn.U.Fn2 (Reducer globalState) globalState (Store globalState)

createStore
  :: forall globalState.
     StoreCreator globalState
  -> Reducer globalState
  -> globalState
  -> Store globalState

createStore template f initialState
  = Fn.U.runFn2 template f initialState

foreign import baseStore :: forall globalState. StoreCreator globalState

foreign import getState :: forall globalState. Store globalState -> globalState

foreign import data Reducer :: * -> *

foreign import mkReducer
  :: forall act state. (Action act) => (state -> act -> state) -> Reducer state

focusReducer
  :: forall globalState state.
     Lens' globalState state
  -> Reducer state
  -> Reducer globalState

focusReducer l r
  = Fn.U.runFn3 focusReducerImpl (captureFunctorDict Identity) l r

foreign import focusReducerImpl
  :: forall globalState state.
     Fn.U.Fn3
      Dict
      (Lens' globalState state)
      (Reducer state)
      (Reducer globalState)

foreign import captureFunctorDict
  :: forall f a.
     (Functor f)
  => (a -> f a)
  -> Dict

instance semigroupReducer :: Semigroup (Reducer state) where
  append r1 r2
    = Fn.U.runFn2 appendReducerImpl r1 r2

instance monoidReducer :: Monoid (Reducer state) where
  mempty
    = idReducer

foreign import appendReducerImpl
  :: forall state. Fn.U.Fn2 (Reducer state) (Reducer state) (Reducer state)

foreign import idReducer :: forall state. Reducer state

class Action act where
  actionType :: Tagged act String

connect
  :: forall innerProps outerProps globalState eff.
     (globalState -> Dispatcher -> outerProps -> innerProps)
  -> R.ReactClass innerProps eff
  -> R.ReactClass outerProps (WithReduxReadState globalState eff)

connect f klass
  = Fn.U.runFn2 connectImpl f klass

connected
  :: forall innerProps outerProps globalState eff.
     R.ReactClass innerProps eff
  -> (globalState -> Dispatcher -> outerProps -> innerProps)
  -> R.ReactClass outerProps (WithReduxReadState globalState eff)

connected klass f
  = Fn.U.runFn2 connectImpl f klass

foreign import connectImpl
  :: forall innerProps outerProps globalState eff.
     Fn.U.Fn2 (globalState -> Dispatcher -> outerProps -> innerProps)
      (R.ReactClass innerProps eff)
      (R.ReactClass outerProps (WithReduxReadState globalState eff))

newtype Dispatcher
  = Dispatcher
      (  forall act eff. (Action act)
      => act
      -> Eff (WithReduxDispatch eff) Unit
      )

dispatchWith
  :: forall act eff.
     (Action act)
  => Dispatcher
  -> act
  -> Eff (WithReduxDispatch eff) Unit

dispatchWith (Dispatcher f)
  = f

foreign import liftDispatchEff
  :: forall eff a. Eff eff a -> Eff (WithReduxDispatch eff) a

foreign import liftDispatchAff
  :: forall eff a. Aff eff a -> Aff (WithReduxDispatch eff) a

type WithReduxDispatch eff
  = ( rxDispatch :: ReduxDispatch
    | eff
    )

foreign import data ReduxDispatch :: !

type WithReduxReadState globalState eff
  = ( rxReadState :: ReduxReadState globalState
    | eff
    )

foreign import data ReduxReadState :: * -> !

type WithReduxEffs globalState eff
  = WithReduxReadState globalState (WithReduxDispatch eff)

provide
  :: forall globalState eff.
     Store globalState
  -> R.ReactElement (WithReduxEffs globalState eff)
  -> R.ReactElement eff

provide store e
  = Fn.U.runFn2 provideImpl store e

foreign import provideImpl
  :: forall globalState eff.
     Fn.U.Fn2
      (Store globalState)
      (R.ReactElement (WithReduxEffs globalState eff))
      (R.ReactElement eff)

foreign import data Middleware :: *

foreign import withMiddleware
  :: forall globalState.
     Middleware
  -> StoreCreator globalState
  -> StoreCreator globalState