├── .gitignore ├── LICENSE ├── README.md ├── elm-package.json ├── elm.json ├── src ├── Accessors.elm └── Accessors │ ├── Internal.elm │ ├── Lazy.elm │ └── Library.elm └── tests ├── Spec.elm ├── SpecLazy.elm ├── Test └── Accessors │ └── Record.elm └── elm-package.json /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff/ 2 | docs.json 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, 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, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The Accessors library 2 | ===================== 3 | 4 | This library provides a way to describe relations between a container and its 5 | content, and use that description to manipulate arbitrary data more easily. 6 | 7 | # Build your relations 8 | 9 | There are two kinds of relations between a container and its content: 1:1 10 | relations (e.g. a record and its field) and 1:n relations (e.g. a `List` can 11 | contain 0-n elements, a `Maybe` can contain 0-1 elements). 12 | 13 | For 1:1 relations, the `makeOneToOne` function will let you build an accessor 14 | by describing how to get the sub-element from the super-element, and how to map 15 | a function over it. For instance, with a record: 16 | 17 | ```elm 18 | recordFoo = 19 | makeOneToOne 20 | .foo 21 | (\change record -> {record | foo = change record.foo}) 22 | 23 | recordBar = 24 | makeOneToOne 25 | .bar 26 | (\change record -> {record | bar = change record.bar}) 27 | ``` 28 | 29 | 1:n relations are more complex in terms of abstraction, but they are usually 30 | very easy to implement: 31 | 32 | ```elm 33 | onEach = 34 | makeOneToN 35 | List.map 36 | List.map 37 | 38 | try = 39 | makeOneToN 40 | Maybe.map 41 | Maybe.map 42 | ``` 43 | 44 | # Combine your relations 45 | 46 | Accessors can be composed easily to describe relations: 47 | 48 | ```elm 49 | myData = { foo = [ {bar = 3} 50 | , {bar = 2} 51 | , {bar = 0} 52 | ] 53 | } 54 | 55 | myAccessor = recordFoo << onEach << recordBar 56 | ``` 57 | 58 | # Manipulate your data easily 59 | 60 | Then you use an action function to determine which kind of operation you want to 61 | do on your data using the accessor 62 | 63 | ```elm 64 | getter = get myAccessor myData 65 | -- returns [3, 2, 0] 66 | 67 | setter = set myAccessor 2 myData 68 | -- returns {foo = [{bar = 2}, {bar = 2}, {bar = 2}]} 69 | 70 | transform = over myAccessor (\n -> n*2) myData 71 | -- returns {foo = [{bar = 6}, {bar = 4}, {bar = 0}]} 72 | ``` 73 | 74 | # Type-safe and reusable 75 | 76 | Applying an accessor on non-matching data structures will yield nice 77 | compile-time errors: 78 | 79 | ```elm 80 | fail = (recordFoo << recordFoo) myData 81 | 82 | --The 2nd argument to `get` is not what I expect: 83 | -- 84 | --293| fail = get (recordFoo << recordFoo) myData 85 | -- ^^^^^^ 86 | --This `myData` value is a: 87 | -- 88 | -- { foo : List { bar : number } } 89 | -- 90 | --But `get` needs the 2nd argument to be: 91 | -- 92 | -- { foo : { a | foo : c } } 93 | ``` 94 | 95 | Any accessor you make can be composed with any other accessor to match your new 96 | data structures: 97 | 98 | ```elm 99 | myOtherData = {bar = Just [1, 3, 2]} 100 | 101 | halfWay = try << onEach 102 | myOtherAccessor = recordBar << halfWay 103 | 104 | getter = get myOtherAccessor myOtherData 105 | -- returns Just [1, 3, 2] 106 | ``` 107 | # Play with it in Ellie 108 | 109 | [Ellie default code with accessors](https://ellie-app.com/4wHNCxgft87a1). 110 | 111 | # Contribute 112 | 113 | build 114 | 115 | ```elm make``` 116 | 117 | run tests 118 | 119 | `elm-test` 120 | 121 | or 122 | 123 | `elm-test-rs` 124 | 125 | If you write new accessor combinators that rely on common library datas, I'll be 126 | happy to review and merge. Please include tests for your combinators. 127 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.0.0", 3 | "summary": "Accessors, a library implementing lenses for Elm.", 4 | "repository": "https://github.com/bChiquet/elm-accessors.git", 5 | "license": "MIT", 6 | "source-directories": [ 7 | "src/" 8 | ], 9 | "exposed-modules": [ 10 | "Accessors", 11 | "Accessors.Library" 12 | ], 13 | "dependencies": { 14 | "elm-lang/core": "5.1.1 <= v < 6.0.0" 15 | }, 16 | "elm-version": "0.18.0 <= v < 0.19.0" 17 | } -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "bChiquet/elm-accessors", 4 | "summary": "Accessors, a library implementing lenses for Elm.", 5 | "license": "MIT", 6 | "version": "3.0.0", 7 | "exposed-modules": [ 8 | "Accessors", 9 | "Accessors.Lazy", 10 | "Accessors.Library" 11 | ], 12 | "elm-version": "0.19.0 <= v < 0.20.0", 13 | "dependencies": { 14 | "elm/core": "1.0.0 <= v < 2.0.0" 15 | }, 16 | "test-dependencies": { 17 | "elm-explorations/test": "1.2.2 <= v < 2.0.0" 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /src/Accessors.elm: -------------------------------------------------------------------------------- 1 | module Accessors exposing 2 | ( Relation 3 | , get, set, over 4 | , makeOneToOne, makeOneToN 5 | ) 6 | 7 | {-| Relations are interfaces to document the relation between two data 8 | structures. For convenience, we'll call the containing structure `super`, and 9 | the contained structure `sub`. What a `Relation` claims is that a `super` is 10 | referencing a `sub` in some way. 11 | 12 | Relations are the building blocks of accessors. An accessor is a function that 13 | expects a `Relation` and builds a new relation with it. Accessors are 14 | composable, which means you can build a chain of relations to manipulate nested 15 | structures without handling the packing and the unpacking. 16 | 17 | # Action functions 18 | 19 | Action functions are functions that take an accessor and let you perform a 20 | specific action on data using that accessor. 21 | 22 | @docs get, set, over 23 | 24 | # Build accessors 25 | 26 | Accessors are built using these functions: 27 | 28 | @docs makeOneToOne, makeOneToN 29 | 30 | # Relation 31 | 32 | @docs Relation 33 | -} 34 | 35 | import Accessors.Internal as Internal exposing (Relation(..), id) 36 | 37 | {-| A `Relation super sub wrap` is a type describing how to interact with a 38 | `sub` data when given a `super` data. 39 | 40 | The `wrap` exists because some types can't ensure that `get` will return a 41 | `sub`. For instance, `Maybe sub` may not actually contain a `sub`. Therefore, 42 | `get` returns a `wrap` which, in that example, will be `Maybe sub` 43 | 44 | Implementation: A relation is a banal record storing a `get` function and an 45 | `over` function. 46 | -} 47 | type alias Relation super sub wrap = Internal.Relation super sub wrap 48 | 49 | 50 | {-| The get function takes: 51 | * An accessor, 52 | * A datastructure with type `super` 53 | and returns the value accessed by that combinator. 54 | ``` 55 | get (foo << bar) myRecord 56 | ``` 57 | -} 58 | get : (Relation sub sub sub -> Relation super sub wrap) -> super -> wrap 59 | get accessor s = 60 | let (Relation relation) = (accessor id) 61 | in relation.get s 62 | 63 | 64 | {-|The set function takes: 65 | * An accessor, 66 | * A value of the type `sub`, 67 | * A datastructure with type `super` 68 | and it returns the data structure, with the accessible field changed to be 69 | the set value. 70 | ``` 71 | set (foo << bar) "Hi!" myRecord 72 | ``` 73 | -} 74 | set : (Relation sub sub sub -> Relation super sub wrap) -> sub -> super -> super 75 | set accessor value s = 76 | let (Relation relation) = (accessor id) 77 | in relation.over (\_ -> value) s 78 | 79 | 80 | {-|The over function takes: 81 | * An accessor, 82 | * A function `(sub -> sub)`, 83 | * A datastructure with type `super` 84 | and it returns the data structure, with the accessible field changed by applying 85 | the function to the existing value. 86 | ``` 87 | over (foo << qux) ((+) 1) myRecord 88 | ``` 89 | -} 90 | over : (Relation sub sub sub -> Relation super sub wrap) 91 | -> (sub -> sub) 92 | -> super 93 | -> super 94 | over accessor change s = 95 | let (Relation relation) = (accessor id) 96 | in relation.over change s 97 | 98 | 99 | {-| This function lets you build an accessor for containers that have 100 | a 1:1 relation with what they contain, such as a record and one of its fields: 101 | 102 | ``` 103 | foo : Relation field sub wrap -> Relation {rec | foo : field} sub wrap 104 | foo = 105 | makeOneToOne 106 | .foo 107 | (\change rec -> {rec | foo = change rec.foo }) 108 | ``` 109 | -} 110 | makeOneToOne : (super -> sub) 111 | -> ((sub -> sub) -> super -> super) 112 | -> Relation sub reachable wrap 113 | -> Relation super reachable wrap 114 | makeOneToOne getter mapper (Relation sub) = 115 | Relation { get = \super -> sub.get (getter super) 116 | , over = \change super -> mapper (sub.over change) super 117 | } 118 | 119 | {-| This function lets you build an accessor for containers that have 120 | a 1:N relation with what they contain, such as `List` (0-N cardinality) or 121 | `Maybe` (0-1). E.g.: 122 | ``` 123 | onEach : Relation elem sub wrap -> Relation (List elem) sub (List wrap) 124 | onEach = 125 | makeOneToN 126 | List.map 127 | List.map 128 | ``` 129 | n.b. implementing those is usually considerably simpler than the type suggests. 130 | -} 131 | makeOneToN : ((sub -> subWrap) -> super -> superWrap) 132 | -> ((sub -> sub) -> super -> super) 133 | -> Relation sub reachable subWrap 134 | -> Relation super reachable superWrap 135 | makeOneToN getter mapper (Relation sub) = 136 | Relation { get = \super -> getter sub.get super 137 | , over = \change super -> mapper (sub.over change) super 138 | } 139 | -------------------------------------------------------------------------------- /src/Accessors/Internal.elm: -------------------------------------------------------------------------------- 1 | module Accessors.Internal exposing 2 | ( Relation(..) 3 | , id 4 | ) 5 | 6 | 7 | {-| A `Relation super sub wrap` is a type describing how to interact with a 8 | `sub` data when given a `super` data. 9 | 10 | The `wrap` exists because some types can't ensure that `get` will return a 11 | `sub`. For instance, `Maybe sub` may not actually contain a `sub`. Therefore, 12 | `get` returns a `wrap` which, in that example, will be `Maybe sub` 13 | 14 | Implementation: A relation is a banal record storing a `get` function and an 15 | `over` function. 16 | -} 17 | type Relation super sub wrap = 18 | Relation { get : super -> wrap 19 | , over : (sub -> sub) -> (super -> super) } 20 | 21 | 22 | {-| id is a neutral `Relation`. It is used to end a braid of accessors (see 23 | the implementation for get, set and over). 24 | -} 25 | id : Relation a a a 26 | id = 27 | Relation { get = \a -> a 28 | , over = \change -> (\a -> change a) 29 | } 30 | -------------------------------------------------------------------------------- /src/Accessors/Lazy.elm: -------------------------------------------------------------------------------- 1 | module Accessors.Lazy exposing 2 | (get, set, over) 3 | 4 | {-| Lazy versions of set, over. 5 | 6 | These actions check that the old and the new version are different before writing. 7 | They are useful when used together with `Html.lazy`, because it uses reference 8 | equality for complex structures. Therefore, using lazy `set` and `over` will 9 | not prevent `Html.lazy` from doing its work. 10 | 11 | get is also reexported for convenience. 12 | 13 | @docs get, set, over 14 | -} 15 | 16 | import Accessors.Internal exposing (Relation(..), id) 17 | import Accessors as Strict 18 | 19 | {-| The get function takes: 20 | * An accessor, 21 | * A datastructure with type `super` 22 | and returns the value accessed by that combinator. 23 | ``` 24 | get (foo << bar) myRecord 25 | ``` 26 | -} 27 | get : (Relation sub sub sub -> Relation super sub wrap) -> super -> wrap 28 | get = Strict.get 29 | 30 | 31 | {-|The set function takes: 32 | * An accessor, 33 | * A value of the type `sub`, 34 | * A datastructure with type `super` 35 | and it returns the data structure, with the accessible field changed to the set value. 36 | The structure is changed only if the new field is different from the old one. 37 | ``` 38 | set (foo << bar) "Hi!" myRecord 39 | ``` 40 | -} 41 | set : (Relation sub sub sub -> Relation super sub wrap) -> sub -> super -> super 42 | set accessor value s = 43 | let newSuper = Strict.set accessor value s 44 | in if get accessor newSuper /= get accessor s 45 | then newSuper 46 | else s 47 | 48 | {-|The over function takes: 49 | * An accessor, 50 | * A function `(sub -> sub)`, 51 | * A datastructure with type `super` 52 | and it returns the data structure, with the accessible field changed by applying 53 | the function to the existing value. 54 | The structure is changed only if the new field is different from the old one. 55 | ``` 56 | over (foo << qux) ((+) 1) myRecord 57 | ``` 58 | -} 59 | over : (Relation sub sub sub -> Relation super sub wrap) 60 | -> (sub -> sub) 61 | -> super 62 | -> super 63 | over accessor change s = 64 | let newSuper = Strict.over accessor change s 65 | in if get accessor newSuper /= get accessor s 66 | then newSuper 67 | else s 68 | -------------------------------------------------------------------------------- /src/Accessors/Library.elm: -------------------------------------------------------------------------------- 1 | module Accessors.Library exposing (onEach, try, dictEntry) 2 | 3 | {-| This library contains common accessors. 4 | 5 | @docs onEach, try, dictEntry 6 | -} 7 | 8 | import Accessors exposing (Relation, makeOneToOne, makeOneToN) 9 | import Dict exposing (Dict) 10 | 11 | {-| This accessor combinator lets you access values inside lists. 12 | 13 | listRecord = { foo = [ {bar = 2} 14 | , {bar = 3} 15 | , {bar = 4} 16 | ] 17 | } 18 | 19 | get (foo << onEach << bar) listRecord 20 | -- returns [2, 3, 4] 21 | 22 | over (foo << onEach << bar) ((+) 1) listRecord 23 | -- returns {foo = [{bar = 3}, {bar = 4}, {bar = 5}]} 24 | -} 25 | onEach : Relation super sub wrap -> Relation (List super) sub (List wrap) 26 | onEach = makeOneToN List.map List.map 27 | 28 | 29 | {-| This accessor combinator lets you access values inside Maybe. 30 | 31 | maybeRecord = { foo = Just {bar = 2} 32 | , qux = Nothing 33 | } 34 | 35 | get (foo << try << bar) maybeRecord 36 | -- returns Just 2 37 | 38 | get (qux << try << bar) maybeRecord 39 | -- returns Nothing 40 | 41 | over (foo << try << bar) ((+) 1) maybeRecord 42 | -- returns {foo = Just {bar = 3}, qux = Nothing} 43 | 44 | over (qux << try << bar) ((+) 1) maybeRecord 45 | -- returns {foo = Just {bar = 2}, qux = Nothing} 46 | -} 47 | try : Relation super sub wrap -> Relation (Maybe super) sub (Maybe wrap) 48 | try = makeOneToN Maybe.map Maybe.map 49 | 50 | {-| This accessor combinator lets you access Dict members. 51 | 52 | In terms of accessors, think of Dicts as records where each field is a Maybe. 53 | 54 | dict = Dict.fromList [("foo", {bar = 2})] 55 | 56 | get (dictEntry "foo") dict 57 | -- returns Just {bar = 2} 58 | 59 | get (dictEntry "baz" dict) 60 | -- returns Nothing 61 | 62 | get (dictEntry "foo" << try << bar) dict 63 | -- returns Just 2 64 | 65 | set (dictEntry "foo") Nothing dict 66 | -- returns Dict.remove "foo" dict 67 | 68 | set (dictEntry "baz" << try << bar) 3 dict 69 | -- returns dict 70 | -} 71 | dictEntry : comparable -> Relation (Maybe v) reachable wrap -> Relation (Dict comparable v) reachable wrap 72 | dictEntry key = 73 | makeOneToOne (Dict.get key) (Dict.update key) 74 | -------------------------------------------------------------------------------- /tests/Spec.elm: -------------------------------------------------------------------------------- 1 | module Spec exposing (suite) 2 | 3 | import Test exposing (Test, describe, test) 4 | import Expect 5 | import Accessors exposing (get, set, over, makeOneToOne, makeOneToN) 6 | import Accessors.Library exposing (onEach, try, dictEntry) 7 | import Test.Accessors.Record exposing (r) 8 | import Dict exposing (Dict) 9 | 10 | 11 | simpleRecord = {foo = 3, bar = "Yop", qux = False} 12 | anotherRecord = {foo = 5, bar = "Sup", qux = True} 13 | nestedRecord = {foo = simpleRecord} 14 | recordWithList = {bar = [simpleRecord, anotherRecord]} 15 | maybeRecord = {bar = Just simpleRecord, foo = Nothing} 16 | dict = Dict.fromList [("foo", 7)] 17 | recordWithDict = {bar = dict} 18 | dictWithRecord = Dict.fromList [("foo", {bar = "Yop"})] 19 | 20 | suite : Test 21 | suite = 22 | describe "working lenses" 23 | [ describe "get" 24 | [ test "simple get" <| \_ -> 25 | Expect.equal 26 | ( get r.foo simpleRecord) 27 | 3 28 | , test "nested get" <| \_ -> 29 | Expect.equal 30 | (get (r.foo << r.bar) nestedRecord) 31 | "Yop" 32 | , test "get in list" <| \_ -> 33 | Expect.equal 34 | (get (r.bar << onEach << r.foo) recordWithList) 35 | [3, 5] 36 | , test "get in Just" <| \_ -> 37 | Expect.equal 38 | (get (r.bar << try << r.qux) maybeRecord) 39 | (Just False) 40 | , test "get in Nothing" <| \_ -> 41 | Expect.equal 42 | (get (r.foo << try << r.bar) maybeRecord) 43 | Nothing 44 | , describe "dict" 45 | [ test "get present" <| \_ -> 46 | Expect.equal 47 | (get (dictEntry "foo") dict) 48 | (Just 7) 49 | , test "get absent" <| \_ -> 50 | Expect.equal 51 | (get (dictEntry "bar") dict) 52 | Nothing 53 | , test "nested get present" <| \_ -> 54 | Expect.equal 55 | (get (r.bar << dictEntry "foo") recordWithDict) 56 | (Just 7) 57 | , test "nested get absent" <| \_ -> 58 | Expect.equal 59 | (get (r.bar << dictEntry "bar") recordWithDict) 60 | Nothing 61 | , test "get with try" <| \_ -> 62 | Expect.equal 63 | (get (dictEntry "foo" << try << r.bar) dictWithRecord) 64 | (Just "Yop") 65 | ] 66 | ] 67 | , describe "set" 68 | [ test "simple set" <| \_ -> 69 | let updatedExample = 70 | (set r.qux True simpleRecord) 71 | in Expect.equal 72 | updatedExample.qux 73 | True 74 | , test "nested set" <| \_-> 75 | let updatedExample = 76 | (set (r.foo << r.foo) 5 nestedRecord) 77 | in Expect.equal 78 | updatedExample.foo.foo 79 | 5 80 | , test "set in list" <| \_ -> 81 | let updatedExample = 82 | (set (r.bar << onEach << r.bar) "Why, hello" recordWithList) 83 | in Expect.equal 84 | (get (r.bar << onEach << r.bar) updatedExample) 85 | ["Why, hello", "Why, hello"] 86 | , test "set in Just" <| \_ -> 87 | let updatedExample = 88 | (set (r.bar << try << r.foo) 4 maybeRecord) 89 | in Expect.equal 90 | (get (r.bar << try << r.foo) updatedExample) 91 | (Just 4) 92 | , test "set in Nothing" <| \_ -> 93 | let updatedExample = 94 | (set (r.foo << try << r.bar) "Nope" maybeRecord) 95 | in Expect.equal 96 | (get (r.foo << try << r.bar) updatedExample) 97 | Nothing 98 | , describe "dict" 99 | [ test "set currently present to present" <| \_ -> 100 | let updatedDict = set (dictEntry "foo") (Just 9) dict 101 | in Expect.equal (get (dictEntry "foo") updatedDict) (Just 9) 102 | , test "set currently absent to present" <| \_ -> 103 | let updatedDict = set (dictEntry "bar") (Just 9) dict 104 | in Expect.equal (get (dictEntry "bar") updatedDict) (Just 9) 105 | , test "set currently present to absent" <| \_ -> 106 | let updatedDict = set (dictEntry "foo") Nothing dict 107 | in Expect.equal (get (dictEntry "foo") updatedDict) Nothing 108 | , test "set currently absent to absent" <| \_ -> 109 | let updatedDict = set (dictEntry "bar") Nothing dict 110 | in Expect.equal (get (dictEntry "bar") updatedDict) Nothing 111 | , test "set with try present" <| \_ -> 112 | let updatedDict = set (dictEntry "foo" << try << r.bar) "Sup" dictWithRecord 113 | in Expect.equal (get (dictEntry "foo" << try << r.bar) updatedDict) (Just "Sup") 114 | , test "set with try absent" <| \_ -> 115 | let updatedDict = set (dictEntry "bar" << try << r.bar) "Sup" dictWithRecord 116 | in Expect.equal (get (dictEntry "bar" << try << r.bar) updatedDict) Nothing 117 | ] 118 | ] 119 | , describe "over" 120 | [ test "simple over" <| \_ -> 121 | let updatedExample = 122 | (over r.bar (\w -> w ++ " lait") simpleRecord) 123 | in Expect.equal 124 | updatedExample.bar 125 | "Yop lait" 126 | , test "nested over" <| \_ -> 127 | let updatedExample = 128 | (over (r.foo << r.qux) (\w -> not w) nestedRecord) 129 | in Expect.equal 130 | updatedExample.foo.qux 131 | True 132 | , test "over list" <| \_ -> 133 | let updatedExample = 134 | (over (r.bar << onEach << r.foo) (\n -> n-2) recordWithList) 135 | in Expect.equal 136 | (get (r.bar << onEach << r.foo) updatedExample) 137 | [1, 3] 138 | , test "over through Just" <| \_ -> 139 | let updatedExample = 140 | (over (r.bar << try << r.foo) (\n -> n+3) maybeRecord) 141 | in Expect.equal 142 | (get (r.bar << try << r.foo) updatedExample) 143 | (Just 6) 144 | , test "over through Nothing" <| \_ -> 145 | let updatedExample = 146 | (over (r.foo << try << r.bar) (\w -> w++"!") maybeRecord) 147 | in Expect.equal 148 | (get (r.foo << try << r.bar) updatedExample) 149 | Nothing 150 | ] 151 | , describe "making accessors" 152 | [ let myFoo = makeOneToOne 153 | .foo 154 | (\f rec -> {rec | foo = f rec.foo}) 155 | in describe "makeOneToOne" 156 | [ test "get" <| \_ -> 157 | Expect.equal 158 | (get (myFoo << r.bar) nestedRecord) 159 | "Yop" 160 | , test "set" <| \_ -> 161 | let updatedRec = (set (r.foo << myFoo) 1 nestedRecord) 162 | in Expect.equal updatedRec.foo.foo 1 163 | , test "over" <| \_ -> 164 | let updatedRec = (over (myFoo << myFoo) (\n -> n+3) nestedRecord) 165 | in Expect.equal updatedRec.foo.foo 6 166 | ] 167 | , let myOnEach = makeOneToN List.map List.map 168 | in describe "makeOneToN" 169 | [ test "get" <| \_ -> 170 | Expect.equal 171 | (get (r.bar << myOnEach << r.foo) recordWithList) 172 | [3, 5] 173 | , test "set" <| \_ -> 174 | let updatedExample = 175 | (set (r.bar << myOnEach << r.bar) "Greetings" recordWithList) 176 | in Expect.equal 177 | (get (r.bar << onEach << r.bar) updatedExample) 178 | ["Greetings", "Greetings"] 179 | , test "over" <| \_ -> 180 | let updatedExample = 181 | (over (r.bar << myOnEach << r.foo) (\n -> n-2) recordWithList) 182 | in Expect.equal 183 | (get (r.bar << onEach << r.foo) updatedExample) 184 | [1, 3] 185 | ] 186 | ] 187 | ] 188 | -------------------------------------------------------------------------------- /tests/SpecLazy.elm: -------------------------------------------------------------------------------- 1 | module SpecLazy exposing (suite) 2 | 3 | import Test exposing (Test, describe, test) 4 | import Expect 5 | import Accessors exposing (makeOneToOne, makeOneToN) 6 | import Accessors.Lazy exposing (get, set, over) 7 | import Accessors.Library exposing (onEach, try, dictEntry) 8 | import Test.Accessors.Record exposing (r) 9 | import Dict exposing (Dict) 10 | 11 | 12 | simpleRecord = {foo = 3, bar = "Yop", qux = False} 13 | anotherRecord = {foo = 5, bar = "Sup", qux = True} 14 | nestedRecord = {foo = simpleRecord} 15 | recordWithList = {bar = [simpleRecord, anotherRecord]} 16 | maybeRecord = {bar = Just simpleRecord, foo = Nothing} 17 | dict = Dict.fromList [("foo", 7)] 18 | recordWithDict = {bar = dict} 19 | dictWithRecord = Dict.fromList [("foo", {bar = "Yop"})] 20 | 21 | suite : Test 22 | suite = 23 | describe "lazy lenses" 24 | [ describe "get" 25 | [ test "simple get" <| \_ -> 26 | Expect.equal 27 | ( get r.foo simpleRecord) 28 | 3 29 | , test "nested get" <| \_ -> 30 | Expect.equal 31 | (get (r.foo << r.bar) nestedRecord) 32 | "Yop" 33 | , test "get in list" <| \_ -> 34 | Expect.equal 35 | (get (r.bar << onEach << r.foo) recordWithList) 36 | [3, 5] 37 | , test "get in Just" <| \_ -> 38 | Expect.equal 39 | (get (r.bar << try << r.qux) maybeRecord) 40 | (Just False) 41 | , test "get in Nothing" <| \_ -> 42 | Expect.equal 43 | (get (r.foo << try << r.bar) maybeRecord) 44 | Nothing 45 | , describe "dict" 46 | [ test "get present" <| \_ -> 47 | Expect.equal 48 | (get (dictEntry "foo") dict) 49 | (Just 7) 50 | , test "get absent" <| \_ -> 51 | Expect.equal 52 | (get (dictEntry "bar") dict) 53 | Nothing 54 | , test "nested get present" <| \_ -> 55 | Expect.equal 56 | (get (r.bar << dictEntry "foo") recordWithDict) 57 | (Just 7) 58 | , test "nested get absent" <| \_ -> 59 | Expect.equal 60 | (get (r.bar << dictEntry "bar") recordWithDict) 61 | Nothing 62 | , test "get with try" <| \_ -> 63 | Expect.equal 64 | (get (dictEntry "foo" << try << r.bar) dictWithRecord) 65 | (Just "Yop") 66 | ] 67 | ] 68 | , describe "set" 69 | [ test "simple set" <| \_ -> 70 | let updatedExample = 71 | (set r.qux True simpleRecord) 72 | in Expect.equal 73 | updatedExample.qux 74 | True 75 | , test "nested set" <| \_-> 76 | let updatedExample = 77 | (set (r.foo << r.foo) 5 nestedRecord) 78 | in Expect.equal 79 | updatedExample.foo.foo 80 | 5 81 | , test "set in list" <| \_ -> 82 | let updatedExample = 83 | (set (r.bar << onEach << r.bar) "Why, hello" recordWithList) 84 | in Expect.equal 85 | (get (r.bar << onEach << r.bar) updatedExample) 86 | ["Why, hello", "Why, hello"] 87 | , test "set in Just" <| \_ -> 88 | let updatedExample = 89 | (set (r.bar << try << r.foo) 4 maybeRecord) 90 | in Expect.equal 91 | (get (r.bar << try << r.foo) updatedExample) 92 | (Just 4) 93 | , test "set in Nothing" <| \_ -> 94 | let updatedExample = 95 | (set (r.foo << try << r.bar) "Nope" maybeRecord) 96 | in Expect.equal 97 | (get (r.foo << try << r.bar) updatedExample) 98 | Nothing 99 | , describe "dict" 100 | [ test "set currently present to present" <| \_ -> 101 | let updatedDict = set (dictEntry "foo") (Just 9) dict 102 | in Expect.equal (get (dictEntry "foo") updatedDict) (Just 9) 103 | , test "set currently absent to present" <| \_ -> 104 | let updatedDict = set (dictEntry "bar") (Just 9) dict 105 | in Expect.equal (get (dictEntry "bar") updatedDict) (Just 9) 106 | , test "set currently present to absent" <| \_ -> 107 | let updatedDict = set (dictEntry "foo") Nothing dict 108 | in Expect.equal (get (dictEntry "foo") updatedDict) Nothing 109 | , test "set currently absent to absent" <| \_ -> 110 | let updatedDict = set (dictEntry "bar") Nothing dict 111 | in Expect.equal (get (dictEntry "bar") updatedDict) Nothing 112 | , test "set with try present" <| \_ -> 113 | let updatedDict = set (dictEntry "foo" << try << r.bar) "Sup" dictWithRecord 114 | in Expect.equal (get (dictEntry "foo" << try << r.bar) updatedDict) (Just "Sup") 115 | , test "set with try absent" <| \_ -> 116 | let updatedDict = set (dictEntry "bar" << try << r.bar) "Sup" dictWithRecord 117 | in Expect.equal (get (dictEntry "bar" << try << r.bar) updatedDict) Nothing 118 | ] 119 | ] 120 | , describe "over" 121 | [ test "simple over" <| \_ -> 122 | let updatedExample = 123 | (over r.bar (\w -> w ++ " lait") simpleRecord) 124 | in Expect.equal 125 | updatedExample.bar 126 | "Yop lait" 127 | , test "nested over" <| \_ -> 128 | let updatedExample = 129 | (over (r.foo << r.qux) (\w -> not w) nestedRecord) 130 | in Expect.equal 131 | updatedExample.foo.qux 132 | True 133 | , test "over list" <| \_ -> 134 | let updatedExample = 135 | (over (r.bar << onEach << r.foo) (\n -> n-2) recordWithList) 136 | in Expect.equal 137 | (get (r.bar << onEach << r.foo) updatedExample) 138 | [1, 3] 139 | , test "over through Just" <| \_ -> 140 | let updatedExample = 141 | (over (r.bar << try << r.foo) (\n -> n+3) maybeRecord) 142 | in Expect.equal 143 | (get (r.bar << try << r.foo) updatedExample) 144 | (Just 6) 145 | , test "over through Nothing" <| \_ -> 146 | let updatedExample = 147 | (over (r.foo << try << r.bar) (\w -> w++"!") maybeRecord) 148 | in Expect.equal 149 | (get (r.foo << try << r.bar) updatedExample) 150 | Nothing 151 | ] 152 | , describe "making accessors" 153 | [ let myFoo = makeOneToOne 154 | .foo 155 | (\f rec -> {rec | foo = f rec.foo}) 156 | in describe "makeOneToOne" 157 | [ test "get" <| \_ -> 158 | Expect.equal 159 | (get (myFoo << r.bar) nestedRecord) 160 | "Yop" 161 | , test "set" <| \_ -> 162 | let updatedRec = (set (r.foo << myFoo) 1 nestedRecord) 163 | in Expect.equal updatedRec.foo.foo 1 164 | , test "over" <| \_ -> 165 | let updatedRec = (over (myFoo << myFoo) (\n -> n+3) nestedRecord) 166 | in Expect.equal updatedRec.foo.foo 6 167 | ] 168 | , let myOnEach = makeOneToN List.map List.map 169 | in describe "makeOneToN" 170 | [ test "get" <| \_ -> 171 | Expect.equal 172 | (get (r.bar << myOnEach << r.foo) recordWithList) 173 | [3, 5] 174 | , test "set" <| \_ -> 175 | let updatedExample = 176 | (set (r.bar << myOnEach << r.bar) "Greetings" recordWithList) 177 | in Expect.equal 178 | (get (r.bar << onEach << r.bar) updatedExample) 179 | ["Greetings", "Greetings"] 180 | , test "over" <| \_ -> 181 | let updatedExample = 182 | (over (r.bar << myOnEach << r.foo) (\n -> n-2) recordWithList) 183 | in Expect.equal 184 | (get (r.bar << onEach << r.foo) updatedExample) 185 | [1, 3] 186 | ] 187 | ] 188 | ] 189 | -------------------------------------------------------------------------------- /tests/Test/Accessors/Record.elm: -------------------------------------------------------------------------------- 1 | module Test.Accessors.Record exposing (r) 2 | 3 | import Accessors exposing (makeOneToOne) 4 | 5 | r = { bar = makeOneToOne 6 | .bar 7 | (\change rec -> {rec | bar = change rec.bar}) 8 | , foo = makeOneToOne 9 | .foo 10 | (\change rec -> {rec | foo = change rec.foo}) 11 | , qux = makeOneToOne 12 | .qux 13 | (\change rec -> {rec | qux = change rec.qux}) 14 | } 15 | -------------------------------------------------------------------------------- /tests/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Test Suites", 4 | "repository": "https://github.com/bChiquet/doesnotexist.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "../src", 8 | "." 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "eeue56/elm-html-test": "5.2.0 <= v < 6.0.0", 13 | "elm-community/elm-test": "4.0.0 <= v < 5.0.0", 14 | "elm-lang/core": "5.1.1 <= v < 6.0.0" 15 | }, 16 | "elm-version": "0.18.0 <= v < 0.19.0" 17 | } 18 | --------------------------------------------------------------------------------