├── .travis.yml ├── .gitignore ├── package.json ├── CHANGELOG.md ├── review ├── src │ └── ReviewConfig.elm └── elm.json ├── elm.json ├── LICENSE ├── benchmark ├── elm.json └── src │ └── Main.elm ├── README.md └── tests ├── AstCodec.elm ├── AstCodecV1.elm ├── Base.elm ├── SerializeV1.elm └── FileSizeTests.elm /.travis.yml: -------------------------------------------------------------------------------- 1 | language: elm 2 | sudo: false -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /elm-stuff 2 | /.idea 3 | /node_modules 4 | /review/elm-stuff 5 | /benchmark/elm-stuff -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "elm-codec-bytes", 3 | "version": "1.0.0", 4 | "main": "index.js", 5 | "license": "MIT", 6 | "scripts": { 7 | "test": "elm-test --watch --fuzz 300" 8 | }, 9 | "dependencies": { 10 | "elm": "^0.19.1-3", 11 | "elm-doc-preview": "^5.0.3", 12 | "elm-format": "^0.8.2", 13 | "elm-review": "^2.2.6", 14 | "elm-test": "^0.19.1-revision6" 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## 1.0.0 4 | 5 | * Initial release 6 | 7 | ## 1.0.1 8 | 9 | * Fixed a bug with encoding multibyte unicode characters 10 | 11 | ## 1.1.0 12 | 13 | * Added Codec for `()` (aka `Unit`) 14 | * Fixed mistakes in documentation 15 | 16 | ## 1.2.0 17 | 18 | * Added `encodeToJson` and `decodeFromJson` 19 | 20 | ## 1.2.1 - 1.2.4 21 | 22 | * Fixed various mistakes in the documentation 23 | 24 | ## 1.2.5 25 | 26 | * Remove unused dependencies 27 | 28 | ## 1.2.6 29 | 30 | * Fix more mistakes in the documentation 31 | 32 | ## 1.3.0 33 | 34 | * Add getJsonDecoder function 35 | 36 | ## 1.3.1 37 | 38 | * Fix mistakes in README.md code examples -------------------------------------------------------------------------------- /review/src/ReviewConfig.elm: -------------------------------------------------------------------------------- 1 | module ReviewConfig exposing (config) 2 | 3 | {-| Do not rename the ReviewConfig module or the config function, because 4 | `elm-review` will look for these. 5 | 6 | To add packages that contain rules, add them to this review project using 7 | 8 | `elm install author/packagename` 9 | 10 | when inside the directory containing this file. 11 | 12 | -} 13 | 14 | import NoUnused.Dependencies 15 | import NoUnused.Parameters 16 | import NoUnused.Patterns 17 | import NoUnused.Variables 18 | import Review.Rule exposing (Rule) 19 | 20 | 21 | config : List Rule 22 | config = 23 | [ NoUnused.Dependencies.rule 24 | , NoUnused.Parameters.rule 25 | , NoUnused.Patterns.rule 26 | , NoUnused.Variables.rule 27 | ] 28 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "MartinSStewart/elm-serialize", 4 | "summary": "Write codecs for encoding and decoding Elm data.", 5 | "license": "MIT", 6 | "version": "1.3.1", 7 | "exposed-modules": [ 8 | "Serialize" 9 | ], 10 | "elm-version": "0.19.0 <= v < 0.20.0", 11 | "dependencies": { 12 | "bburdette/toop": "1.0.1 <= v < 2.0.0", 13 | "danfishgold/base64-bytes": "1.0.3 <= v < 2.0.0", 14 | "elm/bytes": "1.0.8 <= v < 2.0.0", 15 | "elm/core": "1.0.2 <= v < 2.0.0", 16 | "elm/json": "1.1.3 <= v < 2.0.0", 17 | "elm/regex": "1.0.0 <= v < 2.0.0" 18 | }, 19 | "test-dependencies": { 20 | "elm/url": "1.0.0 <= v < 2.0.0", 21 | "elm-community/basics-extra": "4.0.0 <= v < 5.0.0", 22 | "elm-explorations/test": "2.0.0 <= v < 3.0.0", 23 | "stil4m/elm-syntax": "7.1.3 <= v < 8.0.0" 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Martin Stewart 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. -------------------------------------------------------------------------------- /review/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.5", 10 | "elm/json": "1.1.3", 11 | "elm/project-metadata-utils": "1.0.1", 12 | "jfmengels/elm-review": "2.2.0", 13 | "jfmengels/review-unused": "2.1.3", 14 | "stil4m/elm-syntax": "7.1.3" 15 | }, 16 | "indirect": { 17 | "elm/html": "1.0.0", 18 | "elm/parser": "1.1.0", 19 | "elm/random": "1.0.0", 20 | "elm/time": "1.0.0", 21 | "elm/url": "1.0.0", 22 | "elm/virtual-dom": "1.0.2", 23 | "elm-community/json-extra": "4.3.0", 24 | "elm-community/list-extra": "8.2.4", 25 | "elm-explorations/test": "1.2.2", 26 | "rtfeldman/elm-hex": "1.0.0", 27 | "rtfeldman/elm-iso8601-date-strings": "1.1.3", 28 | "stil4m/structured-writer": "1.0.3" 29 | } 30 | }, 31 | "test-dependencies": { 32 | "direct": { 33 | "elm-explorations/test": "1.2.2" 34 | }, 35 | "indirect": {} 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /benchmark/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src", 5 | "../src", 6 | "../tests" 7 | ], 8 | "elm-version": "0.19.1", 9 | "dependencies": { 10 | "direct": { 11 | "bburdette/toop": "1.0.1", 12 | "danfishgold/base64-bytes": "1.0.3", 13 | "elm/browser": "1.0.2", 14 | "elm/bytes": "1.0.8", 15 | "elm/core": "1.0.5", 16 | "elm/html": "1.0.0", 17 | "elm/json": "1.1.3", 18 | "elm/regex": "1.0.0", 19 | "elm-explorations/benchmark": "1.0.1", 20 | "stil4m/elm-syntax": "7.1.3" 21 | }, 22 | "indirect": { 23 | "BrianHicks/elm-trend": "2.1.3", 24 | "Skinney/murmur3": "2.0.8", 25 | "elm/parser": "1.1.0", 26 | "elm/time": "1.0.0", 27 | "elm/url": "1.0.0", 28 | "elm/virtual-dom": "1.0.2", 29 | "elm-community/json-extra": "4.3.0", 30 | "elm-community/list-extra": "8.2.4", 31 | "mdgriffith/style-elements": "5.0.1", 32 | "rtfeldman/elm-hex": "1.0.0", 33 | "rtfeldman/elm-iso8601-date-strings": "1.1.3", 34 | "stil4m/structured-writer": "1.0.3" 35 | } 36 | }, 37 | "test-dependencies": { 38 | "direct": {}, 39 | "indirect": {} 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /benchmark/src/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | {-| These benchmarks take a while to run so don't worry if the browser doesn't show anything for several minutes. 4 | -} 5 | 6 | import AstCodec 7 | import AstCodecV1 8 | import Benchmark exposing (Benchmark, benchmark, describe) 9 | import Benchmark.Runner exposing (BenchmarkProgram) 10 | import Elm.Parser 11 | import Elm.Processing 12 | import Serialize as S 13 | import SerializeV1 14 | 15 | 16 | suite : Benchmark 17 | suite = 18 | describe "Benchmarks" 19 | [ describe "Encoding" 20 | [ benchmark "bytes" <| 21 | \_ -> code |> Result.map (S.encodeToBytes AstCodec.file) 22 | , benchmark "bytes v1" <| 23 | \_ -> code |> Result.map (SerializeV1.encodeToBytes AstCodecV1.file) 24 | , benchmark "json" <| 25 | \_ -> code |> Result.map (S.encodeToJson AstCodec.file) 26 | , benchmark "string" <| 27 | \_ -> code |> Result.map (S.encodeToString AstCodec.file) 28 | , benchmark "string v1" <| 29 | \_ -> code |> Result.map (SerializeV1.encodeToString AstCodecV1.file) 30 | ] 31 | , decodingBenchmarks 32 | ] 33 | 34 | 35 | decodingBenchmarks : Benchmark 36 | decodingBenchmarks = 37 | code 38 | |> Result.map 39 | (\file -> 40 | let 41 | bytesData = 42 | S.encodeToBytes AstCodec.file file 43 | 44 | jsonData = 45 | S.encodeToJson AstCodec.file file 46 | 47 | stringData = 48 | S.encodeToString AstCodec.file file 49 | in 50 | [ benchmark "bytes" <| 51 | \_ -> S.decodeFromBytes AstCodec.file bytesData 52 | , benchmark "bytes v1" <| 53 | \_ -> SerializeV1.decodeFromBytes AstCodecV1.file bytesData 54 | , benchmark "json" <| 55 | \_ -> S.decodeFromJson AstCodec.file jsonData 56 | , benchmark "string" <| 57 | \_ -> S.decodeFromString AstCodec.file stringData 58 | , benchmark "string v1" <| 59 | \_ -> SerializeV1.decodeFromString AstCodecV1.file stringData 60 | ] 61 | ) 62 | |> Result.toMaybe 63 | |> Maybe.withDefault [] 64 | |> describe "Decoding" 65 | 66 | 67 | main : BenchmarkProgram 68 | main = 69 | Benchmark.Runner.program suite 70 | 71 | 72 | code = 73 | Result.map (Elm.Processing.process Elm.Processing.init) <| 74 | Elm.Parser.parse <| 75 | """module Serialize exposing(..) 76 | 77 | 78 | lazy : (() -> Codec e a) -> Codec e a 79 | lazy f = 80 | build 81 | (\\value -> getEncoder (f ()) value) 82 | (BD.succeed () |> BD.andThen (\\() -> getDecoder (f ()))) 83 | 84 | """ 85 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # elm-serialize 2 | 3 | Quickly and reliably write code to handle serialization of Elm data structures. 4 | This is done via `Codec`s which automatically create both the encoder and decoder ensuring that they don't get out of sync with each other. 5 | 6 | ### What elm-serialize is good for? 7 | - Sparing you from having to write both encoders and decoders 8 | - Reliably encoding and decoding Elm types (no more failing to decode because you made a typo somewhere!) 9 | - The data format is an implementation detail so you can use `encodeToJson`, `encodeToBytes`, or `encodeToString`. 10 | 11 | ### What elm-serialize is *not* good for? 12 | - Decoding external data formats 13 | - Encoding to a human readable format 14 | 15 | ## Basic usage 16 | 17 | ```elm 18 | import Serialize as S 19 | 20 | type alias MeAndMyFriends = 21 | { me : String 22 | , myFriends : List String 23 | } 24 | 25 | friendsCodec : S.Codec e (List String) 26 | friendsCodec = 27 | S.list S.string 28 | 29 | meAndMyFriendsCodec : S.Codec e MeAndMyFriends 30 | meAndMyFriendsCodec = 31 | S.record Model 32 | |> S.field .me S.string 33 | |> S.field .myFriends friendsCodec 34 | |> S.finishRecord 35 | 36 | encode : MeAndMyFriends -> Bytes 37 | encode meAndMyFriends = 38 | S.encodeToBytes meAndMyFriendsCodec meAndMyFriends 39 | 40 | decode : Bytes -> Result (S.Error e) MeAndMyFriends 41 | decode data = 42 | S.decodeFromBytes meAndMyFriendsCodec data 43 | ``` 44 | 45 | ## Writing codecs for custom types 46 | 47 | ```elm 48 | import Serialize as S 49 | 50 | type Semaphore 51 | = Red Int String Bool 52 | | Yellow Float 53 | | Green 54 | 55 | semaphoreCodec : S.Codec e Semaphore 56 | semaphoreCodec = 57 | S.customType 58 | (\redEncoder yellowEncoder greenEncoder value -> 59 | case value of 60 | Red i s b -> 61 | redEncoder i s b 62 | 63 | Yellow f -> 64 | yellowEncoder f 65 | 66 | Green -> 67 | greenEncoder 68 | ) 69 | |> S.variant3 Red S.int S.string S.bool 70 | |> S.variant1 Yellow S.float 71 | |> S.variant0 Green 72 | |> S.finishCustomType 73 | ``` 74 | 75 | ## Why isn't there a codec for `Char`? 76 | 77 | `Char` has problems https://github.com/elm/core/issues/1001 78 | 79 | There are a variety of unicode code points that get transformed into multiple code points when you change their casing, but Elm still treats these as `Char`. 80 | So if we made a codec for this we'd drop the extra code points and end up with something like this: 81 | ```elm 82 | import Serialize as S 83 | 84 | Char.toUpper 'ß' --> 'SS' 85 | |> S.encodeToBytes hypotheticalCharCodec 86 | |> S.decodeFromBytes --> Ok 'S' 87 | ``` 88 | 89 | So the short of it is, it's not possible to create a `Char` that won't sometimes mess up your data when decoding. 90 | 91 | ## How do I change my `Codec`s and still be able to decode old data? 92 | 93 | First let's cover what counts as a breaking change for a Codec. 94 | 95 | For records, adding or removing `field` is a breaking change. 96 | Changing the Codec used in a `field` is also a breaking change. 97 | 98 | For custom types, removing a `variant` is a breaking change. 99 | Changing one of the Codecs used in a `variant` or changing how many Codecs are used is a breaking change. 100 | 101 | Appending a `variant` is *not* a breaking change. 102 | ```elm 103 | import Serialize as S 104 | 105 | -- We've enhanced the semaphore with a rainbow variant! 106 | type Semaphore 107 | = Red Int String Bool 108 | | Yellow Float 109 | | Green 110 | | Rainbow 111 | 112 | S.customType 113 | (\redEncoder yellowEncoder greenEncoder rainbowEncoder value -> 114 | case value of 115 | Red i s b -> 116 | redEncoder i s b 117 | 118 | Yellow f -> 119 | yellowEncoder f 120 | 121 | Green -> 122 | greenEncoder 123 | 124 | Rainbow -> 125 | rainbowEncoder 126 | ) 127 | |> S.variant3 Red S.int S.string S.bool 128 | |> S.variant1 Yellow S.float 129 | |> S.variant0 Green 130 | -- We can safely add the new variant here at the end. 131 | |> S.variant0 Rainbow 132 | |> S.finishCustomType 133 | ``` 134 | The example above will still decode anything encoded with the semaphoreCodec in the [custom types example](#writing-codecs-for-custom-types) 135 | 136 | Knowing this, what we can do is have a top level custom type that lets us handle different versions of our Codec. 137 | 138 | Suppose we are making an app that can serialize the users GPS coordinate. 139 | We are in a rush to get this app working so we just store GPS coordinates as a string. 140 | 141 | Here's an example of what that would look like: 142 | ```elm 143 | import Serialize as S 144 | 145 | {-| The gps coordinate used internally in our application 146 | -} 147 | type alias GpsCoordinate = 148 | String 149 | 150 | type GpsVersions 151 | = GpsV1 GpsCoordinate 152 | 153 | gpsV1Codec : S.Codec e GpsCoordinate 154 | gpsV1Codec = 155 | S.string 156 | 157 | gpsCodec : S.Codec e GpsCoordinate 158 | gpsCodec = 159 | S.customType 160 | (\gpsV1Encoder value -> 161 | case value of 162 | GpsV1 text -> 163 | gpsV1Encoder text 164 | ) 165 | |> S.variant1 GpsV1 gpsV1Codec 166 | |> S.finishCustomType 167 | |> S.map 168 | (\value -> 169 | case value of 170 | GpsV1 text -> 171 | text 172 | ) 173 | (\value -> GpsV1 value) 174 | ``` 175 | 176 | Then a while later we start refactoring the app. Internally we replace all those GPS strings with `(Float, Float)`. 177 | We still want to decode all the serialized data though so we change our module to look like this: 178 | 179 | ```elm 180 | import Serialize as S 181 | 182 | {-| The gps coordinate used internally in our application 183 | -} 184 | type alias GpsCoordinate = 185 | ( Float, Float ) 186 | 187 | type GpsCoordinateVersions 188 | = V1GpsCoordinate String -- Old way of storing GPS coordinates 189 | | V2GpsCoordinate GpsCoordinate -- New better way 190 | 191 | gpsCoordinateV1Codec = 192 | S.string 193 | 194 | gpsCoordinateV2Codec = 195 | S.tuple S.float S.float 196 | 197 | gpsCoordinateCodec : S.Codec e GpsCoordinate 198 | gpsCoordinateCodec = 199 | S.customType 200 | (\gpsCoordinateV1Encoder gpsCoordinateV2Encoder value -> 201 | case value of 202 | V1GpsCoordinate text -> 203 | gpsCoordinateV1Encoder text 204 | 205 | V2GpsCoordinate tuple -> 206 | gpsCoordinateV2Encoder tuple 207 | ) 208 | |> S.variant1 V1GpsCoordinate gpsCoordinateV1Codec 209 | -- We append our new GPS codec. This is not a breaking change. 210 | |> S.variant1 V2GpsCoordinate gpsCoordinateV2Codec 211 | |> S.finishCustomType 212 | |> S.map 213 | (\value -> 214 | case value of 215 | V1GpsCoordinate text -> 216 | -- After we've decoded an old GPS coordinate, we need to convert it to the new format. 217 | v1GpsToGpsCoordinate text 218 | 219 | V2GpsCoordinate tuple -> 220 | -- No conversion needed here 221 | tuple 222 | ) 223 | V2GpsCoordinate 224 | 225 | v1GpsToGpsCoordinate : String -> GpsCoordinate 226 | v1GpsToGpsCoordinate = 227 | Debug.todo "Add the conversion code" 228 | ``` 229 | If we decide to make more changes to our GPS coordinate, we can safely just append more variants to act as versions. 230 | The crucial thing is that we had this versioning system set up from the beginning. If we had just written 231 | ```elm 232 | gpsCoordinateCodec : S.Codec e GpsCoordinate 233 | gpsCoordinateCodec = S.string 234 | ``` 235 | then we wouldn't be able to add a new version later. 236 | 237 | ## Credits 238 | 239 | This package is an iteration on `MartinSStewart/elm-codec-bytes` which is in turn inspired by `miniBill/elm-codec`. 240 | 241 | Also thanks to [jfmengels](https://github.com/jfmengels) and [drathier](https://github.com/drathier) for providing lots of feedback! 242 | -------------------------------------------------------------------------------- /tests/AstCodec.elm: -------------------------------------------------------------------------------- 1 | module AstCodec exposing (file) 2 | 3 | import Elm.Syntax.Declaration exposing (Declaration(..)) 4 | import Elm.Syntax.Exposing exposing (ExposedType, Exposing(..), TopLevelExpose(..)) 5 | import Elm.Syntax.Expression exposing (CaseBlock, Expression(..), Function, FunctionImplementation, Lambda, LetBlock, LetDeclaration(..), RecordSetter) 6 | import Elm.Syntax.File exposing (File) 7 | import Elm.Syntax.Import exposing (Import) 8 | import Elm.Syntax.Infix exposing (Infix, InfixDirection(..)) 9 | import Elm.Syntax.Module exposing (DefaultModuleData, EffectModuleData, Module(..)) 10 | import Elm.Syntax.Node exposing (Node(..)) 11 | import Elm.Syntax.Pattern exposing (Pattern(..), QualifiedNameRef) 12 | import Elm.Syntax.Range exposing (Location, Range) 13 | import Elm.Syntax.Signature exposing (Signature) 14 | import Elm.Syntax.Type exposing (Type, ValueConstructor) 15 | import Elm.Syntax.TypeAlias exposing (TypeAlias) 16 | import Elm.Syntax.TypeAnnotation exposing (RecordDefinition, TypeAnnotation(..)) 17 | import Serialize as S exposing (Codec) 18 | 19 | 20 | location : Codec e Location 21 | location = 22 | S.record (\row column -> Location row column) 23 | |> S.field .row S.int 24 | |> S.field .column S.int 25 | |> S.finishRecord 26 | 27 | 28 | range : Codec e Range 29 | range = 30 | S.record Range 31 | |> S.field .start location 32 | |> S.field .end location 33 | |> S.finishRecord 34 | 35 | 36 | node : Codec e a -> Codec e (Node a) 37 | node codec = 38 | S.customType 39 | (\encoder (Node a b) -> 40 | encoder a b 41 | ) 42 | |> S.variant2 Node range codec 43 | |> S.finishCustomType 44 | 45 | 46 | char : Codec DecodeError Char 47 | char = 48 | S.string 49 | |> S.mapValid 50 | (\string -> 51 | case String.toList string of 52 | head :: _ -> 53 | Ok head 54 | 55 | [] -> 56 | Err InvalidChar 57 | ) 58 | String.fromChar 59 | 60 | 61 | type DecodeError 62 | = InvalidChar 63 | 64 | 65 | infixDirection : Codec e InfixDirection 66 | infixDirection = 67 | S.enum Left [ Right, Non ] 68 | 69 | 70 | expression : Codec DecodeError Expression 71 | expression = 72 | S.customType 73 | (\e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11 e12 e13 e14 e15 e16 e17 e18 e19 e20 e21 e22 e23 value -> 74 | case value of 75 | Application a -> 76 | e0 a 77 | 78 | UnitExpr -> 79 | e1 80 | 81 | OperatorApplication a b c d -> 82 | e2 a b c d 83 | 84 | FunctionOrValue a b -> 85 | e3 a b 86 | 87 | IfBlock a b c -> 88 | e4 a b c 89 | 90 | PrefixOperator a -> 91 | e5 a 92 | 93 | Operator a -> 94 | e6 a 95 | 96 | Integer a -> 97 | e7 a 98 | 99 | Hex a -> 100 | e8 a 101 | 102 | Floatable a -> 103 | e9 a 104 | 105 | Negation a -> 106 | e10 a 107 | 108 | Literal a -> 109 | e11 a 110 | 111 | CharLiteral a -> 112 | e12 a 113 | 114 | TupledExpression a -> 115 | e13 a 116 | 117 | ParenthesizedExpression a -> 118 | e14 a 119 | 120 | LetExpression a -> 121 | e15 a 122 | 123 | CaseExpression a -> 124 | e16 a 125 | 126 | LambdaExpression a -> 127 | e17 a 128 | 129 | RecordExpr a -> 130 | e18 a 131 | 132 | ListExpr a -> 133 | e19 a 134 | 135 | RecordAccess a b -> 136 | e20 a b 137 | 138 | RecordAccessFunction a -> 139 | e21 a 140 | 141 | RecordUpdateExpression a b -> 142 | e22 a b 143 | 144 | GLSLExpression a -> 145 | e23 a 146 | ) 147 | |> S.variant1 Application (S.list (node lazyExpression)) 148 | |> S.variant0 UnitExpr 149 | |> S.variant4 OperatorApplication S.string infixDirection (node lazyExpression) (node lazyExpression) 150 | |> S.variant2 FunctionOrValue (S.list S.string) S.string 151 | |> S.variant3 IfBlock (node lazyExpression) (node lazyExpression) (node lazyExpression) 152 | |> S.variant1 PrefixOperator S.string 153 | |> S.variant1 Operator S.string 154 | |> S.variant1 Integer S.int 155 | |> S.variant1 Hex S.int 156 | |> S.variant1 Floatable S.float 157 | |> S.variant1 Negation (node lazyExpression) 158 | |> S.variant1 Literal S.string 159 | |> S.variant1 CharLiteral char 160 | |> S.variant1 TupledExpression (S.list (node lazyExpression)) 161 | |> S.variant1 ParenthesizedExpression (node lazyExpression) 162 | |> S.variant1 LetExpression letBlock 163 | |> S.variant1 CaseExpression caseBlock 164 | |> S.variant1 LambdaExpression lambda 165 | |> S.variant1 RecordExpr (S.list (node recordSetter)) 166 | |> S.variant1 ListExpr (S.list (node lazyExpression)) 167 | |> S.variant2 RecordAccess (node lazyExpression) (node S.string) 168 | |> S.variant1 RecordAccessFunction S.string 169 | |> S.variant2 RecordUpdateExpression (node S.string) (S.list (node recordSetter)) 170 | |> S.variant1 GLSLExpression S.string 171 | |> S.finishCustomType 172 | 173 | 174 | caseBlock : Codec DecodeError CaseBlock 175 | caseBlock = 176 | S.record CaseBlock 177 | |> S.field .expression (node lazyExpression) 178 | |> S.field .cases (S.list (S.tuple (node pattern) (node lazyExpression))) 179 | |> S.finishRecord 180 | 181 | 182 | lambda : Codec DecodeError Lambda 183 | lambda = 184 | S.record Lambda 185 | |> S.field .args (S.list (node pattern)) 186 | |> S.field .expression (node lazyExpression) 187 | |> S.finishRecord 188 | 189 | 190 | recordSetter : Codec DecodeError RecordSetter 191 | recordSetter = 192 | S.tuple (node S.string) (node lazyExpression) 193 | 194 | 195 | letBlock : Codec DecodeError LetBlock 196 | letBlock = 197 | S.record LetBlock 198 | |> S.field .declarations (S.list (node letDeclaration)) 199 | |> S.field .expression (node lazyExpression) 200 | |> S.finishRecord 201 | 202 | 203 | letDeclaration : Codec DecodeError LetDeclaration 204 | letDeclaration = 205 | S.customType 206 | (\e0 e1 value -> 207 | case value of 208 | LetFunction a -> 209 | e0 a 210 | 211 | LetDestructuring a b -> 212 | e1 a b 213 | ) 214 | |> S.variant1 LetFunction function 215 | |> S.variant2 LetDestructuring (node pattern) (node lazyExpression) 216 | |> S.finishCustomType 217 | 218 | 219 | function : Codec DecodeError Function 220 | function = 221 | S.record Function 222 | |> S.field .documentation (S.maybe (node S.string)) 223 | |> S.field .signature (S.maybe (node signature)) 224 | |> S.field .declaration (node functionImplementation) 225 | |> S.finishRecord 226 | 227 | 228 | signature : Codec e Signature 229 | signature = 230 | S.record Signature 231 | |> S.field .name (node S.string) 232 | |> S.field .typeAnnotation (node typeAnnotation) 233 | |> S.finishRecord 234 | 235 | 236 | typeAnnotation : Codec e TypeAnnotation 237 | typeAnnotation = 238 | S.customType 239 | (\e0 e1 e2 e3 e4 e5 e6 value -> 240 | case value of 241 | GenericType a -> 242 | e0 a 243 | 244 | Typed a b -> 245 | e1 a b 246 | 247 | Unit -> 248 | e2 249 | 250 | Tupled a -> 251 | e3 a 252 | 253 | Record a -> 254 | e4 a 255 | 256 | GenericRecord a b -> 257 | e5 a b 258 | 259 | FunctionTypeAnnotation a b -> 260 | e6 a b 261 | ) 262 | |> S.variant1 GenericType S.string 263 | |> S.variant2 Typed (node (S.tuple (S.list S.string) S.string)) (S.list (node lazyTypeAnnotation)) 264 | |> S.variant0 Unit 265 | |> S.variant1 Tupled (S.list (node lazyTypeAnnotation)) 266 | |> S.variant1 Record recordDefinition 267 | |> S.variant2 GenericRecord (node S.string) (node recordDefinition) 268 | |> S.variant2 FunctionTypeAnnotation (node lazyTypeAnnotation) (node lazyTypeAnnotation) 269 | |> S.finishCustomType 270 | 271 | 272 | lazyTypeAnnotation : Codec e TypeAnnotation 273 | lazyTypeAnnotation = 274 | S.lazy (\() -> typeAnnotation) 275 | 276 | 277 | recordDefinition : Codec e RecordDefinition 278 | recordDefinition = 279 | S.list (node (S.tuple (node S.string) (node lazyTypeAnnotation))) 280 | 281 | 282 | functionImplementation : Codec DecodeError FunctionImplementation 283 | functionImplementation = 284 | S.record FunctionImplementation 285 | |> S.field .name (node S.string) 286 | |> S.field .arguments (S.list (node pattern)) 287 | |> S.field .expression (node lazyExpression) 288 | |> S.finishRecord 289 | 290 | 291 | pattern : Codec DecodeError Pattern 292 | pattern = 293 | S.customType 294 | (\e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11 e12 e13 e14 value -> 295 | case value of 296 | AllPattern -> 297 | e0 298 | 299 | UnitPattern -> 300 | e1 301 | 302 | CharPattern a -> 303 | e2 a 304 | 305 | StringPattern a -> 306 | e3 a 307 | 308 | IntPattern a -> 309 | e4 a 310 | 311 | HexPattern a -> 312 | e5 a 313 | 314 | FloatPattern a -> 315 | e6 a 316 | 317 | TuplePattern a -> 318 | e7 a 319 | 320 | RecordPattern a -> 321 | e8 a 322 | 323 | UnConsPattern a b -> 324 | e9 a b 325 | 326 | ListPattern a -> 327 | e10 a 328 | 329 | VarPattern a -> 330 | e11 a 331 | 332 | NamedPattern a b -> 333 | e12 a b 334 | 335 | AsPattern a b -> 336 | e13 a b 337 | 338 | ParenthesizedPattern a -> 339 | e14 a 340 | ) 341 | |> S.variant0 AllPattern 342 | |> S.variant0 UnitPattern 343 | |> S.variant1 CharPattern char 344 | |> S.variant1 StringPattern S.string 345 | |> S.variant1 IntPattern S.int 346 | |> S.variant1 HexPattern S.int 347 | |> S.variant1 FloatPattern S.float 348 | |> S.variant1 TuplePattern (S.list (node lazyPattern)) 349 | |> S.variant1 RecordPattern (S.list (node S.string)) 350 | |> S.variant2 UnConsPattern (node lazyPattern) (node lazyPattern) 351 | |> S.variant1 ListPattern (S.list (node lazyPattern)) 352 | |> S.variant1 VarPattern S.string 353 | |> S.variant2 NamedPattern qualifiedNameRef (S.list (node lazyPattern)) 354 | |> S.variant2 AsPattern (node lazyPattern) (node S.string) 355 | |> S.variant1 ParenthesizedPattern (node lazyPattern) 356 | |> S.finishCustomType 357 | 358 | 359 | lazyPattern : Codec DecodeError Pattern 360 | lazyPattern = 361 | S.lazy (\() -> pattern) 362 | 363 | 364 | qualifiedNameRef : Codec e QualifiedNameRef 365 | qualifiedNameRef = 366 | S.record QualifiedNameRef 367 | |> S.field .moduleName (S.list S.string) 368 | |> S.field .name S.string 369 | |> S.finishRecord 370 | 371 | 372 | lazyExpression : Codec DecodeError Expression 373 | lazyExpression = 374 | S.lazy (\() -> expression) 375 | 376 | 377 | file : Codec DecodeError File 378 | file = 379 | S.record File 380 | |> S.field .moduleDefinition (node module_) 381 | |> S.field .imports (S.list (node import_)) 382 | |> S.field .declarations (S.list (node declaration)) 383 | |> S.field .comments (S.list (node S.string)) 384 | |> S.finishRecord 385 | 386 | 387 | import_ : Codec e Import 388 | import_ = 389 | S.record Import 390 | |> S.field .moduleName (node (S.list S.string)) 391 | |> S.field .moduleAlias (S.maybe (node (S.list S.string))) 392 | |> S.field .exposingList (S.maybe (node exposing_)) 393 | |> S.finishRecord 394 | 395 | 396 | module_ : Codec e Module 397 | module_ = 398 | S.customType 399 | (\e0 e1 e2 value -> 400 | case value of 401 | NormalModule a -> 402 | e0 a 403 | 404 | PortModule a -> 405 | e1 a 406 | 407 | EffectModule a -> 408 | e2 a 409 | ) 410 | |> S.variant1 NormalModule defaultModuleData 411 | |> S.variant1 PortModule defaultModuleData 412 | |> S.variant1 EffectModule effectModuleData 413 | |> S.finishCustomType 414 | 415 | 416 | effectModuleData : Codec e EffectModuleData 417 | effectModuleData = 418 | S.record EffectModuleData 419 | |> S.field .moduleName (node (S.list S.string)) 420 | |> S.field .exposingList (node exposing_) 421 | |> S.field .command (S.maybe (node S.string)) 422 | |> S.field .subscription (S.maybe (node S.string)) 423 | |> S.finishRecord 424 | 425 | 426 | defaultModuleData : Codec e DefaultModuleData 427 | defaultModuleData = 428 | S.record DefaultModuleData 429 | |> S.field .moduleName (node (S.list S.string)) 430 | |> S.field .exposingList (node exposing_) 431 | |> S.finishRecord 432 | 433 | 434 | exposing_ : Codec e Exposing 435 | exposing_ = 436 | S.customType 437 | (\e0 e1 value -> 438 | case value of 439 | All a -> 440 | e0 a 441 | 442 | Explicit a -> 443 | e1 a 444 | ) 445 | |> S.variant1 All range 446 | |> S.variant1 Explicit (S.list (node topLevelExpose)) 447 | |> S.finishCustomType 448 | 449 | 450 | topLevelExpose : Codec e TopLevelExpose 451 | topLevelExpose = 452 | S.customType 453 | (\e0 e1 e2 e3 value -> 454 | case value of 455 | InfixExpose a -> 456 | e0 a 457 | 458 | FunctionExpose a -> 459 | e1 a 460 | 461 | TypeOrAliasExpose a -> 462 | e2 a 463 | 464 | TypeExpose a -> 465 | e3 a 466 | ) 467 | |> S.variant1 InfixExpose S.string 468 | |> S.variant1 FunctionExpose S.string 469 | |> S.variant1 TypeOrAliasExpose S.string 470 | |> S.variant1 TypeExpose exposedType 471 | |> S.finishCustomType 472 | 473 | 474 | exposedType : Codec e ExposedType 475 | exposedType = 476 | S.record ExposedType 477 | |> S.field .name S.string 478 | |> S.field .open (S.maybe range) 479 | |> S.finishRecord 480 | 481 | 482 | declaration : Codec DecodeError Declaration 483 | declaration = 484 | S.customType 485 | (\e0 e1 e2 e3 e4 e5 value -> 486 | case value of 487 | FunctionDeclaration a -> 488 | e0 a 489 | 490 | AliasDeclaration a -> 491 | e1 a 492 | 493 | CustomTypeDeclaration a -> 494 | e2 a 495 | 496 | PortDeclaration a -> 497 | e3 a 498 | 499 | InfixDeclaration a -> 500 | e4 a 501 | 502 | Destructuring a b -> 503 | e5 a b 504 | ) 505 | |> S.variant1 FunctionDeclaration function 506 | |> S.variant1 AliasDeclaration typeAlias 507 | |> S.variant1 CustomTypeDeclaration type_ 508 | |> S.variant1 PortDeclaration signature 509 | |> S.variant1 InfixDeclaration infix_ 510 | |> S.variant2 Destructuring (node pattern) (node expression) 511 | |> S.finishCustomType 512 | 513 | 514 | infix_ : Codec e Infix 515 | infix_ = 516 | S.record Infix 517 | |> S.field .direction (node infixDirection) 518 | |> S.field .precedence (node S.int) 519 | |> S.field .operator (node S.string) 520 | |> S.field .function (node S.string) 521 | |> S.finishRecord 522 | 523 | 524 | typeAlias : Codec e TypeAlias 525 | typeAlias = 526 | S.record TypeAlias 527 | |> S.field .documentation (S.maybe (node S.string)) 528 | |> S.field .name (node S.string) 529 | |> S.field .generics (S.list (node S.string)) 530 | |> S.field .typeAnnotation (node typeAnnotation) 531 | |> S.finishRecord 532 | 533 | 534 | type_ : Codec e Type 535 | type_ = 536 | S.record Type 537 | |> S.field .documentation (S.maybe (node S.string)) 538 | |> S.field .name (node S.string) 539 | |> S.field .generics (S.list (node S.string)) 540 | |> S.field .constructors (S.list (node valueConstructor)) 541 | |> S.finishRecord 542 | 543 | 544 | valueConstructor : Codec e ValueConstructor 545 | valueConstructor = 546 | S.record ValueConstructor 547 | |> S.field .name (node S.string) 548 | |> S.field .arguments (S.list (node typeAnnotation)) 549 | |> S.finishRecord 550 | -------------------------------------------------------------------------------- /tests/AstCodecV1.elm: -------------------------------------------------------------------------------- 1 | module AstCodecV1 exposing (file) 2 | 3 | import Elm.Syntax.Declaration exposing (Declaration(..)) 4 | import Elm.Syntax.Exposing exposing (ExposedType, Exposing(..), TopLevelExpose(..)) 5 | import Elm.Syntax.Expression exposing (CaseBlock, Expression(..), Function, FunctionImplementation, Lambda, LetBlock, LetDeclaration(..), RecordSetter) 6 | import Elm.Syntax.File exposing (File) 7 | import Elm.Syntax.Import exposing (Import) 8 | import Elm.Syntax.Infix exposing (Infix, InfixDirection(..)) 9 | import Elm.Syntax.Module exposing (DefaultModuleData, EffectModuleData, Module(..)) 10 | import Elm.Syntax.Node exposing (Node(..)) 11 | import Elm.Syntax.Pattern exposing (Pattern(..), QualifiedNameRef) 12 | import Elm.Syntax.Range exposing (Location, Range) 13 | import Elm.Syntax.Signature exposing (Signature) 14 | import Elm.Syntax.Type exposing (Type, ValueConstructor) 15 | import Elm.Syntax.TypeAlias exposing (TypeAlias) 16 | import Elm.Syntax.TypeAnnotation exposing (RecordDefinition, TypeAnnotation(..)) 17 | import SerializeV1 as S exposing (Codec) 18 | 19 | 20 | location : Codec e Location 21 | location = 22 | S.record (\row column -> Location row column) 23 | |> S.field .row S.int 24 | |> S.field .column S.int 25 | |> S.finishRecord 26 | 27 | 28 | range : Codec e Range 29 | range = 30 | S.record Range 31 | |> S.field .start location 32 | |> S.field .end location 33 | |> S.finishRecord 34 | 35 | 36 | node : Codec e a -> Codec e (Node a) 37 | node codec = 38 | S.customType 39 | (\encoder (Node a b) -> 40 | encoder a b 41 | ) 42 | |> S.variant2 Node range codec 43 | |> S.finishCustomType 44 | 45 | 46 | char : Codec DecodeError Char 47 | char = 48 | S.string 49 | |> S.mapValid 50 | (\string -> 51 | case String.toList string of 52 | head :: _ -> 53 | Ok head 54 | 55 | [] -> 56 | Err InvalidChar 57 | ) 58 | String.fromChar 59 | 60 | 61 | type DecodeError 62 | = InvalidChar 63 | 64 | 65 | infixDirection : Codec e InfixDirection 66 | infixDirection = 67 | S.enum Left [ Right, Non ] 68 | 69 | 70 | expression : Codec DecodeError Expression 71 | expression = 72 | S.customType 73 | (\e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11 e12 e13 e14 e15 e16 e17 e18 e19 e20 e21 e22 e23 value -> 74 | case value of 75 | Application a -> 76 | e0 a 77 | 78 | UnitExpr -> 79 | e1 80 | 81 | OperatorApplication a b c d -> 82 | e2 a b c d 83 | 84 | FunctionOrValue a b -> 85 | e3 a b 86 | 87 | IfBlock a b c -> 88 | e4 a b c 89 | 90 | PrefixOperator a -> 91 | e5 a 92 | 93 | Operator a -> 94 | e6 a 95 | 96 | Integer a -> 97 | e7 a 98 | 99 | Hex a -> 100 | e8 a 101 | 102 | Floatable a -> 103 | e9 a 104 | 105 | Negation a -> 106 | e10 a 107 | 108 | Literal a -> 109 | e11 a 110 | 111 | CharLiteral a -> 112 | e12 a 113 | 114 | TupledExpression a -> 115 | e13 a 116 | 117 | ParenthesizedExpression a -> 118 | e14 a 119 | 120 | LetExpression a -> 121 | e15 a 122 | 123 | CaseExpression a -> 124 | e16 a 125 | 126 | LambdaExpression a -> 127 | e17 a 128 | 129 | RecordExpr a -> 130 | e18 a 131 | 132 | ListExpr a -> 133 | e19 a 134 | 135 | RecordAccess a b -> 136 | e20 a b 137 | 138 | RecordAccessFunction a -> 139 | e21 a 140 | 141 | RecordUpdateExpression a b -> 142 | e22 a b 143 | 144 | GLSLExpression a -> 145 | e23 a 146 | ) 147 | |> S.variant1 Application (S.list (node lazyExpression)) 148 | |> S.variant0 UnitExpr 149 | |> S.variant4 OperatorApplication S.string infixDirection (node lazyExpression) (node lazyExpression) 150 | |> S.variant2 FunctionOrValue (S.list S.string) S.string 151 | |> S.variant3 IfBlock (node lazyExpression) (node lazyExpression) (node lazyExpression) 152 | |> S.variant1 PrefixOperator S.string 153 | |> S.variant1 Operator S.string 154 | |> S.variant1 Integer S.int 155 | |> S.variant1 Hex S.int 156 | |> S.variant1 Floatable S.float 157 | |> S.variant1 Negation (node lazyExpression) 158 | |> S.variant1 Literal S.string 159 | |> S.variant1 CharLiteral char 160 | |> S.variant1 TupledExpression (S.list (node lazyExpression)) 161 | |> S.variant1 ParenthesizedExpression (node lazyExpression) 162 | |> S.variant1 LetExpression letBlock 163 | |> S.variant1 CaseExpression caseBlock 164 | |> S.variant1 LambdaExpression lambda 165 | |> S.variant1 RecordExpr (S.list (node recordSetter)) 166 | |> S.variant1 ListExpr (S.list (node lazyExpression)) 167 | |> S.variant2 RecordAccess (node lazyExpression) (node S.string) 168 | |> S.variant1 RecordAccessFunction S.string 169 | |> S.variant2 RecordUpdateExpression (node S.string) (S.list (node recordSetter)) 170 | |> S.variant1 GLSLExpression S.string 171 | |> S.finishCustomType 172 | 173 | 174 | caseBlock : Codec DecodeError CaseBlock 175 | caseBlock = 176 | S.record CaseBlock 177 | |> S.field .expression (node lazyExpression) 178 | |> S.field .cases (S.list (S.tuple (node pattern) (node lazyExpression))) 179 | |> S.finishRecord 180 | 181 | 182 | lambda : Codec DecodeError Lambda 183 | lambda = 184 | S.record Lambda 185 | |> S.field .args (S.list (node pattern)) 186 | |> S.field .expression (node lazyExpression) 187 | |> S.finishRecord 188 | 189 | 190 | recordSetter : Codec DecodeError RecordSetter 191 | recordSetter = 192 | S.tuple (node S.string) (node lazyExpression) 193 | 194 | 195 | letBlock : Codec DecodeError LetBlock 196 | letBlock = 197 | S.record LetBlock 198 | |> S.field .declarations (S.list (node letDeclaration)) 199 | |> S.field .expression (node lazyExpression) 200 | |> S.finishRecord 201 | 202 | 203 | letDeclaration : Codec DecodeError LetDeclaration 204 | letDeclaration = 205 | S.customType 206 | (\e0 e1 value -> 207 | case value of 208 | LetFunction a -> 209 | e0 a 210 | 211 | LetDestructuring a b -> 212 | e1 a b 213 | ) 214 | |> S.variant1 LetFunction function 215 | |> S.variant2 LetDestructuring (node pattern) (node lazyExpression) 216 | |> S.finishCustomType 217 | 218 | 219 | function : Codec DecodeError Function 220 | function = 221 | S.record Function 222 | |> S.field .documentation (S.maybe (node S.string)) 223 | |> S.field .signature (S.maybe (node signature)) 224 | |> S.field .declaration (node functionImplementation) 225 | |> S.finishRecord 226 | 227 | 228 | signature : Codec e Signature 229 | signature = 230 | S.record Signature 231 | |> S.field .name (node S.string) 232 | |> S.field .typeAnnotation (node typeAnnotation) 233 | |> S.finishRecord 234 | 235 | 236 | typeAnnotation : Codec e TypeAnnotation 237 | typeAnnotation = 238 | S.customType 239 | (\e0 e1 e2 e3 e4 e5 e6 value -> 240 | case value of 241 | GenericType a -> 242 | e0 a 243 | 244 | Typed a b -> 245 | e1 a b 246 | 247 | Unit -> 248 | e2 249 | 250 | Tupled a -> 251 | e3 a 252 | 253 | Record a -> 254 | e4 a 255 | 256 | GenericRecord a b -> 257 | e5 a b 258 | 259 | FunctionTypeAnnotation a b -> 260 | e6 a b 261 | ) 262 | |> S.variant1 GenericType S.string 263 | |> S.variant2 Typed (node (S.tuple (S.list S.string) S.string)) (S.list (node lazyTypeAnnotation)) 264 | |> S.variant0 Unit 265 | |> S.variant1 Tupled (S.list (node lazyTypeAnnotation)) 266 | |> S.variant1 Record recordDefinition 267 | |> S.variant2 GenericRecord (node S.string) (node recordDefinition) 268 | |> S.variant2 FunctionTypeAnnotation (node lazyTypeAnnotation) (node lazyTypeAnnotation) 269 | |> S.finishCustomType 270 | 271 | 272 | lazyTypeAnnotation : Codec e TypeAnnotation 273 | lazyTypeAnnotation = 274 | S.lazy (\() -> typeAnnotation) 275 | 276 | 277 | recordDefinition : Codec e RecordDefinition 278 | recordDefinition = 279 | S.list (node (S.tuple (node S.string) (node lazyTypeAnnotation))) 280 | 281 | 282 | functionImplementation : Codec DecodeError FunctionImplementation 283 | functionImplementation = 284 | S.record FunctionImplementation 285 | |> S.field .name (node S.string) 286 | |> S.field .arguments (S.list (node pattern)) 287 | |> S.field .expression (node lazyExpression) 288 | |> S.finishRecord 289 | 290 | 291 | pattern : Codec DecodeError Pattern 292 | pattern = 293 | S.customType 294 | (\e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 e10 e11 e12 e13 e14 value -> 295 | case value of 296 | AllPattern -> 297 | e0 298 | 299 | UnitPattern -> 300 | e1 301 | 302 | CharPattern a -> 303 | e2 a 304 | 305 | StringPattern a -> 306 | e3 a 307 | 308 | IntPattern a -> 309 | e4 a 310 | 311 | HexPattern a -> 312 | e5 a 313 | 314 | FloatPattern a -> 315 | e6 a 316 | 317 | TuplePattern a -> 318 | e7 a 319 | 320 | RecordPattern a -> 321 | e8 a 322 | 323 | UnConsPattern a b -> 324 | e9 a b 325 | 326 | ListPattern a -> 327 | e10 a 328 | 329 | VarPattern a -> 330 | e11 a 331 | 332 | NamedPattern a b -> 333 | e12 a b 334 | 335 | AsPattern a b -> 336 | e13 a b 337 | 338 | ParenthesizedPattern a -> 339 | e14 a 340 | ) 341 | |> S.variant0 AllPattern 342 | |> S.variant0 UnitPattern 343 | |> S.variant1 CharPattern char 344 | |> S.variant1 StringPattern S.string 345 | |> S.variant1 IntPattern S.int 346 | |> S.variant1 HexPattern S.int 347 | |> S.variant1 FloatPattern S.float 348 | |> S.variant1 TuplePattern (S.list (node lazyPattern)) 349 | |> S.variant1 RecordPattern (S.list (node S.string)) 350 | |> S.variant2 UnConsPattern (node lazyPattern) (node lazyPattern) 351 | |> S.variant1 ListPattern (S.list (node lazyPattern)) 352 | |> S.variant1 VarPattern S.string 353 | |> S.variant2 NamedPattern qualifiedNameRef (S.list (node lazyPattern)) 354 | |> S.variant2 AsPattern (node lazyPattern) (node S.string) 355 | |> S.variant1 ParenthesizedPattern (node lazyPattern) 356 | |> S.finishCustomType 357 | 358 | 359 | lazyPattern : Codec DecodeError Pattern 360 | lazyPattern = 361 | S.lazy (\() -> pattern) 362 | 363 | 364 | qualifiedNameRef : Codec e QualifiedNameRef 365 | qualifiedNameRef = 366 | S.record QualifiedNameRef 367 | |> S.field .moduleName (S.list S.string) 368 | |> S.field .name S.string 369 | |> S.finishRecord 370 | 371 | 372 | lazyExpression : Codec DecodeError Expression 373 | lazyExpression = 374 | S.lazy (\() -> expression) 375 | 376 | 377 | file : Codec DecodeError File 378 | file = 379 | S.record File 380 | |> S.field .moduleDefinition (node module_) 381 | |> S.field .imports (S.list (node import_)) 382 | |> S.field .declarations (S.list (node declaration)) 383 | |> S.field .comments (S.list (node S.string)) 384 | |> S.finishRecord 385 | 386 | 387 | import_ : Codec e Import 388 | import_ = 389 | S.record Import 390 | |> S.field .moduleName (node (S.list S.string)) 391 | |> S.field .moduleAlias (S.maybe (node (S.list S.string))) 392 | |> S.field .exposingList (S.maybe (node exposing_)) 393 | |> S.finishRecord 394 | 395 | 396 | module_ : Codec e Module 397 | module_ = 398 | S.customType 399 | (\e0 e1 e2 value -> 400 | case value of 401 | NormalModule a -> 402 | e0 a 403 | 404 | PortModule a -> 405 | e1 a 406 | 407 | EffectModule a -> 408 | e2 a 409 | ) 410 | |> S.variant1 NormalModule defaultModuleData 411 | |> S.variant1 PortModule defaultModuleData 412 | |> S.variant1 EffectModule effectModuleData 413 | |> S.finishCustomType 414 | 415 | 416 | effectModuleData : Codec e EffectModuleData 417 | effectModuleData = 418 | S.record EffectModuleData 419 | |> S.field .moduleName (node (S.list S.string)) 420 | |> S.field .exposingList (node exposing_) 421 | |> S.field .command (S.maybe (node S.string)) 422 | |> S.field .subscription (S.maybe (node S.string)) 423 | |> S.finishRecord 424 | 425 | 426 | defaultModuleData : Codec e DefaultModuleData 427 | defaultModuleData = 428 | S.record DefaultModuleData 429 | |> S.field .moduleName (node (S.list S.string)) 430 | |> S.field .exposingList (node exposing_) 431 | |> S.finishRecord 432 | 433 | 434 | exposing_ : Codec e Exposing 435 | exposing_ = 436 | S.customType 437 | (\e0 e1 value -> 438 | case value of 439 | All a -> 440 | e0 a 441 | 442 | Explicit a -> 443 | e1 a 444 | ) 445 | |> S.variant1 All range 446 | |> S.variant1 Explicit (S.list (node topLevelExpose)) 447 | |> S.finishCustomType 448 | 449 | 450 | topLevelExpose : Codec e TopLevelExpose 451 | topLevelExpose = 452 | S.customType 453 | (\e0 e1 e2 e3 value -> 454 | case value of 455 | InfixExpose a -> 456 | e0 a 457 | 458 | FunctionExpose a -> 459 | e1 a 460 | 461 | TypeOrAliasExpose a -> 462 | e2 a 463 | 464 | TypeExpose a -> 465 | e3 a 466 | ) 467 | |> S.variant1 InfixExpose S.string 468 | |> S.variant1 FunctionExpose S.string 469 | |> S.variant1 TypeOrAliasExpose S.string 470 | |> S.variant1 TypeExpose exposedType 471 | |> S.finishCustomType 472 | 473 | 474 | exposedType : Codec e ExposedType 475 | exposedType = 476 | S.record ExposedType 477 | |> S.field .name S.string 478 | |> S.field .open (S.maybe range) 479 | |> S.finishRecord 480 | 481 | 482 | declaration : Codec DecodeError Declaration 483 | declaration = 484 | S.customType 485 | (\e0 e1 e2 e3 e4 e5 value -> 486 | case value of 487 | FunctionDeclaration a -> 488 | e0 a 489 | 490 | AliasDeclaration a -> 491 | e1 a 492 | 493 | CustomTypeDeclaration a -> 494 | e2 a 495 | 496 | PortDeclaration a -> 497 | e3 a 498 | 499 | InfixDeclaration a -> 500 | e4 a 501 | 502 | Destructuring a b -> 503 | e5 a b 504 | ) 505 | |> S.variant1 FunctionDeclaration function 506 | |> S.variant1 AliasDeclaration typeAlias 507 | |> S.variant1 CustomTypeDeclaration type_ 508 | |> S.variant1 PortDeclaration signature 509 | |> S.variant1 InfixDeclaration infix_ 510 | |> S.variant2 Destructuring (node pattern) (node expression) 511 | |> S.finishCustomType 512 | 513 | 514 | infix_ : Codec e Infix 515 | infix_ = 516 | S.record Infix 517 | |> S.field .direction (node infixDirection) 518 | |> S.field .precedence (node S.int) 519 | |> S.field .operator (node S.string) 520 | |> S.field .function (node S.string) 521 | |> S.finishRecord 522 | 523 | 524 | typeAlias : Codec e TypeAlias 525 | typeAlias = 526 | S.record TypeAlias 527 | |> S.field .documentation (S.maybe (node S.string)) 528 | |> S.field .name (node S.string) 529 | |> S.field .generics (S.list (node S.string)) 530 | |> S.field .typeAnnotation (node typeAnnotation) 531 | |> S.finishRecord 532 | 533 | 534 | type_ : Codec e Type 535 | type_ = 536 | S.record Type 537 | |> S.field .documentation (S.maybe (node S.string)) 538 | |> S.field .name (node S.string) 539 | |> S.field .generics (S.list (node S.string)) 540 | |> S.field .constructors (S.list (node valueConstructor)) 541 | |> S.finishRecord 542 | 543 | 544 | valueConstructor : Codec e ValueConstructor 545 | valueConstructor = 546 | S.record ValueConstructor 547 | |> S.field .name (node S.string) 548 | |> S.field .arguments (S.list (node typeAnnotation)) 549 | |> S.finishRecord 550 | -------------------------------------------------------------------------------- /tests/Base.elm: -------------------------------------------------------------------------------- 1 | module Base exposing (roundtrips, suite) 2 | 3 | import Basics.Extra 4 | import Bytes exposing (Bytes) 5 | import Bytes.Encode 6 | import Dict 7 | import Expect 8 | import Fuzz exposing (Fuzzer) 9 | import Json.Decode 10 | import Serialize as S exposing (Codec) 11 | import SerializeV1 12 | import Set 13 | import Test exposing (Test, describe, fuzz, test) 14 | import Toop exposing (T1(..), T2(..), T3(..), T4(..), T5(..), T6(..), T7(..), T8(..)) 15 | import Url 16 | 17 | 18 | suite : Test 19 | suite = 20 | describe "Testing roundtrips" 21 | [ describe "Basic" basicTests 22 | , describe "Containers" containersTests 23 | , describe "Object" objectTests 24 | , describe "Custom" customTests 25 | , describe "map" bimapTests 26 | , describe "andThen" andThenTests 27 | , describe "errorTests" errorTests 28 | , describe "lazy" lazyTests 29 | , describe "maybe" maybeTests 30 | 31 | --, describe "errorToString" errorToStringTest 32 | , describe "enum" enumTest 33 | , fuzz fuzzBytes "toString is url safe" <| 34 | \bytes -> 35 | let 36 | expected = 37 | S.encodeToString S.bytes bytes 38 | in 39 | expected |> Url.percentEncode |> Expect.equal expected 40 | , describe "Serializer version" serializerVersionTests 41 | , Test.fuzz Fuzz.float "Json round trip float" <| 42 | \value -> String.fromFloat value |> String.toFloat |> Expect.equal (Just value) 43 | ] 44 | 45 | 46 | roundtrips : Fuzzer a -> Codec e a -> SerializeV1.Codec e a -> Test 47 | roundtrips fuzzer codec codecV1 = 48 | fuzz fuzzer "is a roundtrip" (roundtripHelper codec codecV1) 49 | 50 | 51 | roundtripHelper : Codec e a -> SerializeV1.Codec e1 a -> a -> Expect.Expectation 52 | roundtripHelper codec codecV1 value = 53 | Expect.all 54 | [ S.encodeToBytes codec >> S.decodeFromBytes codec >> Expect.equal (Ok value) 55 | , S.encodeToString codec >> S.decodeFromString codec >> Expect.equal (Ok value) 56 | , S.encodeToJson codec >> S.decodeFromJson codec >> Expect.equal (Ok value) 57 | , S.encodeToJson codec >> Json.Decode.decodeValue (S.getJsonDecoder (always "") codec) >> Expect.equal (Ok value) 58 | , SerializeV1.encodeToBytes codecV1 >> S.decodeFromBytes codec >> Expect.equal (Ok value) 59 | , SerializeV1.encodeToString codecV1 >> S.decodeFromString codec >> Expect.equal (Ok value) 60 | ] 61 | value 62 | 63 | 64 | basicTests : List Test 65 | basicTests = 66 | [ describe "Codec.string" 67 | [ roundtrips Fuzz.string S.string SerializeV1.string 68 | ] 69 | , describe "Codec.string with unicode chars" [ roundtrips (Fuzz.constant "Ⓐ弈😀") S.string SerializeV1.string ] 70 | , describe "Codec.int" 71 | [ roundtrips maxRangeIntFuzz S.int SerializeV1.int 72 | ] 73 | , describe "Codec.float64" 74 | [ roundtrips Fuzz.float S.float SerializeV1.float 75 | ] 76 | , describe "Codec.bool" 77 | [ roundtrips Fuzz.bool S.bool SerializeV1.bool 78 | ] 79 | 80 | --, describe "Codec.char" 81 | -- [ roundtrips charFuzz S.char 82 | -- ] 83 | , describe "Codec.bytes" 84 | [ roundtrips fuzzBytes S.bytes SerializeV1.bytes 85 | ] 86 | , describe "Codec.byte" 87 | [ roundtrips (Fuzz.intRange 0 255) S.byte SerializeV1.byte 88 | ] 89 | , Test.fuzz Fuzz.int "Codec.byte with value outside of 0-255 range wrap around for encodeToBytes" <| 90 | \value -> 91 | S.encodeToBytes S.byte value 92 | |> S.decodeFromBytes S.byte 93 | |> Expect.equal (Ok (modBy 256 value)) 94 | , Test.fuzz Fuzz.int "Codec.byte with value outside of 0-255 range wrap around for encodeToJson" <| 95 | \value -> 96 | S.encodeToJson S.byte value 97 | |> S.decodeFromJson S.byte 98 | |> Expect.equal (Ok (modBy 256 value)) 99 | , test "Codec.unit" <| 100 | \_ -> roundtripHelper S.unit SerializeV1.unit () 101 | ] 102 | 103 | 104 | fuzzBytes : Fuzzer Bytes 105 | fuzzBytes = 106 | Fuzz.list maxRangeIntFuzz |> Fuzz.map (List.map (Bytes.Encode.unsignedInt32 Bytes.LE) >> Bytes.Encode.sequence >> Bytes.Encode.encode) 107 | 108 | 109 | containersTests : List Test 110 | containersTests = 111 | [ describe "Codec.array" 112 | [ roundtrips (Fuzz.array maxRangeIntFuzz) (S.array S.int) (SerializeV1.array SerializeV1.int) 113 | ] 114 | , describe "Codec.list" 115 | [ roundtrips (Fuzz.list maxRangeIntFuzz) (S.list S.int) (SerializeV1.list SerializeV1.int) 116 | ] 117 | , describe "Codec.dict" 118 | [ roundtrips 119 | (Fuzz.map2 Tuple.pair Fuzz.string maxRangeIntFuzz 120 | |> Fuzz.list 121 | |> Fuzz.map Dict.fromList 122 | ) 123 | (S.dict S.string S.int) 124 | (SerializeV1.dict SerializeV1.string SerializeV1.int) 125 | ] 126 | , describe "Codec.set" 127 | [ roundtrips 128 | (Fuzz.list maxRangeIntFuzz |> Fuzz.map Set.fromList) 129 | (S.set S.int) 130 | (SerializeV1.set SerializeV1.int) 131 | ] 132 | , describe "Codec.tuple" 133 | [ roundtrips 134 | (Fuzz.map2 Tuple.pair maxRangeIntFuzz maxRangeIntFuzz) 135 | (S.tuple S.int S.int) 136 | (SerializeV1.tuple SerializeV1.int SerializeV1.int) 137 | ] 138 | ] 139 | 140 | 141 | maxRangeIntFuzz : Fuzzer Int 142 | maxRangeIntFuzz = 143 | Fuzz.intRange Basics.Extra.minSafeInteger Basics.Extra.maxSafeInteger 144 | 145 | 146 | charFuzz : Fuzzer Char 147 | charFuzz = 148 | [ '😀', 'ß', Char.toUpper 'ß', 'a', '吧', '吗', '\t' ] 149 | |> List.map Fuzz.constant 150 | |> Fuzz.oneOf 151 | 152 | 153 | objectTests : List Test 154 | objectTests = 155 | [ describe "with 0 fields" 156 | [ roundtrips (Fuzz.constant {}) 157 | (S.record {} 158 | |> S.finishRecord 159 | ) 160 | (SerializeV1.record {} 161 | |> SerializeV1.finishRecord 162 | ) 163 | ] 164 | , describe "with 1 field" 165 | [ roundtrips (Fuzz.map (\i -> { fname = i }) maxRangeIntFuzz) 166 | (S.record (\i -> { fname = i }) 167 | |> S.field .fname S.int 168 | |> S.finishRecord 169 | ) 170 | (SerializeV1.record (\i -> { fname = i }) 171 | |> SerializeV1.field .fname SerializeV1.int 172 | |> SerializeV1.finishRecord 173 | ) 174 | ] 175 | , describe "with 2 fields" 176 | [ roundtrips 177 | (Fuzz.map2 178 | (\a b -> 179 | { a = a 180 | , b = b 181 | } 182 | ) 183 | maxRangeIntFuzz 184 | maxRangeIntFuzz 185 | ) 186 | (S.record 187 | (\a b -> 188 | { a = a 189 | , b = b 190 | } 191 | ) 192 | |> S.field .a S.int 193 | |> S.field .b S.int 194 | |> S.finishRecord 195 | ) 196 | (SerializeV1.record 197 | (\a b -> 198 | { a = a 199 | , b = b 200 | } 201 | ) 202 | |> SerializeV1.field .a SerializeV1.int 203 | |> SerializeV1.field .b SerializeV1.int 204 | |> SerializeV1.finishRecord 205 | ) 206 | ] 207 | , test "nested record" <| 208 | \_ -> 209 | roundtripHelper 210 | (S.record 211 | (\a b -> 212 | { a = a 213 | , b = b 214 | } 215 | ) 216 | |> S.field .a 217 | (S.record 218 | (\a b -> 219 | { a = a 220 | , b = b 221 | } 222 | ) 223 | |> S.field .a S.int 224 | |> S.field .b S.int 225 | |> S.finishRecord 226 | ) 227 | |> S.field .b 228 | (S.record 229 | (\a b -> 230 | { a = a 231 | , b = b 232 | } 233 | ) 234 | |> S.field .a S.string 235 | |> S.field .b S.int 236 | |> S.finishRecord 237 | ) 238 | |> S.finishRecord 239 | ) 240 | (SerializeV1.record 241 | (\a b -> 242 | { a = a 243 | , b = b 244 | } 245 | ) 246 | |> SerializeV1.field .a 247 | (SerializeV1.record 248 | (\a b -> 249 | { a = a 250 | , b = b 251 | } 252 | ) 253 | |> SerializeV1.field .a SerializeV1.int 254 | |> SerializeV1.field .b SerializeV1.int 255 | |> SerializeV1.finishRecord 256 | ) 257 | |> SerializeV1.field .b 258 | (SerializeV1.record 259 | (\a b -> 260 | { a = a 261 | , b = b 262 | } 263 | ) 264 | |> SerializeV1.field .a SerializeV1.string 265 | |> SerializeV1.field .b SerializeV1.int 266 | |> SerializeV1.finishRecord 267 | ) 268 | |> SerializeV1.finishRecord 269 | ) 270 | { a = { a = 5, b = 3 }, b = { a = "test", b = 6 } } 271 | ] 272 | 273 | 274 | customTests : List Test 275 | customTests = 276 | [ describe "with 1 ctor, 0 args" 277 | [ roundtrips (Fuzz.constant ()) 278 | (S.customType 279 | (\f v -> 280 | case v of 281 | () -> 282 | f 283 | ) 284 | |> S.variant0 () 285 | |> S.finishCustomType 286 | ) 287 | (SerializeV1.customType 288 | (\f v -> 289 | case v of 290 | () -> 291 | f 292 | ) 293 | |> SerializeV1.variant0 () 294 | |> SerializeV1.finishCustomType 295 | ) 296 | ] 297 | , test "with 1 ctor, 1 arg" <| 298 | \_ -> 299 | roundtripHelper 300 | (S.customType 301 | (\f v -> 302 | case v of 303 | T1 a -> 304 | f a 305 | ) 306 | |> S.variant1 T1 S.int 307 | |> S.finishCustomType 308 | ) 309 | (SerializeV1.customType 310 | (\f v -> 311 | case v of 312 | T1 a -> 313 | f a 314 | ) 315 | |> SerializeV1.variant1 T1 SerializeV1.int 316 | |> SerializeV1.finishCustomType 317 | ) 318 | (T1 6) 319 | , test "with 1 ctor, 2 arg" <| 320 | \_ -> 321 | roundtripHelper 322 | (S.customType 323 | (\function v -> 324 | case v of 325 | T2 a b -> 326 | function a b 327 | ) 328 | |> S.variant2 T2 S.int S.int 329 | |> S.finishCustomType 330 | ) 331 | (SerializeV1.customType 332 | (\function v -> 333 | case v of 334 | T2 a b -> 335 | function a b 336 | ) 337 | |> SerializeV1.variant2 T2 SerializeV1.int SerializeV1.int 338 | |> SerializeV1.finishCustomType 339 | ) 340 | (T2 10 11) 341 | , test "with 1 ctor, 3 arg" <| 342 | \_ -> 343 | roundtripHelper 344 | (S.customType 345 | (\function v -> 346 | case v of 347 | T3 a b c -> 348 | function a b c 349 | ) 350 | |> S.variant3 T3 S.int S.int S.int 351 | |> S.finishCustomType 352 | ) 353 | (SerializeV1.customType 354 | (\function v -> 355 | case v of 356 | T3 a b c -> 357 | function a b c 358 | ) 359 | |> SerializeV1.variant3 T3 SerializeV1.int SerializeV1.int SerializeV1.int 360 | |> SerializeV1.finishCustomType 361 | ) 362 | (T3 10 11 12) 363 | , test "with 1 ctor, 4 arg" <| 364 | \_ -> 365 | roundtripHelper 366 | (S.customType 367 | (\function v -> 368 | case v of 369 | T4 a b c d -> 370 | function a b c d 371 | ) 372 | |> S.variant4 T4 S.int S.int S.int S.int 373 | |> S.finishCustomType 374 | ) 375 | (SerializeV1.customType 376 | (\function v -> 377 | case v of 378 | T4 a b c d -> 379 | function a b c d 380 | ) 381 | |> SerializeV1.variant4 T4 SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int 382 | |> SerializeV1.finishCustomType 383 | ) 384 | (T4 10 11 12 13) 385 | , test "with 1 ctor, 5 arg" <| 386 | \_ -> 387 | roundtripHelper 388 | (S.customType 389 | (\function v -> 390 | case v of 391 | T5 a b c d e -> 392 | function a b c d e 393 | ) 394 | |> S.variant5 T5 S.int S.int S.int S.int S.int 395 | |> S.finishCustomType 396 | ) 397 | (SerializeV1.customType 398 | (\function v -> 399 | case v of 400 | T5 a b c d e -> 401 | function a b c d e 402 | ) 403 | |> SerializeV1.variant5 T5 SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int 404 | |> SerializeV1.finishCustomType 405 | ) 406 | (T5 10 11 12 13 14) 407 | , test "with 1 ctor, 6 arg" <| 408 | \_ -> 409 | roundtripHelper 410 | (S.customType 411 | (\function v -> 412 | case v of 413 | T6 a b c d e f -> 414 | function a b c d e f 415 | ) 416 | |> S.variant6 T6 S.int S.int S.int S.int S.int S.int 417 | |> S.finishCustomType 418 | ) 419 | (SerializeV1.customType 420 | (\function v -> 421 | case v of 422 | T6 a b c d e f -> 423 | function a b c d e f 424 | ) 425 | |> SerializeV1.variant6 T6 SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int 426 | |> SerializeV1.finishCustomType 427 | ) 428 | (T6 10 11 12 13 14 15) 429 | , test "with 1 ctor, 7 arg" <| 430 | \_ -> 431 | roundtripHelper 432 | (S.customType 433 | (\function v -> 434 | case v of 435 | T7 a b c d e f g -> 436 | function a b c d e f g 437 | ) 438 | |> S.variant7 T7 S.int S.int S.int S.int S.int S.int S.int 439 | |> S.finishCustomType 440 | ) 441 | (SerializeV1.customType 442 | (\function v -> 443 | case v of 444 | T7 a b c d e f g -> 445 | function a b c d e f g 446 | ) 447 | |> SerializeV1.variant7 T7 SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int 448 | |> SerializeV1.finishCustomType 449 | ) 450 | (T7 10 11 12 13 14 15 16) 451 | , test "with 1 ctor, 8 arg" <| 452 | \_ -> 453 | roundtripHelper 454 | (S.customType 455 | (\function v -> 456 | case v of 457 | T8 a b c d e f g h -> 458 | function a b c d e f g h 459 | ) 460 | |> S.variant8 T8 S.int S.int S.int S.int S.int S.int S.int S.int 461 | |> S.finishCustomType 462 | ) 463 | (SerializeV1.customType 464 | (\function v -> 465 | case v of 466 | T8 a b c d e f g h -> 467 | function a b c d e f g h 468 | ) 469 | |> SerializeV1.variant8 T8 SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int SerializeV1.int 470 | |> SerializeV1.finishCustomType 471 | ) 472 | (T8 10 11 12 13 14 15 16 17) 473 | , describe "with 2 ctors, 0,1 args" <| 474 | let 475 | match fnothing fjust value = 476 | case value of 477 | Nothing -> 478 | fnothing 479 | 480 | Just v -> 481 | fjust v 482 | 483 | codec = 484 | S.customType match 485 | |> S.variant0 Nothing 486 | |> S.variant1 Just S.int 487 | |> S.finishCustomType 488 | 489 | codecV1 = 490 | SerializeV1.customType match 491 | |> SerializeV1.variant0 Nothing 492 | |> SerializeV1.variant1 Just SerializeV1.int 493 | |> SerializeV1.finishCustomType 494 | 495 | fuzzers = 496 | [ ( "1st ctor", Fuzz.constant Nothing ) 497 | , ( "2nd ctor", Fuzz.map Just maxRangeIntFuzz ) 498 | ] 499 | in 500 | fuzzers 501 | |> List.map 502 | (\( name, fuzz ) -> 503 | describe name 504 | [ roundtrips fuzz codec codecV1 ] 505 | ) 506 | ] 507 | 508 | 509 | bimapTests : List Test 510 | bimapTests = 511 | [ roundtrips Fuzz.float 512 | (S.map 513 | (\x -> x * 2) 514 | (\x -> x / 2) 515 | S.float 516 | ) 517 | (SerializeV1.map 518 | (\x -> x * 2) 519 | (\x -> x / 2) 520 | SerializeV1.float 521 | ) 522 | ] 523 | 524 | 525 | {-| Volume must be between 0 and 1. 526 | -} 527 | volumeCodec : Codec String Float 528 | volumeCodec = 529 | S.float 530 | |> S.mapValid 531 | (\volume -> 532 | if volume <= 1 && volume >= 0 then 533 | Ok volume 534 | 535 | else 536 | Err ("Volume is outside of valid range. Value: " ++ String.fromFloat volume) 537 | ) 538 | (\volume -> volume) 539 | 540 | 541 | volumeCodecV1 : SerializeV1.Codec String Float 542 | volumeCodecV1 = 543 | SerializeV1.float 544 | |> SerializeV1.mapValid 545 | (\volume -> 546 | if volume <= 1 && volume >= 0 then 547 | Ok volume 548 | 549 | else 550 | Err ("Volume is outside of valid range. Value: " ++ String.fromFloat volume) 551 | ) 552 | (\volume -> volume) 553 | 554 | 555 | andThenTests : List Test 556 | andThenTests = 557 | [ roundtrips (Fuzz.floatRange 0 1) volumeCodec volumeCodecV1 558 | , test "andThen fails on invalid binary data." <| 559 | \_ -> 560 | 5 561 | |> S.encodeToBytes volumeCodec 562 | |> S.decodeFromBytes volumeCodec 563 | |> Expect.equal (S.CustomError "Volume is outside of valid range. Value: 5" |> Err) 564 | ] 565 | 566 | 567 | type alias Record = 568 | { a : Int 569 | , b : Float 570 | , c : String 571 | , d : () 572 | , e : Float 573 | } 574 | 575 | 576 | errorTests : List Test 577 | errorTests = 578 | [ test "variant produces correct error message." <| 579 | \_ -> 580 | let 581 | codec = 582 | S.customType 583 | (\encodeNothing encodeJust value -> 584 | case value of 585 | Nothing -> 586 | encodeNothing 587 | 588 | Just v -> 589 | encodeJust v 590 | ) 591 | |> S.variant0 Nothing 592 | |> S.variant1 Just S.int 593 | |> S.finishCustomType 594 | 595 | codecBad = 596 | S.customType 597 | (\encodeNothing _ encodeJust value -> 598 | case value of 599 | Nothing -> 600 | encodeNothing 601 | 602 | Just v -> 603 | encodeJust v 604 | ) 605 | |> S.variant0 Nothing 606 | |> S.variant0 Nothing 607 | |> S.variant1 Just S.int 608 | |> S.finishCustomType 609 | in 610 | S.encodeToBytes codecBad (Just 0) |> S.decodeFromBytes codec |> Expect.equal (Err S.DataCorrupted) 611 | , test "list produces correct error message." <| 612 | \_ -> 613 | let 614 | codec = 615 | S.list volumeCodec 616 | in 617 | S.encodeToBytes codec [ 0, 3, 0, 4, 0, 0 ] 618 | |> S.decodeFromBytes codec 619 | |> Expect.equal 620 | (Err <| S.CustomError "Volume is outside of valid range. Value: 3") 621 | , test "Record produces correct error message." <| 622 | \_ -> 623 | let 624 | codec = 625 | S.record Record 626 | |> S.field .a S.int 627 | |> S.field .b volumeCodec 628 | |> S.field .c S.string 629 | |> S.field .d S.unit 630 | |> S.field .e volumeCodec 631 | |> S.finishRecord 632 | in 633 | S.encodeToBytes codec { a = 0, b = 0, c = "", d = (), e = -1 } 634 | |> S.decodeFromBytes codec 635 | |> Expect.equal 636 | (Err <| S.CustomError "Volume is outside of valid range. Value: -1") 637 | , test "Record produces first error message." <| 638 | \_ -> 639 | let 640 | codec = 641 | S.record Record 642 | |> S.field .a S.int 643 | |> S.field .b volumeCodec 644 | |> S.field .c S.string 645 | |> S.field .d S.unit 646 | |> S.field .e volumeCodec 647 | |> S.finishRecord 648 | in 649 | S.encodeToBytes codec { a = 0, b = -2, c = "", d = (), e = -3 } 650 | |> S.decodeFromBytes codec 651 | |> Expect.equal 652 | (Err <| S.CustomError "Volume is outside of valid range. Value: -2") 653 | , test "Map error message." <| 654 | \_ -> 655 | let 656 | codec = 657 | S.record Record 658 | |> S.field .a S.int 659 | |> S.field .b volumeCodec 660 | |> S.field .c S.string 661 | |> S.field .d S.unit 662 | |> S.field .e volumeCodec 663 | |> S.finishRecord 664 | |> S.mapError (\text -> "Error in Record: " ++ text) 665 | in 666 | S.encodeToBytes codec { a = 0, b = -2, c = "", d = (), e = -3 } 667 | |> S.decodeFromBytes codec 668 | |> Expect.equal 669 | (Err <| S.CustomError "Error in Record: Volume is outside of valid range. Value: -2") 670 | ] 671 | 672 | 673 | type Peano 674 | = Peano (Maybe Peano) 675 | 676 | 677 | {-| This is the same example used in Codec.recursive but adapted for lazy. 678 | -} 679 | peanoCodec : Codec e Peano 680 | peanoCodec = 681 | S.maybe (S.lazy (\() -> peanoCodec)) |> S.map Peano (\(Peano a) -> a) 682 | 683 | 684 | peanoCodecV1 : SerializeV1.Codec e Peano 685 | peanoCodecV1 = 686 | SerializeV1.maybe (SerializeV1.lazy (\() -> peanoCodecV1)) |> SerializeV1.map Peano (\(Peano a) -> a) 687 | 688 | 689 | lazyTests : List Test 690 | lazyTests = 691 | [ roundtrips peanoFuzz peanoCodec peanoCodecV1 692 | ] 693 | 694 | 695 | peanoFuzz : Fuzzer Peano 696 | peanoFuzz = 697 | Fuzz.intRange 0 10 |> Fuzz.map (intToPeano Nothing) 698 | 699 | 700 | intToPeano : Maybe Peano -> Int -> Peano 701 | intToPeano peano value = 702 | if value <= 0 then 703 | Peano Nothing 704 | 705 | else 706 | intToPeano peano (value - 1) |> Just |> Peano 707 | 708 | 709 | maybeTests : List Test 710 | maybeTests = 711 | [ describe "single" 712 | [ roundtrips (maybeFuzz maxRangeIntFuzz) (S.maybe S.int) (SerializeV1.maybe SerializeV1.int) 713 | ] 714 | ] 715 | 716 | 717 | maybeFuzz : Fuzzer a -> Fuzzer (Maybe a) 718 | maybeFuzz fuzzer = 719 | Fuzz.oneOf 720 | [ Fuzz.constant Nothing 721 | , Fuzz.map Just fuzzer 722 | ] 723 | 724 | 725 | type DaysOfWeek 726 | = Monday 727 | | Tuesday 728 | | Wednesday 729 | | Thursday 730 | | Friday 731 | | Saturday 732 | | Sunday 733 | 734 | 735 | daysOfWeekCodec : Codec e DaysOfWeek 736 | daysOfWeekCodec = 737 | S.enum Monday [ Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday ] 738 | 739 | 740 | daysOfWeekCodecV1 : SerializeV1.Codec e DaysOfWeek 741 | daysOfWeekCodecV1 = 742 | SerializeV1.enum Monday [ Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday ] 743 | 744 | 745 | badDaysOfWeekCodec : Codec e DaysOfWeek 746 | badDaysOfWeekCodec = 747 | S.enum Monday [] 748 | 749 | 750 | daysOfWeekFuzz : Fuzzer DaysOfWeek 751 | daysOfWeekFuzz = 752 | [ Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday ] 753 | |> List.map Fuzz.constant 754 | |> Fuzz.oneOf 755 | 756 | 757 | enumTest : List Test 758 | enumTest = 759 | [ roundtrips daysOfWeekFuzz daysOfWeekCodec daysOfWeekCodecV1 760 | , test "Default to first item when encoding if item doesn't exist." <| 761 | \_ -> 762 | S.encodeToBytes badDaysOfWeekCodec Tuesday |> S.decodeFromBytes badDaysOfWeekCodec |> Expect.equal (Ok Monday) 763 | , test "Error if enum index is greater than number of values in enum." <| 764 | \_ -> 765 | S.encodeToBytes daysOfWeekCodec Tuesday |> S.decodeFromBytes badDaysOfWeekCodec |> Expect.equal (Err S.DataCorrupted) 766 | ] 767 | 768 | 769 | serializerVersionTests : List Test 770 | serializerVersionTests = 771 | [ test "DataCorrupted error if version is 0" <| 772 | \_ -> 773 | Bytes.Encode.sequence [ Bytes.Encode.unsignedInt8 0, Bytes.Encode.unsignedInt8 5 ] 774 | |> Bytes.Encode.encode 775 | |> S.decodeFromBytes S.byte 776 | |> Expect.equal (Err S.DataCorrupted) 777 | , test "Ok result if version is 1" <| 778 | \_ -> 779 | Bytes.Encode.sequence [ Bytes.Encode.unsignedInt8 1, Bytes.Encode.unsignedInt8 5 ] 780 | |> Bytes.Encode.encode 781 | |> S.decodeFromBytes S.byte 782 | |> Expect.equal (Ok 5) 783 | , fuzz (Fuzz.intRange 2 255) "SerializerOutOfDate if version is greater than Serializer version" <| 784 | \version -> 785 | Bytes.Encode.sequence [ Bytes.Encode.unsignedInt8 version, Bytes.Encode.unsignedInt8 5 ] 786 | |> Bytes.Encode.encode 787 | |> S.decodeFromBytes S.byte 788 | |> Expect.equal (Err S.SerializerOutOfDate) 789 | ] 790 | -------------------------------------------------------------------------------- /tests/SerializeV1.elm: -------------------------------------------------------------------------------- 1 | module SerializeV1 exposing 2 | ( Codec, Error(..) 3 | , decodeFromBytes, decodeFromString 4 | , encodeToBytes, encodeToString 5 | , string, bool, float, int, unit, bytes, byte 6 | , maybe, list, array, dict, set, tuple, triple, result, enum 7 | , RecordCodec, record, field, finishRecord 8 | , CustomTypeCodec, customType, variant0, variant1, variant2, variant3, variant4, variant5, variant6, variant7, variant8, finishCustomType, VariantEncoder 9 | , map, mapValid, mapError 10 | , lazy 11 | , decodeFromJson, encodeToJson 12 | ) 13 | 14 | {-| 15 | 16 | 17 | # Definition 18 | 19 | @docs Codec, Error 20 | 21 | 22 | # Decode 23 | 24 | @docs decodeFromBytes, decodeFromString 25 | 26 | 27 | # Encode 28 | 29 | @docs encodeToBytes, encodeToString 30 | 31 | 32 | # Primitives 33 | 34 | @docs string, bool, float, int, unit, bytes, byte 35 | 36 | 37 | # Data Structures 38 | 39 | @docs maybe, list, array, dict, set, tuple, triple, result, enum 40 | 41 | 42 | # Records 43 | 44 | @docs RecordCodec, record, field, finishRecord 45 | 46 | 47 | # Custom Types 48 | 49 | @docs CustomTypeCodec, customType, variant0, variant1, variant2, variant3, variant4, variant5, variant6, variant7, variant8, finishCustomType, VariantEncoder 50 | 51 | 52 | # Mapping 53 | 54 | @docs map, mapValid, mapError 55 | 56 | 57 | # Stack unsafe 58 | 59 | @docs lazy 60 | 61 | -} 62 | 63 | import Array exposing (Array) 64 | import Base64 65 | import Bytes 66 | import Bytes.Decode as BD 67 | import Bytes.Encode as BE 68 | import Dict exposing (Dict) 69 | import Json.Decode as JD 70 | import Json.Encode as JE 71 | import Regex exposing (Regex) 72 | import Set exposing (Set) 73 | import Toop exposing (T4(..), T5(..), T6(..), T7(..), T8(..)) 74 | 75 | 76 | 77 | -- DEFINITION 78 | 79 | 80 | {-| A value that knows how to encode and decode an Elm data structure. 81 | -} 82 | type Codec e a 83 | = Codec 84 | { encoder : a -> BE.Encoder 85 | , decoder : Decoder (Result (Error e) a) 86 | , jsonEncoder : a -> JE.Value 87 | , jsonDecoder : JD.Decoder (Result (Error e) a) 88 | } 89 | 90 | 91 | {-| Possible errors that can occur when decoding. 92 | 93 | - `CustomError` - An error caused by `andThen` returning an Err value. 94 | - `DataCorrupted` - This most likely will occur if you make breaking changes to your codec and try to decode old data\*. Have a look at `How do I change my codecs and still be able to decode old data?` in the readme for how to avoid introducing breaking changes. 95 | - `SerializerOutOfDate` - When encoding, this package will include a version number. This makes it possible for me to make improvements to how data gets encoded without introducing breaking changes to your codecs. This error then, says that you're trying to decode data encoded with a newer version of elm-serialize. 96 | 97 | \*It's possible for corrupted data to still succeed in decoding (but with nonsense Elm values). 98 | This is because internally we're just encoding Elm values and not storing any kind of structural information. 99 | So if you encoded an Int and then a Float, and then tried decoding it as a Float and then an Int, there's no way for the decoder to know it read the data in the wrong order. 100 | 101 | -} 102 | type Error e 103 | = CustomError e 104 | | DataCorrupted 105 | | SerializerOutOfDate 106 | 107 | 108 | version : Int 109 | version = 110 | 1 111 | 112 | 113 | 114 | -- DECODE 115 | 116 | 117 | {-| Describes how to turn a sequence of bytes into a nice Elm value. 118 | -} 119 | type alias Decoder a = 120 | BD.Decoder a 121 | 122 | 123 | endian : Bytes.Endianness 124 | endian = 125 | Bytes.BE 126 | 127 | 128 | {-| Extracts the `Decoder` contained inside the `Codec`. 129 | -} 130 | getDecoder : Codec e a -> Decoder (Result (Error e) a) 131 | getDecoder (Codec m) = 132 | m.decoder 133 | 134 | 135 | {-| Extracts the json `Decoder` contained inside the `Codec`. 136 | -} 137 | getJsonDecoder : Codec e a -> JD.Decoder (Result (Error e) a) 138 | getJsonDecoder (Codec m) = 139 | m.jsonDecoder 140 | 141 | 142 | {-| Run a `Codec` to turn a sequence of bytes into an Elm value. 143 | -} 144 | decodeFromBytes : Codec e a -> Bytes.Bytes -> Result (Error e) a 145 | decodeFromBytes codec bytes_ = 146 | let 147 | decoder = 148 | BD.unsignedInt8 149 | |> BD.andThen 150 | (\value -> 151 | if value <= 0 then 152 | Err DataCorrupted |> BD.succeed 153 | 154 | else if value == version then 155 | getDecoder codec 156 | 157 | else 158 | Err SerializerOutOfDate |> BD.succeed 159 | ) 160 | in 161 | case BD.decode decoder bytes_ of 162 | Just value -> 163 | value 164 | 165 | Nothing -> 166 | Err DataCorrupted 167 | 168 | 169 | {-| Run a `Codec` to turn a String encoded with `encodeToString` into an Elm value. 170 | -} 171 | decodeFromString : Codec e a -> String -> Result (Error e) a 172 | decodeFromString codec base64 = 173 | case decode base64 of 174 | Just bytes_ -> 175 | decodeFromBytes codec bytes_ 176 | 177 | Nothing -> 178 | Err DataCorrupted 179 | 180 | 181 | decodeFromJson : Codec e a -> JE.Value -> Result (Error e) a 182 | decodeFromJson codec json = 183 | let 184 | decoder = 185 | JD.index 0 JD.int 186 | |> JD.andThen 187 | (\value -> 188 | if value <= 0 then 189 | Err DataCorrupted |> JD.succeed 190 | 191 | else if value == version then 192 | JD.index 1 (getJsonDecoder codec) 193 | 194 | else 195 | Err SerializerOutOfDate |> JD.succeed 196 | ) 197 | in 198 | case JD.decodeValue decoder json of 199 | Ok value -> 200 | value 201 | 202 | Err _ -> 203 | Err DataCorrupted 204 | 205 | 206 | decode : String -> Maybe Bytes.Bytes 207 | decode base64text = 208 | let 209 | replaceChar rematch = 210 | case rematch.match of 211 | "-" -> 212 | "+" 213 | 214 | _ -> 215 | "/" 216 | 217 | strlen = 218 | String.length base64text 219 | in 220 | if strlen == 0 then 221 | BE.encode (BE.sequence []) |> Just 222 | 223 | else 224 | let 225 | hanging = 226 | modBy 4 strlen 227 | 228 | ilen = 229 | if hanging == 0 then 230 | 0 231 | 232 | else 233 | 4 - hanging 234 | in 235 | Regex.replace replaceFromUrl replaceChar (base64text ++ String.repeat ilen "=") |> Base64.toBytes 236 | 237 | 238 | replaceFromUrl : Regex 239 | replaceFromUrl = 240 | Regex.fromString "[-_]" |> Maybe.withDefault Regex.never 241 | 242 | 243 | 244 | -- ENCODE 245 | 246 | 247 | {-| Extracts the encoding function contained inside the `Codec`. 248 | -} 249 | getEncoder : Codec e a -> a -> BE.Encoder 250 | getEncoder (Codec m) = 251 | m.encoder 252 | 253 | 254 | {-| Extracts the json encoding function contained inside the `Codec`. 255 | -} 256 | getJsonEncoder : Codec e a -> a -> JE.Value 257 | getJsonEncoder (Codec m) = 258 | m.jsonEncoder 259 | 260 | 261 | {-| Convert an Elm value into a sequence of bytes. 262 | -} 263 | encodeToBytes : Codec e a -> a -> Bytes.Bytes 264 | encodeToBytes codec value = 265 | BE.sequence 266 | [ BE.unsignedInt8 version 267 | , value |> getEncoder codec 268 | ] 269 | |> BE.encode 270 | 271 | 272 | {-| Convert an Elm value into a string. This string contains only url safe characters, so you can do the following: 273 | 274 | import Serialize as S 275 | 276 | myUrl = 277 | "www.mywebsite.com/?data=" ++ S.encodeToString S.float 1234 278 | 279 | and not risk generating an invalid url. 280 | 281 | -} 282 | encodeToString : Codec e a -> a -> String 283 | encodeToString codec = 284 | encodeToBytes codec >> replaceBase64Chars 285 | 286 | 287 | encodeToJson : Codec e a -> a -> JE.Value 288 | encodeToJson codec value = 289 | JE.list 290 | identity 291 | [ JE.int version 292 | , value |> getJsonEncoder codec 293 | ] 294 | 295 | 296 | replaceBase64Chars : Bytes.Bytes -> String 297 | replaceBase64Chars = 298 | let 299 | replaceChar rematch = 300 | case rematch.match of 301 | "+" -> 302 | "-" 303 | 304 | "/" -> 305 | "_" 306 | 307 | _ -> 308 | "" 309 | in 310 | Base64.fromBytes >> Maybe.withDefault "" >> Regex.replace replaceForUrl replaceChar 311 | 312 | 313 | replaceForUrl : Regex 314 | replaceForUrl = 315 | Regex.fromString "[\\+/=]" |> Maybe.withDefault Regex.never 316 | 317 | 318 | 319 | -- BASE 320 | 321 | 322 | build : 323 | (a -> BE.Encoder) 324 | -> Decoder (Result (Error e) a) 325 | -> (a -> JE.Value) 326 | -> JD.Decoder (Result (Error e) a) 327 | -> Codec e a 328 | build encoder_ decoder_ jsonEncoder jsonDecoder = 329 | Codec 330 | { encoder = encoder_ 331 | , decoder = decoder_ 332 | , jsonEncoder = jsonEncoder 333 | , jsonDecoder = jsonDecoder 334 | } 335 | 336 | 337 | {-| Codec for serializing a `String` 338 | -} 339 | string : Codec e String 340 | string = 341 | build 342 | (\text -> 343 | BE.sequence 344 | [ BE.unsignedInt32 endian (BE.getStringWidth text) 345 | , BE.string text 346 | ] 347 | ) 348 | (BD.unsignedInt32 endian 349 | |> BD.andThen 350 | (\charCount -> BD.string charCount |> BD.map Ok) 351 | ) 352 | JE.string 353 | (JD.string |> JD.map Ok) 354 | 355 | 356 | {-| Codec for serializing a `Bool` 357 | -} 358 | bool : Codec e Bool 359 | bool = 360 | build 361 | (\value -> 362 | case value of 363 | True -> 364 | BE.unsignedInt8 1 365 | 366 | False -> 367 | BE.unsignedInt8 0 368 | ) 369 | (BD.unsignedInt8 370 | |> BD.map 371 | (\value -> 372 | case value of 373 | 0 -> 374 | Ok False 375 | 376 | 1 -> 377 | Ok True 378 | 379 | _ -> 380 | Err DataCorrupted 381 | ) 382 | ) 383 | JE.bool 384 | (JD.bool |> JD.map Ok) 385 | 386 | 387 | {-| Codec for serializing an `Int` 388 | -} 389 | int : Codec e Int 390 | int = 391 | build 392 | (toFloat >> BE.float64 endian) 393 | (BD.float64 endian |> BD.map (round >> Ok)) 394 | JE.int 395 | (JD.int |> JD.map Ok) 396 | 397 | 398 | {-| Codec for serializing a `Float` 399 | -} 400 | float : Codec e Float 401 | float = 402 | build 403 | (BE.float64 endian) 404 | (BD.float64 endian |> BD.map Ok) 405 | JE.float 406 | (JD.float |> JD.map Ok) 407 | 408 | 409 | {-| Codec for serializing a `Char` 410 | -} 411 | char : Codec e Char 412 | char = 413 | let 414 | charEncode text = 415 | BE.sequence 416 | [ BE.unsignedInt32 endian (String.length text) 417 | , BE.string text 418 | ] 419 | in 420 | build 421 | (String.fromChar >> charEncode) 422 | (BD.unsignedInt32 endian 423 | |> BD.andThen (\charCount -> BD.string charCount) 424 | |> BD.map 425 | (\text -> 426 | case String.toList text |> List.head of 427 | Just char_ -> 428 | Ok char_ 429 | 430 | Nothing -> 431 | Err DataCorrupted 432 | ) 433 | ) 434 | (String.fromChar >> JE.string) 435 | (JD.string 436 | |> JD.map 437 | (\text -> 438 | case String.toList text |> List.head of 439 | Just char_ -> 440 | Ok char_ 441 | 442 | Nothing -> 443 | Err DataCorrupted 444 | ) 445 | ) 446 | 447 | 448 | 449 | -- DATA STRUCTURES 450 | 451 | 452 | {-| Codec for serializing a `Maybe` 453 | 454 | import Serialize as S 455 | 456 | maybeIntCodec : S.Codec (Maybe Int) 457 | maybeIntCodec = 458 | S.Maybe S.Int 459 | 460 | -} 461 | maybe : Codec e a -> Codec e (Maybe a) 462 | maybe justCodec = 463 | customType 464 | (\nothingEncoder justEncoder value -> 465 | case value of 466 | Nothing -> 467 | nothingEncoder 468 | 469 | Just value_ -> 470 | justEncoder value_ 471 | ) 472 | |> variant0 Nothing 473 | |> variant1 Just justCodec 474 | |> finishCustomType 475 | 476 | 477 | {-| Codec for serializing a `List` 478 | 479 | import Serialize as S 480 | 481 | listOfStringsCodec : S.Codec (List String) 482 | listOfStringsCodec = 483 | S.list S.string 484 | 485 | -} 486 | list : Codec e a -> Codec e (List a) 487 | list codec = 488 | build 489 | (listEncode (getEncoder codec)) 490 | (BD.unsignedInt32 endian 491 | |> BD.andThen 492 | (\length -> BD.loop ( length, [] ) (listStep (getDecoder codec))) 493 | ) 494 | (JE.list (getJsonEncoder codec)) 495 | (JD.list (getJsonDecoder codec) 496 | |> JD.map 497 | (List.foldr 498 | (\value state -> 499 | case ( value, state ) of 500 | ( Ok ok, Ok okState ) -> 501 | ok :: okState |> Ok 502 | 503 | ( _, Err _ ) -> 504 | state 505 | 506 | ( Err error, Ok _ ) -> 507 | Err error 508 | ) 509 | (Ok []) 510 | ) 511 | ) 512 | 513 | 514 | isError : Result e a -> Bool 515 | isError result_ = 516 | case result_ of 517 | Ok _ -> 518 | False 519 | 520 | Err _ -> 521 | True 522 | 523 | 524 | listEncode : (a -> BE.Encoder) -> List a -> BE.Encoder 525 | listEncode encoder_ list_ = 526 | list_ 527 | |> List.map encoder_ 528 | |> (::) (BE.unsignedInt32 endian (List.length list_)) 529 | |> BE.sequence 530 | 531 | 532 | listStep : BD.Decoder (Result (Error e) a) -> ( Int, List a ) -> Decoder (BD.Step ( Int, List a ) (Result (Error e) (List a))) 533 | listStep decoder_ ( n, xs ) = 534 | if n <= 0 then 535 | BD.succeed (BD.Done (xs |> List.reverse |> Ok)) 536 | 537 | else 538 | BD.map 539 | (\x -> 540 | case x of 541 | Ok ok -> 542 | BD.Loop ( n - 1, ok :: xs ) 543 | 544 | Err err -> 545 | BD.Done (Err err) 546 | ) 547 | decoder_ 548 | 549 | 550 | {-| Codec for serializing an `Array` 551 | -} 552 | array : Codec e a -> Codec e (Array a) 553 | array codec = 554 | list codec |> mapHelper (Result.map Array.fromList) Array.toList 555 | 556 | 557 | {-| Codec for serializing a `Dict` 558 | 559 | import Serialize as S 560 | 561 | type alias Name = 562 | String 563 | 564 | peoplesAgeCodec : S.Codec (Dict Name Int) 565 | peoplesAgeCodec = 566 | S.dict S.string S.int 567 | 568 | -} 569 | dict : Codec e comparable -> Codec e a -> Codec e (Dict comparable a) 570 | dict keyCodec valueCodec = 571 | list (tuple keyCodec valueCodec) 572 | |> mapHelper (Result.map Dict.fromList) Dict.toList 573 | 574 | 575 | {-| Codec for serializing a `Set` 576 | -} 577 | set : Codec e comparable -> Codec e (Set comparable) 578 | set codec = 579 | list codec |> mapHelper (Result.map Set.fromList) Set.toList 580 | 581 | 582 | {-| Codec for serializing `()` (aka `Unit`). 583 | -} 584 | unit : Codec e () 585 | unit = 586 | build 587 | (always (BE.sequence [])) 588 | (BD.succeed (Ok ())) 589 | (\_ -> JE.int 0) 590 | (JD.succeed (Ok ())) 591 | 592 | 593 | {-| Codec for serializing a tuple with 2 elements 594 | 595 | import Serialize as S 596 | 597 | pointCodec : S.Codec ( Float, Float ) 598 | pointCodec = 599 | S.tuple S.float S.float 600 | 601 | -} 602 | tuple : Codec e a -> Codec e b -> Codec e ( a, b ) 603 | tuple codecFirst codecSecond = 604 | record Tuple.pair 605 | |> field Tuple.first codecFirst 606 | |> field Tuple.second codecSecond 607 | |> finishRecord 608 | 609 | 610 | {-| Codec for serializing a tuple with 3 elements 611 | 612 | import Serialize as S 613 | 614 | pointCodec : S.Codec ( Float, Float, Float ) 615 | pointCodec = 616 | S.tuple S.float S.float S.float 617 | 618 | -} 619 | triple : Codec e a -> Codec e b -> Codec e c -> Codec e ( a, b, c ) 620 | triple codecFirst codecSecond codecThird = 621 | record (\a b c -> ( a, b, c )) 622 | |> field (\( a, _, _ ) -> a) codecFirst 623 | |> field (\( _, b, _ ) -> b) codecSecond 624 | |> field (\( _, _, c ) -> c) codecThird 625 | |> finishRecord 626 | 627 | 628 | {-| Codec for serializing a `Result` 629 | -} 630 | result : Codec e error -> Codec e value -> Codec e (Result error value) 631 | result errorCodec valueCodec = 632 | customType 633 | (\errEncoder okEncoder value -> 634 | case value of 635 | Err err -> 636 | errEncoder err 637 | 638 | Ok ok -> 639 | okEncoder ok 640 | ) 641 | |> variant1 Err errorCodec 642 | |> variant1 Ok valueCodec 643 | |> finishCustomType 644 | 645 | 646 | {-| Codec for serializing [`Bytes`](https://package.elm-lang.org/packages/elm/bytes/latest/). 647 | This is useful in combination with `mapValid` for encoding and decoding data using some specialized format. 648 | 649 | import Image exposing (Image) 650 | import Serialize as S 651 | 652 | imageCodec : S.Codec String Image 653 | imageCodec = 654 | S.bytes 655 | |> S.mapValid 656 | (Image.decode >> Result.fromMaybe "Failed to decode PNG image.") 657 | Image.toPng 658 | 659 | -} 660 | bytes : Codec e Bytes.Bytes 661 | bytes = 662 | build 663 | (\bytes_ -> 664 | BE.sequence 665 | [ BE.unsignedInt32 endian (Bytes.width bytes_) 666 | , BE.bytes bytes_ 667 | ] 668 | ) 669 | (BD.unsignedInt32 endian |> BD.andThen (\length -> BD.bytes length |> BD.map Ok)) 670 | (replaceBase64Chars >> JE.string) 671 | (JD.string 672 | |> JD.map 673 | (\text -> 674 | case decode text of 675 | Just bytes_ -> 676 | Ok bytes_ 677 | 678 | Nothing -> 679 | Err DataCorrupted 680 | ) 681 | ) 682 | 683 | 684 | {-| Codec for serializing an integer ranging from 0 to 255. 685 | This is useful if you have a small integer you want to serialize and not use up a lot of space. 686 | 687 | import Serialize as S 688 | 689 | type alias Color = 690 | { red : Int 691 | , green : Int 692 | , blue : Int 693 | } 694 | 695 | color : S.Codec Color 696 | color = 697 | Color.record Color 698 | |> S.field .red byte 699 | |> S.field .green byte 700 | |> S.field .blue byte 701 | |> S.finishRecord 702 | 703 | **Warning:** values greater than 255 or less than 0 will wrap around. 704 | So if you encode -1 you'll get back 255 and if you encode 257 you'll get back 2. 705 | 706 | -} 707 | byte : Codec e Int 708 | byte = 709 | build 710 | BE.unsignedInt8 711 | (BD.unsignedInt8 |> BD.map Ok) 712 | (modBy 256 >> JE.int) 713 | (JD.int |> JD.map Ok) 714 | 715 | 716 | {-| A codec for serializing an item from a list of possible items. 717 | If you try to encode an item that isn't in the list then the first item is defaulted to. 718 | 719 | import Serialize as S 720 | 721 | type DaysOfWeek 722 | = Monday 723 | | Tuesday 724 | | Wednesday 725 | | Thursday 726 | | Friday 727 | | Saturday 728 | | Sunday 729 | 730 | daysOfWeekCodec : S.Codec DaysOfWeek 731 | daysOfWeekCodec = 732 | S.enum Monday [ Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday ] 733 | 734 | Note that inserting new items in the middle of the list or removing items is a breaking change. 735 | It's safe to add items to the end of the list though. 736 | 737 | -} 738 | enum : a -> List a -> Codec e a 739 | enum defaultItem items = 740 | let 741 | getIndex value = 742 | items 743 | |> findIndex ((==) value) 744 | |> Maybe.withDefault -1 745 | |> (+) 1 746 | 747 | getItem index = 748 | if index < 0 then 749 | Err DataCorrupted 750 | 751 | else if index > List.length items then 752 | Err DataCorrupted 753 | 754 | else 755 | getAt (index - 1) items |> Maybe.withDefault defaultItem |> Ok 756 | in 757 | build 758 | (getIndex >> BE.unsignedInt32 endian) 759 | (BD.unsignedInt32 endian |> BD.map getItem) 760 | (getIndex >> JE.int) 761 | (JD.int |> JD.map getItem) 762 | 763 | 764 | getAt : Int -> List a -> Maybe a 765 | getAt idx xs = 766 | if idx < 0 then 767 | Nothing 768 | 769 | else 770 | List.head <| List.drop idx xs 771 | 772 | 773 | {-| 774 | -} 775 | findIndex : (a -> Bool) -> List a -> Maybe Int 776 | findIndex = 777 | findIndexHelp 0 778 | 779 | 780 | {-| 781 | -} 782 | findIndexHelp : Int -> (a -> Bool) -> List a -> Maybe Int 783 | findIndexHelp index predicate list_ = 784 | case list_ of 785 | [] -> 786 | Nothing 787 | 788 | x :: xs -> 789 | if predicate x then 790 | Just index 791 | 792 | else 793 | findIndexHelp (index + 1) predicate xs 794 | 795 | 796 | 797 | -- OBJECTS 798 | 799 | 800 | {-| A partially built Codec for a record. 801 | -} 802 | type RecordCodec e a b 803 | = RecordCodec 804 | { encoder : a -> List BE.Encoder 805 | , decoder : Decoder (Result (Error e) b) 806 | , jsonEncoder : a -> List JE.Value 807 | , jsonDecoder : JD.Decoder (Result (Error e) b) 808 | , fieldIndex : Int 809 | } 810 | 811 | 812 | {-| Start creating a codec for a record. 813 | 814 | import Serialize as S 815 | 816 | type alias Point = 817 | { x : Int 818 | , y : Int 819 | } 820 | 821 | pointCodec : S.Codec Point 822 | pointCodec = 823 | S.record Point 824 | -- Note that adding, removing, or reordering fields will prevent you from decoding any data you've previously encoded. 825 | |> S.field .x S.int 826 | |> S.field .y S.int 827 | |> S.finishRecord 828 | 829 | -} 830 | record : b -> RecordCodec e a b 831 | record ctor = 832 | RecordCodec 833 | { encoder = \_ -> [] 834 | , decoder = BD.succeed (Ok ctor) 835 | , jsonEncoder = \_ -> [] 836 | , jsonDecoder = JD.succeed (Ok ctor) 837 | , fieldIndex = 0 838 | } 839 | 840 | 841 | {-| Add a field to the record we are creating a codec for. 842 | -} 843 | field : (a -> f) -> Codec e f -> RecordCodec e a (f -> b) -> RecordCodec e a b 844 | field getter codec (RecordCodec recordCodec) = 845 | RecordCodec 846 | { encoder = \v -> (getEncoder codec <| getter v) :: recordCodec.encoder v 847 | , decoder = 848 | BD.map2 849 | (\f x -> 850 | case ( f, x ) of 851 | ( Ok fOk, Ok xOk ) -> 852 | fOk xOk |> Ok 853 | 854 | ( Err err, _ ) -> 855 | Err err 856 | 857 | ( _, Err err ) -> 858 | Err err 859 | ) 860 | recordCodec.decoder 861 | (getDecoder codec) 862 | , jsonEncoder = \v -> (getJsonEncoder codec <| getter v) :: recordCodec.jsonEncoder v 863 | , jsonDecoder = 864 | JD.map2 865 | (\f x -> 866 | case ( f, x ) of 867 | ( Ok fOk, Ok xOk ) -> 868 | fOk xOk |> Ok 869 | 870 | ( Err err, _ ) -> 871 | Err err 872 | 873 | ( _, Err err ) -> 874 | Err err 875 | ) 876 | recordCodec.jsonDecoder 877 | (JD.index recordCodec.fieldIndex (getJsonDecoder codec)) 878 | , fieldIndex = recordCodec.fieldIndex + 1 879 | } 880 | 881 | 882 | {-| Finish creating a codec for a record. 883 | -} 884 | finishRecord : RecordCodec e a a -> Codec e a 885 | finishRecord (RecordCodec codec) = 886 | Codec 887 | { encoder = codec.encoder >> List.reverse >> BE.sequence 888 | , decoder = codec.decoder 889 | , jsonEncoder = codec.jsonEncoder >> List.reverse >> JE.list identity 890 | , jsonDecoder = codec.jsonDecoder 891 | } 892 | 893 | 894 | 895 | -- CUSTOM 896 | 897 | 898 | {-| A partially built codec for a custom type. 899 | -} 900 | type CustomTypeCodec a e match v 901 | = CustomTypeCodec 902 | { match : match 903 | , jsonMatch : match 904 | , decoder : Int -> Decoder (Result (Error e) v) -> Decoder (Result (Error e) v) 905 | , jsonDecoder : Int -> JD.Decoder (Result (Error e) v) -> JD.Decoder (Result (Error e) v) 906 | , idCounter : Int 907 | } 908 | 909 | 910 | {-| Starts building a `Codec` for a custom type. 911 | You need to pass a pattern matching function, see the FAQ for details. 912 | 913 | import Serialize as S 914 | 915 | type Semaphore 916 | = Red Int String Bool 917 | | Yellow Float 918 | | Green 919 | 920 | semaphoreCodec : S.Codec Semaphore 921 | semaphoreCodec = 922 | S.custom 923 | (\redEncoder yellowEncoder greenEncoder value -> 924 | case value of 925 | Red i s b -> 926 | redEncoder i s b 927 | 928 | Yellow f -> 929 | yellowEncoder f 930 | 931 | Green -> 932 | greenEncoder 933 | ) 934 | -- Note that removing a variant, inserting a variant before an existing one, or swapping two variants will prevent you from decoding any data you've previously encoded. 935 | |> S.variant3 Red S.int S.string S.bool 936 | |> S.variant1 Yellow S.float 937 | |> S.variant0 Green 938 | -- It's safe to add new variants here later though 939 | |> S.finishCustom 940 | 941 | -} 942 | customType : match -> CustomTypeCodec { youNeedAtLeastOneVariant : () } e match value 943 | customType match = 944 | CustomTypeCodec 945 | { match = match 946 | , jsonMatch = match 947 | , decoder = \_ -> identity 948 | , jsonDecoder = \_ -> identity 949 | , idCounter = 0 950 | } 951 | 952 | 953 | {-| -} 954 | type VariantEncoder 955 | = VariantEncoder ( BE.Encoder, JE.Value ) 956 | 957 | 958 | variant : 959 | ((List BE.Encoder -> VariantEncoder) -> a) 960 | -> ((List JE.Value -> VariantEncoder) -> a) 961 | -> Decoder (Result (Error error) v) 962 | -> JD.Decoder (Result (Error error) v) 963 | -> CustomTypeCodec z error (a -> b) v 964 | -> CustomTypeCodec () error b v 965 | variant matchPiece matchJsonPiece decoderPiece jsonDecoderPiece (CustomTypeCodec am) = 966 | let 967 | enc : List BE.Encoder -> VariantEncoder 968 | enc v = 969 | ( BE.unsignedInt16 endian am.idCounter :: v |> BE.sequence 970 | , JE.null 971 | ) 972 | |> VariantEncoder 973 | 974 | jsonEnc : List JE.Value -> VariantEncoder 975 | jsonEnc v = 976 | ( BE.sequence [] 977 | , JE.int am.idCounter :: v |> JE.list identity 978 | ) 979 | |> VariantEncoder 980 | 981 | decoder_ : Int -> Decoder (Result (Error error) v) -> Decoder (Result (Error error) v) 982 | decoder_ tag orElse = 983 | if tag == am.idCounter then 984 | decoderPiece 985 | 986 | else 987 | am.decoder tag orElse 988 | 989 | jsonDecoder_ : Int -> JD.Decoder (Result (Error error) v) -> JD.Decoder (Result (Error error) v) 990 | jsonDecoder_ tag orElse = 991 | if tag == am.idCounter then 992 | jsonDecoderPiece 993 | 994 | else 995 | am.jsonDecoder tag orElse 996 | in 997 | CustomTypeCodec 998 | { match = am.match <| matchPiece enc 999 | , jsonMatch = am.jsonMatch <| matchJsonPiece jsonEnc 1000 | , decoder = decoder_ 1001 | , jsonDecoder = jsonDecoder_ 1002 | , idCounter = am.idCounter + 1 1003 | } 1004 | 1005 | 1006 | {-| Define a variant with 0 parameters for a custom type. 1007 | -} 1008 | variant0 : v -> CustomTypeCodec z e (VariantEncoder -> a) v -> CustomTypeCodec () e a v 1009 | variant0 ctor = 1010 | variant 1011 | (\c -> c []) 1012 | (\c -> c []) 1013 | (BD.succeed (Ok ctor)) 1014 | (JD.succeed (Ok ctor)) 1015 | 1016 | 1017 | {-| Define a variant with 1 parameters for a custom type. 1018 | -} 1019 | variant1 : 1020 | (a -> v) 1021 | -> Codec error a 1022 | -> CustomTypeCodec z error ((a -> VariantEncoder) -> b) v 1023 | -> CustomTypeCodec () error b v 1024 | variant1 ctor m1 = 1025 | variant 1026 | (\c v -> 1027 | c 1028 | [ getEncoder m1 v 1029 | ] 1030 | ) 1031 | (\c v -> 1032 | c 1033 | [ getJsonEncoder m1 v 1034 | ] 1035 | ) 1036 | (BD.map (result1 ctor) (getDecoder m1)) 1037 | (JD.map (result1 ctor) (JD.index 1 (getJsonDecoder m1))) 1038 | 1039 | 1040 | result1 : (value -> a) -> Result error value -> Result error a 1041 | result1 ctor value = 1042 | case value of 1043 | Ok ok -> 1044 | ctor ok |> Ok 1045 | 1046 | Err err -> 1047 | Err err 1048 | 1049 | 1050 | {-| Define a variant with 2 parameters for a custom type. 1051 | -} 1052 | variant2 : 1053 | (a -> b -> v) 1054 | -> Codec error a 1055 | -> Codec error b 1056 | -> CustomTypeCodec z error ((a -> b -> VariantEncoder) -> c) v 1057 | -> CustomTypeCodec () error c v 1058 | variant2 ctor m1 m2 = 1059 | variant 1060 | (\c v1 v2 -> 1061 | [ getEncoder m1 v1 1062 | , getEncoder m2 v2 1063 | ] 1064 | |> c 1065 | ) 1066 | (\c v1 v2 -> 1067 | [ getJsonEncoder m1 v1 1068 | , getJsonEncoder m2 v2 1069 | ] 1070 | |> c 1071 | ) 1072 | (BD.map2 1073 | (result2 ctor) 1074 | (getDecoder m1) 1075 | (getDecoder m2) 1076 | ) 1077 | (JD.map2 1078 | (result2 ctor) 1079 | (JD.index 1 (getJsonDecoder m1)) 1080 | (JD.index 2 (getJsonDecoder m2)) 1081 | ) 1082 | 1083 | 1084 | result2 : (value -> a -> b) -> Result error value -> Result error a -> Result error b 1085 | result2 ctor v1 v2 = 1086 | case ( v1, v2 ) of 1087 | ( Ok ok1, Ok ok2 ) -> 1088 | ctor ok1 ok2 |> Ok 1089 | 1090 | ( Err err, _ ) -> 1091 | Err err 1092 | 1093 | ( _, Err err ) -> 1094 | Err err 1095 | 1096 | 1097 | {-| Define a variant with 3 parameters for a custom type. 1098 | -} 1099 | variant3 : 1100 | (a -> b -> c -> v) 1101 | -> Codec error a 1102 | -> Codec error b 1103 | -> Codec error c 1104 | -> CustomTypeCodec z error ((a -> b -> c -> VariantEncoder) -> partial) v 1105 | -> CustomTypeCodec () error partial v 1106 | variant3 ctor m1 m2 m3 = 1107 | variant 1108 | (\c v1 v2 v3 -> 1109 | [ getEncoder m1 v1 1110 | , getEncoder m2 v2 1111 | , getEncoder m3 v3 1112 | ] 1113 | |> c 1114 | ) 1115 | (\c v1 v2 v3 -> 1116 | [ getJsonEncoder m1 v1 1117 | , getJsonEncoder m2 v2 1118 | , getJsonEncoder m3 v3 1119 | ] 1120 | |> c 1121 | ) 1122 | (BD.map3 1123 | (result3 ctor) 1124 | (getDecoder m1) 1125 | (getDecoder m2) 1126 | (getDecoder m3) 1127 | ) 1128 | (JD.map3 1129 | (result3 ctor) 1130 | (JD.index 1 (getJsonDecoder m1)) 1131 | (JD.index 2 (getJsonDecoder m2)) 1132 | (JD.index 3 (getJsonDecoder m3)) 1133 | ) 1134 | 1135 | 1136 | result3 : (value -> a -> b -> c) -> Result error value -> Result error a -> Result error b -> Result error c 1137 | result3 ctor v1 v2 v3 = 1138 | case ( v1, v2, v3 ) of 1139 | ( Ok ok1, Ok ok2, Ok ok3 ) -> 1140 | ctor ok1 ok2 ok3 |> Ok 1141 | 1142 | ( Err err, _, _ ) -> 1143 | Err err 1144 | 1145 | ( _, Err err, _ ) -> 1146 | Err err 1147 | 1148 | ( _, _, Err err ) -> 1149 | Err err 1150 | 1151 | 1152 | {-| Define a variant with 4 parameters for a custom type. 1153 | -} 1154 | variant4 : 1155 | (a -> b -> c -> d -> v) 1156 | -> Codec error a 1157 | -> Codec error b 1158 | -> Codec error c 1159 | -> Codec error d 1160 | -> CustomTypeCodec z error ((a -> b -> c -> d -> VariantEncoder) -> partial) v 1161 | -> CustomTypeCodec () error partial v 1162 | variant4 ctor m1 m2 m3 m4 = 1163 | variant 1164 | (\c v1 v2 v3 v4 -> 1165 | [ getEncoder m1 v1 1166 | , getEncoder m2 v2 1167 | , getEncoder m3 v3 1168 | , getEncoder m4 v4 1169 | ] 1170 | |> c 1171 | ) 1172 | (\c v1 v2 v3 v4 -> 1173 | [ getJsonEncoder m1 v1 1174 | , getJsonEncoder m2 v2 1175 | , getJsonEncoder m3 v3 1176 | , getJsonEncoder m4 v4 1177 | ] 1178 | |> c 1179 | ) 1180 | (BD.map4 1181 | (result4 ctor) 1182 | (getDecoder m1) 1183 | (getDecoder m2) 1184 | (getDecoder m3) 1185 | (getDecoder m4) 1186 | ) 1187 | (JD.map4 1188 | (result4 ctor) 1189 | (JD.index 1 (getJsonDecoder m1)) 1190 | (JD.index 2 (getJsonDecoder m2)) 1191 | (JD.index 3 (getJsonDecoder m3)) 1192 | (JD.index 4 (getJsonDecoder m4)) 1193 | ) 1194 | 1195 | 1196 | result4 : (value -> a -> b -> c -> d) -> Result error value -> Result error a -> Result error b -> Result error c -> Result error d 1197 | result4 ctor v1 v2 v3 v4 = 1198 | case T4 v1 v2 v3 v4 of 1199 | T4 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) -> 1200 | ctor ok1 ok2 ok3 ok4 |> Ok 1201 | 1202 | T4 (Err err) _ _ _ -> 1203 | Err err 1204 | 1205 | T4 _ (Err err) _ _ -> 1206 | Err err 1207 | 1208 | T4 _ _ (Err err) _ -> 1209 | Err err 1210 | 1211 | T4 _ _ _ (Err err) -> 1212 | Err err 1213 | 1214 | 1215 | {-| Define a variant with 5 parameters for a custom type. 1216 | -} 1217 | variant5 : 1218 | (a -> b -> c -> d -> e -> v) 1219 | -> Codec error a 1220 | -> Codec error b 1221 | -> Codec error c 1222 | -> Codec error d 1223 | -> Codec error e 1224 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> VariantEncoder) -> partial) v 1225 | -> CustomTypeCodec () error partial v 1226 | variant5 ctor m1 m2 m3 m4 m5 = 1227 | variant 1228 | (\c v1 v2 v3 v4 v5 -> 1229 | [ getEncoder m1 v1 1230 | , getEncoder m2 v2 1231 | , getEncoder m3 v3 1232 | , getEncoder m4 v4 1233 | , getEncoder m5 v5 1234 | ] 1235 | |> c 1236 | ) 1237 | (\c v1 v2 v3 v4 v5 -> 1238 | [ getJsonEncoder m1 v1 1239 | , getJsonEncoder m2 v2 1240 | , getJsonEncoder m3 v3 1241 | , getJsonEncoder m4 v4 1242 | , getJsonEncoder m5 v5 1243 | ] 1244 | |> c 1245 | ) 1246 | (BD.map5 1247 | (result5 ctor) 1248 | (getDecoder m1) 1249 | (getDecoder m2) 1250 | (getDecoder m3) 1251 | (getDecoder m4) 1252 | (getDecoder m5) 1253 | ) 1254 | (JD.map5 1255 | (result5 ctor) 1256 | (JD.index 1 (getJsonDecoder m1)) 1257 | (JD.index 2 (getJsonDecoder m2)) 1258 | (JD.index 3 (getJsonDecoder m3)) 1259 | (JD.index 4 (getJsonDecoder m4)) 1260 | (JD.index 5 (getJsonDecoder m5)) 1261 | ) 1262 | 1263 | 1264 | result5 ctor v1 v2 v3 v4 v5 = 1265 | case T5 v1 v2 v3 v4 v5 of 1266 | T5 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) -> 1267 | ctor ok1 ok2 ok3 ok4 ok5 |> Ok 1268 | 1269 | T5 (Err err) _ _ _ _ -> 1270 | Err err 1271 | 1272 | T5 _ (Err err) _ _ _ -> 1273 | Err err 1274 | 1275 | T5 _ _ (Err err) _ _ -> 1276 | Err err 1277 | 1278 | T5 _ _ _ (Err err) _ -> 1279 | Err err 1280 | 1281 | T5 _ _ _ _ (Err err) -> 1282 | Err err 1283 | 1284 | 1285 | {-| Define a variant with 6 parameters for a custom type. 1286 | -} 1287 | variant6 : 1288 | (a -> b -> c -> d -> e -> f -> v) 1289 | -> Codec error a 1290 | -> Codec error b 1291 | -> Codec error c 1292 | -> Codec error d 1293 | -> Codec error e 1294 | -> Codec error f 1295 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> VariantEncoder) -> partial) v 1296 | -> CustomTypeCodec () error partial v 1297 | variant6 ctor m1 m2 m3 m4 m5 m6 = 1298 | variant 1299 | (\c v1 v2 v3 v4 v5 v6 -> 1300 | [ getEncoder m1 v1 1301 | , getEncoder m2 v2 1302 | , getEncoder m3 v3 1303 | , getEncoder m4 v4 1304 | , getEncoder m5 v5 1305 | , getEncoder m6 v6 1306 | ] 1307 | |> c 1308 | ) 1309 | (\c v1 v2 v3 v4 v5 v6 -> 1310 | [ getJsonEncoder m1 v1 1311 | , getJsonEncoder m2 v2 1312 | , getJsonEncoder m3 v3 1313 | , getJsonEncoder m4 v4 1314 | , getJsonEncoder m5 v5 1315 | , getJsonEncoder m6 v6 1316 | ] 1317 | |> c 1318 | ) 1319 | (BD.map5 1320 | (result6 ctor) 1321 | (getDecoder m1) 1322 | (getDecoder m2) 1323 | (getDecoder m3) 1324 | (getDecoder m4) 1325 | (BD.map2 Tuple.pair 1326 | (getDecoder m5) 1327 | (getDecoder m6) 1328 | ) 1329 | ) 1330 | (JD.map5 1331 | (result6 ctor) 1332 | (JD.index 1 (getJsonDecoder m1)) 1333 | (JD.index 2 (getJsonDecoder m2)) 1334 | (JD.index 3 (getJsonDecoder m3)) 1335 | (JD.index 4 (getJsonDecoder m4)) 1336 | (JD.map2 Tuple.pair 1337 | (JD.index 5 (getJsonDecoder m5)) 1338 | (JD.index 6 (getJsonDecoder m6)) 1339 | ) 1340 | ) 1341 | 1342 | 1343 | result6 : (value -> a -> b -> c -> d -> e -> f) -> Result error value -> Result error a -> Result error b -> Result error c -> ( Result error d, Result error e ) -> Result error f 1344 | result6 ctor v1 v2 v3 v4 ( v5, v6 ) = 1345 | case T6 v1 v2 v3 v4 v5 v6 of 1346 | T6 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) -> 1347 | ctor ok1 ok2 ok3 ok4 ok5 ok6 |> Ok 1348 | 1349 | T6 (Err err) _ _ _ _ _ -> 1350 | Err err 1351 | 1352 | T6 _ (Err err) _ _ _ _ -> 1353 | Err err 1354 | 1355 | T6 _ _ (Err err) _ _ _ -> 1356 | Err err 1357 | 1358 | T6 _ _ _ (Err err) _ _ -> 1359 | Err err 1360 | 1361 | T6 _ _ _ _ (Err err) _ -> 1362 | Err err 1363 | 1364 | T6 _ _ _ _ _ (Err err) -> 1365 | Err err 1366 | 1367 | 1368 | {-| Define a variant with 7 parameters for a custom type. 1369 | -} 1370 | variant7 : 1371 | (a -> b -> c -> d -> e -> f -> g -> v) 1372 | -> Codec error a 1373 | -> Codec error b 1374 | -> Codec error c 1375 | -> Codec error d 1376 | -> Codec error e 1377 | -> Codec error f 1378 | -> Codec error g 1379 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> g -> VariantEncoder) -> partial) v 1380 | -> CustomTypeCodec () error partial v 1381 | variant7 ctor m1 m2 m3 m4 m5 m6 m7 = 1382 | variant 1383 | (\c v1 v2 v3 v4 v5 v6 v7 -> 1384 | [ getEncoder m1 v1 1385 | , getEncoder m2 v2 1386 | , getEncoder m3 v3 1387 | , getEncoder m4 v4 1388 | , getEncoder m5 v5 1389 | , getEncoder m6 v6 1390 | , getEncoder m7 v7 1391 | ] 1392 | |> c 1393 | ) 1394 | (\c v1 v2 v3 v4 v5 v6 v7 -> 1395 | [ getJsonEncoder m1 v1 1396 | , getJsonEncoder m2 v2 1397 | , getJsonEncoder m3 v3 1398 | , getJsonEncoder m4 v4 1399 | , getJsonEncoder m5 v5 1400 | , getJsonEncoder m6 v6 1401 | , getJsonEncoder m7 v7 1402 | ] 1403 | |> c 1404 | ) 1405 | (BD.map5 1406 | (result7 ctor) 1407 | (getDecoder m1) 1408 | (getDecoder m2) 1409 | (getDecoder m3) 1410 | (BD.map2 Tuple.pair 1411 | (getDecoder m4) 1412 | (getDecoder m5) 1413 | ) 1414 | (BD.map2 Tuple.pair 1415 | (getDecoder m6) 1416 | (getDecoder m7) 1417 | ) 1418 | ) 1419 | (JD.map5 1420 | (result7 ctor) 1421 | (JD.index 1 (getJsonDecoder m1)) 1422 | (JD.index 2 (getJsonDecoder m2)) 1423 | (JD.index 3 (getJsonDecoder m3)) 1424 | (JD.map2 Tuple.pair 1425 | (JD.index 4 (getJsonDecoder m4)) 1426 | (JD.index 5 (getJsonDecoder m5)) 1427 | ) 1428 | (JD.map2 Tuple.pair 1429 | (JD.index 6 (getJsonDecoder m6)) 1430 | (JD.index 7 (getJsonDecoder m7)) 1431 | ) 1432 | ) 1433 | 1434 | 1435 | result7 : (value -> a -> b -> c -> d -> e -> f -> g) -> Result error value -> Result error a -> Result error b -> ( Result error c, Result error d ) -> ( Result error e, Result error f ) -> Result error g 1436 | result7 ctor v1 v2 v3 ( v4, v5 ) ( v6, v7 ) = 1437 | case T7 v1 v2 v3 v4 v5 v6 v7 of 1438 | T7 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) (Ok ok7) -> 1439 | ctor ok1 ok2 ok3 ok4 ok5 ok6 ok7 |> Ok 1440 | 1441 | T7 (Err err) _ _ _ _ _ _ -> 1442 | Err err 1443 | 1444 | T7 _ (Err err) _ _ _ _ _ -> 1445 | Err err 1446 | 1447 | T7 _ _ (Err err) _ _ _ _ -> 1448 | Err err 1449 | 1450 | T7 _ _ _ (Err err) _ _ _ -> 1451 | Err err 1452 | 1453 | T7 _ _ _ _ (Err err) _ _ -> 1454 | Err err 1455 | 1456 | T7 _ _ _ _ _ (Err err) _ -> 1457 | Err err 1458 | 1459 | T7 _ _ _ _ _ _ (Err err) -> 1460 | Err err 1461 | 1462 | 1463 | {-| Define a variant with 8 parameters for a custom type. 1464 | -} 1465 | variant8 : 1466 | (a -> b -> c -> d -> e -> f -> g -> h -> v) 1467 | -> Codec error a 1468 | -> Codec error b 1469 | -> Codec error c 1470 | -> Codec error d 1471 | -> Codec error e 1472 | -> Codec error f 1473 | -> Codec error g 1474 | -> Codec error h 1475 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> g -> h -> VariantEncoder) -> partial) v 1476 | -> CustomTypeCodec () error partial v 1477 | variant8 ctor m1 m2 m3 m4 m5 m6 m7 m8 = 1478 | variant 1479 | (\c v1 v2 v3 v4 v5 v6 v7 v8 -> 1480 | [ getEncoder m1 v1 1481 | , getEncoder m2 v2 1482 | , getEncoder m3 v3 1483 | , getEncoder m4 v4 1484 | , getEncoder m5 v5 1485 | , getEncoder m6 v6 1486 | , getEncoder m7 v7 1487 | , getEncoder m8 v8 1488 | ] 1489 | |> c 1490 | ) 1491 | (\c v1 v2 v3 v4 v5 v6 v7 v8 -> 1492 | [ getJsonEncoder m1 v1 1493 | , getJsonEncoder m2 v2 1494 | , getJsonEncoder m3 v3 1495 | , getJsonEncoder m4 v4 1496 | , getJsonEncoder m5 v5 1497 | , getJsonEncoder m6 v6 1498 | , getJsonEncoder m7 v7 1499 | , getJsonEncoder m8 v8 1500 | ] 1501 | |> c 1502 | ) 1503 | (BD.map5 1504 | (result8 ctor) 1505 | (getDecoder m1) 1506 | (getDecoder m2) 1507 | (BD.map2 Tuple.pair 1508 | (getDecoder m3) 1509 | (getDecoder m4) 1510 | ) 1511 | (BD.map2 Tuple.pair 1512 | (getDecoder m5) 1513 | (getDecoder m6) 1514 | ) 1515 | (BD.map2 Tuple.pair 1516 | (getDecoder m7) 1517 | (getDecoder m8) 1518 | ) 1519 | ) 1520 | (JD.map5 1521 | (result8 ctor) 1522 | (JD.index 1 (getJsonDecoder m1)) 1523 | (JD.index 2 (getJsonDecoder m2)) 1524 | (JD.map2 Tuple.pair 1525 | (JD.index 3 (getJsonDecoder m3)) 1526 | (JD.index 4 (getJsonDecoder m4)) 1527 | ) 1528 | (JD.map2 Tuple.pair 1529 | (JD.index 5 (getJsonDecoder m5)) 1530 | (JD.index 6 (getJsonDecoder m6)) 1531 | ) 1532 | (JD.map2 Tuple.pair 1533 | (JD.index 7 (getJsonDecoder m7)) 1534 | (JD.index 8 (getJsonDecoder m8)) 1535 | ) 1536 | ) 1537 | 1538 | 1539 | result8 : (value -> a -> b -> c -> d -> e -> f -> g -> h) -> Result error value -> Result error a -> ( Result error b, Result error c ) -> ( Result error d, Result error e ) -> ( Result error f, Result error g ) -> Result error h 1540 | result8 ctor v1 v2 ( v3, v4 ) ( v5, v6 ) ( v7, v8 ) = 1541 | case T8 v1 v2 v3 v4 v5 v6 v7 v8 of 1542 | T8 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) (Ok ok7) (Ok ok8) -> 1543 | ctor ok1 ok2 ok3 ok4 ok5 ok6 ok7 ok8 |> Ok 1544 | 1545 | T8 (Err err) _ _ _ _ _ _ _ -> 1546 | Err err 1547 | 1548 | T8 _ (Err err) _ _ _ _ _ _ -> 1549 | Err err 1550 | 1551 | T8 _ _ (Err err) _ _ _ _ _ -> 1552 | Err err 1553 | 1554 | T8 _ _ _ (Err err) _ _ _ _ -> 1555 | Err err 1556 | 1557 | T8 _ _ _ _ (Err err) _ _ _ -> 1558 | Err err 1559 | 1560 | T8 _ _ _ _ _ (Err err) _ _ -> 1561 | Err err 1562 | 1563 | T8 _ _ _ _ _ _ (Err err) _ -> 1564 | Err err 1565 | 1566 | T8 _ _ _ _ _ _ _ (Err err) -> 1567 | Err err 1568 | 1569 | 1570 | {-| Finish creating a codec for a custom type. 1571 | -} 1572 | finishCustomType : CustomTypeCodec () e (a -> VariantEncoder) a -> Codec e a 1573 | finishCustomType (CustomTypeCodec am) = 1574 | build 1575 | (am.match >> (\(VariantEncoder ( a, _ )) -> a)) 1576 | (BD.unsignedInt16 endian 1577 | |> BD.andThen 1578 | (\tag -> 1579 | am.decoder tag (BD.succeed (Err DataCorrupted)) 1580 | ) 1581 | ) 1582 | (am.jsonMatch >> (\(VariantEncoder ( _, a )) -> a)) 1583 | (JD.index 0 JD.int 1584 | |> JD.andThen 1585 | (\tag -> 1586 | am.jsonDecoder tag (JD.succeed (Err DataCorrupted)) 1587 | ) 1588 | ) 1589 | 1590 | 1591 | 1592 | ---- MAPPING 1593 | 1594 | 1595 | {-| Map from one codec to another codec 1596 | 1597 | import Serialize as S 1598 | 1599 | type UserId 1600 | = UserId Int 1601 | 1602 | userIdCodec : S.Codec UserId 1603 | userIdCodec = 1604 | S.int |> S.map UserId (\(UserId id) -> id) 1605 | 1606 | Note that there's nothing preventing you from encoding Elm values that will map to some different value when you decode them. 1607 | I recommend writing tests for Codecs that use `map` to make sure you get back the same Elm value you put in. 1608 | [Here's some helper functions to get you started.](https://github.com/MartinSStewart/elm-geometry-serialize/blob/6f2244c28631ede1b864cb43541d1573dc628904/tests/Tests.elm#L49-L74) 1609 | 1610 | -} 1611 | map : (a -> b) -> (b -> a) -> Codec e a -> Codec e b 1612 | map fromBytes_ toBytes_ codec = 1613 | mapHelper 1614 | (\value -> 1615 | case value of 1616 | Ok ok -> 1617 | fromBytes_ ok |> Ok 1618 | 1619 | Err err -> 1620 | Err err 1621 | ) 1622 | toBytes_ 1623 | codec 1624 | 1625 | 1626 | mapHelper : (Result (Error e) a -> Result (Error e) b) -> (b -> a) -> Codec e a -> Codec e b 1627 | mapHelper fromBytes_ toBytes_ codec = 1628 | build 1629 | (\v -> toBytes_ v |> getEncoder codec) 1630 | (getDecoder codec |> BD.map fromBytes_) 1631 | (\v -> toBytes_ v |> getJsonEncoder codec) 1632 | (getJsonDecoder codec |> JD.map fromBytes_) 1633 | 1634 | 1635 | {-| Map from one codec to another codec in a way that can potentially fail when decoding. 1636 | 1637 | -- Email module is from https://package.elm-lang.org/packages/tricycle/elm-email/1.0.2/ 1638 | 1639 | 1640 | import Email 1641 | import Serialize as S 1642 | 1643 | emailCodec : S.Codec String Float 1644 | emailCodec = 1645 | S.string 1646 | |> S.mapValid 1647 | (\text -> 1648 | case Email.fromString of 1649 | Just email -> 1650 | Ok email 1651 | 1652 | Nothing -> 1653 | Err "Invalid email" 1654 | ) 1655 | Email.toString 1656 | 1657 | Note that there's nothing preventing you from encoding Elm values that will produce Err when you decode them. 1658 | I recommend writing tests for Codecs that use `mapValid` to make sure you get back the same Elm value you put in. 1659 | [Here's some helper functions to get you started.](https://github.com/MartinSStewart/elm-geometry-serialize/blob/6f2244c28631ede1b864cb43541d1573dc628904/tests/Tests.elm#L49-L74) 1660 | 1661 | -} 1662 | mapValid : (a -> Result e b) -> (b -> a) -> Codec e a -> Codec e b 1663 | mapValid fromBytes_ toBytes_ codec = 1664 | build 1665 | (\v -> toBytes_ v |> getEncoder codec) 1666 | (getDecoder codec 1667 | |> BD.map 1668 | (\value -> 1669 | case value of 1670 | Ok ok -> 1671 | fromBytes_ ok |> Result.mapError CustomError 1672 | 1673 | Err err -> 1674 | Err err 1675 | ) 1676 | ) 1677 | (\v -> toBytes_ v |> getJsonEncoder codec) 1678 | (getJsonDecoder codec 1679 | |> JD.map 1680 | (\value -> 1681 | case value of 1682 | Ok ok -> 1683 | fromBytes_ ok |> Result.mapError CustomError 1684 | 1685 | Err err -> 1686 | Err err 1687 | ) 1688 | ) 1689 | 1690 | 1691 | {-| Map errors generated by `mapValid`. 1692 | -} 1693 | mapError : (e1 -> e2) -> Codec e1 a -> Codec e2 a 1694 | mapError mapFunc codec = 1695 | build 1696 | (getEncoder codec) 1697 | (getDecoder codec |> BD.map (mapErrorHelper mapFunc)) 1698 | (getJsonEncoder codec) 1699 | (getJsonDecoder codec |> JD.map (mapErrorHelper mapFunc)) 1700 | 1701 | 1702 | mapErrorHelper : (e -> a) -> Result (Error e) b -> Result (Error a) b 1703 | mapErrorHelper mapFunc = 1704 | Result.mapError 1705 | (\error -> 1706 | case error of 1707 | CustomError custom -> 1708 | mapFunc custom |> CustomError 1709 | 1710 | DataCorrupted -> 1711 | DataCorrupted 1712 | 1713 | SerializerOutOfDate -> 1714 | SerializerOutOfDate 1715 | ) 1716 | 1717 | 1718 | 1719 | -- STACK UNSAFE 1720 | 1721 | 1722 | {-| Handle situations where you need to define a codec in terms of itself. 1723 | 1724 | import Serialize as S 1725 | 1726 | type Peano 1727 | = Peano (Maybe Peano) 1728 | 1729 | {-| The compiler will complain that this function causes an infinite loop. 1730 | -} 1731 | badPeanoCodec : S.Codec Peano 1732 | badPeanoCodec = 1733 | S.maybe badPeanoCodec |> S.map Peano (\(Peano a) -> a) 1734 | 1735 | {-| Now the compiler is happy! 1736 | -} 1737 | goodPeanoCodec : S.Codec Peano 1738 | goodPeanoCodec = 1739 | S.maybe (S.lazy (\() -> goodPeanoCodec)) |> S.map Peano (\(Peano a) -> a) 1740 | 1741 | **Warning:** This is not stack safe. 1742 | 1743 | In general if you have a type that contains itself, like with our the Peano example, then you're at risk of a stack overflow while decoding. 1744 | Even if you're translating your nested data into a list before encoding, you're at risk, because the function translating back after decoding can cause a stack overflow if the original value was nested deeply enough. 1745 | Be careful here, and test your codecs using elm-test with larger inputs than you ever expect to see in real life. 1746 | 1747 | -} 1748 | lazy : (() -> Codec e a) -> Codec e a 1749 | lazy f = 1750 | build 1751 | (\value -> getEncoder (f ()) value) 1752 | (BD.succeed () |> BD.andThen (\() -> getDecoder (f ()))) 1753 | (\value -> getJsonEncoder (f ()) value) 1754 | (JD.succeed () |> JD.andThen (\() -> getJsonDecoder (f ()))) 1755 | -------------------------------------------------------------------------------- /tests/FileSizeTests.elm: -------------------------------------------------------------------------------- 1 | module FileSizeTests exposing (..) 2 | 3 | import AstCodec 4 | import Bytes 5 | import Bytes.Encode 6 | import Elm.Parser 7 | import Elm.Processing 8 | import Expect 9 | import Json.Encode 10 | import Serialize 11 | import Test exposing (Test, describe, test) 12 | 13 | 14 | tests : Test 15 | tests = 16 | describe "File size test" 17 | [ test "encodeToJson file size" <| 18 | \_ -> 19 | case code of 20 | Ok parsed -> 21 | Elm.Processing.process Elm.Processing.init parsed 22 | |> Serialize.encodeToJson AstCodec.file 23 | |> Json.Encode.encode 0 24 | |> Bytes.Encode.getStringWidth 25 | |> Expect.lessThan 211657 26 | 27 | Err error -> 28 | Expect.fail ("Failed to parse: " ++ Debug.toString error) 29 | , test "encodeToBytes file size" <| 30 | \_ -> 31 | case code of 32 | Ok parsed -> 33 | Elm.Processing.process Elm.Processing.init parsed 34 | |> Serialize.encodeToBytes AstCodec.file 35 | |> Bytes.width 36 | |> Expect.lessThan 259131 37 | 38 | Err error -> 39 | Expect.fail ("Failed to parse: " ++ Debug.toString error) 40 | , test "encodeToString file size" <| 41 | \_ -> 42 | case code of 43 | Ok parsed -> 44 | Elm.Processing.process Elm.Processing.init parsed 45 | |> Serialize.encodeToString AstCodec.file 46 | |> Bytes.Encode.getStringWidth 47 | |> Expect.lessThan 345508 48 | 49 | Err error -> 50 | Expect.fail ("Failed to parse: " ++ Debug.toString error) 51 | ] 52 | 53 | 54 | code = 55 | Elm.Parser.parse <| 56 | String.replace 57 | "\u{000D}" 58 | "" 59 | """module Serialize exposing 60 | ( Codec, Error(..) 61 | , decodeFromBytes, decodeFromString 62 | , encodeToBytes, encodeToString 63 | , string, bool, float, int, unit, bytes, byte 64 | , maybe, list, array, dict, set, tuple, triple, result, enum 65 | , RecordCodec, record, field, finishRecord 66 | , CustomTypeCodec, customType, variant0, variant1, variant2, variant3, variant4, variant5, variant6, variant7, variant8, finishCustomType, VariantEncoder 67 | , map, mapValid, mapError 68 | , lazy 69 | , decodeFromJson, encodeToJson 70 | ) 71 | 72 | {-| 73 | 74 | 75 | # Definition 76 | 77 | @docs Codec, Error 78 | 79 | 80 | # Decode 81 | 82 | @docs decodeFromBytes, decodeFromString 83 | 84 | 85 | # Encode 86 | 87 | @docs encodeToBytes, encodeToString 88 | 89 | 90 | # Primitives 91 | 92 | @docs string, bool, float, int, unit, bytes, byte 93 | 94 | 95 | # Data Structures 96 | 97 | @docs maybe, list, array, dict, set, tuple, triple, result, enum 98 | 99 | 100 | # Records 101 | 102 | @docs RecordCodec, record, field, finishRecord 103 | 104 | 105 | # Custom Types 106 | 107 | @docs CustomTypeCodec, customType, variant0, variant1, variant2, variant3, variant4, variant5, variant6, variant7, variant8, finishCustomType, VariantEncoder 108 | 109 | 110 | # Mapping 111 | 112 | @docs map, mapValid, mapError 113 | 114 | 115 | # Stack unsafe 116 | 117 | @docs lazy 118 | 119 | -} 120 | 121 | import Array exposing (Array) 122 | import Base64 123 | import Bytes 124 | import Bytes.Decode as BD 125 | import Bytes.Encode as BE 126 | import Dict exposing (Dict) 127 | import Json.Decode as JD 128 | import Json.Encode as JE 129 | import Regex exposing (Regex) 130 | import Set exposing (Set) 131 | import Toop exposing (T4(..), T5(..), T6(..), T7(..), T8(..)) 132 | 133 | 134 | 135 | -- DEFINITION 136 | 137 | 138 | {-| A value that knows how to encode and decode an Elm data structure. 139 | -} 140 | type Codec e a 141 | = Codec 142 | { encoder : a -> BE.Encoder 143 | , decoder : Decoder (Result (Error e) a) 144 | , jsonEncoder : a -> JE.Value 145 | , jsonDecoder : JD.Decoder (Result (Error e) a) 146 | } 147 | 148 | 149 | {-| Possible errors that can occur when decoding. 150 | 151 | - `CustomError` - An error caused by `andThen` returning an Err value. 152 | - `DataCorrupted` - This most likely will occur if you make breaking changes to your codec and try to decode old data\\*. Have a look at `How do I change my codecs and still be able to decode old data?` in the readme for how to avoid introducing breaking changes. 153 | - `SerializerOutOfDate` - When encoding, this package will include a version number. This makes it possible for me to make improvements to how data gets encoded without introducing breaking changes to your codecs. This error then, says that you're trying to decode data encoded with a newer version of elm-serialize. 154 | 155 | \\*It's possible for corrupted data to still succeed in decoding (but with nonsense Elm values). 156 | This is because internally we're just encoding Elm values and not storing any kind of structural information. 157 | So if you encoded an Int and then a Float, and then tried decoding it as a Float and then an Int, there's no way for the decoder to know it read the data in the wrong order. 158 | 159 | -} 160 | type Error e 161 | = CustomError e 162 | | DataCorrupted 163 | | SerializerOutOfDate 164 | 165 | 166 | version : Int 167 | version = 168 | 1 169 | 170 | 171 | 172 | -- DECODE 173 | 174 | 175 | {-| Describes how to turn a sequence of bytes into a nice Elm value. 176 | -} 177 | type alias Decoder a = 178 | BD.Decoder a 179 | 180 | 181 | endian : Bytes.Endianness 182 | endian = 183 | Bytes.BE 184 | 185 | 186 | {-| Extracts the `Decoder` contained inside the `Codec`. 187 | -} 188 | getDecoder : Codec e a -> Decoder (Result (Error e) a) 189 | getDecoder (Codec m) = 190 | m.decoder 191 | 192 | 193 | {-| Extracts the json `Decoder` contained inside the `Codec`. 194 | -} 195 | getJsonDecoder : Codec e a -> JD.Decoder (Result (Error e) a) 196 | getJsonDecoder (Codec m) = 197 | m.jsonDecoder 198 | 199 | 200 | {-| Run a `Codec` to turn a sequence of bytes into an Elm value. 201 | -} 202 | decodeFromBytes : Codec e a -> Bytes.Bytes -> Result (Error e) a 203 | decodeFromBytes codec bytes_ = 204 | let 205 | decoder = 206 | BD.unsignedInt8 207 | |> BD.andThen 208 | (\\value -> 209 | if value <= 0 then 210 | Err DataCorrupted |> BD.succeed 211 | 212 | else if value == version then 213 | getDecoder codec 214 | 215 | else 216 | Err SerializerOutOfDate |> BD.succeed 217 | ) 218 | in 219 | case BD.decode decoder bytes_ of 220 | Just value -> 221 | value 222 | 223 | Nothing -> 224 | Err DataCorrupted 225 | 226 | 227 | {-| Run a `Codec` to turn a String encoded with `encodeToString` into an Elm value. 228 | -} 229 | decodeFromString : Codec e a -> String -> Result (Error e) a 230 | decodeFromString codec base64 = 231 | case decode base64 of 232 | Just bytes_ -> 233 | decodeFromBytes codec bytes_ 234 | 235 | Nothing -> 236 | Err DataCorrupted 237 | 238 | 239 | decodeFromJson : Codec e a -> JE.Value -> Result (Error e) a 240 | decodeFromJson codec json = 241 | let 242 | decoder = 243 | JD.index 0 JD.int 244 | |> JD.andThen 245 | (\\value -> 246 | if value <= 0 then 247 | Err DataCorrupted |> JD.succeed 248 | 249 | else if value == version then 250 | JD.index 1 (getJsonDecoder codec) 251 | 252 | else 253 | Err SerializerOutOfDate |> JD.succeed 254 | ) 255 | in 256 | case JD.decodeValue decoder json of 257 | Ok value -> 258 | value 259 | 260 | Err error -> 261 | Err DataCorrupted 262 | 263 | 264 | decode : String -> Maybe Bytes.Bytes 265 | decode base64text = 266 | let 267 | replaceChar rematch = 268 | case rematch.match of 269 | "-" -> 270 | "+" 271 | 272 | _ -> 273 | "/" 274 | 275 | strlen = 276 | String.length base64text 277 | in 278 | if strlen == 0 then 279 | BE.encode (BE.sequence []) |> Just 280 | 281 | else 282 | let 283 | hanging = 284 | modBy 4 strlen 285 | 286 | ilen = 287 | if hanging == 0 then 288 | 0 289 | 290 | else 291 | 4 - hanging 292 | in 293 | Regex.replace replaceFromUrl replaceChar (base64text ++ String.repeat ilen "=") |> Base64.toBytes 294 | 295 | 296 | replaceFromUrl : Regex 297 | replaceFromUrl = 298 | Regex.fromString "[-_]" |> Maybe.withDefault Regex.never 299 | 300 | 301 | 302 | -- ENCODE 303 | 304 | 305 | {-| Extracts the encoding function contained inside the `Codec`. 306 | -} 307 | getEncoder : Codec e a -> a -> BE.Encoder 308 | getEncoder (Codec m) = 309 | m.encoder 310 | 311 | 312 | {-| Extracts the json encoding function contained inside the `Codec`. 313 | -} 314 | getJsonEncoder : Codec e a -> a -> JE.Value 315 | getJsonEncoder (Codec m) = 316 | m.jsonEncoder 317 | 318 | 319 | {-| Convert an Elm value into a sequence of bytes. 320 | -} 321 | encodeToBytes : Codec e a -> a -> Bytes.Bytes 322 | encodeToBytes codec value = 323 | BE.sequence 324 | [ BE.unsignedInt8 version 325 | , value |> getEncoder codec 326 | ] 327 | |> BE.encode 328 | 329 | 330 | {-| Convert an Elm value into a string. This string contains only url safe characters, so you can do the following: 331 | 332 | import Serialize as S 333 | 334 | myUrl = 335 | "www.mywebsite.com/?data=" ++ S.encodeToString S.float 1234 336 | 337 | and not risk generating an invalid url. 338 | 339 | -} 340 | encodeToString : Codec e a -> a -> String 341 | encodeToString codec = 342 | encodeToBytes codec >> replaceBase64Chars 343 | 344 | 345 | encodeToJson : Codec e a -> a -> JE.Value 346 | encodeToJson codec value = 347 | JE.list 348 | identity 349 | [ JE.int version 350 | , value |> getJsonEncoder codec 351 | ] 352 | 353 | 354 | replaceBase64Chars : Bytes.Bytes -> String 355 | replaceBase64Chars = 356 | let 357 | replaceChar rematch = 358 | case rematch.match of 359 | "+" -> 360 | "-" 361 | 362 | "/" -> 363 | "_" 364 | 365 | _ -> 366 | "" 367 | in 368 | Base64.fromBytes >> Maybe.withDefault "" >> Regex.replace replaceForUrl replaceChar 369 | 370 | 371 | replaceForUrl : Regex 372 | replaceForUrl = 373 | Regex.fromString "[\\\\+/=]" |> Maybe.withDefault Regex.never 374 | 375 | 376 | 377 | -- BASE 378 | 379 | 380 | build : 381 | (a -> BE.Encoder) 382 | -> Decoder (Result (Error e) a) 383 | -> (a -> JE.Value) 384 | -> JD.Decoder (Result (Error e) a) 385 | -> Codec e a 386 | build encoder_ decoder_ jsonEncoder jsonDecoder = 387 | Codec 388 | { encoder = encoder_ 389 | , decoder = decoder_ 390 | , jsonEncoder = jsonEncoder 391 | , jsonDecoder = jsonDecoder 392 | } 393 | 394 | 395 | {-| Codec for serializing a `String` 396 | -} 397 | string : Codec e String 398 | string = 399 | build 400 | (\\text -> 401 | BE.sequence 402 | [ BE.unsignedInt32 endian (BE.getStringWidth text) 403 | , BE.string text 404 | ] 405 | ) 406 | (BD.unsignedInt32 endian 407 | |> BD.andThen 408 | (\\charCount -> BD.string charCount |> BD.map Ok) 409 | ) 410 | JE.string 411 | (JD.string |> JD.map Ok) 412 | 413 | 414 | {-| Codec for serializing a `Bool` 415 | -} 416 | bool : Codec e Bool 417 | bool = 418 | build 419 | (\\value -> 420 | case value of 421 | True -> 422 | BE.unsignedInt8 1 423 | 424 | False -> 425 | BE.unsignedInt8 0 426 | ) 427 | (BD.unsignedInt8 428 | |> BD.map 429 | (\\value -> 430 | case value of 431 | 0 -> 432 | Ok False 433 | 434 | 1 -> 435 | Ok True 436 | 437 | _ -> 438 | Err DataCorrupted 439 | ) 440 | ) 441 | JE.bool 442 | (JD.bool |> JD.map Ok) 443 | 444 | 445 | {-| Codec for serializing an `Int` 446 | -} 447 | int : Codec e Int 448 | int = 449 | build 450 | (toFloat >> BE.float64 endian) 451 | (BD.float64 endian |> BD.map (round >> Ok)) 452 | JE.int 453 | (JD.int |> JD.map Ok) 454 | 455 | 456 | {-| Codec for serializing a `Float` 457 | -} 458 | float : Codec e Float 459 | float = 460 | build 461 | (BE.float64 endian) 462 | (BD.float64 endian |> BD.map Ok) 463 | JE.float 464 | (JD.float |> JD.map Ok) 465 | 466 | 467 | {-| Codec for serializing a `Char` 468 | -} 469 | char : Codec e Char 470 | char = 471 | let 472 | charEncode text = 473 | BE.sequence 474 | [ BE.unsignedInt32 endian (String.length text) 475 | , BE.string text 476 | ] 477 | in 478 | build 479 | (String.fromChar >> charEncode) 480 | (BD.unsignedInt32 endian 481 | |> BD.andThen (\\charCount -> BD.string charCount) 482 | |> BD.map 483 | (\\text -> 484 | case String.toList text |> List.head of 485 | Just char_ -> 486 | Ok char_ 487 | 488 | Nothing -> 489 | Err DataCorrupted 490 | ) 491 | ) 492 | (String.fromChar >> JE.string) 493 | (JD.string 494 | |> JD.map 495 | (\\text -> 496 | case String.toList text |> List.head of 497 | Just char_ -> 498 | Ok char_ 499 | 500 | Nothing -> 501 | Err DataCorrupted 502 | ) 503 | ) 504 | 505 | 506 | 507 | -- DATA STRUCTURES 508 | 509 | 510 | {-| Codec for serializing a `Maybe` 511 | 512 | import Serialize as S 513 | 514 | maybeIntCodec : S.Codec (Maybe Int) 515 | maybeIntCodec = 516 | S.Maybe S.Int 517 | 518 | -} 519 | maybe : Codec e a -> Codec e (Maybe a) 520 | maybe justCodec = 521 | customType 522 | (\\nothingEncoder justEncoder value -> 523 | case value of 524 | Nothing -> 525 | nothingEncoder 526 | 527 | Just value_ -> 528 | justEncoder value_ 529 | ) 530 | |> variant0 Nothing 531 | |> variant1 Just justCodec 532 | |> finishCustomType 533 | 534 | 535 | {-| Codec for serializing a `List` 536 | 537 | import Serialize as S 538 | 539 | listOfStringsCodec : S.Codec (List String) 540 | listOfStringsCodec = 541 | S.list S.string 542 | 543 | -} 544 | list : Codec e a -> Codec e (List a) 545 | list codec = 546 | build 547 | (listEncode (getEncoder codec)) 548 | (BD.unsignedInt32 endian 549 | |> BD.andThen 550 | (\\length -> BD.loop ( length, [] ) (listStep (getDecoder codec))) 551 | ) 552 | (JE.list (getJsonEncoder codec)) 553 | (JD.list (getJsonDecoder codec) 554 | |> JD.map 555 | (List.foldr 556 | (\\value state -> 557 | case ( value, state ) of 558 | ( Ok ok, Ok okState ) -> 559 | ok :: okState |> Ok 560 | 561 | ( _, Err _ ) -> 562 | state 563 | 564 | ( Err error, Ok _ ) -> 565 | Err error 566 | ) 567 | (Ok []) 568 | ) 569 | ) 570 | 571 | 572 | isError : Result e a -> Bool 573 | isError result_ = 574 | case result_ of 575 | Ok _ -> 576 | False 577 | 578 | Err _ -> 579 | True 580 | 581 | 582 | listEncode : (a -> BE.Encoder) -> List a -> BE.Encoder 583 | listEncode encoder_ list_ = 584 | list_ 585 | |> List.map encoder_ 586 | |> (::) (BE.unsignedInt32 endian (List.length list_)) 587 | |> BE.sequence 588 | 589 | 590 | listStep : BD.Decoder (Result (Error e) a) -> ( Int, List a ) -> Decoder (BD.Step ( Int, List a ) (Result (Error e) (List a))) 591 | listStep decoder_ ( n, xs ) = 592 | if n <= 0 then 593 | BD.succeed (BD.Done (xs |> List.reverse |> Ok)) 594 | 595 | else 596 | BD.map 597 | (\\x -> 598 | case x of 599 | Ok ok -> 600 | BD.Loop ( n - 1, ok :: xs ) 601 | 602 | Err err -> 603 | BD.Done (Err err) 604 | ) 605 | decoder_ 606 | 607 | 608 | {-| Codec for serializing an `Array` 609 | -} 610 | array : Codec e a -> Codec e (Array a) 611 | array codec = 612 | list codec |> mapHelper (Result.map Array.fromList) Array.toList 613 | 614 | 615 | {-| Codec for serializing a `Dict` 616 | 617 | import Serialize as S 618 | 619 | type alias Name = 620 | String 621 | 622 | peoplesAgeCodec : S.Codec (Dict Name Int) 623 | peoplesAgeCodec = 624 | S.dict S.string S.int 625 | 626 | -} 627 | dict : Codec e comparable -> Codec e a -> Codec e (Dict comparable a) 628 | dict keyCodec valueCodec = 629 | list (tuple keyCodec valueCodec) 630 | |> mapHelper (Result.map Dict.fromList) Dict.toList 631 | 632 | 633 | {-| Codec for serializing a `Set` 634 | -} 635 | set : Codec e comparable -> Codec e (Set comparable) 636 | set codec = 637 | list codec |> mapHelper (Result.map Set.fromList) Set.toList 638 | 639 | 640 | {-| Codec for serializing `()` (aka `Unit`). 641 | -} 642 | unit : Codec e () 643 | unit = 644 | build 645 | (always (BE.sequence [])) 646 | (BD.succeed (Ok ())) 647 | (\\_ -> JE.int 0) 648 | (JD.succeed (Ok ())) 649 | 650 | 651 | {-| Codec for serializing a tuple with 2 elements 652 | 653 | import Serialize as S 654 | 655 | pointCodec : S.Codec ( Float, Float ) 656 | pointCodec = 657 | S.tuple S.float S.float 658 | 659 | -} 660 | tuple : Codec e a -> Codec e b -> Codec e ( a, b ) 661 | tuple codecFirst codecSecond = 662 | record Tuple.pair 663 | |> field Tuple.first codecFirst 664 | |> field Tuple.second codecSecond 665 | |> finishRecord 666 | 667 | 668 | {-| Codec for serializing a tuple with 3 elements 669 | 670 | import Serialize as S 671 | 672 | pointCodec : S.Codec ( Float, Float, Float ) 673 | pointCodec = 674 | S.tuple S.float S.float S.float 675 | 676 | -} 677 | triple : Codec e a -> Codec e b -> Codec e c -> Codec e ( a, b, c ) 678 | triple codecFirst codecSecond codecThird = 679 | record (\\a b c -> ( a, b, c )) 680 | |> field (\\( a, _, _ ) -> a) codecFirst 681 | |> field (\\( _, b, _ ) -> b) codecSecond 682 | |> field (\\( _, _, c ) -> c) codecThird 683 | |> finishRecord 684 | 685 | 686 | {-| Codec for serializing a `Result` 687 | -} 688 | result : Codec e error -> Codec e value -> Codec e (Result error value) 689 | result errorCodec valueCodec = 690 | customType 691 | (\\errEncoder okEncoder value -> 692 | case value of 693 | Err err -> 694 | errEncoder err 695 | 696 | Ok ok -> 697 | okEncoder ok 698 | ) 699 | |> variant1 Err errorCodec 700 | |> variant1 Ok valueCodec 701 | |> finishCustomType 702 | 703 | 704 | {-| Codec for serializing [`Bytes`](https://package.elm-lang.org/packages/elm/bytes/latest/). 705 | This is useful in combination with `mapValid` for encoding and decoding data using some specialized format. 706 | 707 | import Image exposing (Image) 708 | import Serialize as S 709 | 710 | imageCodec : S.Codec String Image 711 | imageCodec = 712 | S.bytes 713 | |> S.mapValid 714 | (Image.decode >> Result.fromMaybe "Failed to decode PNG image.") 715 | Image.toPng 716 | 717 | -} 718 | bytes : Codec e Bytes.Bytes 719 | bytes = 720 | build 721 | (\\bytes_ -> 722 | BE.sequence 723 | [ BE.unsignedInt32 endian (Bytes.width bytes_) 724 | , BE.bytes bytes_ 725 | ] 726 | ) 727 | (BD.unsignedInt32 endian |> BD.andThen (\\length -> BD.bytes length |> BD.map Ok)) 728 | (replaceBase64Chars >> JE.string) 729 | (JD.string 730 | |> JD.map 731 | (\\text -> 732 | case decode text of 733 | Just bytes_ -> 734 | Ok bytes_ 735 | 736 | Nothing -> 737 | Err DataCorrupted 738 | ) 739 | ) 740 | 741 | 742 | {-| Codec for serializing an integer ranging from 0 to 255. 743 | This is useful if you have a small integer you want to serialize and not use up a lot of space. 744 | 745 | import Serialize as S 746 | 747 | type alias Color = 748 | { red : Int 749 | , green : Int 750 | , blue : Int 751 | } 752 | 753 | color : S.Codec Color 754 | color = 755 | Color.record Color 756 | |> S.field .red byte 757 | |> S.field .green byte 758 | |> S.field .blue byte 759 | |> S.finishRecord 760 | 761 | -} 762 | byte : Codec e Int 763 | byte = 764 | build 765 | BE.unsignedInt8 766 | (BD.unsignedInt8 |> BD.map Ok) 767 | JE.int 768 | (JD.int |> JD.map Ok) 769 | 770 | 771 | {-| A codec for serializing an item from a list of possible items. 772 | If you try to encode an item that isn't in the list then the first item is defaulted to. 773 | 774 | import Serialize as S 775 | 776 | type DaysOfWeek 777 | = Monday 778 | | Tuesday 779 | | Wednesday 780 | | Thursday 781 | | Friday 782 | | Saturday 783 | | Sunday 784 | 785 | daysOfWeekCodec : S.Codec DaysOfWeek 786 | daysOfWeekCodec = 787 | S.enum Monday [ Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday ] 788 | 789 | -} 790 | enum : a -> List a -> Codec e a 791 | enum defaultItem items = 792 | let 793 | getIndex value = 794 | items 795 | |> findIndex ((==) value) 796 | |> Maybe.withDefault -1 797 | |> (+) 1 798 | 799 | getItem index = 800 | if index < 0 then 801 | Err DataCorrupted 802 | 803 | else if index > List.length items then 804 | Err DataCorrupted 805 | 806 | else 807 | getAt (index - 1) items |> Maybe.withDefault defaultItem |> Ok 808 | in 809 | build 810 | (getIndex >> BE.unsignedInt32 endian) 811 | (BD.unsignedInt32 endian |> BD.map getItem) 812 | (getIndex >> JE.int) 813 | (JD.int |> JD.map getItem) 814 | 815 | 816 | getAt : Int -> List a -> Maybe a 817 | getAt idx xs = 818 | if idx < 0 then 819 | Nothing 820 | 821 | else 822 | List.head <| List.drop idx xs 823 | 824 | 825 | {-| 826 | -} 827 | findIndex : (a -> Bool) -> List a -> Maybe Int 828 | findIndex = 829 | findIndexHelp 0 830 | 831 | 832 | {-| 833 | -} 834 | findIndexHelp : Int -> (a -> Bool) -> List a -> Maybe Int 835 | findIndexHelp index predicate list_ = 836 | case list_ of 837 | [] -> 838 | Nothing 839 | 840 | x :: xs -> 841 | if predicate x then 842 | Just index 843 | 844 | else 845 | findIndexHelp (index + 1) predicate xs 846 | 847 | 848 | 849 | -- OBJECTS 850 | 851 | 852 | {-| A partially built Codec for a record. 853 | -} 854 | type RecordCodec e a b 855 | = RecordCodec 856 | { encoder : a -> List BE.Encoder 857 | , decoder : Decoder (Result (Error e) b) 858 | , jsonEncoder : a -> List JE.Value 859 | , jsonDecoder : JD.Decoder (Result (Error e) b) 860 | , fieldIndex : Int 861 | } 862 | 863 | 864 | {-| Start creating a codec for a record. 865 | 866 | import Serialize as S 867 | 868 | type alias Point = 869 | { x : Int 870 | , y : Int 871 | } 872 | 873 | pointCodec : S.Codec Point 874 | pointCodec = 875 | S.record Point 876 | -- Note that adding, removing, or reordering fields will prevent you from decoding any data you've previously encoded. 877 | |> S.field .x S.int 878 | |> S.field .y S.int 879 | |> S.finishRecord 880 | 881 | -} 882 | record : b -> RecordCodec e a b 883 | record ctor = 884 | RecordCodec 885 | { encoder = \\_ -> [] 886 | , decoder = BD.succeed (Ok ctor) 887 | , jsonEncoder = \\_ -> [] 888 | , jsonDecoder = JD.succeed (Ok ctor) 889 | , fieldIndex = 0 890 | } 891 | 892 | 893 | {-| Add a field to the record we are creating a codec for. 894 | -} 895 | field : (a -> f) -> Codec e f -> RecordCodec e a (f -> b) -> RecordCodec e a b 896 | field getter codec (RecordCodec recordCodec) = 897 | RecordCodec 898 | { encoder = \\v -> (getEncoder codec <| getter v) :: recordCodec.encoder v 899 | , decoder = 900 | BD.map2 901 | (\\f x -> 902 | case ( f, x ) of 903 | ( Ok fOk, Ok xOk ) -> 904 | fOk xOk |> Ok 905 | 906 | ( Err err, _ ) -> 907 | Err err 908 | 909 | ( _, Err err ) -> 910 | Err err 911 | ) 912 | recordCodec.decoder 913 | (getDecoder codec) 914 | , jsonEncoder = \\v -> (getJsonEncoder codec <| getter v) :: recordCodec.jsonEncoder v 915 | , jsonDecoder = 916 | JD.map2 917 | (\\f x -> 918 | case ( f, x ) of 919 | ( Ok fOk, Ok xOk ) -> 920 | fOk xOk |> Ok 921 | 922 | ( Err err, _ ) -> 923 | Err err 924 | 925 | ( _, Err err ) -> 926 | Err err 927 | ) 928 | recordCodec.jsonDecoder 929 | (JD.index recordCodec.fieldIndex (getJsonDecoder codec)) 930 | , fieldIndex = recordCodec.fieldIndex + 1 931 | } 932 | 933 | 934 | {-| Finish creating a codec for a record. 935 | -} 936 | finishRecord : RecordCodec e a a -> Codec e a 937 | finishRecord (RecordCodec codec) = 938 | Codec 939 | { encoder = codec.encoder >> List.reverse >> BE.sequence 940 | , decoder = codec.decoder 941 | , jsonEncoder = codec.jsonEncoder >> List.reverse >> JE.list identity 942 | , jsonDecoder = codec.jsonDecoder 943 | } 944 | 945 | 946 | 947 | -- CUSTOM 948 | 949 | 950 | {-| A partially built codec for a custom type. 951 | -} 952 | type CustomTypeCodec a e match v 953 | = CustomTypeCodec 954 | { match : match 955 | , jsonMatch : match 956 | , decoder : Int -> Decoder (Result (Error e) v) -> Decoder (Result (Error e) v) 957 | , jsonDecoder : Int -> JD.Decoder (Result (Error e) v) -> JD.Decoder (Result (Error e) v) 958 | , idCounter : Int 959 | } 960 | 961 | 962 | {-| Starts building a `Codec` for a custom type. 963 | You need to pass a pattern matching function, see the FAQ for details. 964 | 965 | import Serialize as S 966 | 967 | type Semaphore 968 | = Red Int String Bool 969 | | Yellow Float 970 | | Green 971 | 972 | semaphoreCodec : S.Codec Semaphore 973 | semaphoreCodec = 974 | S.custom 975 | (\\redEncoder yellowEncoder greenEncoder value -> 976 | case value of 977 | Red i s b -> 978 | redEncoder i s b 979 | 980 | Yellow f -> 981 | yellowEncoder f 982 | 983 | Green -> 984 | greenEncoder 985 | ) 986 | -- Note that removing a variant, inserting a variant before an existing one, or swapping two variants will prevent you from decoding any data you've previously encoded. 987 | |> S.variant3 Red S.int S.string S.bool 988 | |> S.variant1 Yellow S.float 989 | |> S.variant0 Green 990 | -- It's safe to add new variants here later though 991 | |> S.finishCustom 992 | 993 | -} 994 | customType : match -> CustomTypeCodec { youNeedAtLeastOneVariant : () } e match value 995 | customType match = 996 | CustomTypeCodec 997 | { match = match 998 | , jsonMatch = match 999 | , decoder = \\_ -> identity 1000 | , jsonDecoder = \\_ -> identity 1001 | , idCounter = 0 1002 | } 1003 | 1004 | 1005 | {-| -} 1006 | type VariantEncoder 1007 | = VariantEncoder ( BE.Encoder, JE.Value ) 1008 | 1009 | 1010 | variant : 1011 | ((List BE.Encoder -> VariantEncoder) -> a) 1012 | -> ((List JE.Value -> VariantEncoder) -> a) 1013 | -> Decoder (Result (Error error) v) 1014 | -> JD.Decoder (Result (Error error) v) 1015 | -> CustomTypeCodec z error (a -> b) v 1016 | -> CustomTypeCodec () error b v 1017 | variant matchPiece matchJsonPiece decoderPiece jsonDecoderPiece (CustomTypeCodec am) = 1018 | let 1019 | enc : List BE.Encoder -> VariantEncoder 1020 | enc v = 1021 | ( BE.unsignedInt16 endian am.idCounter :: v |> BE.sequence 1022 | , JE.null 1023 | ) 1024 | |> VariantEncoder 1025 | 1026 | jsonEnc : List JE.Value -> VariantEncoder 1027 | jsonEnc v = 1028 | ( BE.sequence [] 1029 | , JE.int am.idCounter :: v |> JE.list identity 1030 | ) 1031 | |> VariantEncoder 1032 | 1033 | decoder_ : Int -> Decoder (Result (Error error) v) -> Decoder (Result (Error error) v) 1034 | decoder_ tag orElse = 1035 | if tag == am.idCounter then 1036 | decoderPiece 1037 | 1038 | else 1039 | am.decoder tag orElse 1040 | 1041 | jsonDecoder_ : Int -> JD.Decoder (Result (Error error) v) -> JD.Decoder (Result (Error error) v) 1042 | jsonDecoder_ tag orElse = 1043 | if tag == am.idCounter then 1044 | jsonDecoderPiece 1045 | 1046 | else 1047 | am.jsonDecoder tag orElse 1048 | in 1049 | CustomTypeCodec 1050 | { match = am.match <| matchPiece enc 1051 | , jsonMatch = am.jsonMatch <| matchJsonPiece jsonEnc 1052 | , decoder = decoder_ 1053 | , jsonDecoder = jsonDecoder_ 1054 | , idCounter = am.idCounter + 1 1055 | } 1056 | 1057 | 1058 | {-| Define a variant with 0 parameters for a custom type. 1059 | -} 1060 | variant0 : v -> CustomTypeCodec z e (VariantEncoder -> a) v -> CustomTypeCodec () e a v 1061 | variant0 ctor = 1062 | variant 1063 | (\\c -> c []) 1064 | (\\c -> c []) 1065 | (BD.succeed (Ok ctor)) 1066 | (JD.succeed (Ok ctor)) 1067 | 1068 | 1069 | {-| Define a variant with 1 parameters for a custom type. 1070 | -} 1071 | variant1 : 1072 | (a -> v) 1073 | -> Codec error a 1074 | -> CustomTypeCodec z error ((a -> VariantEncoder) -> b) v 1075 | -> CustomTypeCodec () error b v 1076 | variant1 ctor m1 = 1077 | variant 1078 | (\\c v -> 1079 | c 1080 | [ getEncoder m1 v 1081 | ] 1082 | ) 1083 | (\\c v -> 1084 | c 1085 | [ getJsonEncoder m1 v 1086 | ] 1087 | ) 1088 | (BD.map (result1 ctor) (getDecoder m1)) 1089 | (JD.map (result1 ctor) (JD.index 1 (getJsonDecoder m1))) 1090 | 1091 | 1092 | result1 : (value -> a) -> Result error value -> Result error a 1093 | result1 ctor value = 1094 | case value of 1095 | Ok ok -> 1096 | ctor ok |> Ok 1097 | 1098 | Err err -> 1099 | Err err 1100 | 1101 | 1102 | {-| Define a variant with 2 parameters for a custom type. 1103 | -} 1104 | variant2 : 1105 | (a -> b -> v) 1106 | -> Codec error a 1107 | -> Codec error b 1108 | -> CustomTypeCodec z error ((a -> b -> VariantEncoder) -> c) v 1109 | -> CustomTypeCodec () error c v 1110 | variant2 ctor m1 m2 = 1111 | variant 1112 | (\\c v1 v2 -> 1113 | [ getEncoder m1 v1 1114 | , getEncoder m2 v2 1115 | ] 1116 | |> c 1117 | ) 1118 | (\\c v1 v2 -> 1119 | [ getJsonEncoder m1 v1 1120 | , getJsonEncoder m2 v2 1121 | ] 1122 | |> c 1123 | ) 1124 | (BD.map2 1125 | (result2 ctor) 1126 | (getDecoder m1) 1127 | (getDecoder m2) 1128 | ) 1129 | (JD.map2 1130 | (result2 ctor) 1131 | (JD.index 1 (getJsonDecoder m1)) 1132 | (JD.index 2 (getJsonDecoder m2)) 1133 | ) 1134 | 1135 | 1136 | result2 : (value -> a -> b) -> Result error value -> Result error a -> Result error b 1137 | result2 ctor v1 v2 = 1138 | case ( v1, v2 ) of 1139 | ( Ok ok1, Ok ok2 ) -> 1140 | ctor ok1 ok2 |> Ok 1141 | 1142 | ( Err err, _ ) -> 1143 | Err err 1144 | 1145 | ( _, Err err ) -> 1146 | Err err 1147 | 1148 | 1149 | {-| Define a variant with 3 parameters for a custom type. 1150 | -} 1151 | variant3 : 1152 | (a -> b -> c -> v) 1153 | -> Codec error a 1154 | -> Codec error b 1155 | -> Codec error c 1156 | -> CustomTypeCodec z error ((a -> b -> c -> VariantEncoder) -> partial) v 1157 | -> CustomTypeCodec () error partial v 1158 | variant3 ctor m1 m2 m3 = 1159 | variant 1160 | (\\c v1 v2 v3 -> 1161 | [ getEncoder m1 v1 1162 | , getEncoder m2 v2 1163 | , getEncoder m3 v3 1164 | ] 1165 | |> c 1166 | ) 1167 | (\\c v1 v2 v3 -> 1168 | [ getJsonEncoder m1 v1 1169 | , getJsonEncoder m2 v2 1170 | , getJsonEncoder m3 v3 1171 | ] 1172 | |> c 1173 | ) 1174 | (BD.map3 1175 | (result3 ctor) 1176 | (getDecoder m1) 1177 | (getDecoder m2) 1178 | (getDecoder m3) 1179 | ) 1180 | (JD.map3 1181 | (result3 ctor) 1182 | (JD.index 1 (getJsonDecoder m1)) 1183 | (JD.index 2 (getJsonDecoder m2)) 1184 | (JD.index 3 (getJsonDecoder m3)) 1185 | ) 1186 | 1187 | 1188 | result3 : (value -> a -> b -> c) -> Result error value -> Result error a -> Result error b -> Result error c 1189 | result3 ctor v1 v2 v3 = 1190 | case ( v1, v2, v3 ) of 1191 | ( Ok ok1, Ok ok2, Ok ok3 ) -> 1192 | ctor ok1 ok2 ok3 |> Ok 1193 | 1194 | ( Err err, _, _ ) -> 1195 | Err err 1196 | 1197 | ( _, Err err, _ ) -> 1198 | Err err 1199 | 1200 | ( _, _, Err err ) -> 1201 | Err err 1202 | 1203 | 1204 | {-| Define a variant with 4 parameters for a custom type. 1205 | -} 1206 | variant4 : 1207 | (a -> b -> c -> d -> v) 1208 | -> Codec error a 1209 | -> Codec error b 1210 | -> Codec error c 1211 | -> Codec error d 1212 | -> CustomTypeCodec z error ((a -> b -> c -> d -> VariantEncoder) -> partial) v 1213 | -> CustomTypeCodec () error partial v 1214 | variant4 ctor m1 m2 m3 m4 = 1215 | variant 1216 | (\\c v1 v2 v3 v4 -> 1217 | [ getEncoder m1 v1 1218 | , getEncoder m2 v2 1219 | , getEncoder m3 v3 1220 | , getEncoder m4 v4 1221 | ] 1222 | |> c 1223 | ) 1224 | (\\c v1 v2 v3 v4 -> 1225 | [ getJsonEncoder m1 v1 1226 | , getJsonEncoder m2 v2 1227 | , getJsonEncoder m3 v3 1228 | , getJsonEncoder m4 v4 1229 | ] 1230 | |> c 1231 | ) 1232 | (BD.map4 1233 | (result4 ctor) 1234 | (getDecoder m1) 1235 | (getDecoder m2) 1236 | (getDecoder m3) 1237 | (getDecoder m4) 1238 | ) 1239 | (JD.map4 1240 | (result4 ctor) 1241 | (JD.index 1 (getJsonDecoder m1)) 1242 | (JD.index 2 (getJsonDecoder m2)) 1243 | (JD.index 3 (getJsonDecoder m3)) 1244 | (JD.index 4 (getJsonDecoder m4)) 1245 | ) 1246 | 1247 | 1248 | result4 : (value -> a -> b -> c -> d) -> Result error value -> Result error a -> Result error b -> Result error c -> Result error d 1249 | result4 ctor v1 v2 v3 v4 = 1250 | case T4 v1 v2 v3 v4 of 1251 | T4 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) -> 1252 | ctor ok1 ok2 ok3 ok4 |> Ok 1253 | 1254 | T4 (Err err) _ _ _ -> 1255 | Err err 1256 | 1257 | T4 _ (Err err) _ _ -> 1258 | Err err 1259 | 1260 | T4 _ _ (Err err) _ -> 1261 | Err err 1262 | 1263 | T4 _ _ _ (Err err) -> 1264 | Err err 1265 | 1266 | 1267 | {-| Define a variant with 5 parameters for a custom type. 1268 | -} 1269 | variant5 : 1270 | (a -> b -> c -> d -> e -> v) 1271 | -> Codec error a 1272 | -> Codec error b 1273 | -> Codec error c 1274 | -> Codec error d 1275 | -> Codec error e 1276 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> VariantEncoder) -> partial) v 1277 | -> CustomTypeCodec () error partial v 1278 | variant5 ctor m1 m2 m3 m4 m5 = 1279 | variant 1280 | (\\c v1 v2 v3 v4 v5 -> 1281 | [ getEncoder m1 v1 1282 | , getEncoder m2 v2 1283 | , getEncoder m3 v3 1284 | , getEncoder m4 v4 1285 | , getEncoder m5 v5 1286 | ] 1287 | |> c 1288 | ) 1289 | (\\c v1 v2 v3 v4 v5 -> 1290 | [ getJsonEncoder m1 v1 1291 | , getJsonEncoder m2 v2 1292 | , getJsonEncoder m3 v3 1293 | , getJsonEncoder m4 v4 1294 | , getJsonEncoder m5 v5 1295 | ] 1296 | |> c 1297 | ) 1298 | (BD.map5 1299 | (result5 ctor) 1300 | (getDecoder m1) 1301 | (getDecoder m2) 1302 | (getDecoder m3) 1303 | (getDecoder m4) 1304 | (getDecoder m5) 1305 | ) 1306 | (JD.map5 1307 | (result5 ctor) 1308 | (JD.index 1 (getJsonDecoder m1)) 1309 | (JD.index 2 (getJsonDecoder m2)) 1310 | (JD.index 3 (getJsonDecoder m3)) 1311 | (JD.index 4 (getJsonDecoder m4)) 1312 | (JD.index 5 (getJsonDecoder m5)) 1313 | ) 1314 | 1315 | 1316 | result5 ctor v1 v2 v3 v4 v5 = 1317 | case T5 v1 v2 v3 v4 v5 of 1318 | T5 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) -> 1319 | ctor ok1 ok2 ok3 ok4 ok5 |> Ok 1320 | 1321 | T5 (Err err) _ _ _ _ -> 1322 | Err err 1323 | 1324 | T5 _ (Err err) _ _ _ -> 1325 | Err err 1326 | 1327 | T5 _ _ (Err err) _ _ -> 1328 | Err err 1329 | 1330 | T5 _ _ _ (Err err) _ -> 1331 | Err err 1332 | 1333 | T5 _ _ _ _ (Err err) -> 1334 | Err err 1335 | 1336 | 1337 | {-| Define a variant with 6 parameters for a custom type. 1338 | -} 1339 | variant6 : 1340 | (a -> b -> c -> d -> e -> f -> v) 1341 | -> Codec error a 1342 | -> Codec error b 1343 | -> Codec error c 1344 | -> Codec error d 1345 | -> Codec error e 1346 | -> Codec error f 1347 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> VariantEncoder) -> partial) v 1348 | -> CustomTypeCodec () error partial v 1349 | variant6 ctor m1 m2 m3 m4 m5 m6 = 1350 | variant 1351 | (\\c v1 v2 v3 v4 v5 v6 -> 1352 | [ getEncoder m1 v1 1353 | , getEncoder m2 v2 1354 | , getEncoder m3 v3 1355 | , getEncoder m4 v4 1356 | , getEncoder m5 v5 1357 | , getEncoder m6 v6 1358 | ] 1359 | |> c 1360 | ) 1361 | (\\c v1 v2 v3 v4 v5 v6 -> 1362 | [ getJsonEncoder m1 v1 1363 | , getJsonEncoder m2 v2 1364 | , getJsonEncoder m3 v3 1365 | , getJsonEncoder m4 v4 1366 | , getJsonEncoder m5 v5 1367 | , getJsonEncoder m6 v6 1368 | ] 1369 | |> c 1370 | ) 1371 | (BD.map5 1372 | (result6 ctor) 1373 | (getDecoder m1) 1374 | (getDecoder m2) 1375 | (getDecoder m3) 1376 | (getDecoder m4) 1377 | (BD.map2 Tuple.pair 1378 | (getDecoder m5) 1379 | (getDecoder m6) 1380 | ) 1381 | ) 1382 | (JD.map5 1383 | (result6 ctor) 1384 | (JD.index 1 (getJsonDecoder m1)) 1385 | (JD.index 2 (getJsonDecoder m2)) 1386 | (JD.index 3 (getJsonDecoder m3)) 1387 | (JD.index 4 (getJsonDecoder m4)) 1388 | (JD.map2 Tuple.pair 1389 | (JD.index 5 (getJsonDecoder m5)) 1390 | (JD.index 6 (getJsonDecoder m6)) 1391 | ) 1392 | ) 1393 | 1394 | 1395 | result6 : (value -> a -> b -> c -> d -> e -> f) -> Result error value -> Result error a -> Result error b -> Result error c -> ( Result error d, Result error e ) -> Result error f 1396 | result6 ctor v1 v2 v3 v4 ( v5, v6 ) = 1397 | case T6 v1 v2 v3 v4 v5 v6 of 1398 | T6 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) -> 1399 | ctor ok1 ok2 ok3 ok4 ok5 ok6 |> Ok 1400 | 1401 | T6 (Err err) _ _ _ _ _ -> 1402 | Err err 1403 | 1404 | T6 _ (Err err) _ _ _ _ -> 1405 | Err err 1406 | 1407 | T6 _ _ (Err err) _ _ _ -> 1408 | Err err 1409 | 1410 | T6 _ _ _ (Err err) _ _ -> 1411 | Err err 1412 | 1413 | T6 _ _ _ _ (Err err) _ -> 1414 | Err err 1415 | 1416 | T6 _ _ _ _ _ (Err err) -> 1417 | Err err 1418 | 1419 | 1420 | {-| Define a variant with 7 parameters for a custom type. 1421 | -} 1422 | variant7 : 1423 | (a -> b -> c -> d -> e -> f -> g -> v) 1424 | -> Codec error a 1425 | -> Codec error b 1426 | -> Codec error c 1427 | -> Codec error d 1428 | -> Codec error e 1429 | -> Codec error f 1430 | -> Codec error g 1431 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> g -> VariantEncoder) -> partial) v 1432 | -> CustomTypeCodec () error partial v 1433 | variant7 ctor m1 m2 m3 m4 m5 m6 m7 = 1434 | variant 1435 | (\\c v1 v2 v3 v4 v5 v6 v7 -> 1436 | [ getEncoder m1 v1 1437 | , getEncoder m2 v2 1438 | , getEncoder m3 v3 1439 | , getEncoder m4 v4 1440 | , getEncoder m5 v5 1441 | , getEncoder m6 v6 1442 | , getEncoder m7 v7 1443 | ] 1444 | |> c 1445 | ) 1446 | (\\c v1 v2 v3 v4 v5 v6 v7 -> 1447 | [ getJsonEncoder m1 v1 1448 | , getJsonEncoder m2 v2 1449 | , getJsonEncoder m3 v3 1450 | , getJsonEncoder m4 v4 1451 | , getJsonEncoder m5 v5 1452 | , getJsonEncoder m6 v6 1453 | , getJsonEncoder m7 v7 1454 | ] 1455 | |> c 1456 | ) 1457 | (BD.map5 1458 | (result7 ctor) 1459 | (getDecoder m1) 1460 | (getDecoder m2) 1461 | (getDecoder m3) 1462 | (BD.map2 Tuple.pair 1463 | (getDecoder m4) 1464 | (getDecoder m5) 1465 | ) 1466 | (BD.map2 Tuple.pair 1467 | (getDecoder m6) 1468 | (getDecoder m7) 1469 | ) 1470 | ) 1471 | (JD.map5 1472 | (result7 ctor) 1473 | (JD.index 1 (getJsonDecoder m1)) 1474 | (JD.index 2 (getJsonDecoder m2)) 1475 | (JD.index 3 (getJsonDecoder m3)) 1476 | (JD.map2 Tuple.pair 1477 | (JD.index 4 (getJsonDecoder m4)) 1478 | (JD.index 5 (getJsonDecoder m5)) 1479 | ) 1480 | (JD.map2 Tuple.pair 1481 | (JD.index 6 (getJsonDecoder m6)) 1482 | (JD.index 7 (getJsonDecoder m7)) 1483 | ) 1484 | ) 1485 | 1486 | 1487 | result7 : (value -> a -> b -> c -> d -> e -> f -> g) -> Result error value -> Result error a -> Result error b -> ( Result error c, Result error d ) -> ( Result error e, Result error f ) -> Result error g 1488 | result7 ctor v1 v2 v3 ( v4, v5 ) ( v6, v7 ) = 1489 | case T7 v1 v2 v3 v4 v5 v6 v7 of 1490 | T7 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) (Ok ok7) -> 1491 | ctor ok1 ok2 ok3 ok4 ok5 ok6 ok7 |> Ok 1492 | 1493 | T7 (Err err) _ _ _ _ _ _ -> 1494 | Err err 1495 | 1496 | T7 _ (Err err) _ _ _ _ _ -> 1497 | Err err 1498 | 1499 | T7 _ _ (Err err) _ _ _ _ -> 1500 | Err err 1501 | 1502 | T7 _ _ _ (Err err) _ _ _ -> 1503 | Err err 1504 | 1505 | T7 _ _ _ _ (Err err) _ _ -> 1506 | Err err 1507 | 1508 | T7 _ _ _ _ _ (Err err) _ -> 1509 | Err err 1510 | 1511 | T7 _ _ _ _ _ _ (Err err) -> 1512 | Err err 1513 | 1514 | 1515 | {-| Define a variant with 8 parameters for a custom type. 1516 | -} 1517 | variant8 : 1518 | (a -> b -> c -> d -> e -> f -> g -> h -> v) 1519 | -> Codec error a 1520 | -> Codec error b 1521 | -> Codec error c 1522 | -> Codec error d 1523 | -> Codec error e 1524 | -> Codec error f 1525 | -> Codec error g 1526 | -> Codec error h 1527 | -> CustomTypeCodec z error ((a -> b -> c -> d -> e -> f -> g -> h -> VariantEncoder) -> partial) v 1528 | -> CustomTypeCodec () error partial v 1529 | variant8 ctor m1 m2 m3 m4 m5 m6 m7 m8 = 1530 | variant 1531 | (\\c v1 v2 v3 v4 v5 v6 v7 v8 -> 1532 | [ getEncoder m1 v1 1533 | , getEncoder m2 v2 1534 | , getEncoder m3 v3 1535 | , getEncoder m4 v4 1536 | , getEncoder m5 v5 1537 | , getEncoder m6 v6 1538 | , getEncoder m7 v7 1539 | , getEncoder m8 v8 1540 | ] 1541 | |> c 1542 | ) 1543 | (\\c v1 v2 v3 v4 v5 v6 v7 v8 -> 1544 | [ getJsonEncoder m1 v1 1545 | , getJsonEncoder m2 v2 1546 | , getJsonEncoder m3 v3 1547 | , getJsonEncoder m4 v4 1548 | , getJsonEncoder m5 v5 1549 | , getJsonEncoder m6 v6 1550 | , getJsonEncoder m7 v7 1551 | , getJsonEncoder m8 v8 1552 | ] 1553 | |> c 1554 | ) 1555 | (BD.map5 1556 | (result8 ctor) 1557 | (getDecoder m1) 1558 | (getDecoder m2) 1559 | (BD.map2 Tuple.pair 1560 | (getDecoder m3) 1561 | (getDecoder m4) 1562 | ) 1563 | (BD.map2 Tuple.pair 1564 | (getDecoder m5) 1565 | (getDecoder m6) 1566 | ) 1567 | (BD.map2 Tuple.pair 1568 | (getDecoder m7) 1569 | (getDecoder m8) 1570 | ) 1571 | ) 1572 | (JD.map5 1573 | (result8 ctor) 1574 | (JD.index 1 (getJsonDecoder m1)) 1575 | (JD.index 2 (getJsonDecoder m2)) 1576 | (JD.map2 Tuple.pair 1577 | (JD.index 3 (getJsonDecoder m3)) 1578 | (JD.index 4 (getJsonDecoder m4)) 1579 | ) 1580 | (JD.map2 Tuple.pair 1581 | (JD.index 5 (getJsonDecoder m5)) 1582 | (JD.index 6 (getJsonDecoder m6)) 1583 | ) 1584 | (JD.map2 Tuple.pair 1585 | (JD.index 7 (getJsonDecoder m7)) 1586 | (JD.index 8 (getJsonDecoder m8)) 1587 | ) 1588 | ) 1589 | 1590 | 1591 | result8 : (value -> a -> b -> c -> d -> e -> f -> g -> h) -> Result error value -> Result error a -> ( Result error b, Result error c ) -> ( Result error d, Result error e ) -> ( Result error f, Result error g ) -> Result error h 1592 | result8 ctor v1 v2 ( v3, v4 ) ( v5, v6 ) ( v7, v8 ) = 1593 | case T8 v1 v2 v3 v4 v5 v6 v7 v8 of 1594 | T8 (Ok ok1) (Ok ok2) (Ok ok3) (Ok ok4) (Ok ok5) (Ok ok6) (Ok ok7) (Ok ok8) -> 1595 | ctor ok1 ok2 ok3 ok4 ok5 ok6 ok7 ok8 |> Ok 1596 | 1597 | T8 (Err err) _ _ _ _ _ _ _ -> 1598 | Err err 1599 | 1600 | T8 _ (Err err) _ _ _ _ _ _ -> 1601 | Err err 1602 | 1603 | T8 _ _ (Err err) _ _ _ _ _ -> 1604 | Err err 1605 | 1606 | T8 _ _ _ (Err err) _ _ _ _ -> 1607 | Err err 1608 | 1609 | T8 _ _ _ _ (Err err) _ _ _ -> 1610 | Err err 1611 | 1612 | T8 _ _ _ _ _ (Err err) _ _ -> 1613 | Err err 1614 | 1615 | T8 _ _ _ _ _ _ (Err err) _ -> 1616 | Err err 1617 | 1618 | T8 _ _ _ _ _ _ _ (Err err) -> 1619 | Err err 1620 | 1621 | 1622 | {-| Finish creating a codec for a custom type. 1623 | -} 1624 | finishCustomType : CustomTypeCodec () e (a -> VariantEncoder) a -> Codec e a 1625 | finishCustomType (CustomTypeCodec am) = 1626 | build 1627 | (am.match >> (\\(VariantEncoder ( a, _ )) -> a)) 1628 | (BD.unsignedInt16 endian 1629 | |> BD.andThen 1630 | (\\tag -> 1631 | am.decoder tag (BD.succeed (Err DataCorrupted)) 1632 | ) 1633 | ) 1634 | (am.jsonMatch >> (\\(VariantEncoder ( _, a )) -> a)) 1635 | (JD.index 0 JD.int 1636 | |> JD.andThen 1637 | (\\tag -> 1638 | am.jsonDecoder tag (JD.succeed (Err DataCorrupted)) 1639 | ) 1640 | ) 1641 | 1642 | 1643 | 1644 | ---- MAPPING 1645 | 1646 | 1647 | {-| Map from one codec to another codec 1648 | 1649 | import Serialize as S 1650 | 1651 | type UserId 1652 | = UserId Int 1653 | 1654 | userIdCodec : S.Codec UserId 1655 | userIdCodec = 1656 | S.int |> S.map UserId (\\(UserId id) -> id) 1657 | 1658 | Note that there's nothing preventing you from encoding Elm values that will map to some different value when you decode them. 1659 | I recommend writing tests for Codecs that use `map` to make sure you get back the same Elm value you put in. 1660 | [Here's some helper functions to get you started.](https://github.com/MartinSStewart/elm-geometry-serialize/blob/6f2244c28631ede1b864cb43541d1573dc628904/tests/Tests.elm#L49-L74) 1661 | 1662 | -} 1663 | map : (a -> b) -> (b -> a) -> Codec e a -> Codec e b 1664 | map fromBytes_ toBytes_ codec = 1665 | mapHelper 1666 | (\\value -> 1667 | case value of 1668 | Ok ok -> 1669 | fromBytes_ ok |> Ok 1670 | 1671 | Err err -> 1672 | Err err 1673 | ) 1674 | toBytes_ 1675 | codec 1676 | 1677 | 1678 | mapHelper : (Result (Error e) a -> Result (Error e) b) -> (b -> a) -> Codec e a -> Codec e b 1679 | mapHelper fromBytes_ toBytes_ codec = 1680 | build 1681 | (\\v -> toBytes_ v |> getEncoder codec) 1682 | (getDecoder codec |> BD.map fromBytes_) 1683 | (\\v -> toBytes_ v |> getJsonEncoder codec) 1684 | (getJsonDecoder codec |> JD.map fromBytes_) 1685 | 1686 | 1687 | {-| Map from one codec to another codec in a way that can potentially fail when decoding. 1688 | 1689 | -- Email module is from https://package.elm-lang.org/packages/tricycle/elm-email/1.0.2/ 1690 | 1691 | 1692 | import Email 1693 | import Serialize as S 1694 | 1695 | emailCodec : S.Codec String Float 1696 | emailCodec = 1697 | S.string 1698 | |> S.mapValid 1699 | (\\text -> 1700 | case Email.fromString of 1701 | Just email -> 1702 | Ok email 1703 | 1704 | Nothing -> 1705 | Err "Invalid email" 1706 | ) 1707 | Email.toString 1708 | 1709 | Note that there's nothing preventing you from encoding Elm values that will produce Err when you decode them. 1710 | I recommend writing tests for Codecs that use `mapValid` to make sure you get back the same Elm value you put in. 1711 | [Here's some helper functions to get you started.](https://github.com/MartinSStewart/elm-geometry-serialize/blob/6f2244c28631ede1b864cb43541d1573dc628904/tests/Tests.elm#L49-L74) 1712 | 1713 | -} 1714 | mapValid : (a -> Result e b) -> (b -> a) -> Codec e a -> Codec e b 1715 | mapValid fromBytes_ toBytes_ codec = 1716 | build 1717 | (\\v -> toBytes_ v |> getEncoder codec) 1718 | (getDecoder codec 1719 | |> BD.map 1720 | (\\value -> 1721 | case value of 1722 | Ok ok -> 1723 | fromBytes_ ok |> Result.mapError CustomError 1724 | 1725 | Err err -> 1726 | Err err 1727 | ) 1728 | ) 1729 | (\\v -> toBytes_ v |> getJsonEncoder codec) 1730 | (getJsonDecoder codec 1731 | |> JD.map 1732 | (\\value -> 1733 | case value of 1734 | Ok ok -> 1735 | fromBytes_ ok |> Result.mapError CustomError 1736 | 1737 | Err err -> 1738 | Err err 1739 | ) 1740 | ) 1741 | 1742 | 1743 | {-| Map errors generated by `mapValid`. 1744 | -} 1745 | mapError : (e1 -> e2) -> Codec e1 a -> Codec e2 a 1746 | mapError mapFunc codec = 1747 | build 1748 | (getEncoder codec) 1749 | (getDecoder codec |> BD.map (mapErrorHelper mapFunc)) 1750 | (getJsonEncoder codec) 1751 | (getJsonDecoder codec |> JD.map (mapErrorHelper mapFunc)) 1752 | 1753 | 1754 | mapErrorHelper : (e -> a) -> Result (Error e) b -> Result (Error a) b 1755 | mapErrorHelper mapFunc = 1756 | Result.mapError 1757 | (\\error -> 1758 | case error of 1759 | CustomError custom -> 1760 | mapFunc custom |> CustomError 1761 | 1762 | DataCorrupted -> 1763 | DataCorrupted 1764 | 1765 | SerializerOutOfDate -> 1766 | SerializerOutOfDate 1767 | ) 1768 | 1769 | 1770 | 1771 | -- STACK UNSAFE 1772 | 1773 | 1774 | {-| Handle situations where you need to define a codec in terms of itself. 1775 | 1776 | import Serialize as S 1777 | 1778 | type Peano 1779 | = Peano (Maybe Peano) 1780 | 1781 | {-| The compiler will complain that this function causes an infinite loop. 1782 | -} 1783 | badPeanoCodec : S.Codec Peano 1784 | badPeanoCodec = 1785 | S.maybe badPeanoCodec |> S.map Peano (\\(Peano a) -> a) 1786 | 1787 | {-| Now the compiler is happy! 1788 | -} 1789 | goodPeanoCodec : S.Codec Peano 1790 | goodPeanoCodec = 1791 | S.maybe (S.lazy (\\() -> goodPeanoCodec)) |> S.map Peano (\\(Peano a) -> a) 1792 | 1793 | **Warning:** This is not stack safe. 1794 | 1795 | In general if you have a type that contains itself, like with our the Peano example, then you're at risk of a stack overflow while decoding. 1796 | Even if you're translating your nested data into a list before encoding, you're at risk, because the function translating back after decoding can cause a stack overflow if the original value was nested deeply enough. 1797 | Be careful here, and test your codecs using elm-test with larger inputs than you ever expect to see in real life. 1798 | 1799 | -} 1800 | lazy : (() -> Codec e a) -> Codec e a 1801 | lazy f = 1802 | build 1803 | (\\value -> getEncoder (f ()) value) 1804 | (BD.succeed () |> BD.andThen (\\() -> getDecoder (f ()))) 1805 | (\\value -> getJsonEncoder (f ()) value) 1806 | (JD.succeed () |> JD.andThen (\\() -> getJsonDecoder (f ()))) 1807 | 1808 | """ 1809 | --------------------------------------------------------------------------------