Commit 7b710820 authored by James Laver's avatar James Laver

Rework R.Hooks adding a bunch of hooks

parent 49d8ddba
'use strict';
var React = require("react");
function _simple(prop) {
return function() { return React[prop].apply(React, arguments); };
}
function _memo(prop) {
return function() {
var args = Array.prototype.slice.call(arguments);
args.unshift(args.pop());
return React[prop].apply(React, args);
}
}
exports._tuple = function tuple(ctor, v) { return ctor(v[0])(v[1]); };
exports._tupleCurrent = function tupleCurrent(ctor, ref) {
const set = function(v) { ref.current = v; };
return ctor(ref.current)(set);
};
exports._useContext = _simple('useContext');
exports._useDebugValue = _simple('useDebugValue');
exports._useDebugValuePrime = _simple('useDebugValue');
// exports._useImperativeHandle = _simple('useImperativeHandle');
exports._useMemo = _simple('useMemo');
exports._useMemo1 = _memo('useMemo');
exports._useMemo2 = _memo('useMemo');
exports._useMemo3 = _memo('useMemo');
exports._useMemo4 = _memo('useMemo');
exports._useMemo5 = _memo('useMemo');
module Reactix.Hooks module Reactix.Hooks
( State, useState ( State, useState, useState'
, HookEffect , Reducer, useReducer, useReducer'
, useEffect, useEffect1, useEffect2, useEffect3, useEffect4, useEffect5 , useContext
, useLayoutEffect, useLayoutEffect1, useLayoutEffect2
, useLayoutEffect3, useLayoutEffect4, useLayoutEffect5
-- , Reducer
-- , useReducer, useReducer'
-- , useContext
-- , useMemo, useMemo1, useMemo2 --, useMemo3, useMemo4, useMemo5
, useRef , useRef
-- , useDebugValue, useDebugValue' , useDebugValue, useDebugValue'
-- , useImperativeHandle , HookEffect, nothing, thenNothing
, useEffect, useEffect', useEffect1, useEffect1'
, useEffect2, useEffect2', useEffect3, useEffect3'
, useEffect4, useEffect4', useEffect5, useEffect5'
, useLayoutEffect, useLayoutEffect'
, useLayoutEffect1, useLayoutEffect1'
, useLayoutEffect2, useLayoutEffect2'
, useLayoutEffect3, useLayoutEffect3'
, useLayoutEffect4, useLayoutEffect4'
, useLayoutEffect5, useLayoutEffect5'
, useMemo, useMemo1, useMemo2, useMemo3, useMemo4, useMemo5
, useCallback, useCallback1, useCallback2
, useCallback3, useCallback4, useCallback5
, useImperativeHandle, useImperativeHandle1, useImperativeHandle2
, useImperativeHandle3, useImperativeHandle4, useImperativeHandle5
) )
where where
import Prelude import Prelude
import Data.Function.Uncurried ( Fn2, mkFn2, runFn2 ) import Data.Function.Uncurried (Fn2, mkFn2, runFn2)
import Data.Tuple ( Tuple(..) ) import Data.Tuple (Tuple(..))
import Effect ( Effect ) import Effect (Effect)
import Effect.Uncurried ( EffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4, EffectFn5, runEffectFn5, EffectFn6, runEffectFn6 ) import Effect.Uncurried
import FFI.Simple ( (...), (..), delay, args2, args3, args4, args5, setProperty ) ( EffectFn1, runEffectFn1, mkEffectFn1
, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3
, EffectFn4, runEffectFn4, EffectFn5, runEffectFn5, EffectFn6, runEffectFn6 )
import FFI.Simple ((...), (..), delay, args2, args3, args4, args5, setProperty)
import FFI.Simple.PseudoArray as Array
import DOM.Simple.Console import DOM.Simple.Console
import Reactix.Utils (tuple, currySecond, hook)
import Reactix.React ( Ref, Hooks, react, unsafeHooksEffect ) import Reactix.React (Context, Ref, Hooks, react)
--- useState --- useState
...@@ -31,38 +43,61 @@ type State state = Tuple state (state -> Effect Unit) ...@@ -31,38 +43,61 @@ type State state = Tuple state (state -> Effect Unit)
-- | Given an Effect function returning an initial value, returns a State -- | Given an Effect function returning an initial value, returns a State
useState :: forall s. (Unit -> Effect s) -> Hooks (State s) useState :: forall s. (Unit -> Effect s) -> Hooks (State s)
useState s = hook $ \_ -> pure $ currySecond $ tuple $ react ... "useState" $ [ delay unit s ] useState s =
-- -- useReducer hook $ \_ ->
pure $ currySecond $ tuple $ react ... "useState" $ [ delay unit s ]
-- type Reducer state action = Tuple state (EffectFn1 action Unit)
useState' :: forall s. s -> Hooks (State s)
useState' s = useState $ \_ -> pure s
-- useReducer
-- | A reducer hook is a tuple of value and reducer-setter
type Reducer state action = Tuple state (action -> Effect Unit)
-- | Given a reducer function from a state and action to a new state,
-- | an initialiser function and argument for the initialiser, returns
-- | a Reducer. Note args 2 and 3 are swapped in order from React.
useReducer :: forall s a i. (s -> a -> s) -> (i -> Effect s) -> i -> Hooks (Reducer s a)
useReducer f i j =
hook $ \_ ->
pure $ currySecond $ tuple $ react ... "useReducer" $ args3 (mkFn2 f) j (mkEffectFn1 i)
-- | Like `useReducer`, but takes an initial state instead of an
-- | initialiser function and argument
useReducer' :: forall s a. (s -> a -> s) -> s -> Hooks (Reducer s a)
useReducer' r = useReducer r pure
-- useReducer :: forall s a i. (s -> a -> s) -> (i -> s) -> i -> Hooks (Reducer s a) -- useContext
-- useReducer f i j = pure $ tuple $ react ... "useReducer" $ args3 f i j
-- useReducer' :: forall s a. (s -> a -> s) -> s -> Hooks (Reducer s a) -- | Given a `Context`, returns its current value
-- useReducer' r = useReducer r identity useContext :: forall a. Context a -> Hooks a
useContext c = hook $ \_ -> pure $ react ... "useContext" $ [c]
-- instance readReducer :: Read (Reducer s a) s where -- useRef
-- read = _read0
-- instance writeReducer :: Write (Reducer s a) a where useRef :: forall r. r -> Hooks (Ref r)
-- write = runEffectFn2 _call1 useRef r = hook $ \_ -> pure $ react ... "useRef" $ [ r ]
-- useDebugValue
useDebugValue :: forall v v'. v -> (v -> v') -> Hooks Unit
useDebugValue v f = hook $ \_ -> pure $ react ... "useDebugValue" $ (args2 v f)
useDebugValue' :: forall v. v -> Hooks Unit
useDebugValue' v = hook $ \_ -> pure $ react ... "useDebugValue" $ [v]
-- useEffect -- useEffect
type HookEffect = Unit -> Effect (Unit -> Effect Unit) type HookEffect = Unit -> Effect (Unit -> Effect Unit)
wrapEffect :: HookEffect -> Effect (Effect Unit) -- | A cleanup handler that does nothing
wrapEffect f = delay unit $ \_ -> do nothing :: Unit -> Effect Unit
cleanup <- f unit nothing _ = pure unit
pure $ delay unit cleanup
_useEffect :: forall a. HookEffect -> a -> Hooks Unit -- | Turns a simple effect function into an effect function that does
_useEffect e a = hook $ \_ -> pure $ react ... "useEffect" $ args2 (wrapEffect e) a -- | nothing in cleanup after running
thenNothing :: forall a. (Unit -> Effect a) -> HookEffect
thenNothing e _ = e unit *> pure nothing
-- | Given an Effect function which returns a cleanup Effect function, -- | Given an Effect function which returns a cleanup Effect function,
-- | register an effect to be called after rendering -- | register an effect to be called after rendering
...@@ -89,6 +124,41 @@ useEffect4 a b c d e = _useEffect e $ args4 a b c d ...@@ -89,6 +124,41 @@ useEffect4 a b c d e = _useEffect e $ args4 a b c d
useEffect5 :: forall a b c d e. a -> b -> c -> d -> e -> HookEffect -> Hooks Unit useEffect5 :: forall a b c d e. a -> b -> c -> d -> e -> HookEffect -> Hooks Unit
useEffect5 a b c d f e = _useEffect e $ args5 a b c d f useEffect5 a b c d f e = _useEffect e $ args5 a b c d f
_useEffect :: forall a. HookEffect -> a -> Hooks Unit
_useEffect e a =
hook $ \_ ->
pure $ react ... "useEffect" $
args2 (wrapEffect e) (Array.from a)
wrapEffect :: HookEffect -> Effect (Effect Unit)
wrapEffect f = delay unit $ \_ -> do
cleanup <- f unit
pure $ delay unit cleanup
-- | Like useEffect, but the provided Effect fn does not return a cleanup handler
useEffect' :: forall a. (Unit -> Effect a) -> Hooks Unit
useEffect' = useEffect <<< thenNothing
-- | Like useEffect1, but the provided Effect fn does not return a cleanup handler
useEffect1' :: forall a b. a -> (Unit -> Effect b) -> Hooks Unit
useEffect1' a = useEffect1 a <<< thenNothing
-- | Like useEffect2, but the provided Effect fn does not return a cleanup handler
useEffect2' :: forall a b c. a -> b -> (Unit -> Effect c) -> Hooks Unit
useEffect2' a b = useEffect2 a b <<< thenNothing
-- | Like useEffect3, but the provided Effect fn does not return a cleanup handler
useEffect3' :: forall a b c d. a -> b -> c -> (Unit -> Effect d) -> Hooks Unit
useEffect3' a b c = useEffect3 a b c <<< thenNothing
-- | Like useEffect4, but the provided Effect fn does not return a cleanup handler
useEffect4' :: forall a b c d e. a -> b -> c -> d -> (Unit -> Effect e) -> Hooks Unit
useEffect4' a b c d = useEffect4 a b c d <<< thenNothing
-- | Like useEffect5, but the provided Effect fn does not return a cleanup handler
useEffect5' :: forall a b c d e f. a -> b -> c -> d -> e -> (Unit -> Effect f) -> Hooks Unit
useEffect5' a b c d e = useEffect5 a b c d e <<< thenNothing
-- useLayoutEffect -- useLayoutEffect
-- | Given an Effect function which returns a cleanup Effect function, -- | Given an Effect function which returns a cleanup Effect function,
...@@ -97,9 +167,6 @@ useEffect5 a b c d f e = _useEffect e $ args5 a b c d f ...@@ -97,9 +167,6 @@ useEffect5 a b c d f e = _useEffect e $ args5 a b c d f
useLayoutEffect :: HookEffect -> Hooks Unit useLayoutEffect :: HookEffect -> Hooks Unit
useLayoutEffect e = hook $ \_ -> pure $ react ... "useLayoutEffect" $ [ wrapEffect e ] useLayoutEffect e = hook $ \_ -> pure $ react ... "useLayoutEffect" $ [ wrapEffect e ]
_useLayoutEffect :: forall a. HookEffect -> a -> Hooks Unit
_useLayoutEffect e a = hook $ \_ -> pure $ react ... "useLayoutEffect" $ args2 (wrapEffect e) a
-- | Like useLayoutEffect, but with a memo value -- | Like useLayoutEffect, but with a memo value
useLayoutEffect1 :: forall a. a -> HookEffect -> Hooks Unit useLayoutEffect1 :: forall a. a -> HookEffect -> Hooks Unit
useLayoutEffect1 a e = _useLayoutEffect e [a] useLayoutEffect1 a e = _useLayoutEffect e [a]
...@@ -120,68 +187,135 @@ useLayoutEffect4 a b c d e = _useLayoutEffect e $ args4 a b c d ...@@ -120,68 +187,135 @@ useLayoutEffect4 a b c d e = _useLayoutEffect e $ args4 a b c d
useLayoutEffect5 :: forall a b c d e. a -> b -> c -> d -> e -> HookEffect -> Hooks Unit useLayoutEffect5 :: forall a b c d e. a -> b -> c -> d -> e -> HookEffect -> Hooks Unit
useLayoutEffect5 a b c d f e = _useLayoutEffect e $ args5 a b c d f useLayoutEffect5 a b c d f e = _useLayoutEffect e $ args5 a b c d f
-- useMemo -- | Like useLayoutEffect, but the provided Effect fn does not return a cleanup handler
useLayoutEffect' :: forall a. (Unit -> Effect a) -> Hooks Unit
useLayoutEffect' = useLayoutEffect <<< thenNothing
-- | Like useLayoutEffect1, but the provided Effect fn does not return a cleanup handler
useLayoutEffect1' :: forall a b. a -> (Unit -> Effect b) -> Hooks Unit
useLayoutEffect1' a = useLayoutEffect1 a <<< thenNothing
-- useMemo :: forall a. Effect a -> Hooks a -- | Like useLayoutEffect2, but the provided Effect fn does not return a cleanup handler
-- useMemo = unsafeHooksEffect <<< runEffectFn1 _useMemo useLayoutEffect2' :: forall a b c. a -> b -> (Unit -> Effect c) -> Hooks Unit
-- useMemo1 :: forall a b. b -> Effect a -> Hooks a useLayoutEffect2' a b = useLayoutEffect2 a b <<< thenNothing
-- useMemo1 a = unsafeHooksEffect <<< runEffectFn2 _useMemo1 a
-- useMemo2 :: forall a b c. b -> c -> Effect a -> Hooks a
-- useMemo2 a b = unsafeHooksEffect <<< runEffectFn3 _useMemo2 a b
-- foreign import _useMemo :: forall a. EffectFn1 (Effect a) a -- | Like useLayoutEffect3, but the provided Effect fn does not return a cleanup handler
-- foreign import _useMemo1 :: forall a b. EffectFn2 b (Effect a) a useLayoutEffect3' :: forall a b c d. a -> b -> c -> (Unit -> Effect d) -> Hooks Unit
-- foreign import _useMemo2 :: forall a b c. EffectFn3 b c (Effect a) a useLayoutEffect3' a b c = useLayoutEffect3 a b c <<< thenNothing
-- | Like useLayoutEffect4, but the provided Effect fn does not return a cleanup handler
useLayoutEffect4' :: forall a b c d e. a -> b -> c -> d -> (Unit -> Effect e) -> Hooks Unit
useLayoutEffect4' a b c d = useLayoutEffect4 a b c d <<< thenNothing
-- | Like useLayoutEffect5, but the provided Effect fn does not return a cleanup handler
useLayoutEffect5' :: forall a b c d e f. a -> b -> c -> d -> e -> (Unit -> Effect f) -> Hooks Unit
useLayoutEffect5' a b c d f = useLayoutEffect5 a b c d f <<< thenNothing
_useLayoutEffect :: forall a. HookEffect -> a -> Hooks Unit
_useLayoutEffect e a =
hook $ \_ ->
pure $ react ... "useLayoutEffect" $
args2 (wrapEffect e) (Array.from a)
-- useRef -- useMemo
useRef :: forall r. r -> Hooks (Ref r)
useRef r = hook $ \_ -> pure $ react ... "useRef" $ [ r ]
-- useContext
-- foreign import _useContext :: forall a. Context a -> Hooks a
-- useContext :: forall a. Context a -> Hooks a
-- useContext = _useContext
-- useDebugValue
useDebugValue :: forall v v'. v -> (v -> v') -> Hooks Unit
useDebugValue v = unsafeHooksEffect <<< runEffectFn2 _useDebugValue v
useDebugValue' :: forall v. v -> Hooks Unit
useDebugValue' = unsafeHooksEffect <<< runEffectFn1 _useDebugValuePrime
foreign import _useDebugValue :: forall v v'. EffectFn2 v (v -> v') Unit
foreign import _useDebugValuePrime :: forall v. EffectFn1 v Unit
-- foreign import _useImperativeHandle ::
-- ffi utilities
tuple :: forall a b c. a -> Tuple b c
tuple = runFn2 _tuple Tuple
foreign import _tuple :: forall a b c. Fn2 (a -> b -> Tuple a b) c (Tuple a b)
tupleCurrent :: forall a b c. a -> Tuple b c
tupleCurrent = runFn2 _tupleCurrent Tuple
foreign import _tupleCurrent :: forall a b c. Fn2 (a -> b -> Tuple a b) c (Tuple a b)
currySecond :: forall a b c. Tuple a (EffectFn1 b c) -> Tuple a (b -> Effect c)
currySecond (Tuple a b) = Tuple a (runEffectFn1 b)
hook :: forall v. (Unit -> Effect v) -> Hooks v
hook f = unsafeHooksEffect (delay unit f)
-- | Given a function to compure an expensive value, returns the value
useMemo :: forall t. (Unit -> t) -> Hooks t
useMemo f = hook $ \_ -> pure $ react ... "useMemo" $ [ delay unit (\_ -> pure (f unit)) ]
-- | Like `useMemo` but takes a memo value
useMemo1 :: forall a t. a -> (Unit -> t) -> Hooks t
useMemo1 a f = _useMemo f [a]
-- | Like `useMemo` but takes 2 memo values
useMemo2 :: forall a b t. a -> b -> (Unit -> t) -> Hooks t
useMemo2 a b f = _useMemo f $ args2 a b
-- | Like `useMemo` but takes 3 memo values
useMemo3 :: forall a b c t. a -> b -> c -> (Unit -> t) -> Hooks t
useMemo3 a b c f = _useMemo f $ args3 a b c
-- | Like `useMemo` but takes 4 memo values
useMemo4 :: forall a b c d t. a -> b -> c -> d -> (Unit -> t) -> Hooks t
useMemo4 a b c d f = _useMemo f $ args4 a b c d
-- | Like `useMemo` but takes 5 memo values
useMemo5 :: forall a b c d e t. a -> b -> c -> d -> e -> (Unit -> t) -> Hooks t
useMemo5 a b c d e f = _useMemo f $ args5 a b c d e
_useMemo :: forall t a. (Unit -> t) -> a -> Hooks t
_useMemo f a =
hook $ \_ ->
pure $ react ... "useMemo" $
args2 (delay unit (\_ -> pure (f unit))) (Array.from a)
-- useCallback
-- | Given a function to compure an expensive value, returns the value
useCallback :: forall t. (Unit -> t) -> Hooks (Effect t)
useCallback f = hook $ \_ -> pure $ react ... "useCallback" $ [ delay unit (\_ -> pure (f unit)) ]
-- | Like `useCallback` but takes a memo value
useCallback1 :: forall a t. a -> (Unit -> t) -> Hooks (Effect t)
useCallback1 a f = _useCallback f [a]
-- | Like `useCallback` but takes 2 memo values
useCallback2 :: forall a b t. a -> b -> (Unit -> t) -> Hooks (Effect t)
useCallback2 a b f = _useCallback f $ args2 a b
-- | Like `useCallback` but takes 3 memo values
useCallback3 :: forall a b c t. a -> b -> c -> (Unit -> t) -> Hooks (Effect t)
useCallback3 a b c f = _useCallback f $ args3 a b c
-- | Like `useCallback` but takes 4 memo values
useCallback4 :: forall a b c d t. a -> b -> c -> d -> (Unit -> t) -> Hooks (Effect t)
useCallback4 a b c d f = _useCallback f $ args4 a b c d
-- | Like `useCallback` but takes 5 memo values
useCallback5 :: forall a b c d e t. a -> b -> c -> d -> e -> (Unit -> t) -> Hooks (Effect t)
useCallback5 a b c d e f = _useCallback f $ args5 a b c d e
_useCallback :: forall t a. (Unit -> t) -> a -> Hooks (Effect t)
_useCallback f a =
hook $ \_ ->
pure $ react ... "useCallback" $
args2 f (Array.from a)
-- useImperativeHandle
useImperativeHandle
:: forall r r'
. Ref r -> (Unit -> Effect r') -> Hooks Unit
useImperativeHandle r f =
hook $ \_ ->
pure $ react ... "useImperativeHandle" $ args2 r f
useImperativeHandle1
:: forall a r r'
. a -> Ref r -> (Unit -> Effect r') -> Hooks Unit
useImperativeHandle1 a r f = _useImperativeHandle r f [a]
useImperativeHandle2
:: forall a b r r'
. a -> b -> Ref r -> (Unit -> Effect r') -> Hooks Unit
useImperativeHandle2 a b r f = _useImperativeHandle r f (args2 a b)
useImperativeHandle3
:: forall a b c r r'
. a -> b -> c -> Ref r -> (Unit -> Effect r') -> Hooks Unit
useImperativeHandle3 a b c r f = _useImperativeHandle r f (args3 a b c)
useImperativeHandle4
:: forall a b c d r r'
. a -> b -> c -> d -> Ref r -> (Unit -> Effect r') -> Hooks Unit
useImperativeHandle4 a b c d r f = _useImperativeHandle r f (args4 a b c d)
useImperativeHandle5
:: forall a b c d e r r'
. a -> b -> c -> d -> e -> Ref r -> (Unit -> Effect r') -> Hooks Unit
useImperativeHandle5 a b c d e r f = _useImperativeHandle r f (args5 a b c d e)
_useImperativeHandle :: forall r r' a. Ref r -> (Unit -> Effect r') -> a -> Hooks Unit
_useImperativeHandle r f a = hook $ \_ ->
pure $ react ... "useImperativeHandle" $
args3 r (delay unit f) (Array.from a)
'use strict';
exports._tuple = function tuple(ctor, v) { return ctor(v[0])(v[1]); };
module Reactix.Utils where
import Data.Unit (Unit, unit)
import Data.Tuple (Tuple(..))
import Data.Function.Uncurried (Fn2, runFn2)
import Effect (Effect)
import Effect.Uncurried (EffectFn1, runEffectFn1)
import FFI.Simple (delay)
import Reactix.React (Hooks, unsafeHooksEffect)
tuple :: forall a b c. a -> Tuple b c
tuple = runFn2 _tuple Tuple
foreign import _tuple :: forall a b c. Fn2 (a -> b -> Tuple a b) c (Tuple a b)
currySecond :: forall a b c. Tuple a (EffectFn1 b c) -> Tuple a (b -> Effect c)
currySecond (Tuple a b) = Tuple a (runEffectFn1 b)
hook :: forall v. (Unit -> Effect v) -> Hooks v
hook f = unsafeHooksEffect (delay unit f)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment