From ac367545a8f852d6485d8340565eb6ea1f56d2a2 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Wed, 12 Aug 2020 07:25:34 +0300 Subject: [PATCH 1/3] Adds fuseSetters --- src/Data/Lens/Setter.purs | 126 ++++++++++++++++++++++++++++++-------- 1 file changed, 102 insertions(+), 24 deletions(-) diff --git a/src/Data/Lens/Setter.purs b/src/Data/Lens/Setter.purs index 8434e9e..0c35df9 100644 --- a/src/Data/Lens/Setter.purs +++ b/src/Data/Lens/Setter.purs @@ -1,60 +1,101 @@ -- | This module defines functions for working with setters. module Data.Lens.Setter - ( (%~), over, iover - , (.~), set - , (+~), addOver - , (-~), subOver - , (*~), mulOver - , (//~), divOver - , (||~), disjOver - , (&&~), conjOver - , (<>~), appendOver + ( (%~) + , over + , iover + , (.~) + , set + , (+~) + , addOver + , (-~) + , subOver + , (*~) + , mulOver + , (//~) + , divOver + , (||~) + , disjOver + , (&&~) + , conjOver + , (<>~) + , appendOver , (++~) - , (?~), setJust - , (.=), assign - , (%=), modifying - , (+=), addModifying - , (*=), mulModifying - , (-=), subModifying - , (//=), divModifying - , (||=), disjModifying - , (&&=), conjModifying - , (<>=), appendModifying + , (?~) + , setJust + , (.=) + , assign + , (%=) + , modifying + , (+=) + , addModifying + , (*=) + , mulModifying + , (-=) + , subModifying + , (//=) + , divModifying + , (||=) + , disjModifying + , (&&=) + , conjModifying + , (<>=) + , appendModifying , (++=) - , (?=), assignJust + , (?=) + , assignJust + , fuseSetters + , cTuple , module Data.Lens.Types ) where import Prelude - import Control.Monad.State.Class (class MonadState, modify) - import Data.Lens.Types (IndexedSetter, Indexed(..), Setter, Setter') import Data.Maybe (Maybe(..)) -import Data.Tuple (uncurry) +import Data.Tuple (uncurry, Tuple(..)) infixr 4 over as %~ + infixr 4 set as .~ + infixr 4 addOver as +~ + infixr 4 subOver as -~ + infixr 4 mulOver as *~ + infixr 4 divOver as //~ + infixr 4 disjOver as ||~ + infixr 4 conjOver as &&~ + infixr 4 appendOver as <>~ + infixr 4 appendOver as ++~ + infixr 4 setJust as ?~ infix 4 assign as .= + infix 4 modifying as %= + infix 4 addModifying as += + infix 4 mulModifying as *= + infix 4 subModifying as -= + infix 4 divModifying as //= + infix 4 disjModifying as ||= + infix 4 conjModifying as &&= + infix 4 appendModifying as <>= + infix 4 appendModifying as ++= + infix 4 assignJust as ?= -- | Apply a function to the foci of a `Setter`. @@ -94,7 +135,6 @@ setJust :: forall s t a b. Setter s t a (Maybe b) -> b -> s -> t setJust p = set p <<< Just -- Stateful - -- | Set the foci of a `Setter` in a monadic state to a constant value. assign :: forall s a b m. MonadState s m => Setter s s a b -> b -> m Unit assign p b = void (modify (set p b)) @@ -126,3 +166,41 @@ appendModifying p = modifying p <<< flip append assignJust :: forall s a b m. MonadState s m => Setter s s a (Maybe b) -> b -> m Unit assignJust p = assign p <<< Just + +-- | Add two setters as "branches" to a trunk setter. +-- | +-- | Useful when there are multiple setters acting on the same data structure. +-- | and you need to optimize performance. For large operations (ie a setter +-- | over an audio file or a photo), this can have a 1.5-2x performance increase +-- | for each fused setter. The performance increase compounds with each nested +-- | fused setter. +-- | +-- | ```purescript +-- | over (fuseSetters _1 (fuseSetters _1 _2 _2) _2) +-- | ( cTuple +-- | ((+) 55) +-- | (cTuple (flip (-) 101) ((*) 57)) +-- | ) +-- | (Tuple 0 (Tuple 0 (Tuple 1 2))) +-- | ``` +-- | +-- | This yields: +-- | +-- | ```bash +-- | (Tuple 0 (Tuple 55 (Tuple -100 114))) +-- | ``` +-- | +-- | Use `cTuple` along with `fuseSetters` to create the tree of functions used +-- | by `over`. +fuseSetters :: forall s a b c. Setter' a b -> Setter' a c -> Setter' s a -> Setter' s (Tuple (b -> b) (c -> c)) +fuseSetters a b c l = over c (over a fa <<< over b fb) + where + t = l $ Tuple identity identity + + fa = fst t + + fb = snd t + +-- | For use with `fuseSetters` +cTuple :: forall a b c. a -> b -> c -> Tuple a b +cTuple a b _ = Tuple a b From 9a5f0c6baffede7f0da676aab0ba3e3ebcac6627 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Wed, 12 Aug 2020 07:29:27 +0300 Subject: [PATCH 2/3] Imports fst and snd --- src/Data/Lens/Setter.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Lens/Setter.purs b/src/Data/Lens/Setter.purs index 0c35df9..f304aa4 100644 --- a/src/Data/Lens/Setter.purs +++ b/src/Data/Lens/Setter.purs @@ -52,7 +52,7 @@ import Prelude import Control.Monad.State.Class (class MonadState, modify) import Data.Lens.Types (IndexedSetter, Indexed(..), Setter, Setter') import Data.Maybe (Maybe(..)) -import Data.Tuple (uncurry, Tuple(..)) +import Data.Tuple (uncurry, Tuple(..), fst, snd) infixr 4 over as %~ From 259ee1faea464f92e6d23eea7c75ffa87a708eaf Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Wed, 12 Aug 2020 13:44:57 +0300 Subject: [PATCH 3/3] Better fuse setters --- src/Data/Lens/Setter.purs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/Data/Lens/Setter.purs b/src/Data/Lens/Setter.purs index f304aa4..1d36be1 100644 --- a/src/Data/Lens/Setter.purs +++ b/src/Data/Lens/Setter.purs @@ -176,12 +176,13 @@ assignJust p = assign p <<< Just -- | fused setter. -- | -- | ```purescript --- | over (fuseSetters _1 (fuseSetters _1 _2 _2) _2) --- | ( cTuple --- | ((+) 55) --- | (cTuple (flip (-) 101) ((*) 57)) --- | ) --- | (Tuple 0 (Tuple 0 (Tuple 1 2))) +-- |over +-- | (_2 <<< (fuseSetters _1 (_2 <<< (fuseSetters _1 _2)))) +-- | ( cTuple +-- | ((+) 55) +-- | (cTuple (flip (-) 101) ((*) 57)) +-- | ) +-- | (Tuple 0 (Tuple 0 (Tuple 1 2))) -- | ``` -- | -- | This yields: @@ -192,10 +193,10 @@ assignJust p = assign p <<< Just -- | -- | Use `cTuple` along with `fuseSetters` to create the tree of functions used -- | by `over`. -fuseSetters :: forall s a b c. Setter' a b -> Setter' a c -> Setter' s a -> Setter' s (Tuple (b -> b) (c -> c)) -fuseSetters a b c l = over c (over a fa <<< over b fb) +fuseSetters :: forall a b c. Setter' a b -> Setter' a c -> Setter' a (Tuple (b -> b) (c -> c)) +fuseSetters ba ca l = (over ba fa <<< over ca fb) where - t = l $ Tuple identity identity + t = l (Tuple identity identity) fa = fst t