├── .gitignore ├── package.json ├── .travis.yml ├── README.md ├── bower.json ├── generated-docs └── Data │ ├── Incremental │ ├── Tuple.md │ ├── Monoid.md │ ├── Record.md │ ├── Eq.md │ ├── Abelian.md │ ├── Array.md │ └── Map.md │ └── Incremental.md ├── LICENSE ├── src └── Data │ ├── Incremental │ ├── Tuple.purs │ ├── Monoid.purs │ ├── Eq.purs │ ├── Record.purs │ ├── Array.purs │ └── Map.purs │ └── Incremental.purs └── test └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /.psc* 6 | /.psa* 7 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "pulp build && pulp test" 6 | }, 7 | "devDependencies": { 8 | "pulp": "^12.3.0", 9 | "purescript-psa": "^0.5.0", 10 | "purescript": "^0.12.0", 11 | "rimraf": "^2.5.4" 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | dist: trusty 3 | sudo: required 4 | node_js: stable 5 | install: 6 | - npm install -g bower 7 | - npm install 8 | - bower install 9 | script: 10 | - npm run -s build 11 | after_success: 12 | - >- 13 | test $TRAVIS_TAG && 14 | echo $GITHUB_TOKEN | pulp login && 15 | echo y | pulp publish --no-push 16 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-incremental-functions 2 | 3 | [![Build Status](https://travis-ci.org/paf31/purescript-incremental-functions.svg?branch=master)](https://travis-ci.org/paf31/purescript-incremental-functions) 4 | 5 | Incremental lambda calculus in the HOAS style, based on 6 | 7 | > "A Theory of Changes for Higher-Order Languages" by Cai, Giarrusso, Rendel and Ostermann. 8 | 9 | - [Module Documentation](generated-docs/Data) 10 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-incremental-functions", 3 | "ignore": [ 4 | "**/.*", 5 | "node_modules", 6 | "bower_components", 7 | "output" 8 | ], 9 | "license": "MIT", 10 | "repository": { 11 | "type": "git", 12 | "url": "git://github.com/paf31/purescript-incremental-functions.git" 13 | }, 14 | "dependencies": { 15 | "purescript-tuples": "^5.0.0", 16 | "purescript-these": "^4.0.0", 17 | "purescript-typelevel-prelude": "^3.0.0", 18 | "purescript-enums": "^4.0.0", 19 | "purescript-filterable": "^3.0.0", 20 | "purescript-record": "^1.0.0", 21 | "purescript-foldable-traversable": "^4.0.0", 22 | "purescript-ordered-collections": "^1.0.0" 23 | }, 24 | "devDependencies": { 25 | "purescript-console": "^4.1.0", 26 | "purescript-psci-support": "^4.0.0", 27 | "purescript-assert": "^4.0.0" 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental/Tuple.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental.Tuple 2 | 3 | #### `fst` 4 | 5 | ``` purescript 6 | fst :: forall a da b db. Patch a da => Patch b db => Jet (Tuple a b) -> Jet a 7 | ``` 8 | 9 | Extract the first component of a `Tuple`, incrementally. 10 | 11 | #### `snd` 12 | 13 | ``` purescript 14 | snd :: forall a da b db. Patch a da => Patch b db => Jet (Tuple a b) -> Jet b 15 | ``` 16 | 17 | Extract the second component of a `Tuple`, incrementally. 18 | 19 | #### `tuple` 20 | 21 | ``` purescript 22 | tuple :: forall a da b db. Patch a da => Patch b db => Jet a -> Jet b -> Jet (Tuple a b) 23 | ``` 24 | 25 | Construct a `Tuple`, incrementally. 26 | 27 | #### `uncurry` 28 | 29 | ``` purescript 30 | uncurry :: forall a da b db c. Patch a da => Patch b db => (Jet a -> Jet b -> Jet c) -> Jet (Tuple a b) -> Jet c 31 | ``` 32 | 33 | Uncurry an incremental function. 34 | 35 | #### `curry` 36 | 37 | ``` purescript 38 | curry :: forall a da b db c. Patch a da => Patch b db => (Jet (Tuple a b) -> Jet c) -> Jet a -> Jet b -> Jet c 39 | ``` 40 | 41 | Curry an incremental function. 42 | 43 | 44 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017-2018 Phil Freeman 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental/Monoid.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental.Monoid 2 | 3 | #### `Left` 4 | 5 | ``` purescript 6 | newtype Left a 7 | = Left a 8 | ``` 9 | 10 | A change structure for any monoid, with the `Dual` monoid acting by 11 | appending on the left. 12 | 13 | ##### Instances 14 | ``` purescript 15 | (Eq a) => Eq (Left a) 16 | (Ord a) => Ord (Left a) 17 | Newtype (Left a) _ 18 | (Show a) => Show (Left a) 19 | (Monoid a) => Patch (Left a) (Dual a) 20 | ``` 21 | 22 | #### `appendLeft` 23 | 24 | ``` purescript 25 | appendLeft :: forall a. Monoid a => a -> Change (Left a) 26 | ``` 27 | 28 | Change by appending a value on the left. 29 | 30 | #### `Right` 31 | 32 | ``` purescript 33 | newtype Right a 34 | = Right a 35 | ``` 36 | 37 | A change structure for any monoid, acting on itself by appending on the right. 38 | 39 | ##### Instances 40 | ``` purescript 41 | (Semigroup a) => Semigroup (Right a) 42 | (Monoid a) => Monoid (Right a) 43 | (Eq a) => Eq (Right a) 44 | (Ord a) => Ord (Right a) 45 | Newtype (Right a) _ 46 | (Show a) => Show (Right a) 47 | (Monoid a) => Patch (Right a) (Right a) 48 | ``` 49 | 50 | #### `appendRight` 51 | 52 | ``` purescript 53 | appendRight :: forall a. Monoid a => a -> Change (Right a) 54 | ``` 55 | 56 | Change by appending a value on the right. 57 | 58 | 59 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental/Record.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental.Record 2 | 3 | #### `IRecord` 4 | 5 | ``` purescript 6 | newtype IRecord r 7 | = IRecord ({ | r }) 8 | ``` 9 | 10 | ##### Instances 11 | ``` purescript 12 | Newtype (IRecord a) _ 13 | ``` 14 | 15 | #### `get` 16 | 17 | ``` purescript 18 | get :: forall l a da r rl rest1 rest2 d dl. IsSymbol l => RowCons l a rest1 r => RowCons l da rest2 d => RowToList r rl => RowToList d dl => PatchRL r rl d dl => Patch a da => SProxy l -> Jet (IRecord r) -> Jet a 19 | ``` 20 | 21 | An incremental property accessor function 22 | 23 | #### `update` 24 | 25 | ``` purescript 26 | update :: forall l a da r rl rest1 rest2 d dl. IsSymbol l => RowCons l a rest1 r => RowCons l da rest2 d => RowToList r rl => RowToList d dl => PatchRL r rl d dl => Patch a da => SProxy l -> Change a -> Change (IRecord r) 27 | ``` 28 | 29 | An incremental property update function 30 | 31 | #### `PatchRL` 32 | 33 | ``` purescript 34 | class (MonoidRL dl d) <= PatchRL r (rl :: RowList) d (dl :: RowList) | rl -> r, dl -> d, rl -> dl where 35 | patchRL :: RLProxy rl -> RLProxy dl -> { | r } -> { | d } -> { | r } 36 | ``` 37 | 38 | ##### Instances 39 | ``` purescript 40 | PatchRL () Nil () Nil 41 | (IsSymbol l, Patch a m, PatchRL r1 rl d1 dl, RowCons l a r1 r2, RowCons l m d1 d2, RowLacks l r1, RowLacks l d1) => PatchRL r2 (Cons l a rl) d2 (Cons l m dl) 42 | ``` 43 | 44 | 45 | -------------------------------------------------------------------------------- /src/Data/Incremental/Tuple.purs: -------------------------------------------------------------------------------- 1 | module Data.Incremental.Tuple where 2 | 3 | import Data.Incremental (class Patch, Jet, fromChange, toChange) 4 | import Data.Tuple (Tuple(..)) 5 | import Data.Tuple as Tuple 6 | 7 | -- | Extract the first component of a `Tuple`, incrementally. 8 | fst :: forall a da b db. Patch a da => Patch b db => Jet (Tuple a b) -> Jet a 9 | fst { position, velocity } = 10 | { position: Tuple.fst position 11 | , velocity: toChange (Tuple.fst (fromChange velocity)) 12 | } 13 | 14 | -- | Extract the second component of a `Tuple`, incrementally. 15 | snd :: forall a da b db. Patch a da => Patch b db => Jet (Tuple a b) -> Jet b 16 | snd { position, velocity } = 17 | { position: Tuple.snd position 18 | , velocity: toChange (Tuple.snd (fromChange velocity)) 19 | } 20 | 21 | -- | Construct a `Tuple`, incrementally. 22 | tuple :: forall a da b db. Patch a da => Patch b db => Jet a -> Jet b -> Jet (Tuple a b) 23 | tuple a b = 24 | { position: Tuple a.position b.position 25 | , velocity: toChange (Tuple (fromChange a.velocity) (fromChange b.velocity)) 26 | } 27 | 28 | -- | Uncurry an incremental function. 29 | uncurry 30 | :: forall a da b db c 31 | . Patch a da 32 | => Patch b db 33 | => (Jet a -> Jet b -> Jet c) 34 | -> Jet (Tuple a b) 35 | -> Jet c 36 | uncurry f t = f (fst t) (snd t) 37 | 38 | -- | Curry an incremental function. 39 | curry 40 | :: forall a da b db c 41 | . Patch a da 42 | => Patch b db 43 | => (Jet (Tuple a b) -> Jet c) 44 | -> Jet a 45 | -> Jet b 46 | -> Jet c 47 | curry f a b = f (tuple a b) 48 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental/Eq.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental.Eq 2 | 3 | #### `Atomic` 4 | 5 | ``` purescript 6 | newtype Atomic a 7 | = Atomic a 8 | ``` 9 | 10 | A change structure for any type with equality. 11 | 12 | ##### Instances 13 | ``` purescript 14 | (Eq a) => Eq (Atomic a) 15 | (Ord a) => Ord (Atomic a) 16 | Newtype (Atomic a) _ 17 | (Show a) => Show (Atomic a) 18 | Patch (Atomic a) (Last a) 19 | (Eq a) => Diff (Atomic a) (Last a) 20 | ``` 21 | 22 | #### `replace` 23 | 24 | ``` purescript 25 | replace :: forall a. a -> Change (Atomic a) 26 | ``` 27 | 28 | Change by replacing the current value. 29 | 30 | #### `map` 31 | 32 | ``` purescript 33 | map :: forall a b. (a -> b) -> Jet (Atomic a) -> Jet (Atomic b) 34 | ``` 35 | 36 | Change an `Atomic` value using a regular function. 37 | 38 | #### `lift2` 39 | 40 | ``` purescript 41 | lift2 :: forall a b c. (a -> b -> c) -> Jet (Atomic a) -> Jet (Atomic b) -> Jet (Atomic c) 42 | ``` 43 | 44 | Combine two `Atomic` values using a regular function. 45 | 46 | _Note_: The result will change (entirely) if either argument 47 | changes. If changes should be independent, consider using a `Tuple` 48 | instead. 49 | 50 | #### `apply` 51 | 52 | ``` purescript 53 | apply :: forall a b. Jet (Atomic (a -> b)) -> Jet (Atomic a) -> Jet (Atomic b) 54 | ``` 55 | 56 | Combine two `Atomic` values in an applicative style. 57 | 58 | #### `mapAtomic` 59 | 60 | ``` purescript 61 | mapAtomic :: forall a b. (a -> b) -> Jet (Atomic a) -> Jet (Atomic b) 62 | ``` 63 | 64 | Change an `Atomic` value using a regular function. 65 | 66 | This alias for `map` will be removed in a future version. 67 | 68 | 69 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental/Abelian.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental.Abelian 2 | 3 | #### `Group` 4 | 5 | ``` purescript 6 | class (Monoid g) <= Group g where 7 | inverse :: g -> g 8 | ``` 9 | 10 | A `Group` is a `Monoid` with inverses. 11 | 12 | Laws: 13 | 14 | - _Left inverse_: `inverse x <> x = mempty` 15 | - _Right inverse_: `x <> inverse x = mempty` 16 | 17 | ##### Instances 18 | ``` purescript 19 | (Ring a) => Group (Additive a) 20 | (Group g) => Group (WrappedAbelian g) 21 | ``` 22 | 23 | #### `subtract` 24 | 25 | ``` purescript 26 | subtract :: forall g. Group g => g -> g -> g 27 | ``` 28 | 29 | Subtraction in a group. 30 | 31 | #### `Abelian` 32 | 33 | ``` purescript 34 | class (Group g) <= Abelian g 35 | ``` 36 | 37 | An `Abelian` group is a `Group` whose `append` operation also satisfies the 38 | _commutativity law_: 39 | 40 | - _Commutativity_ `x <> y = y <> x` 41 | 42 | ##### Instances 43 | ``` purescript 44 | (Ring a) => Abelian (Additive a) 45 | (Abelian g) => Abelian (WrappedAbelian g) 46 | ``` 47 | 48 | #### `WrappedAbelian` 49 | 50 | ``` purescript 51 | newtype WrappedAbelian g 52 | = WrappedAbelian g 53 | ``` 54 | 55 | A change structure for any abelian group. 56 | 57 | ##### Instances 58 | ``` purescript 59 | (Semigroup g) => Semigroup (WrappedAbelian g) 60 | (Monoid g) => Monoid (WrappedAbelian g) 61 | (Group g) => Group (WrappedAbelian g) 62 | (Abelian g) => Abelian (WrappedAbelian g) 63 | (Eq g) => Eq (WrappedAbelian g) 64 | (Ord g) => Ord (WrappedAbelian g) 65 | Newtype (WrappedAbelian g) _ 66 | (Show g) => Show (WrappedAbelian g) 67 | (Abelian g) => ChangeStructure (WrappedAbelian g) (WrappedAbelian g) 68 | ``` 69 | 70 | 71 | -------------------------------------------------------------------------------- /src/Data/Incremental/Monoid.purs: -------------------------------------------------------------------------------- 1 | module Data.Incremental.Monoid 2 | ( Left(..) 3 | , appendLeft 4 | , Right(..) 5 | , appendRight 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Data.Incremental (class Patch, Change, toChange) 11 | import Data.Monoid.Dual (Dual(..)) 12 | import Data.Newtype (class Newtype) 13 | 14 | -- | A change structure for any monoid, with the `Dual` monoid acting by 15 | -- | appending on the left. 16 | newtype Left a = Left a 17 | 18 | derive instance eqLeft :: Eq a => Eq (Left a) 19 | derive instance ordLeft :: Ord a => Ord (Left a) 20 | derive instance newtypeLeft :: Newtype (Left a) _ 21 | 22 | instance showLeft :: Show a => Show (Left a) where 23 | show (Left a) = "(Left " <> show a <> ")" 24 | 25 | instance patchLeft :: Monoid a => Patch (Left a) (Dual a) where 26 | patch (Left x) (Dual y) = Left (y <> x) 27 | 28 | -- | Change by appending a value on the left. 29 | appendLeft :: forall a. Monoid a => a -> Change (Left a) 30 | appendLeft = toChange <<< Dual 31 | 32 | -- | A change structure for any monoid, acting on itself by appending on the right. 33 | newtype Right a = Right a 34 | 35 | derive newtype instance semigroupRight :: Semigroup a => Semigroup (Right a) 36 | derive newtype instance monoidRight :: Monoid a => Monoid (Right a) 37 | 38 | derive instance eqRight :: Eq a => Eq (Right a) 39 | derive instance ordRight :: Ord a => Ord (Right a) 40 | derive instance newtypeRight :: Newtype (Right a) _ 41 | 42 | instance showRight :: Show a => Show (Right a) where 43 | show (Right a) = "(Right " <> show a <> ")" 44 | 45 | instance patchRight :: Monoid a => Patch (Right a) (Right a) where 46 | patch (Right x) (Right y) = Right (x <> y) 47 | 48 | -- | Change by appending a value on the right. 49 | appendRight :: forall a. Monoid a => a -> Change (Right a) 50 | appendRight = toChange <<< Right 51 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental 2 | 3 | Incremental computation, based on 4 | 5 | > "A Theory of Changes for Higher-Order Languages" by 6 | > Cai, Giarrusso, Rendel and Ostermann. 7 | 8 | This module also defines a HOAS-style interface for working with 9 | function changes. 10 | 11 | #### `Patch` 12 | 13 | ``` purescript 14 | class (Monoid d) <= Patch a d | a -> d where 15 | patch :: a -> d -> a 16 | ``` 17 | 18 | The monoid `d` of changes acts on values of type `a`. 19 | 20 | ##### Instances 21 | ``` purescript 22 | Patch Unit Unit 23 | (Patch a da, Patch b db) => Patch (Tuple a b) (Tuple da db) 24 | ``` 25 | 26 | #### `Diff` 27 | 28 | ``` purescript 29 | class (Patch a d) <= Diff a d | a -> d where 30 | diff :: a -> a -> d 31 | ``` 32 | 33 | ##### Instances 34 | ``` purescript 35 | Diff Unit Unit 36 | (Diff a da, Diff b db) => Diff (Tuple a b) (Tuple da db) 37 | ``` 38 | 39 | #### `Change` 40 | 41 | ``` purescript 42 | data Change a 43 | ``` 44 | 45 | A type level function which maps a type to the type of its change structure. 46 | 47 | Uniqueness of instances makes the coercions `fromChange` and `toChange` safe, 48 | since the functional dependency makes the change structure type unique. 49 | 50 | ##### Instances 51 | ``` purescript 52 | (Patch a da, Semigroup da) => Semigroup (Change a) 53 | (Patch a da, Monoid da) => Monoid (Change a) 54 | ``` 55 | 56 | #### `fromChange` 57 | 58 | ``` purescript 59 | fromChange :: forall a da. Patch a da => Change a -> da 60 | ``` 61 | 62 | #### `toChange` 63 | 64 | ``` purescript 65 | toChange :: forall a da. Patch a da => da -> Change a 66 | ``` 67 | 68 | #### `Jet` 69 | 70 | ``` purescript 71 | type Jet a = { position :: a, velocity :: Change a } 72 | ``` 73 | 74 | A value (`position`) paired with a change (`velocity`). 75 | 76 | We can think of these modified terms as conceptually similar to dual 77 | numbers. 78 | 79 | We can use functions of type `Jet a -> Jet b` as incremental 80 | functions from `a` to `b`, which gives us a HOAS-style DSL for working 81 | with jets. 82 | 83 | #### `constant` 84 | 85 | ``` purescript 86 | constant :: forall a da. Patch a da => a -> Jet a 87 | ``` 88 | 89 | A constant term 90 | 91 | #### `change` 92 | 93 | ``` purescript 94 | change :: forall a da. Patch a da => Change a -> Jet a -> Jet a 95 | ``` 96 | 97 | Create a function which applies a patch to its input 98 | 99 | 100 | -------------------------------------------------------------------------------- /src/Data/Incremental.purs: -------------------------------------------------------------------------------- 1 | -- | Incremental computation, based on 2 | -- | 3 | -- | > "A Theory of Changes for Higher-Order Languages" by 4 | -- | > Cai, Giarrusso, Rendel and Ostermann. 5 | -- | 6 | -- | This module also defines a HOAS-style interface for working with 7 | -- | function changes. 8 | 9 | module Data.Incremental 10 | ( class Patch 11 | , patch 12 | , class Diff 13 | , diff 14 | , Change 15 | , fromChange 16 | , toChange 17 | , Jet 18 | , constant 19 | , change 20 | ) where 21 | 22 | import Prelude 23 | 24 | import Data.Tuple (Tuple(..)) 25 | import Unsafe.Coerce (unsafeCoerce) 26 | 27 | -- | The monoid `d` of changes acts on values of type `a`. 28 | class Monoid d <= Patch a d | a -> d where 29 | patch :: a -> d -> a 30 | 31 | class Patch a d <= Diff a d | a -> d where 32 | diff :: a -> a -> d 33 | 34 | instance patchUnit :: Patch Unit Unit where 35 | patch _ _ = unit 36 | 37 | instance diffUnit :: Diff Unit Unit where 38 | diff _ _ = unit 39 | 40 | instance patchTuple :: (Patch a da, Patch b db) => Patch (Tuple a b) (Tuple da db) where 41 | patch (Tuple a b) (Tuple c d) = Tuple (patch a c) (patch b d) 42 | 43 | instance diffTuple :: (Diff a da, Diff b db) => Diff (Tuple a b) (Tuple da db) where 44 | diff (Tuple a b) (Tuple c d) = Tuple (diff a c) (diff b d) 45 | 46 | -- | A type level function which maps a type to the type of its change structure. 47 | -- | 48 | -- | Uniqueness of instances makes the coercions `fromChange` and `toChange` safe, 49 | -- | since the functional dependency makes the change structure type unique. 50 | data Change a 51 | 52 | instance semigroupChange :: (Patch a da, Semigroup da) => Semigroup (Change a) where 53 | append x y = toChange (fromChange x <> fromChange y) 54 | 55 | instance monoidChange :: (Patch a da, Monoid da) => Monoid (Change a) where 56 | mempty = toChange mempty 57 | 58 | fromChange :: forall a da. Patch a da => Change a -> da 59 | fromChange = unsafeCoerce 60 | 61 | toChange :: forall a da. Patch a da => da -> Change a 62 | toChange = unsafeCoerce 63 | 64 | -- | A value (`position`) paired with a change (`velocity`). 65 | -- | 66 | -- | We can think of these modified terms as conceptually similar to dual 67 | -- | numbers. 68 | -- | 69 | -- | We can use functions of type `Jet a -> Jet b` as incremental 70 | -- | functions from `a` to `b`, which gives us a HOAS-style DSL for working 71 | -- | with jets. 72 | type Jet a = 73 | { position :: a 74 | , velocity :: Change a 75 | } 76 | 77 | -- | A constant term 78 | constant :: forall a da. Patch a da => a -> Jet a 79 | constant position = { position, velocity: mempty } 80 | 81 | -- | Create a function which applies a patch to its input 82 | change :: forall a da. Patch a da => Change a -> Jet a -> Jet a 83 | change c { position, velocity } = 84 | { position: position `patch` fromChange c 85 | , velocity 86 | } 87 | -------------------------------------------------------------------------------- /src/Data/Incremental/Eq.purs: -------------------------------------------------------------------------------- 1 | module Data.Incremental.Eq 2 | ( Atomic(..) 3 | , replace 4 | , map 5 | , lift2 6 | , apply 7 | , mapAtomic 8 | ) where 9 | 10 | import Prelude hiding (map, apply) 11 | import Prelude as Prelude 12 | 13 | import Data.Incremental (class Diff, class Patch, Change, Jet, fromChange, toChange) 14 | import Data.Maybe (Maybe(..), fromMaybe) 15 | import Data.Maybe.Last (Last(..)) 16 | import Data.Newtype (class Newtype, unwrap, wrap) 17 | 18 | -- | A change structure for any type with equality. 19 | newtype Atomic a = Atomic a 20 | 21 | derive instance eqAtomic :: Eq a => Eq (Atomic a) 22 | derive instance ordAtomic :: Ord a => Ord (Atomic a) 23 | derive instance newtypeAtomic :: Newtype (Atomic a) _ 24 | 25 | instance showAtomic :: Show a => Show (Atomic a) where 26 | show (Atomic a) = "(Atomic " <> show a <> ")" 27 | 28 | instance patchAtomic :: Patch (Atomic a) (Last a) where 29 | patch x (Last Nothing) = x 30 | patch _ (Last (Just y)) = Atomic y 31 | 32 | instance diffAtomic :: Eq a => Diff (Atomic a) (Last a) where 33 | diff (Atomic x) (Atomic y) 34 | | x == y = Last Nothing 35 | | otherwise = Last (Just y) 36 | 37 | -- | Change by replacing the current value. 38 | replace :: forall a. a -> Change (Atomic a) 39 | replace a = toChange (Last (Just a)) 40 | 41 | -- | Change an `Atomic` value using a regular function. 42 | -- | 43 | -- | This alias for `map` will be removed in a future version. 44 | mapAtomic 45 | :: forall a b 46 | . (a -> b) 47 | -> Jet (Atomic a) 48 | -> Jet (Atomic b) 49 | mapAtomic f { position, velocity } = 50 | { position: wrap (f (unwrap position)) 51 | , velocity: toChange (Prelude.map f (fromChange velocity)) 52 | } 53 | 54 | -- | Change an `Atomic` value using a regular function. 55 | map 56 | :: forall a b 57 | . (a -> b) 58 | -> Jet (Atomic a) 59 | -> Jet (Atomic b) 60 | map = mapAtomic 61 | 62 | -- | Combine two `Atomic` values using a regular function. 63 | -- | 64 | -- | _Note_: The result will change (entirely) if either argument 65 | -- | changes. If changes should be independent, consider using a `Tuple` 66 | -- | instead. 67 | lift2 68 | :: forall a b c 69 | . (a -> b -> c) 70 | -> Jet (Atomic a) 71 | -> Jet (Atomic b) 72 | -> Jet (Atomic c) 73 | lift2 f a b = 74 | { position: wrap (f (unwrap a.position) (unwrap b.position)) 75 | , velocity: toChange (combine f (fromChange a.velocity) (fromChange b.velocity)) 76 | } 77 | where 78 | combine _ (Last Nothing) (Last Nothing) = 79 | Last Nothing 80 | combine g (Last a') (Last b') = 81 | Last (Just (g (fromMaybe (unwrap a.position) a') 82 | (fromMaybe (unwrap b.position) b'))) 83 | 84 | -- | Combine two `Atomic` values in an applicative style. 85 | apply 86 | :: forall a b 87 | . Jet (Atomic (a -> b)) 88 | -> Jet (Atomic a) 89 | -> Jet (Atomic b) 90 | apply = lift2 ($) 91 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental/Array.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental.Array 2 | 3 | #### `IArray` 4 | 5 | ``` purescript 6 | newtype IArray a 7 | = IArray (Array a) 8 | ``` 9 | 10 | ##### Instances 11 | ``` purescript 12 | (Eq a) => Eq (IArray a) 13 | (Show a) => Show (IArray a) 14 | Newtype (IArray a) _ 15 | (Patch a da) => Patch (IArray a) (Array (ArrayChange a da)) 16 | ``` 17 | 18 | #### `ArrayChange` 19 | 20 | ``` purescript 21 | data ArrayChange a da 22 | = InsertAt Int a 23 | | DeleteAt Int 24 | | ModifyAt Int da 25 | ``` 26 | 27 | ##### Instances 28 | ``` purescript 29 | (Eq a, Eq da) => Eq (ArrayChange a da) 30 | (Show a, Show da) => Show (ArrayChange a da) 31 | (Patch a da) => Patch (IArray a) (Array (ArrayChange a da)) 32 | ``` 33 | 34 | #### `insertAt` 35 | 36 | ``` purescript 37 | insertAt :: forall a da. Patch a da => Int -> a -> Change (IArray a) 38 | ``` 39 | 40 | #### `deleteAt` 41 | 42 | ``` purescript 43 | deleteAt :: forall a da. Patch a da => Int -> Change (IArray a) 44 | ``` 45 | 46 | #### `modifyAt` 47 | 48 | ``` purescript 49 | modifyAt :: forall a da. Patch a da => Int -> Change a -> Change (IArray a) 50 | ``` 51 | 52 | #### `length` 53 | 54 | ``` purescript 55 | length :: forall a da. Patch a da => Jet (IArray a) -> Jet (Atomic Int) 56 | ``` 57 | 58 | Compute the length of the array incrementally. 59 | 60 | #### `map` 61 | 62 | ``` purescript 63 | map :: forall a b da db. Patch a da => Patch b db => (Jet a -> Jet b) -> Jet (IArray a) -> Jet (IArray b) 64 | ``` 65 | 66 | Modify each array element by applying the specified function. 67 | 68 | #### `mapWithIndex` 69 | 70 | ``` purescript 71 | mapWithIndex :: forall a da b db. Patch a da => Patch b db => (Jet (Atomic Int) -> Jet a -> Jet b) -> Jet (IArray a) -> Jet (IArray b) 72 | ``` 73 | 74 | Modify each array element by applying the specified function, taking the 75 | index of each element into account. 76 | 77 | _Note_: Insertions or removals in the middle of an array will result 78 | in a cascade of modifications to the tail of the result. 79 | 80 | #### `singleton` 81 | 82 | ``` purescript 83 | singleton :: forall a da. Patch a da => Jet a -> Jet (IArray a) 84 | ``` 85 | 86 | Construct an array from a single element. 87 | 88 | #### `static` 89 | 90 | ``` purescript 91 | static :: forall a da. Patch a da => Array (Jet a) -> Jet (IArray a) 92 | ``` 93 | 94 | Construct an array whose elements can change but whose length is fixed, 95 | from an array of jets. 96 | 97 | #### `withIndex` 98 | 99 | ``` purescript 100 | withIndex :: forall a da. Patch a da => Jet (IArray a) -> Jet (IArray (Tuple (Atomic Int) a)) 101 | ``` 102 | 103 | Annotate an array with the indices of its elements. 104 | 105 | _Note_: Insertions or removals in the middle of an array will result 106 | in a cascade of modifications to the tail of the result. 107 | 108 | 109 | -------------------------------------------------------------------------------- /generated-docs/Data/Incremental/Map.md: -------------------------------------------------------------------------------- 1 | ## Module Data.Incremental.Map 2 | 3 | A change structure for maps, and helper functions. 4 | 5 | #### `IMap` 6 | 7 | ``` purescript 8 | newtype IMap k v 9 | = IMap (Map k v) 10 | ``` 11 | 12 | A change structure for `Map` which tracks changes for each key. 13 | 14 | ##### Instances 15 | ``` purescript 16 | (Eq k, Eq v) => Eq (IMap k v) 17 | (Show k, Show v) => Show (IMap k v) 18 | Newtype (IMap k v) _ 19 | (Ord k, Patch v dv) => Patch (IMap k v) (MapChanges k v dv) 20 | (Ord k, Diff v dv) => Diff (IMap k v) (MapChanges k v dv) 21 | ``` 22 | 23 | #### `MapChanges` 24 | 25 | ``` purescript 26 | newtype MapChanges k v dv 27 | = MapChanges (Map k (MapChange v dv)) 28 | ``` 29 | 30 | A change for each possible key. 31 | 32 | ##### Instances 33 | ``` purescript 34 | (Eq k, Eq v, Eq dv) => Eq (MapChanges k v dv) 35 | Newtype (MapChanges k v dv) _ 36 | (Show k, Show v, Show dv) => Show (MapChanges k v dv) 37 | (Ord k, Patch v dv) => Semigroup (MapChanges k v dv) 38 | (Ord k, Patch v dv) => Monoid (MapChanges k v dv) 39 | (Ord k, Patch v dv) => Patch (IMap k v) (MapChanges k v dv) 40 | (Ord k, Diff v dv) => Diff (IMap k v) (MapChanges k v dv) 41 | ``` 42 | 43 | #### `MapChange` 44 | 45 | ``` purescript 46 | data MapChange v dv 47 | = Add v 48 | | Remove 49 | | Update dv 50 | ``` 51 | 52 | A change for a single key is an addition, removal, or update. 53 | 54 | ##### Instances 55 | ``` purescript 56 | (Eq v, Eq dv) => Eq (MapChange v dv) 57 | (Show v, Show dv) => Show (MapChange v dv) 58 | ``` 59 | 60 | #### `insert` 61 | 62 | ``` purescript 63 | insert :: forall k v dv. Ord k => Patch v dv => k -> v -> Change (IMap k v) 64 | ``` 65 | 66 | #### `remove` 67 | 68 | ``` purescript 69 | remove :: forall k v dv. Ord k => Patch v dv => k -> Change (IMap k v) 70 | ``` 71 | 72 | #### `updateAt` 73 | 74 | ``` purescript 75 | updateAt :: forall k v dv. Ord k => Patch v dv => k -> Change v -> Change (IMap k v) 76 | ``` 77 | 78 | #### `static` 79 | 80 | ``` purescript 81 | static :: forall k v dv. Ord k => Patch v dv => Map k (Jet v) -> Jet (IMap k v) 82 | ``` 83 | 84 | Construct a map whose values can change but whose keys are fixed. 85 | 86 | #### `singleton` 87 | 88 | ``` purescript 89 | singleton :: forall k v dv. Ord k => Patch v dv => k -> Jet v -> Jet (IMap k v) 90 | ``` 91 | 92 | Construct a map from a key/value pair. 93 | 94 | #### `map` 95 | 96 | ``` purescript 97 | map :: forall k a da b db. Ord k => Patch a da => Patch b db => (Jet a -> Jet b) -> Jet (IMap k a) -> Jet (IMap k b) 98 | ``` 99 | 100 | Update every key by applying a function. 101 | 102 | #### `modifyAt` 103 | 104 | ``` purescript 105 | modifyAt :: forall k v dv. Ord k => Patch v dv => k -> (Jet v -> Jet v) -> Jet (IMap k v) -> Jet (IMap k v) 106 | ``` 107 | 108 | Update a single key by applying a function. 109 | 110 | #### `size` 111 | 112 | ``` purescript 113 | size :: forall k a da. Ord k => Patch a da => Jet (IMap k a) -> Jet (Atomic Int) 114 | ``` 115 | 116 | Compute the size of an `IMap`, incrementally. 117 | 118 | #### `zip` 119 | 120 | ``` purescript 121 | zip :: forall k a da b db. Ord k => Patch a da => Patch b db => Jet (IMap k a) -> Jet (IMap k b) -> Jet (IMap k (Tuple a b)) 122 | ``` 123 | 124 | Zip two maps, keeping those keys which are common to _both_ input maps. 125 | 126 | #### `toIArray` 127 | 128 | ``` purescript 129 | toIArray :: forall k a da. Ord k => Patch a da => Jet (IMap k a) -> Jet (IArray (Tuple (Atomic k) a)) 130 | ``` 131 | 132 | Convert an `IMap` into an `IArray` of tuples of keys and values, in order, 133 | incrementally. 134 | 135 | 136 | -------------------------------------------------------------------------------- /src/Data/Incremental/Record.purs: -------------------------------------------------------------------------------- 1 | module Data.Incremental.Record 2 | ( IRecord(..) 3 | , get 4 | , update 5 | , class MonoidRL 6 | , memptyRL 7 | , class SemigroupRL 8 | , appendRL 9 | , class PatchRL 10 | , patchRL 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Data.Incremental (class Patch, Change, Jet, fromChange, patch, toChange) 16 | import Data.Newtype (class Newtype, unwrap, wrap) 17 | import Data.Symbol (class IsSymbol, SProxy(..)) 18 | import Type.Row (class RowToList, Cons, Nil, RLProxy(..), kind RowList) 19 | import Record as Record 20 | import Prim.Row as Row 21 | 22 | newtype IRecord r = IRecord (Record r) 23 | 24 | derive instance newtypeIRecord :: Newtype (IRecord a) _ 25 | 26 | instance semigroupRecord 27 | :: (RowToList r rl, SemigroupRL rl r) 28 | => Semigroup (IRecord r) where 29 | append (IRecord x) (IRecord y) = IRecord (appendRL (RLProxy :: RLProxy rl) x y) 30 | 31 | class SemigroupRL (rl :: RowList) r | rl -> r where 32 | appendRL :: RLProxy rl -> Record r -> Record r -> Record r 33 | 34 | instance semigroupRLNil :: SemigroupRL Nil () where 35 | appendRL _ _ _ = {} 36 | 37 | instance semigroupRLCons 38 | :: ( IsSymbol l 39 | , Semigroup a 40 | , SemigroupRL rl r1 41 | , Row.Cons l a r1 r2 42 | , Row.Lacks l r1 43 | ) 44 | => SemigroupRL (Cons l a rl) r2 where 45 | appendRL _ x y = 46 | Record.insert l 47 | (append (Record.get l x) (Record.get l y)) 48 | rest 49 | where 50 | l = SProxy :: SProxy l 51 | 52 | rest :: Record r1 53 | rest = appendRL (RLProxy :: RLProxy rl) (Record.delete l x) (Record.delete l y) 54 | 55 | instance monoidRecord 56 | :: (RowToList r rl, MonoidRL rl r) 57 | => Monoid (IRecord r) where 58 | mempty = IRecord (memptyRL (RLProxy :: RLProxy rl)) 59 | 60 | class SemigroupRL rl r <= MonoidRL (rl :: RowList) r | rl -> r where 61 | memptyRL :: RLProxy rl -> Record r 62 | 63 | instance monoidRLNil :: MonoidRL Nil () where 64 | memptyRL _ = {} 65 | 66 | instance monoidRLCons 67 | :: ( IsSymbol l 68 | , Monoid a 69 | , MonoidRL rl r1 70 | , Row.Cons l a r1 r2 71 | , Row.Lacks l r1 72 | ) 73 | => MonoidRL (Cons l a rl) r2 where 74 | memptyRL _ = 75 | Record.insert l mempty rest 76 | where 77 | l = SProxy :: SProxy l 78 | 79 | rest :: Record r1 80 | rest = memptyRL (RLProxy :: RLProxy rl) 81 | 82 | instance patchRecord 83 | :: (RowToList r rl, RowToList d dl, MonoidRL dl d, PatchRL r rl d dl) 84 | => Patch (IRecord r) (IRecord d) where 85 | patch (IRecord r) (IRecord d) = IRecord (patchRL (RLProxy :: RLProxy rl) (RLProxy :: RLProxy dl) r d) 86 | 87 | class MonoidRL dl d <= PatchRL r (rl :: RowList) d (dl :: RowList) | rl -> r, dl -> d, rl -> dl where 88 | patchRL :: RLProxy rl -> RLProxy dl -> Record r -> Record d -> Record r 89 | 90 | instance patchRLNil :: PatchRL () Nil () Nil where 91 | patchRL _ _ _ _ = {} 92 | 93 | instance patchRLCons 94 | :: ( IsSymbol l 95 | , Patch a m 96 | , PatchRL r1 rl d1 dl 97 | , Row.Cons l a r1 r2 98 | , Row.Cons l m d1 d2 99 | , Row.Lacks l r1 100 | , Row.Lacks l d1 101 | ) 102 | => PatchRL r2 (Cons l a rl) d2 (Cons l m dl) where 103 | patchRL _ _ x y = 104 | Record.insert l 105 | (patch (Record.get l x) (Record.get l y)) 106 | rest 107 | where 108 | l = SProxy :: SProxy l 109 | 110 | rest :: Record r1 111 | rest = patchRL (RLProxy :: RLProxy rl) (RLProxy :: RLProxy dl) (Record.delete l x) (Record.delete l y) 112 | 113 | -- | An incremental property accessor function 114 | get 115 | :: forall l a da r rl rest1 rest2 d dl 116 | . IsSymbol l 117 | => Row.Cons l a rest1 r 118 | => Row.Cons l da rest2 d 119 | => RowToList r rl 120 | => RowToList d dl 121 | => PatchRL r rl d dl 122 | => Patch a da 123 | => SProxy l 124 | -> Jet (IRecord r) 125 | -> Jet a 126 | get l { position, velocity } = 127 | { position: Record.get l (unwrap position) 128 | , velocity: toChange (Record.get l (unwrap (fromChange velocity))) 129 | } 130 | 131 | -- | An incremental property update function 132 | update 133 | :: forall l a da r rl rest1 rest2 d dl 134 | . IsSymbol l 135 | => Row.Cons l a rest1 r 136 | => Row.Cons l da rest2 d 137 | => RowToList r rl 138 | => RowToList d dl 139 | => PatchRL r rl d dl 140 | => Patch a da 141 | => SProxy l 142 | -> Change a 143 | -> Change (IRecord r) 144 | update l c = toChange (wrap (Record.set l (fromChange c) (unwrap (mempty :: IRecord d)))) 145 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Data.Incremental (Jet, constant, fromChange, patch) 6 | import Data.Incremental.Array (IArray(..)) 7 | import Data.Incremental.Array as IArray 8 | import Data.Incremental.Eq (Atomic(..), mapAtomic, replace) 9 | import Data.Incremental.Map as IMap 10 | import Data.Incremental.Record as IRecord 11 | import Data.Map as Map 12 | import Data.Maybe.Last (Last(..)) 13 | import Data.Newtype (unwrap, wrap) 14 | import Data.Symbol (SProxy(..)) 15 | import Data.Tuple (Tuple(..)) 16 | import Effect (Effect) 17 | import Test.Assert (assert) 18 | 19 | -- | The function \x -> x * 2, together with its derivative 20 | times2 :: Jet (Atomic Int) -> Jet (Atomic Int) 21 | times2 = mapAtomic (_ * 2) 22 | 23 | -- | The `double` function iterated three times 24 | times8 :: Jet (Atomic Int) -> Jet (Atomic Int) 25 | times8 = times2 >>> times2 >>> times2 26 | 27 | main :: Effect Unit 28 | main = do 29 | let t1 = times8 (constant (wrap 1)) 30 | assert (t1.position == wrap 8) 31 | assert (fromChange t1.velocity == mempty) 32 | 33 | let t2 = times8 { position: wrap 1, velocity: replace 2 } 34 | assert (t2.position == wrap 8) 35 | assert (fromChange t2.velocity == Last (pure 16)) 36 | 37 | let t3 = IMap.modifyAt 1 times8 (constant (wrap (Map.fromFoldable [Tuple 1 (wrap 1), Tuple 2 (wrap 2)]))) 38 | assert (unwrap t3.position == Map.fromFoldable [Tuple 1 (wrap 8), Tuple 2 (wrap 2)]) 39 | 40 | let t4 = IMap.modifyAt 1 times8 41 | { position: wrap (Map.fromFoldable [Tuple 1 (wrap 1), Tuple 2 (wrap 2)]) 42 | , velocity: IMap.updateAt 1 (replace 2) 43 | } 44 | assert (unwrap t4.position == Map.fromFoldable [Tuple 1 (wrap 8), Tuple 2 (wrap 2)]) 45 | assert (fromChange t4.velocity == fromChange (IMap.updateAt 1 (replace 16))) 46 | 47 | let t5 = IArray.map times8 48 | { position: wrap [wrap 1, wrap 2] 49 | , velocity: IArray.modifyAt 1 (replace 3) 50 | } 51 | assert (unwrap t5.position == [wrap 8, wrap 16]) 52 | assert (unwrap (patch t5.position (fromChange t5.velocity)) == [wrap 8, wrap 24]) 53 | 54 | let t6 = IArray.map (IArray.map times8) 55 | { position: wrap [wrap [wrap 1, wrap 2], wrap [wrap 3]] 56 | , velocity: IArray.modifyAt 0 (IArray.modifyAt 1 (replace 4)) 57 | } 58 | assert (unwrap t6.position == [wrap [wrap 8, wrap 16], wrap [wrap 24]]) 59 | assert (unwrap (patch t6.position (fromChange t6.velocity)) == [wrap [wrap 8, wrap 32], wrap [wrap 24]]) 60 | 61 | let testRecord :: IRecord.IRecord (foo :: Atomic Int, bar :: Atomic Char) 62 | testRecord = IRecord.IRecord { foo: wrap 0, bar: wrap 'a' } 63 | t7 = IRecord.get (SProxy :: SProxy "foo") 64 | { position: testRecord 65 | , velocity: IRecord.update (SProxy :: SProxy "foo") (replace 42) 66 | } 67 | assert (unwrap t7.position == 0) 68 | assert (fromChange t7.velocity == fromChange (replace 42)) 69 | 70 | let t8 = IMap.size $ IMap.zip 71 | (constant (wrap (Map.fromFoldable [Tuple 1 (Atomic 1), Tuple 2 (Atomic 2)]))) 72 | { position: wrap (Map.fromFoldable [Tuple 1 (Atomic 'a'), Tuple 2 (Atomic 'b')]) 73 | , velocity: IMap.remove 1 74 | } 75 | assert (unwrap t8.position == 2) 76 | assert (fromChange t8.velocity == Last (pure 1)) 77 | 78 | let t9 = IArray.withIndex 79 | { position: wrap [Atomic 'a', Atomic 'b', Atomic 'c'] 80 | , velocity: 81 | IArray.insertAt 1 (Atomic 'x') 82 | <> IArray.deleteAt 2 83 | <> IArray.modifyAt 2 (replace 'y') 84 | } 85 | assert $ unwrap t9.position == 86 | [ Tuple (Atomic 0) (Atomic 'a') 87 | , Tuple (Atomic 1) (Atomic 'b') 88 | , Tuple (Atomic 2) (Atomic 'c') 89 | ] 90 | assert $ unwrap (patch t9.position (fromChange t9.velocity)) == 91 | [ Tuple (Atomic 0) (Atomic 'a') 92 | , Tuple (Atomic 1) (Atomic 'x') 93 | , Tuple (Atomic 2) (Atomic 'y') 94 | ] 95 | 96 | let t10 = IArray.withIndex 97 | { position: wrap [Atomic 'a', Atomic 'b', Atomic 'c'] 98 | , velocity: 99 | IArray.insertAt 1 (Atomic 'x') 100 | <> IArray.insertAt 2 (Atomic 'y') 101 | } 102 | assert $ unwrap t10.position == 103 | [ Tuple (Atomic 0) (Atomic 'a') 104 | , Tuple (Atomic 1) (Atomic 'b') 105 | , Tuple (Atomic 2) (Atomic 'c') 106 | ] 107 | assert $ unwrap (patch t10.position (fromChange t10.velocity)) == 108 | [ Tuple (Atomic 0) (Atomic 'a') 109 | , Tuple (Atomic 1) (Atomic 'x') 110 | , Tuple (Atomic 2) (Atomic 'y') 111 | , Tuple (Atomic 3) (Atomic 'b') 112 | , Tuple (Atomic 4) (Atomic 'c') 113 | ] 114 | 115 | let t11 = IArray.withIndex 116 | { position: wrap [Atomic 'a', Atomic 'b', Atomic 'c'] 117 | , velocity: 118 | IArray.deleteAt 0 119 | <> IArray.deleteAt 0 120 | } 121 | assert $ unwrap t11.position == 122 | [ Tuple (Atomic 0) (Atomic 'a') 123 | , Tuple (Atomic 1) (Atomic 'b') 124 | , Tuple (Atomic 2) (Atomic 'c') 125 | ] 126 | assert $ unwrap (patch t11.position (fromChange t11.velocity)) == 127 | [ Tuple (Atomic 0) (Atomic 'c') 128 | ] 129 | 130 | let t12 = IMap.toIArray 131 | { position: wrap (Map.fromFoldable [Tuple 1 (Atomic 1), Tuple 3 (Atomic 3), Tuple 4 (Atomic 4)]) 132 | , velocity: IMap.insert 2 (Atomic 2) <> IMap.remove 3 <> IMap.updateAt 4 (replace 5) 133 | } 134 | assert $ unwrap t12.position == 135 | [ Tuple (Atomic 1) (Atomic 1) 136 | , Tuple (Atomic 3) (Atomic 3) 137 | , Tuple (Atomic 4) (Atomic 4) 138 | ] 139 | assert $ unwrap (patch t12.position (fromChange t12.velocity)) == 140 | [ Tuple (Atomic 1) (Atomic 1) 141 | , Tuple (Atomic 2) (Atomic 2) 142 | , Tuple (Atomic 4) (Atomic 5) 143 | ] 144 | 145 | let t13 = (\x -> IArray.map \_ -> x) 146 | { position: Atomic 1 147 | , velocity: replace 2 148 | } (constant (IArray [Atomic unit])) 149 | assert $ unwrap t13.position == [Atomic 1] 150 | assert $ fromChange t13.velocity == fromChange (IArray.modifyAt 0 (replace 2)) 151 | -------------------------------------------------------------------------------- /src/Data/Incremental/Array.purs: -------------------------------------------------------------------------------- 1 | module Data.Incremental.Array 2 | ( IArray(..) 3 | , ArrayChange(..) 4 | , insertAt 5 | , deleteAt 6 | , modifyAt 7 | , length 8 | , map 9 | , mapWithIndex 10 | , singleton 11 | , static 12 | , withIndex 13 | ) where 14 | 15 | import Prelude hiding (map) 16 | 17 | import Data.Array ((:), (!!)) 18 | import Data.Array as Array 19 | import Data.Enum (enumFromTo) 20 | import Data.Foldable (foldl) 21 | import Data.Incremental (class Patch, Change, Jet, constant, fromChange, patch, toChange) 22 | import Data.Incremental.Eq (Atomic(..)) 23 | import Data.Incremental.Tuple (uncurry) 24 | import Data.Maybe (Maybe(..), fromMaybe) 25 | import Data.Newtype (class Newtype, unwrap, wrap) 26 | import Data.Traversable (mapAccumL) 27 | import Data.Tuple (Tuple(..)) 28 | import Prelude as Prelude 29 | 30 | newtype IArray a = IArray (Array a) 31 | 32 | derive instance eqIArray :: Eq a => Eq (IArray a) 33 | 34 | instance showIArray :: Show a => Show (IArray a) where 35 | show (IArray xs) = "(IArray " <> show xs <> ")" 36 | 37 | derive instance newtypeIArray :: Newtype (IArray a) _ 38 | 39 | data ArrayChange a da 40 | = InsertAt Int a 41 | | DeleteAt Int 42 | | ModifyAt Int da 43 | 44 | derive instance eqArrayChange :: (Eq a, Eq da) => Eq (ArrayChange a da) 45 | 46 | instance showArrayChange :: (Show a, Show da) => Show (ArrayChange a da) where 47 | show (InsertAt i a) = "(InsertAt " <> show i <> " " <> show a <> ")" 48 | show (DeleteAt i) = "(DeleteAt " <> show i <> ")" 49 | show (ModifyAt i da) = "(ModifyAt " <> show i <> " " <> show da <> ")" 50 | 51 | instance patchIArray 52 | :: Patch a da 53 | => Patch (IArray a) (Array (ArrayChange a da)) where 54 | patch (IArray xs) = IArray <<< foldl patchOne xs where 55 | patchOne xs_ (InsertAt i x) = fromMaybe xs_ (Array.insertAt i x xs_) 56 | patchOne xs_ (DeleteAt i) = fromMaybe xs_ (Array.deleteAt i xs_) 57 | patchOne xs_ (ModifyAt i da) = fromMaybe xs_ (Array.modifyAt i (_ `patch` da) xs_) 58 | 59 | insertAt :: forall a da. Patch a da => Int -> a -> Change (IArray a) 60 | insertAt i v = toChange [InsertAt i v] 61 | 62 | deleteAt :: forall a da. Patch a da => Int -> Change (IArray a) 63 | deleteAt i = toChange [DeleteAt i] 64 | 65 | modifyAt :: forall a da. Patch a da => Int -> Change a -> Change (IArray a) 66 | modifyAt i c = toChange [ModifyAt i (fromChange c)] 67 | 68 | -- | Construct an array from a single element. 69 | singleton :: forall a da. Patch a da => Jet a -> Jet (IArray a) 70 | singleton { position, velocity } = 71 | { position: wrap [position] 72 | , velocity: toChange [ModifyAt 0 (fromChange velocity)] 73 | } 74 | 75 | -- | Construct an array whose elements can change but whose length is fixed, 76 | -- | from an array of jets. 77 | static 78 | :: forall a da 79 | . Patch a da 80 | => Array (Jet a) 81 | -> Jet (IArray a) 82 | static xs = 83 | { position: wrap (Prelude.map _.position xs) 84 | , velocity: toChange (Array.mapWithIndex (\i -> ModifyAt i <<< fromChange <<< _.velocity) xs) 85 | } 86 | 87 | -- | Compute the length of the array incrementally. 88 | length 89 | :: forall a da 90 | . Patch a da 91 | => Jet (IArray a) 92 | -> Jet (Atomic Int) 93 | length { position, velocity } = 94 | { position: wrap len0 95 | , velocity: toChange (pure (foldl go len0 (fromChange velocity))) 96 | } 97 | where 98 | len0 = Array.length (unwrap position) 99 | 100 | go len (InsertAt _ _) = len + 1 101 | go len (DeleteAt _) | len > 0 = len - 1 102 | go len _ = len 103 | 104 | -- | Modify each array element by applying the specified function. 105 | map 106 | :: forall a b da db 107 | . Patch a da 108 | => Patch b db 109 | => (Jet a -> Jet b) 110 | -> Jet (IArray a) 111 | -> Jet (IArray b) 112 | map f { position: IArray xs, velocity: dxs } = 113 | { position: IArray (Prelude.map f0 xs) 114 | , velocity: toChange (f_updates <> xs_updates) 115 | } 116 | where 117 | f0 = _.position <<< f <<< constant 118 | f1 position velocity = (f { position, velocity }).velocity 119 | 120 | -- Changes originating from changes in f 121 | f_updates :: Array (ArrayChange b db) 122 | f_updates = Array.mapWithIndex (\i a -> ModifyAt i (fromChange (f (constant a)).velocity)) xs 123 | 124 | -- Changes originating from changes in xs 125 | xs_updates :: Array (ArrayChange b db) 126 | xs_updates = Array.catMaybes (mapAccumL go xs (fromChange dxs)).value 127 | 128 | go :: Array a -> ArrayChange a da -> { accum :: Array a, value :: Maybe (ArrayChange b db) } 129 | go xs_ (InsertAt i a) = 130 | { accum: fromMaybe xs_ (Array.insertAt i a xs_) 131 | , value: Just (InsertAt i (f (constant a)).position) 132 | } 133 | go xs_ (DeleteAt i) = 134 | { accum: fromMaybe xs_ (Array.deleteAt i xs_) 135 | , value: Just (DeleteAt i) 136 | } 137 | go xs_ (ModifyAt i da) = 138 | { accum: fromMaybe xs_ (Array.modifyAt i (_ `patch` da) xs_) 139 | , value: (xs_ !! i) <#> \a -> 140 | ModifyAt i (fromChange (f1 a (toChange da))) 141 | } 142 | 143 | -- | Annotate an array with the indices of its elements. 144 | -- | 145 | -- | _Note_: Insertions or removals in the middle of an array will result 146 | -- | in a cascade of modifications to the tail of the result. 147 | withIndex 148 | :: forall a da 149 | . Patch a da 150 | => Jet (IArray a) 151 | -> Jet (IArray (Tuple (Atomic Int) a)) 152 | withIndex { position, velocity } = 153 | { position: wrap (Array.mapWithIndex (Tuple <<< Atomic) (unwrap position)) 154 | , velocity: toChange (Array.fold (mapAccumL go len0 (fromChange velocity)).value) 155 | } 156 | where 157 | len0 = Array.length (unwrap position) 158 | 159 | go len (InsertAt i a) = 160 | { accum: len + 1 161 | , value: InsertAt i (Tuple (Atomic i) a) 162 | : Prelude.map 163 | (\j -> ModifyAt j (Tuple (pure j) mempty)) 164 | (enumFromTo (i + 1) len) 165 | } 166 | go len (DeleteAt i) = 167 | { accum: len - 1 168 | , value: DeleteAt i 169 | : Prelude.map 170 | (\j -> ModifyAt j (Tuple (pure j) mempty)) 171 | (enumFromTo i (len - 2)) 172 | } 173 | go len (ModifyAt i da) = 174 | { accum: len 175 | , value: [ModifyAt i (Tuple mempty da)] 176 | } 177 | 178 | -- | Modify each array element by applying the specified function, taking the 179 | -- | index of each element into account. 180 | -- | 181 | -- | _Note_: Insertions or removals in the middle of an array will result 182 | -- | in a cascade of modifications to the tail of the result. 183 | mapWithIndex 184 | :: forall a da b db 185 | . Patch a da 186 | => Patch b db 187 | => (Jet (Atomic Int) -> Jet a -> Jet b) 188 | -> Jet (IArray a) 189 | -> Jet (IArray b) 190 | mapWithIndex f = withIndex >>> map (uncurry f) 191 | -------------------------------------------------------------------------------- /src/Data/Incremental/Map.purs: -------------------------------------------------------------------------------- 1 | -- | A change structure for maps, and helper functions. 2 | 3 | module Data.Incremental.Map 4 | ( IMap(..) 5 | , MapChanges(..) 6 | , MapChange(..) 7 | , insert 8 | , remove 9 | , updateAt 10 | , static 11 | , singleton 12 | , map 13 | , modifyAt 14 | , size 15 | , zip 16 | , toIArray 17 | ) where 18 | 19 | import Prelude hiding (map) 20 | 21 | import Data.Bifoldable (biany) 22 | import Data.Bifunctor (lmap) 23 | import Data.Filterable (filterMap) 24 | import Data.Foldable (sum) 25 | import Data.Incremental (class Diff, class Patch, Change, Jet, constant, diff, fromChange, patch, toChange) 26 | import Data.Incremental.Array (ArrayChange(..), IArray) 27 | import Data.Incremental.Eq (Atomic(..)) 28 | import Data.List (mapMaybe) 29 | import Data.Map (Map) 30 | import Data.Map as Map 31 | import Data.Maybe (Maybe(..)) 32 | import Data.Maybe.Last (Last) 33 | import Data.Monoid.Additive (Additive(..)) 34 | import Data.Newtype (class Newtype, unwrap, wrap) 35 | import Data.These (These(..)) 36 | import Data.Traversable (mapAccumL) 37 | import Data.Tuple (Tuple(..)) 38 | import Partial.Unsafe (unsafePartial) 39 | import Prelude as Prelude 40 | 41 | -- | A change structure for `Map` which tracks changes for each key. 42 | newtype IMap k v = IMap (Map k v) 43 | 44 | derive instance eqIMap :: (Eq k, Eq v) => Eq (IMap k v) 45 | 46 | instance showIMap :: (Show k, Show v) => Show (IMap k v) where 47 | show (IMap m) = "(IMap " <> show m <> ")" 48 | 49 | derive instance newtypeIMap :: Newtype (IMap k v) _ 50 | 51 | -- | A change for a single key is an addition, removal, or update. 52 | data MapChange v dv 53 | = Add v 54 | | Remove 55 | | Update dv 56 | 57 | derive instance eqMapChange :: (Eq v, Eq dv) => Eq (MapChange v dv) 58 | 59 | instance showMapChange :: (Show v, Show dv) => Show (MapChange v dv) where 60 | show (Add v) = "(Add " <> show v <> ")" 61 | show Remove = "Remove" 62 | show (Update dv) = "(Update " <> show dv <> ")" 63 | 64 | -- | A change for each possible key. 65 | newtype MapChanges k v dv = MapChanges (Map k (MapChange v dv)) 66 | 67 | derive instance eqMapChanges :: (Eq k, Eq v, Eq dv) => Eq (MapChanges k v dv) 68 | derive instance newtypeMapChanges :: Newtype (MapChanges k v dv) _ 69 | 70 | instance showMapChanges :: (Show k, Show v, Show dv) => Show (MapChanges k v dv) where 71 | show (MapChanges m) = "(MapChanges " <> show m <> ")" 72 | 73 | instance semigroupMapChanges :: (Ord k, Patch v dv) => Semigroup (MapChanges k v dv) where 74 | append (MapChanges m1) (MapChanges m2) = MapChanges (Map.unionWith combine m1 m2) where 75 | combine _ (Add v) = Add v 76 | combine _ Remove = Remove 77 | combine (Add v) (Update dv) = Add (patch v dv) 78 | combine Remove (Update _) = Remove 79 | combine (Update dv1) (Update dv2) = Update (dv1 <> dv2) 80 | 81 | instance monoidMapChanges :: (Ord k, Patch v dv) => Monoid (MapChanges k v dv) where 82 | mempty = MapChanges Map.empty 83 | 84 | instance patchIMap 85 | :: (Ord k, Patch v dv) 86 | => Patch (IMap k v) (MapChanges k v dv) where 87 | patch (IMap m1) (MapChanges m2) = 88 | IMap <<< Map.fromFoldable <<< mapMaybe (\(Tuple k v) -> Tuple k <$> v) <<< Map.toUnfoldable $ align m1 m2 <#> 89 | case _ of 90 | This x -> Just x 91 | That (Add v) -> Just v 92 | Both _ (Add v) -> Just v 93 | Both v (Update dv) -> Just (patch v dv) 94 | _ -> Nothing 95 | 96 | instance diffIMap 97 | :: (Ord k, Diff v dv) 98 | => Diff (IMap k v) (MapChanges k v dv) where 99 | diff (IMap m1) (IMap m2) = MapChanges $ align m1 m2 <#> 100 | case _ of 101 | This x -> Remove 102 | That y -> Add y 103 | Both x y -> Update (diff x y) 104 | 105 | insert :: forall k v dv. Ord k => Patch v dv => k -> v -> Change (IMap k v) 106 | insert k v = toChange (wrap (Map.singleton k (Add v))) 107 | 108 | remove :: forall k v dv. Ord k => Patch v dv => k -> Change (IMap k v) 109 | remove k = toChange (wrap (Map.singleton k Remove)) 110 | 111 | updateAt :: forall k v dv. Ord k => Patch v dv => k -> Change v -> Change (IMap k v) 112 | updateAt k c = toChange (wrap (Map.singleton k (Update (fromChange c)))) 113 | 114 | -- | Construct a map from a key/value pair. 115 | singleton :: forall k v dv. Ord k => Patch v dv => k -> Jet v -> Jet (IMap k v) 116 | singleton k v = static (Map.singleton k v) 117 | 118 | -- | Construct a map whose values can change but whose keys are fixed. 119 | static 120 | :: forall k v dv 121 | . Ord k 122 | => Patch v dv 123 | => Map.Map k (Jet v) 124 | -> Jet (IMap k v) 125 | static xs = 126 | { position: wrap (Prelude.map _.position xs) 127 | , velocity: toChange (MapChanges (Prelude.map (Update <<< fromChange <<< _.velocity) xs)) 128 | } 129 | 130 | -- | Update a single key by applying a function. 131 | modifyAt 132 | :: forall k v dv 133 | . Ord k 134 | => Patch v dv 135 | => k 136 | -> (Jet v -> Jet v) 137 | -> Jet (IMap k v) 138 | -> Jet (IMap k v) 139 | modifyAt k f { position: IMap m, velocity: dm } = 140 | { position: IMap (Map.update (Just <<< _.position <<< f <<< constant) k m) 141 | , velocity: toChange (MapChanges (Map.update (Just <<< go (Map.lookup k m)) k (unwrap (fromChange dm)))) 142 | } 143 | where 144 | go _ (Add v) = Add (patch v (fromChange j.velocity)) where j = f (constant v) 145 | go _ Remove = Remove 146 | go (Just v) (Update dv) = Update (fromChange j.velocity) where j = f { position: v, velocity: toChange dv } 147 | go _ (Update _) = Update mempty 148 | 149 | -- | Update every key by applying a function. 150 | map 151 | :: forall k a da b db 152 | . Ord k 153 | => Patch a da 154 | => Patch b db 155 | => (Jet a -> Jet b) 156 | -> Jet (IMap k a) 157 | -> Jet (IMap k b) 158 | map f { position: IMap m, velocity: dm } = 159 | { position: IMap (Prelude.map (_.position <<< f <<< constant) m) 160 | , velocity: toChange (MapChanges (go <$> align m (unwrap (fromChange dm)))) 161 | } 162 | where 163 | go :: These a (MapChange a da) -> MapChange b db 164 | go (This v) = Update (fromChange j.velocity) where j = f (constant v) 165 | go (That (Add v)) = Add (patch j.position (fromChange j.velocity)) where j = f (constant v) 166 | go (Both _ Remove) = Remove 167 | go (Both v (Update dv)) = Update (fromChange j.velocity) where j = f { position: v, velocity: toChange dv } 168 | go _ = Update mempty 169 | 170 | -- | Compute the size of an `IMap`, incrementally. 171 | size 172 | :: forall k a da 173 | . Ord k 174 | => Patch a da 175 | => Jet (IMap k a) 176 | -> Jet (Atomic Int) 177 | size { position: IMap m, velocity: dm } = 178 | { position: wrap cur 179 | , velocity: toChange (pure (cur + sum (Prelude.map sizeOf (align m (unwrap (fromChange dm)))))) 180 | } 181 | where 182 | cur = Map.size m 183 | 184 | sizeOf :: These a (MapChange a da) -> Int 185 | sizeOf (Both _ Remove) = -1 186 | sizeOf (That (Add _)) = 1 187 | sizeOf _ = 0 188 | 189 | -- | Zip two maps, keeping those keys which are common to _both_ input maps. 190 | zip 191 | :: forall k a da b db 192 | . Ord k 193 | => Patch a da 194 | => Patch b db 195 | => Jet (IMap k a) 196 | -> Jet (IMap k b) 197 | -> Jet (IMap k (Tuple a b)) 198 | zip { position: IMap m1, velocity: dm1 } { position: IMap m2, velocity: dm2 } = 199 | let z = zipMap m1 m2 200 | 201 | isRemove :: forall x dx. MapChange x dx -> Boolean 202 | isRemove Remove = true 203 | isRemove _ = false 204 | 205 | go :: These (Tuple a b) (These (MapChange a da) (MapChange b db)) 206 | -> Maybe (MapChange (Tuple a b) (Tuple da db)) 207 | go (That (Both (Add a) (Add b))) = Just (Add (Tuple a b)) 208 | go (Both _ e) | biany isRemove isRemove e = Just Remove 209 | go (Both _ (This (Update da))) = Just (Update (Tuple da mempty)) 210 | go (Both _ (That (Update db))) = Just (Update (Tuple mempty db)) 211 | go (Both _ (Both (Update da) (Update db))) = Just (Update (Tuple da db)) 212 | go _ = Nothing 213 | in { position: IMap z 214 | , velocity: toChange (MapChanges (filterMap go (z `align` (unwrap (fromChange dm1) `align` unwrap (fromChange dm2))))) 215 | } 216 | 217 | -- | Convert an `IMap` into an `IArray` of tuples of keys and values, in order, 218 | -- | incrementally. 219 | toIArray 220 | :: forall k a da 221 | . Ord k 222 | => Patch a da 223 | => Jet (IMap k a) 224 | -> Jet (IArray (Tuple (Atomic k) a)) 225 | toIArray { position, velocity } = 226 | { position: wrap (Prelude.map (lmap Atomic) (Map.toUnfoldable (unwrap position))) 227 | , velocity: toChange (mapAccumL go 0 (Map.toUnfoldable (unwrap (fromChange velocity)))).value 228 | } 229 | where 230 | indexOf :: forall x. k -> Map k x -> Int 231 | indexOf k m = unwrap (Map.foldSubmap Nothing (Just k) (\_ _ -> Additive 1) m) - 1 232 | 233 | go :: Int 234 | -> Tuple k (MapChange a da) 235 | -> { accum :: Int 236 | , value :: ArrayChange (Tuple (Atomic k) a) (Tuple (Last k) da) 237 | } 238 | go n (Tuple k (Add a)) = 239 | { accum: n + 1 240 | , value: InsertAt (n + indexOf k (unwrap position) + 1) (Tuple (Atomic k) a) 241 | } 242 | go n (Tuple k Remove) = 243 | { accum: n - 1 244 | , value: DeleteAt (n + indexOf k (unwrap position)) 245 | } 246 | go n (Tuple k (Update da)) = 247 | { accum: n 248 | , value: ModifyAt (indexOf k (unwrap position)) (Tuple mempty da) 249 | } 250 | 251 | -- Helpers 252 | 253 | align :: forall k a b. Ord k => Map k a -> Map k b -> Map k (These a b) 254 | align xs ys = 255 | Map.unionWith 256 | (unsafePartial \(This x) (That y) -> Both x y) 257 | (Prelude.map This xs) 258 | (Prelude.map That ys) 259 | 260 | zipMap 261 | :: forall k a b 262 | . Ord k 263 | => Map k a 264 | -> Map k b 265 | -> Map k (Tuple a b) 266 | zipMap m1 m2 = filterMap go (align m1 m2) where 267 | go (Both a b) = Just (Tuple a b) 268 | go _ = Nothing 269 | --------------------------------------------------------------------------------