├── docs
├── .nojekyll
└── index.html
├── .tool-versions
├── tests
├── elm-verify-examples.json
├── IssueCases.elm
└── XmlDecodeTest.elm
├── benchmarks
├── result1.0.png
├── result20191108.png
├── result20220219.png
├── elm.json
├── DecodeXml.elm
├── README.md
├── DecodeString.elm
└── ExampleXml.elm
├── .gitignore
├── elm-tooling.json
├── package.json
├── .github
├── dependabot.yml
└── workflows
│ └── main.yml
├── elm.json
├── LICENSE
├── CHANGELOG.md
├── src
└── Xml
│ ├── Decode
│ └── Internal.elm
│ └── Decode.elm
└── README.md
/docs/.nojekyll:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/.tool-versions:
--------------------------------------------------------------------------------
1 | nodejs 22.2.0
2 |
--------------------------------------------------------------------------------
/tests/elm-verify-examples.json:
--------------------------------------------------------------------------------
1 | {
2 | "tests": "exposed"
3 | }
4 |
--------------------------------------------------------------------------------
/benchmarks/result1.0.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/ymtszw/elm-xml-decode/HEAD/benchmarks/result1.0.png
--------------------------------------------------------------------------------
/benchmarks/result20191108.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/ymtszw/elm-xml-decode/HEAD/benchmarks/result20191108.png
--------------------------------------------------------------------------------
/benchmarks/result20220219.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/ymtszw/elm-xml-decode/HEAD/benchmarks/result20220219.png
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | elm-stuff/
2 | node_modules/
3 | tests/Doc/
4 | tests/VerifyExamples/
5 | docs.json
6 | docs/DecodeString.html
7 | docs/DecodeXml.html
8 |
--------------------------------------------------------------------------------
/elm-tooling.json:
--------------------------------------------------------------------------------
1 | {
2 | "tools": {
3 | "elm": "0.19.1",
4 | "elm-format": "0.8.7",
5 | "elm-json": "0.2.13",
6 | "elm-test-rs": "3.0.0"
7 | }
8 | }
9 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "devDependencies": {
3 | "elm-tooling": ">= 1.7.0",
4 | "elm-verify-examples": ">= 6.0.3"
5 | },
6 | "scripts": {
7 | "test": "elm-verify-examples && elm-test-rs && rm -rf tests/VerifyExamples",
8 | "generate-benchmark": "cd benchmarks;elm make DecodeString.elm --optimize --output=../docs/DecodeString.html;elm make DecodeXml.elm --optimize --output=../docs/DecodeXml.html",
9 | "postinstall": "elm-tooling install"
10 | }
11 | }
12 |
--------------------------------------------------------------------------------
/docs/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Benchmarks
6 |
12 |
13 |
14 |
15 | Benchmarks
16 |
20 |
21 |
22 |
--------------------------------------------------------------------------------
/.github/dependabot.yml:
--------------------------------------------------------------------------------
1 | version: 2
2 | updates:
3 | # See https://docs.github.com/en/code-security/dependabot/working-with-dependabot/keeping-your-actions-up-to-date-with-dependabot
4 | - package-ecosystem: "github-actions"
5 | directory: "/"
6 | schedule:
7 | interval: "weekly"
8 | groups:
9 | dependabot:
10 | patterns:
11 | - "*"
12 | - package-ecosystem: "npm"
13 | versioning-strategy: "lockfile-only"
14 | directory: "/"
15 | schedule:
16 | interval: "weekly"
17 | groups:
18 | dependabot:
19 | patterns:
20 | - "*"
21 |
--------------------------------------------------------------------------------
/elm.json:
--------------------------------------------------------------------------------
1 | {
2 | "type": "package",
3 | "name": "ymtszw/elm-xml-decode",
4 | "summary": "Xml decoder sharing the spirit of Json.Decode",
5 | "license": "BSD-3-Clause",
6 | "version": "3.2.2",
7 | "exposed-modules": [
8 | "Xml.Decode"
9 | ],
10 | "elm-version": "0.19.0 <= v < 0.20.0",
11 | "dependencies": {
12 | "elm/core": "1.0.0 <= v < 2.0.0",
13 | "elm/parser": "1.1.0 <= v < 2.0.0",
14 | "miniBill/elm-xml-parser": "1.0.0 <= v < 2.0.0"
15 | },
16 | "test-dependencies": {
17 | "elm-explorations/test": "2.0.0 <= v < 3.0.0"
18 | }
19 | }
20 |
--------------------------------------------------------------------------------
/benchmarks/elm.json:
--------------------------------------------------------------------------------
1 | {
2 | "type": "application",
3 | "source-directories": [
4 | "../src",
5 | "."
6 | ],
7 | "elm-version": "0.19.1",
8 | "dependencies": {
9 | "direct": {
10 | "elm/core": "1.0.5",
11 | "elm/json": "1.1.3",
12 | "elm/parser": "1.1.0",
13 | "elm-explorations/benchmark": "1.0.2",
14 | "jinjor/elm-xml-parser": "2.0.0"
15 | },
16 | "indirect": {
17 | "BrianHicks/elm-trend": "2.1.3",
18 | "elm/browser": "1.0.2",
19 | "elm/html": "1.0.0",
20 | "elm/regex": "1.0.0",
21 | "elm/time": "1.0.0",
22 | "elm/url": "1.0.0",
23 | "elm/virtual-dom": "1.0.2",
24 | "mdgriffith/style-elements": "5.0.2",
25 | "robinheghan/murmur3": "1.0.0",
26 | "rtfeldman/elm-hex": "1.0.0"
27 | }
28 | },
29 | "test-dependencies": {
30 | "direct": {},
31 | "indirect": {}
32 | }
33 | }
34 |
--------------------------------------------------------------------------------
/benchmarks/DecodeXml.elm:
--------------------------------------------------------------------------------
1 | module DecodeXml exposing (main)
2 |
3 | import Benchmark exposing (benchmark, describe)
4 | import Benchmark.Runner exposing (BenchmarkProgram, program)
5 | import DecodeString exposing (cdCatalogDecoder, noteDecoder)
6 | import ExampleXml
7 | import Xml.Decode exposing (..)
8 | import XmlParser
9 |
10 |
11 | main : BenchmarkProgram
12 | main =
13 | program <|
14 | let
15 | justRootXml =
16 | unsafeParse ExampleXml.justRoot
17 |
18 | noteXml =
19 | unsafeParse ExampleXml.note
20 |
21 | cdCatalogXml =
22 | unsafeParse ExampleXml.cdCatalog
23 | in
24 | describe "Xml.Decode.decodeXml"
25 | [ benchmark "just root" <|
26 | \_ -> decodeXml (succeed ()) justRootXml
27 | , benchmark "note" <|
28 | \_ -> decodeXml noteDecoder noteXml
29 | , benchmark "CD catalog" <|
30 | \_ -> decodeXml cdCatalogDecoder cdCatalogXml
31 | ]
32 |
33 |
34 | unsafeParse : String -> XmlParser.Xml
35 | unsafeParse xmlStr =
36 | case XmlParser.parse xmlStr of
37 | Ok xml ->
38 | xml
39 |
40 | Err _ ->
41 | -- Should not happen
42 | unsafeParse xmlStr
43 |
--------------------------------------------------------------------------------
/benchmarks/README.md:
--------------------------------------------------------------------------------
1 | # Benchmark app
2 |
3 | See [elm-explorations/benchmark](https://github.com/elm-explorations/benchmark)
4 |
5 | ```sh
6 | # In this directory (if elm is globally available):
7 | $ elm make DecodeString.elm --optimize --output=../docs/DecodeString.html
8 | $ elm make DecodeXml.elm --optimize --output=../docs/DecodeXml.html
9 | ```
10 |
11 | Then, open `../docs/index.html` in your browser!
12 |
13 |
14 | ## Result History
15 |
16 | ### Elm 0.19.1, elm-xml-decode 3.0
17 |
18 | Sample result (on my MacBook Pro 2019):
19 |
20 | - Environment
21 | - CPU: Intel Core i7 1.7GHz
22 | - Mem: DDR4 16GB
23 | - macOS Mojave 10.14.6
24 | - Google Chrome 78.0.3904.87 64bit
25 | - Versions
26 | - elm 0.19.1
27 | - elm-xml-decode version: 3.1.0
28 | - elm-benchmark 1.0.1
29 |
30 | 
31 |
32 | ### Elm 0.18, elm-xml-decode 1.x
33 |
34 | Was using [BrianHicks/elm-benchmark](https://github.com/BrianHicks/elm-benchmark).
35 |
36 | Sample result (on my MacBookPro early 2015):
37 |
38 | - CPU: Core i5 2.7GHz
39 | - Mem: DDR3 8GB 1867MHz
40 | - macOS (was El Capitan era, IIRC)
41 | - Google Chrome 63.0.3239.84 64bit
42 |
43 | 
44 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2017, Yu Matsuzawa
2 | All rights reserved.
3 |
4 | Redistribution and use in source and binary forms, with or without
5 | modification, are permitted provided that the following conditions are met:
6 | * Redistributions of source code must retain the above copyright notice,
7 | this list of conditions and the following disclaimer.
8 | * Redistributions in binary form must reproduce the above copyright notice,
9 | this list of conditions and the following disclaimer in the documentation
10 | and/or other materials provided with the distribution.
11 | * Neither the name of the nor the names of its contributors
12 | may be used to endorse or promote products derived from this software
13 | without specific prior written permission.
14 |
15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
18 | DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY
19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
25 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Changelog
2 |
3 | ## Upcoming
4 |
5 | - ...
6 |
7 | ## 3.2.2
8 |
9 | - Now uses [miniBill/elm-xml-parser](https://package.elm-lang.org/packages/miniBill/elm-xml-parser/latest/) fork for parsing XML. Thanks [@miniBill](https://github.com/miniBill)!
10 |
11 | ## 3.2.1
12 |
13 | - Doc fix
14 |
15 | ## 3.2.0
16 |
17 | - Added `node` for customized decoding. Thanks [@marmutro](https://github.com/marmutro)!
18 |
19 | ## 3.1.0
20 |
21 | - Added `with` for CPS.
22 | - [Misc change] Upgraded benchmark.
23 |
24 | ## 3.0.0
25 |
26 | - Added `oneOf`, `index`.
27 | - Re-defined `Error` structure to fit `OneOf`. Also it is aligned with `Json.Decode.Error` now.
28 | - [Behavior change] Improved error messages. Now they have newlines with indented structure.
29 |
30 | ## 2.0.0
31 |
32 | - `Decoder` and `ListDecoder` are now opaque types.
33 | - `fail` now takes plain `String`, allowing easier failure construction.
34 | - Removed `date` and `dateAttr` since core `Date` module has been removed.
35 | - For now, pipe `string` or `stringAttr` into `andThen` with your favorite date string parser,
36 | such as [rtfeldman/elm-iso8601-date-strings][iso].
37 | - Removed `(|:)` since custom infix operators are no longer supported.
38 | - You may replace them with `|> andMap ( ... )`, or use Pipeline-style.
39 | - Collapse `Xml.Decode.Extra` and `Xml.Decode.Pipeline` into `Xml.Decode`.
40 | - [Behavior change] Elements with no children are now decoded into empty strings (`""`) when using `string`.
41 |
42 | [iso]: https://package.elm-lang.org/packages/rtfeldman/elm-iso8601-date-strings/latest/Iso8601
43 |
44 | ## 1.0.0
45 |
46 | - Initial release 🎉
47 |
--------------------------------------------------------------------------------
/src/Xml/Decode/Internal.elm:
--------------------------------------------------------------------------------
1 | module Xml.Decode.Internal exposing (escape, formatNode)
2 |
3 | {-| Internal functions.
4 | -}
5 |
6 | import XmlParser exposing (Attribute, Node(..))
7 |
8 |
9 | {-| Format XML node for error dump. Always produce end tags.
10 | -}
11 | formatNode : Node -> String
12 | formatNode node =
13 | case node of
14 | Element tagName attrs children ->
15 | "<"
16 | ++ escape tagName
17 | ++ attributesToString attrs
18 | ++ ">"
19 | ++ (children |> List.map formatNode |> String.join "")
20 | ++ ""
23 |
24 | Text s ->
25 | escape s
26 |
27 |
28 | attributesToString : List Attribute -> String
29 | attributesToString attrs =
30 | case attrs of
31 | [] ->
32 | ""
33 |
34 | _ ->
35 | " " ++ (attrs |> List.map formatAttribute |> String.join " ")
36 |
37 |
38 | formatAttribute : Attribute -> String
39 | formatAttribute attribute =
40 | escape attribute.name ++ "=\"" ++ escape attribute.value ++ "\""
41 |
42 |
43 | {-| Replaces by char-based predicate.
44 | -}
45 | escape : String -> String
46 | escape s =
47 | let
48 | reducer char =
49 | case char of
50 | '&' ->
51 | String.append "&"
52 |
53 | '<' ->
54 | String.append "<"
55 |
56 | '>' ->
57 | String.append ">"
58 |
59 | '"' ->
60 | String.append """
61 |
62 | '\'' ->
63 | String.append "'"
64 |
65 | c ->
66 | String.cons c
67 | in
68 | String.foldr reducer "" s
69 |
--------------------------------------------------------------------------------
/benchmarks/DecodeString.elm:
--------------------------------------------------------------------------------
1 | module DecodeString exposing (cdCatalogDecoder, main, noteDecoder)
2 |
3 | import Benchmark exposing (benchmark, describe)
4 | import Benchmark.Runner exposing (BenchmarkProgram, program)
5 | import ExampleXml
6 | import Xml.Decode exposing (..)
7 |
8 |
9 | main : BenchmarkProgram
10 | main =
11 | program <|
12 | describe "Xml.Decode.decodeString"
13 | [ benchmark "just root" <|
14 | \_ -> decodeString (succeed ()) ExampleXml.justRoot
15 | , benchmark "note" <|
16 | \_ -> decodeString noteDecoder ExampleXml.note
17 | , benchmark "CD catalog" <|
18 | \_ -> decodeString cdCatalogDecoder ExampleXml.cdCatalog
19 | ]
20 |
21 |
22 | type alias Note =
23 | { to : String
24 | , from : String
25 | , heading : String
26 | , body : String
27 | }
28 |
29 |
30 | noteDecoder : Decoder Note
31 | noteDecoder =
32 | map4 Note
33 | (path [ "to" ] (single string))
34 | (path [ "from" ] (single string))
35 | (path [ "heading" ] (single string))
36 | (path [ "body" ] (single string))
37 |
38 |
39 | type alias CD =
40 | { title : String
41 | , artist : String
42 | , country : String
43 | , company : String
44 | , price : Float
45 | , year : Int
46 | }
47 |
48 |
49 | cdCatalogDecoder : Decoder (List CD)
50 | cdCatalogDecoder =
51 | let
52 | cdDecoder =
53 | succeed CD
54 | |> andMap (path [ "TITLE" ] (single string))
55 | |> andMap (path [ "ARTIST" ] (single string))
56 | |> andMap (path [ "COUNTRY" ] (single string))
57 | |> andMap (path [ "COMPANY" ] (single string))
58 | |> andMap (path [ "PRICE" ] (single float))
59 | |> andMap (path [ "YEAR" ] (single int))
60 | in
61 | path [ "CD" ] (list cdDecoder)
62 |
--------------------------------------------------------------------------------
/.github/workflows/main.yml:
--------------------------------------------------------------------------------
1 | name: Main Workflow
2 |
3 | on:
4 | push:
5 | branches:
6 | - master
7 | pull_request:
8 |
9 | concurrency:
10 | group: ${{ github.workflow }}-${{ github.ref }}
11 |
12 | permissions:
13 | contents: write
14 | pages: write
15 | id-token: write
16 |
17 | jobs:
18 | test:
19 | runs-on: ubuntu-22.04
20 | steps:
21 | - uses: actions/checkout@v6
22 | - uses: actions/cache@v5
23 | with:
24 | key: v1-${{ hashFiles('package-lock.json') }}-${{ hashFiles('elm.json', 'elm-tooling.json') }}
25 | restore-keys: |
26 | v1-${{ hashFiles('package-lock.json') }}-
27 | v1-
28 | path: |
29 | node_modules
30 | elm-stuff
31 | benchmarks/elm-stuff
32 | ~/.elm
33 | - uses: actions/setup-node@v6
34 | with:
35 | node-version: "22"
36 | - run: npm install
37 | - run: npm test
38 | - run: npx elm-format --validate src/ tests/ benchmarks/
39 | publish:
40 | if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/master' }}
41 | needs: test
42 | runs-on: ubuntu-22.04
43 | steps:
44 | - uses: actions/checkout@v6
45 | - uses: actions/cache@v5
46 | with:
47 | key: v1-${{ hashFiles('package-lock.json') }}-${{ hashFiles('elm.json', 'elm-tooling.json') }}
48 | restore-keys: |
49 | v1-${{ hashFiles('package-lock.json') }}-
50 | v1-
51 | path: |
52 | node_modules
53 | elm-stuff
54 | benchmarks/elm-stuff
55 | ~/.elm
56 | - uses: actions/setup-node@v6
57 | with:
58 | node-version: "20"
59 | - uses: dillonkearns/elm-publish-action@v1
60 | with:
61 | github-token: ${{ secrets.GITHUB_TOKEN }}
62 | path-to-elm: ./node_modules/.bin/elm
63 | deploy-benchmark:
64 | if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/master' }}
65 | needs: test
66 | runs-on: ubuntu-22.04
67 | steps:
68 | - uses: actions/checkout@v6
69 | - uses: actions/cache@v5
70 | with:
71 | key: v1-${{ hashFiles('package-lock.json') }}-${{ hashFiles('elm.json', 'elm-tooling.json') }}
72 | restore-keys: |
73 | v1-${{ hashFiles('package-lock.json') }}-
74 | v1-
75 | path: |
76 | node_modules
77 | elm-stuff
78 | benchmarks/elm-stuff
79 | ~/.elm
80 | - run: npm run generate-benchmark
81 | - name: Setup Pages
82 | uses: actions/configure-pages@v5
83 | - name: Upload artifact
84 | uses: actions/upload-pages-artifact@v4
85 | with:
86 | path: "./docs"
87 | - name: Deploy to GitHub Pages
88 | id: deployment
89 | uses: actions/deploy-pages@v4
90 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # elm-xml-decode
2 |
3 | [](https://github.com/ymtszw/elm-xml-decode/actions/workflows/main.yml)
4 |
5 | XML decoder, sharing the spirit of [`Json.Decode`][jd]. Ready for Elm 0.19.
6 |
7 | Using [miniBill/elm-xml-parser][exp] as its parser component, which is based on [elm/parser][ep].
8 |
9 | [jd]: https://github.com/elm/json
10 | [exp]: http://github.com/miniBill/elm-xml-parser
11 | [ep]: https://github.com/elm/parser
12 |
13 | ## Related Works
14 |
15 | [eeue56/elm-xml][ex] was an existing full-package XML parser/decoder for Elm,
16 | though I intended to provide an alternative XML decoder which exhibits following properties:
17 |
18 | - Provides [`Decoder`][de]-based APIs, sharing the spirit of [`Json.Decode`][jd]
19 | - Also provides DSL-styled decoder compositions, sharing the sprits of [`Json.Decode.Pipeline`][jdp]
20 | - Handles list of XML node with identical tags, using [`ListDecoder`][ld] type
21 | - Locates targeting XML nodes using "path" of tags, partially mimicking XPath
22 |
23 | [ex]: https://github.com/eeue56/elm-xml
24 | [de]: https://package.elm-lang.org/packages/ymtszw/elm-xml-decode/latest/Xml-Decode#Decoder
25 | [jdp]: https://package.elm-lang.org/packages/NoRedInk/elm-decode-pipeline/latest/Json-Decode-Pipeline
26 | [ld]: https://package.elm-lang.org/packages/ymtszw/elm-xml-decode/latest/Xml-Decode#ListDecoder
27 |
28 | ## Examples
29 |
30 | Basics:
31 |
32 | ```elm
33 | import Xml.Decode exposing (..)
34 |
35 | type alias Data =
36 | { string : String
37 | , integers : List Int
38 | }
39 |
40 | dataDecoder : Decoder Data
41 | dataDecoder =
42 | map2 Data
43 | (path [ "path", "to", "string", "value" ] (single string))
44 | (path [ "path", "to", "int", "values" ] (list int))
45 |
46 | run dataDecoder
47 | """
48 |
49 |
50 |
51 |
52 | SomeString
53 |
54 |
55 | 1
56 | 2
57 |
58 |
59 |
60 |
61 | """
62 | --> Ok { string = "SomeString", integers = [ 1, 2 ] }
63 | ```
64 |
65 | ### Pipeline Decoder compositions
66 |
67 | We have `map`, `map2` and variants, though the Pipeline style is also possible:
68 |
69 | ```elm
70 | pipelineDecoder : Decoder Data
71 | pipelineDecoder =
72 | succeed Data
73 | |> requiredPath [ "path", "to", "string", "value" ] (single string)
74 | |> requiredPath [ "path", "to", "int", "values" ] (list int)
75 | ```
76 |
77 | ## Development
78 |
79 | Install reasonably new Node.js (currently [Node.js 22 is tested](https://github.com/ymtszw/elm-xml-decode/blob/master/.github/workflows/main.yml))
80 |
81 | ```sh
82 | npm install
83 | npm test
84 | ```
85 |
86 | ## Benchmarks
87 |
88 | Benchmark app can be found in `benchmarks/` directory.
89 | Using [examples in W3School](https://www.w3schools.com/xml/xml_examples.asp) and
90 | [elm-explorations/benchmark](https://github.com/elm-explorations/benchmark).
91 |
92 | ```sh
93 | npm run generate-benchmark
94 | # Open docs/index.html
95 | ```
96 |
97 | Also available at
98 |
99 | **It may hang for a while** during JIT warming up, but keep waiting (~ a minute).
100 |
101 | ### Elm 0.19.1, elm-xml-decode 3.2.1
102 |
103 | Sample result (on my Windows 10 machine):
104 |
105 | - Environment
106 | - CPU: Intel Core i7-8700K @ 3.7GHz
107 | - Mem: 64GB
108 | - Windows 10 Pro, 10.0.19044
109 | - Google Chrome 98.0.4758.82 64bit
110 | - Versions
111 | - elm 0.19.1
112 | - elm-xml-decode version: 3.2.1
113 | - elm-benchmark 1.0.2
114 |
115 | 
116 |
117 | ## License
118 |
119 | BSD-3-Clause
120 |
--------------------------------------------------------------------------------
/tests/IssueCases.elm:
--------------------------------------------------------------------------------
1 | module IssueCases exposing (suite)
2 |
3 | import Expect
4 | import Test exposing (..)
5 | import Xml.Decode exposing (..)
6 | import XmlParser exposing (Node(..))
7 |
8 |
9 | suite : Test
10 | suite =
11 | describe "From Issues"
12 | [ describe "#4" <|
13 | -- https://github.com/ymtszw/elm-xml-decode/issues/4
14 | let
15 | exampleXml =
16 | "ab"
17 | in
18 | [ test "incorrect decoder" <|
19 | \_ ->
20 | let
21 | listItemDecoder =
22 | map2 Tuple.pair
23 | (path [] (single (intAttr "id")))
24 | (path [ "value" ] (single string))
25 | in
26 | exampleXml
27 | |> run (path [ "ListItem" ] (list listItemDecoder))
28 | |> Expect.equal (Err "Path: /ListItem\nNode: a\nAttribute 'id' not found.")
29 | , test "fixed decoder" <|
30 | \_ ->
31 | let
32 | listItemDecoderFixed =
33 | map2 Tuple.pair
34 | (intAttr "id")
35 | (path [ "value" ] (single string))
36 | in
37 | exampleXml
38 | |> run (path [ "ListItem" ] (list listItemDecoderFixed))
39 | |> Expect.equal (Ok [ ( 1, "a" ), ( 2, "b" ) ])
40 | ]
41 | , describe "discourse#5412" <|
42 | -- https://discourse.elm-lang.org/t/using-xml-decode/5412
43 | let
44 | exampleXml =
45 | """
46 |
47 |
48 | foo
49 | bar
50 |
51 |
52 | foo
53 | bar
54 |
55 |
56 | ban
57 |
58 |
59 | """
60 | in
61 | [ test "proposedDecoder" <|
62 | \_ ->
63 | let
64 | proposedDecoder =
65 | path [] (leakyList decodeSchemaEntry)
66 |
67 | decodeSchemaEntry =
68 | with node <|
69 | \n ->
70 | case n of
71 | Element "EntityType" _ _ ->
72 | map2 EntityType (stringAttr "Name") decodeEntityTypeEntry
73 |
74 | Element "ComplexType" _ _ ->
75 | succeed ComplexType
76 |
77 | _ ->
78 | fail "More To Come"
79 |
80 | decodeEntityTypeEntry =
81 | oneOf
82 | [ path [ "Property" ] <| leakyList <| map Property string
83 |
84 | -- More to come here
85 | ]
86 | in
87 | exampleXml
88 | |> run proposedDecoder
89 | |> Expect.equal
90 | (Ok
91 | [ EntityType "Person" [ Property "foo", Property "bar" ]
92 | , ComplexType
93 | , EntityType "Animal" [ Property "ban" ]
94 | ]
95 | )
96 | ]
97 | , describe "#8" <|
98 | -- https://github.com/ymtszw/elm-xml-decode/issues/8
99 | [ test "stringAttr should not cut values" <|
100 | \_ ->
101 | ""
102 | |> run (stringAttr "url")
103 | |> Expect.equal (Ok "a&b")
104 | ]
105 | ]
106 |
107 |
108 |
109 | ------------------------
110 | --- For "discourse#5412"
111 | ------------------------
112 |
113 |
114 | type SchemaEntry
115 | = EntityType String (List EntityTypeEntry)
116 | | ComplexType
117 |
118 |
119 | type EntityTypeEntry
120 | = Property PropertyDetails
121 |
122 |
123 | type alias PropertyDetails =
124 | String
125 |
--------------------------------------------------------------------------------
/benchmarks/ExampleXml.elm:
--------------------------------------------------------------------------------
1 | module ExampleXml exposing (cdCatalog, justRoot, note)
2 |
3 | {-| Provides XML resources for benchmark.
4 | -}
5 |
6 |
7 | justRoot : String
8 | justRoot =
9 | ""
10 |
11 |
12 | {-| Taken from
13 | -}
14 | note : String
15 | note =
16 | """
17 |
18 | Tove
19 | Jani
20 | Reminder
21 | Don't forget me this weekend!
22 |
23 | """
24 |
25 |
26 | {-| Taken from
27 | -}
28 | cdCatalog : String
29 | cdCatalog =
30 | """
31 |
32 |
33 | Empire Burlesque
34 | Bob Dylan
35 | USA
36 | Columbia
37 | 10.90
38 | 1985
39 |
40 |
41 | Hide your heart
42 | Bonnie Tyler
43 | UK
44 | CBS Records
45 | 9.90
46 | 1988
47 |
48 |
49 | Greatest Hits
50 | Dolly Parton
51 | USA
52 | RCA
53 | 9.90
54 | 1982
55 |
56 |
57 | Still got the blues
58 | Gary Moore
59 | UK
60 | Virgin records
61 | 10.20
62 | 1990
63 |
64 |
65 | Eros
66 | Eros Ramazzotti
67 | EU
68 | BMG
69 | 9.90
70 | 1997
71 |
72 |
73 | One night only
74 | Bee Gees
75 | UK
76 | Polydor
77 | 10.90
78 | 1998
79 |
80 |
81 | Sylvias Mother
82 | Dr.Hook
83 | UK
84 | CBS
85 | 8.10
86 | 1973
87 |
88 |
89 | Maggie May
90 | Rod Stewart
91 | UK
92 | Pickwick
93 | 8.50
94 | 1990
95 |
96 |
97 | Romanza
98 | Andrea Bocelli
99 | EU
100 | Polydor
101 | 10.80
102 | 1996
103 |
104 |
105 | When a man loves a woman
106 | Percy Sledge
107 | USA
108 | Atlantic
109 | 8.70
110 | 1987
111 |
112 |
113 | Black angel
114 | Savage Rose
115 | EU
116 | Mega
117 | 10.90
118 | 1995
119 |
120 |
121 | 1999 Grammy Nominees
122 | Many
123 | USA
124 | Grammy
125 | 10.20
126 | 1999
127 |
128 |
129 | For the good times
130 | Kenny Rogers
131 | UK
132 | Mucik Master
133 | 8.70
134 | 1995
135 |
136 |
137 | Big Willie style
138 | Will Smith
139 | USA
140 | Columbia
141 | 9.90
142 | 1997
143 |
144 |
145 | Tupelo Honey
146 | Van Morrison
147 | UK
148 | Polydor
149 | 8.20
150 | 1971
151 |
152 |
153 | Soulsville
154 | Jorn Hoel
155 | Norway
156 | WEA
157 | 7.90
158 | 1996
159 |
160 |
161 | The very best of
162 | Cat Stevens
163 | UK
164 | Island
165 | 8.90
166 | 1990
167 |
168 |
169 | Stop
170 | Sam Brown
171 | UK
172 | A and M
173 | 8.90
174 | 1988
175 |
176 |
177 | Bridge of Spies
178 | T'Pau
179 | UK
180 | Siren
181 | 7.90
182 | 1987
183 |
184 |
185 | Private Dancer
186 | Tina Turner
187 | UK
188 | Capitol
189 | 8.90
190 | 1983
191 |
192 |
193 | Midt om natten
194 | Kim Larsen
195 | EU
196 | Medley
197 | 7.80
198 | 1983
199 |
200 |
201 | Pavarotti Gala Concert
202 | Luciano Pavarotti
203 | UK
204 | DECCA
205 | 9.90
206 | 1991
207 |
208 |
209 | The dock of the bay
210 | Otis Redding
211 | USA
212 | Stax Records
213 | 7.90
214 | 1968
215 |
216 |
217 | Picture book
218 | Simply Red
219 | EU
220 | Elektra
221 | 7.20
222 | 1985
223 |
224 |
225 | Red
226 | The Communards
227 | UK
228 | London
229 | 7.80
230 | 1987
231 |
232 |
233 | Unchain my heart
234 | Joe Cocker
235 | USA
236 | EMI
237 | 8.20
238 | 1987
239 |
240 |
241 | """
242 |
--------------------------------------------------------------------------------
/tests/XmlDecodeTest.elm:
--------------------------------------------------------------------------------
1 | module XmlDecodeTest exposing (suite)
2 |
3 | import Expect
4 | import Fuzz exposing (Fuzzer)
5 | import Test exposing (..)
6 | import Xml.Decode exposing (..)
7 | import Xml.Decode.Internal exposing (escape)
8 |
9 |
10 | suite : Test
11 | suite =
12 | describe "Xml.Decode"
13 | [ stringSuite
14 | , intSuite
15 | , floatSuite
16 | , boolSuite
17 | , pathSuite
18 | , withDefaultSuite
19 | , maybeSuite
20 | , oneOfSuite
21 | , errorMessageSuite
22 | ]
23 |
24 |
25 | stringSuite : Test
26 | stringSuite =
27 | describe "string"
28 | [ fuzzOk escapedStringFuzzer string "bare string" identity
29 | , testOk string "" ""
30 | , testErr string "nestedText"
31 | , testErr string "notSimpleText"
32 | , testErr string "notSimpleText"
33 | ]
34 |
35 |
36 | escapedStringFuzzer : Fuzzer String
37 | escapedStringFuzzer =
38 | Fuzz.map escape Fuzz.string
39 |
40 |
41 | testOk : Decoder a -> String -> a -> Test
42 | testOk decoder input expect =
43 | test ("should decode " ++ xml input) <| \_ -> run decoder (xml input) |> Expect.equal (Ok expect)
44 |
45 |
46 | testErr : Decoder a -> String -> Test
47 | testErr decoder input =
48 | test ("should reject " ++ xml input) <| \_ -> run decoder (xml input) |> Expect.err
49 |
50 |
51 | fuzzOk : Fuzzer a -> Decoder b -> String -> (a -> String) -> Test
52 | fuzzOk fuzzer decoder valKind valConv =
53 | fuzz fuzzer ("should decode " ++ valKind) <| \v -> run decoder (xml <| valConv <| v) |> Expect.ok
54 |
55 |
56 | fuzzErr : Fuzzer a -> Decoder b -> String -> (a -> String) -> Test
57 | fuzzErr fuzzer decoder valKind valConv =
58 | fuzz fuzzer ("should reject " ++ valKind) <| \v -> run decoder (xml <| valConv <| v) |> Expect.err
59 |
60 |
61 | xml : String -> String
62 | xml contents =
63 | "" ++ contents ++ ""
64 |
65 |
66 | intSuite : Test
67 | intSuite =
68 | describe "int"
69 | [ fuzzOk Fuzz.int int "bare int" String.fromInt
70 | , testErr int "string"
71 | , testErr int "1.0"
72 | ]
73 |
74 |
75 | floatSuite : Test
76 | floatSuite =
77 | describe "float"
78 | [ fuzzOk Fuzz.niceFloat float "nice float" String.fromFloat
79 | , fuzzOk Fuzz.int float "bare int" String.fromInt
80 | , testOk float "Infinity" (1 / 0) -- !!
81 | , testOk float "-Infinity" (-1 / 0) -- !!
82 | , testErr float "string"
83 | , testErr float "NaN" -- Infinity is acceptable but NaN is not
84 | ]
85 |
86 |
87 | boolSuite : Test
88 | boolSuite =
89 | describe "bool"
90 | [ testOk bool "true" True
91 | , testOk bool "1" True
92 | , testOk bool "false" False
93 | , testOk bool "0" False
94 | , fuzzErr nonBoolFuzzer bool "non-bool bare string" identity
95 | ]
96 |
97 |
98 | nonBoolFuzzer : Fuzzer String
99 | nonBoolFuzzer =
100 | let
101 | alterBoolString a =
102 | if List.member a [ "true", "1", "false", "0" ] then
103 | "a" ++ a
104 |
105 | else
106 | a
107 | in
108 | Fuzz.map alterBoolString escapedStringFuzzer
109 |
110 |
111 | pathSuite : Test
112 | pathSuite =
113 | describe "path"
114 | [ singleSuite
115 | , listSuite
116 | , leakyListSuite
117 | , indexSuite
118 | ]
119 |
120 |
121 | singleSuite : Test
122 | singleSuite =
123 | describe "single"
124 | [ testSinglePathOk [] "target"
125 | , testSinglePathOk [ "tag" ] "target"
126 | , testSinglePathOk [ "tag1", "tag2" ] "target"
127 | , testSinglePathOk [ "sametag", "sametag" ] "target"
128 | , testSinglePathErr [ "nonexisting" ] "target"
129 | , testSinglePathErr [ "tag1", "wrongLeaf" ] "target"
130 | , testSinglePathErr [ "wrongTrunk", "tag2" ] "target"
131 | , testSinglePathErr [ "multiple" ] "targettarget"
132 | ]
133 |
134 |
135 | testSinglePathOk : List String -> String -> Test
136 | testSinglePathOk path_ doc =
137 | test ("should decode " ++ xml doc ++ " with path: " ++ Debug.toString path_) <|
138 | \_ ->
139 | run (path path_ (single string)) (xml doc)
140 | |> Expect.equal (Ok "target")
141 |
142 |
143 | testSinglePathErr : List String -> String -> Test
144 | testSinglePathErr path_ doc =
145 | test ("should fail to decode " ++ xml doc ++ " with path: " ++ Debug.toString path_) <|
146 | \_ ->
147 | run (path path_ (single string)) (xml doc)
148 | |> Expect.err
149 |
150 |
151 | listSuite : Test
152 | listSuite =
153 | describe "list"
154 | [ testListPathOk [ "tag" ] "value1value2" [ "value1", "value2" ]
155 | , testListPathOk [ "tag" ] "nonEmpty" [ "nonEmpty", "" ]
156 | , testListPathOk [ "tag" ] "value1" [ "value1" ]
157 | , testListPathOk [ "tag" ] "" []
158 | , testListPathOk [ "wrong", "tag" ] "value1" []
159 | , test "should fail to decode into list when value is not decodable" <|
160 | \_ ->
161 | run (path [ "tag" ] (list int)) (xml "nonInt") |> Expect.err
162 | ]
163 |
164 |
165 | testListPathOk : List String -> String -> List String -> Test
166 | testListPathOk path_ doc expect =
167 | test ("should decode " ++ xml doc ++ " with path: " ++ Debug.toString path_) <|
168 | \_ ->
169 | run (path path_ (list string)) (xml doc)
170 | |> Expect.equal (Ok expect)
171 |
172 |
173 | leakyListSuite : Test
174 | leakyListSuite =
175 | describe "leakyList"
176 | [ testLeakyListPathOk [ "tag" ] "12" [ 1, 2 ]
177 | , testLeakyListPathOk [ "tag" ] "1nonInt" [ 1 ]
178 | , testLeakyListPathOk [ "tag" ] "nonIntnonInt" []
179 | , testLeakyListPathOk [ "tag" ] "" []
180 | ]
181 |
182 |
183 | testLeakyListPathOk : List String -> String -> List Int -> Test
184 | testLeakyListPathOk path_ doc expect =
185 | test ("should decode " ++ xml doc ++ " with path: " ++ Debug.toString path_) <|
186 | \_ ->
187 | run (path path_ (leakyList int)) (xml doc)
188 | |> Expect.equal (Ok expect)
189 |
190 |
191 | indexSuite : Test
192 | indexSuite =
193 | let
194 | xml_ =
195 | xml "01"
196 | in
197 | describe "index"
198 | [ test "should decode node at index 0" <|
199 | \_ -> run (path [ "tag" ] (index 0 int)) xml_ |> Expect.equal (Ok 0)
200 | , test "should decode node at index 1" <|
201 | \_ -> run (path [ "tag" ] (index 1 int)) xml_ |> Expect.equal (Ok 1)
202 | , test "should fail for node at index 2" <|
203 | \_ -> run (path [ "tag" ] (index 2 int)) xml_ |> Expect.err
204 | ]
205 |
206 |
207 | withDefaultSuite : Test
208 | withDefaultSuite =
209 | describe "withDefault"
210 | [ testWithDefault bool "nonBool" True
211 | , testWithDefault (path [ "nonexisting" ] (single string)) "value" "default"
212 | ]
213 |
214 |
215 | testWithDefault : Decoder a -> String -> a -> Test
216 | testWithDefault decoder input expect =
217 | test ("should decode into default value from input " ++ xml input) <|
218 | \_ ->
219 | run (withDefault expect decoder) (xml input)
220 | |> Expect.equal (Ok expect)
221 |
222 |
223 | maybeSuite : Test
224 | maybeSuite =
225 | describe "maybe"
226 | [ testMaybe bool "true" (Just True)
227 | , testMaybe bool "nonBool" Nothing
228 | , testMaybe (path [ "nonexisting" ] (single string)) "value" Nothing
229 | ]
230 |
231 |
232 | testMaybe : Decoder a -> String -> Maybe a -> Test
233 | testMaybe decoder input expect =
234 | test ("should decode into " ++ Debug.toString expect ++ " from " ++ xml input) <|
235 | \_ ->
236 | run (maybe decoder) (xml input)
237 | |> Expect.equal (Ok expect)
238 |
239 |
240 | type IntOrBool
241 | = I Int
242 | | B Bool
243 |
244 |
245 | oneOfSuite : Test
246 | oneOfSuite =
247 | describe "oneOf"
248 | [ testOneOfOk "[ int ]" [ map I int ] "1" (I 1)
249 | , testOneOfOk "[ bool ]" [ map B bool ] "1" (B True)
250 | , testOneOfOk "[ int, bool ]" [ map I int, map B bool ] "1" (I 1)
251 | , testOneOfOk "[ int, bool ]" [ map I int, map B bool ] "true" (B True)
252 | , testOneOfOk "[ bool, int ]" [ map B bool, map I int ] "1" (B True)
253 | , testOneOfOk "[ bool, int ]" [ map B bool, map I int ] "2" (I 2)
254 | , testOneOfErr "[]" [] "1"
255 | , testOneOfErr "[ int ]" [ map I int ] "true"
256 | , testOneOfErr "[ bool ]" [ map B bool ] "2"
257 | , testOneOfErr "[ int, bool ]" [ map I int, map B bool ] "nonInt,nonBool"
258 | , testOneOfErr "[ bool, int ]" [ map B bool, map I int ] "nonInt,nonBool"
259 | ]
260 |
261 |
262 | testOneOfOk : String -> List (Decoder IntOrBool) -> String -> IntOrBool -> Test
263 | testOneOfOk desc decoders input expect =
264 | test ("should decode " ++ xml input ++ " into " ++ Debug.toString expect ++ " by " ++ desc) <|
265 | \_ ->
266 | run (oneOf decoders) (xml input) |> Expect.equal (Ok expect)
267 |
268 |
269 | testOneOfErr : String -> List (Decoder IntOrBool) -> String -> Test
270 | testOneOfErr desc decoders input =
271 | test ("should fail to decode " ++ xml input ++ " by " ++ desc) <|
272 | \_ ->
273 | run (oneOf decoders) (xml input) |> Expect.err
274 |
275 |
276 | errorMessageSuite : Test
277 | errorMessageSuite =
278 | describe "errorToString"
279 | [ testErrorMessages (map I int)
280 | "nonInt"
281 | [ "Node: nonInt"
282 | , "could not convert string 'nonInt' to an Int"
283 | ]
284 | , testErrorMessages (path [ "tag" ] (single (map I int)))
285 | "nonInt"
286 | [ "Path: /tag"
287 | , "Node: nonInt"
288 | , "could not convert string 'nonInt' to an Int"
289 | ]
290 | , testErrorMessages (path [ "nested", "tag" ] (single (map I int)))
291 | "nonInt"
292 | [ "Path: /nested/tag"
293 | , "Node: nonInt"
294 | , "could not convert string 'nonInt' to an Int"
295 | ]
296 | , testErrorMessages (path [ "tag" ] (single (map I int)))
297 | "nonIntnonInt"
298 | [ "Path: /tag"
299 | , "Node: nonIntnonInt"
300 | , "Multiple nodes found."
301 | ]
302 | , testErrorMessages (path [ "tag" ] (index 2 (map I int)))
303 | "01"
304 | [ "Path: /tag"
305 | , "Node: 01"
306 | , "Expected a node at index [2], but only see 2 nodes."
307 | ]
308 | , testErrorMessages (path [ "tag" ] (single (oneOf [ map I int, map B bool ])))
309 | "nonInt,nonBool"
310 | [ "Path: /tag"
311 | , "All decoders failed:"
312 | , " 1) Node: nonInt,nonBool"
313 | , " could not convert string 'nonInt,nonBool' to an Int"
314 | , " 2) Node: nonInt,nonBool"
315 | , " Not a valid boolean value."
316 | ]
317 | , testErrorMessages (path [ "tag" ] (single (oneOf [ map I int, oneOf [ map B bool ] ])))
318 | "nonInt,nonBool"
319 | [ "Path: /tag"
320 | , "All decoders failed:"
321 | , " 1) Node: nonInt,nonBool"
322 | , " could not convert string 'nonInt,nonBool' to an Int"
323 | , " 2) All decoders failed:"
324 | , " 1) Node: nonInt,nonBool"
325 | , " Not a valid boolean value."
326 | ]
327 | ]
328 |
329 |
330 | testErrorMessages : Decoder IntOrBool -> String -> List String -> Test
331 | testErrorMessages decoder input expectedRows =
332 | let
333 | expect =
334 | String.join "\n" expectedRows
335 | in
336 | test ("should produce error message:\n" ++ expect) <|
337 | \_ ->
338 | run decoder (xml input) |> Expect.equal (Err expect)
339 |
--------------------------------------------------------------------------------
/src/Xml/Decode.elm:
--------------------------------------------------------------------------------
1 | module Xml.Decode exposing
2 | ( Decoder, ListDecoder, Error(..)
3 | , run, decodeString, decodeXml
4 | , string, int, float, bool, node
5 | , stringAttr, intAttr, floatAttr, boolAttr
6 | , single, list, leakyList, index
7 | , succeed, fail, oneOf, andThen, with, map, map2, map3, map4, map5, andMap, withDefault, maybe, lazy
8 | , path
9 | , requiredPath, optionalPath, possiblePath
10 | , errorToString
11 | )
12 |
13 | {-| XML decoder module sharing the spirit of [`Json.Decode`][jd].
14 |
15 | Using [`XmlParser`][xp] as its parser component.
16 |
17 | [jd]: http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode
18 | [xp]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser
19 |
20 |
21 | # Basic Example
22 |
23 | Examples in this package are doc-tested.
24 |
25 | exampleDecoder : Decoder ( String, List Int )
26 | exampleDecoder =
27 | map2 Tuple.pair
28 | (path [ "string", "value" ] (single string))
29 | (path [ "int", "values" ] (list int))
30 |
31 | run exampleDecoder
32 | """
33 |
34 |
35 | SomeString
36 |
37 |
38 | 1
39 | 2
40 |
41 |
42 | """
43 | --> Ok ( "SomeString", [ 1, 2 ] )
44 |
45 |
46 | # Types
47 |
48 | @docs Decoder, ListDecoder, Error
49 |
50 |
51 | # Decode Executor
52 |
53 | @docs run, decodeString, decodeXml
54 |
55 |
56 | # Decoders
57 |
58 | @docs string, int, float, bool, node
59 |
60 |
61 | # Attribute Decoders
62 |
63 | @docs stringAttr, intAttr, floatAttr, boolAttr
64 |
65 |
66 | # List Decoders
67 |
68 | @docs single, list, leakyList, index
69 |
70 |
71 | # Decoder Utilities
72 |
73 | `mapN` series are backed by `Result.mapN` series, thus it only supports up to `map5`.
74 |
75 | @docs succeed, fail, oneOf, andThen, with, map, map2, map3, map4, map5, andMap, withDefault, maybe, lazy
76 |
77 |
78 | # Node Locater
79 |
80 | @docs path
81 |
82 |
83 | # Pipeline APIs
84 |
85 | Allow writing Decoders in Pipeline-style, just like [`Json.Decode.Pipeline`][jdp].
86 |
87 | [jdp]: http://package.elm-lang.org/packages/NoRedInk/elm-decode-pipeline/latest/Json-Decode-Pipeline
88 |
89 | @docs requiredPath, optionalPath, possiblePath
90 |
91 |
92 | # Error Utility
93 |
94 | @docs errorToString
95 |
96 | -}
97 |
98 | import Parser
99 | import Xml.Decode.Internal exposing (..)
100 | import XmlParser exposing (Attribute, Node(..), Xml)
101 |
102 |
103 |
104 | -- TYPES
105 |
106 |
107 | {-| A function that knows how to decode an XML node into Elm value.
108 | -}
109 | type Decoder a
110 | = Decoder (Node -> Result Error a)
111 |
112 |
113 | {-| A function that knows how to decode list of XML nodes into Elm value.
114 |
115 | They are constructed by functions such as [`single`](#single) or [`list`](#list),
116 | then used in conjunction with [`path`](#path).
117 |
118 | See [`path`](#path) for examples.
119 |
120 | -}
121 | type ListDecoder a
122 | = ListDecoder (( List Node, Node ) -> Result Error a)
123 |
124 |
125 | {-| Represents error on decode execution.
126 | -}
127 | type Error
128 | = Path (List String) Error
129 | | OneOf (List Error)
130 | | Failure String Node
131 |
132 |
133 |
134 | -- DECODE EXECUTOR
135 |
136 |
137 | {-| Synonym of [`decodeString`](#decodeString).
138 | -}
139 | run : Decoder a -> String -> Result String a
140 | run =
141 | decodeString
142 |
143 |
144 | {-| Parses an XML string and decodes into Elm value.
145 |
146 | Parsing will be done by [`XmlParser.parse`][xpp]
147 |
148 | This function returns error in `String`.
149 | Should you need to separately handle [`Parser.Error`][pe] and [`Xml.Decode.Error`](#Error),
150 | explicitly use [`XmlParser.parse`][xpp] and [`decodeXml`](#decodeXml).
151 |
152 | [xpp]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser#parse
153 | [pe]: http://package.elm-lang.org/packages/elm-tools/parser/latest/Parser#Error
154 |
155 | -}
156 | decodeString : Decoder a -> String -> Result String a
157 | decodeString decoder s =
158 | case XmlParser.parse s of
159 | Ok xml ->
160 | case decodeXml decoder xml of
161 | Ok decoded ->
162 | Ok decoded
163 |
164 | Err dErr ->
165 | Err (errorToString dErr)
166 |
167 | Err pErr ->
168 | Err (parseErrorsToString pErr)
169 |
170 |
171 | parseErrorsToString : List { advanced | row : Int, col : Int, problem : Parser.Problem } -> String
172 | parseErrorsToString deadEnds =
173 | deadEnds
174 | |> List.map
175 | (\deadEnd ->
176 | ("At [" ++ String.fromInt deadEnd.row ++ "," ++ String.fromInt deadEnd.col ++ "], ")
177 | ++ parserProblemToString deadEnd.problem
178 | )
179 | |> String.join "\n"
180 | |> String.append "Invalid XML document.\n"
181 |
182 |
183 | parserProblemToString : Parser.Problem -> String
184 | parserProblemToString problem =
185 | case problem of
186 | Parser.Expecting expect ->
187 | "I was expecting: " ++ expect
188 |
189 | Parser.ExpectingInt ->
190 | "I was expecting an integer"
191 |
192 | Parser.ExpectingHex ->
193 | "I was expecting a hexadecimal"
194 |
195 | Parser.ExpectingOctal ->
196 | "I was expecting an octal"
197 |
198 | Parser.ExpectingBinary ->
199 | "I was expecting a binary"
200 |
201 | Parser.ExpectingFloat ->
202 | "I was expecting a float"
203 |
204 | Parser.ExpectingNumber ->
205 | "I was expecting a number"
206 |
207 | Parser.ExpectingVariable ->
208 | "I was expecting a variable"
209 |
210 | Parser.ExpectingSymbol symbol ->
211 | "I was expecting a symbol: " ++ symbol
212 |
213 | Parser.ExpectingKeyword keyword ->
214 | "I was expecting a keyword: " ++ keyword
215 |
216 | Parser.ExpectingEnd ->
217 | "I was expecting the end of input"
218 |
219 | Parser.UnexpectedChar ->
220 | "I got an unexpected character"
221 |
222 | Parser.Problem text ->
223 | text
224 |
225 | Parser.BadRepeat ->
226 | "I got a bad repetition"
227 |
228 |
229 | {-| Decodes an [`XmlParser.Xml`][xpx] value into other type of Elm value.
230 |
231 | [xpx]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser#Xml
232 |
233 | It discards Document Type Definitoin (DTD) and Processing Instruction in XML,
234 | only cares about root XML node.
235 |
236 | import XmlParser exposing (Xml, Node(..))
237 |
238 | exampleDecoder : Decoder ( String, List Int )
239 | exampleDecoder =
240 | map2 Tuple.pair
241 | (path [ "string", "value" ] (single string))
242 | (path [ "int", "values" ] (list int))
243 |
244 | decodeXml exampleDecoder <|
245 | Xml [] Nothing <|
246 | Element "root" []
247 | [ Element "string" []
248 | [ Element "value" [] [ Text "SomeString" ]
249 | ]
250 | , Element "int" []
251 | [ Element "values" [] [ Text "1" ]
252 | , Element "values" [] [ Text "2" ]
253 | ]
254 | ]
255 | --> Ok ( "SomeString", [ 1, 2 ] )
256 |
257 | -}
258 | decodeXml : Decoder a -> Xml -> Result Error a
259 | decodeXml (Decoder decoder) { root } =
260 | decoder root
261 |
262 |
263 |
264 | -- DECODERS
265 |
266 |
267 | {-| Decodes an [`XmlParser.Node`][xpn] into `String`.
268 |
269 | - If the node is `XmlParser.Text`, extracts its value.
270 | - If the node is `XmlParser.Element` AND contains nothing, treat it as "empty text".
271 | - If the node is `XmlParser.Element` AND contains a single `XmlParser.Text` child,
272 | extracts its value.
273 | - Otherwise fails.
274 |
275 | If you want to extract values from node attribute, use [`stringAttr`](#stringAttr) and variants.
276 |
277 | [xpn]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser#Node
278 |
279 | run string "string"
280 | --> Ok "string"
281 |
282 | run string ""
283 | --> Ok ""
284 |
285 | run string "string"
286 | --> Err "Node: string\nThe node is not a simple text node."
287 |
288 | -}
289 | string : Decoder String
290 | string =
291 | cdata Ok
292 |
293 |
294 | cdata : (String -> Result String a) -> Decoder a
295 | cdata generator =
296 | Decoder (cdataImpl generator)
297 |
298 |
299 | cdataImpl : (String -> Result String a) -> Node -> Result Error a
300 | cdataImpl generator aNode =
301 | let
302 | unparsable message =
303 | Failure message aNode
304 |
305 | gen =
306 | generator >> Result.mapError unparsable
307 | in
308 | case aNode of
309 | Text str ->
310 | gen str
311 |
312 | Element _ _ [] ->
313 | -- Accepts empty tag as "empty string"
314 | gen ""
315 |
316 | Element _ _ [ Text str ] ->
317 | gen str
318 |
319 | _ ->
320 | Err (unparsable "The node is not a simple text node.")
321 |
322 |
323 | {-| Similar to [`string`](#string), but also tries to convert `String` to `Int`.
324 |
325 | run int "1"
326 | --> Ok 1
327 |
328 | run int "value"
329 | --> Err "Node: value\ncould not convert string 'value' to an Int"
330 |
331 | -}
332 | int : Decoder Int
333 | int =
334 | cdata (convertCdata String.toInt "an Int")
335 |
336 |
337 | convertCdata : (String -> Maybe a) -> String -> String -> Result String a
338 | convertCdata toType typeStr raw =
339 | case toType raw of
340 | Just a ->
341 | Ok a
342 |
343 | Nothing ->
344 | Err ("could not convert string '" ++ raw ++ "' to " ++ typeStr)
345 |
346 |
347 | {-| Decodes to `Float`.
348 |
349 | run float "1.0"
350 | --> Ok 1.0
351 |
352 | run float "value"
353 | --> Err "Node: value\ncould not convert string 'value' to a Float"
354 |
355 | -}
356 | float : Decoder Float
357 | float =
358 | cdata (convertCdata String.toFloat "a Float")
359 |
360 |
361 | {-| Decodes to `Bool`.
362 |
363 | In [Xml Schema Definition (XSD)][xsd], valid lexical representation of boolean values are,
364 |
365 | - 'true'
366 | - 'false'
367 | - '1'
368 | - '0'
369 |
370 | We follow this specification, case-sensitively.
371 |
372 | [xsd]: https://www.w3.org/TR/xmlschema-2/#boolean
373 |
374 | run bool "true"
375 | --> Ok True
376 |
377 | run bool "value"
378 | --> Err "Node: value\nNot a valid boolean value."
379 |
380 | -}
381 | bool : Decoder Bool
382 | bool =
383 | cdata toBool
384 |
385 |
386 | toBool : String -> Result String Bool
387 | toBool str =
388 | case str of
389 | "true" ->
390 | Ok True
391 |
392 | "1" ->
393 | Ok True
394 |
395 | "false" ->
396 | Ok False
397 |
398 | "0" ->
399 | Ok False
400 |
401 | _ ->
402 | Err "Not a valid boolean value."
403 |
404 |
405 | {-| Decodes an [`XmlParser.Node`][xpn] into itself.
406 |
407 | See [`XmlParser`][xp] to further decompose the node.
408 |
409 | [xpn]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser#Node
410 | [xp]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser
411 |
412 | import XmlParser exposing (Node(..))
413 |
414 | run (path ["path", "to", "target"] (list node)) """"""
415 | --> Ok [Element "target" [] [Element "child" [] [],Element "child" [] []],Element "target" [] []]
416 |
417 | run (path ["path", "to", "target"] (single node)) """"""
418 | --> Err ("Path: /path/to/target\nNode: \nMultiple nodes found.")
419 |
420 | -}
421 | node : Decoder Node
422 | node =
423 | Decoder Ok
424 |
425 |
426 |
427 | -- ATTRIBUTE DECODERS
428 |
429 |
430 | {-| Decodes an attribute value of [`XmlParser.Node`][xpn] into `String`.
431 |
432 | Fails if the node does not have specified attribute.
433 |
434 | run (stringAttr "attr") ""
435 | --> Ok "value"
436 |
437 | run (stringAttr "attr") ""
438 | --> Err "Node: \nAttribute 'attr' not found."
439 |
440 | [xpn]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser#Node
441 |
442 | -}
443 | stringAttr : String -> Decoder String
444 | stringAttr name_ =
445 | cdataAttr name_ Ok
446 |
447 |
448 | cdataAttr : String -> (String -> Result String a) -> Decoder a
449 | cdataAttr name_ generator =
450 | Decoder (cdataAttrImpl name_ generator)
451 |
452 |
453 | cdataAttrImpl : String -> (String -> Result String a) -> Node -> Result Error a
454 | cdataAttrImpl name_ generator aNode =
455 | let
456 | notFound =
457 | Failure ("Attribute '" ++ name_ ++ "' not found.") aNode
458 |
459 | gen =
460 | generator >> Result.mapError (\message -> Failure message aNode)
461 | in
462 | case aNode of
463 | Text _ ->
464 | Err notFound
465 |
466 | Element _ attrs _ ->
467 | attrs
468 | |> fetchAttributeValue name_
469 | |> Result.fromMaybe notFound
470 | |> Result.andThen gen
471 |
472 |
473 | fetchAttributeValue : String -> List Attribute -> Maybe String
474 | fetchAttributeValue name_ attrs =
475 | case attrs of
476 | [] ->
477 | Nothing
478 |
479 | { name, value } :: tl ->
480 | if name == name_ then
481 | Just value
482 |
483 | else
484 | fetchAttributeValue name_ tl
485 |
486 |
487 | {-| Decodes an attribute value into `Int`.
488 |
489 | run (intAttr "attr") ""
490 | --> Ok 1
491 |
492 | run (intAttr "attr") ""
493 | --> Err "Node: \ncould not convert string 'value' to an Int"
494 |
495 | -}
496 | intAttr : String -> Decoder Int
497 | intAttr name_ =
498 | cdataAttr name_ (convertCdata String.toInt "an Int")
499 |
500 |
501 | {-| Decodes an attribute value into `Float`.
502 |
503 | run (floatAttr "attr") ""
504 | --> Ok 1.5
505 |
506 | run (floatAttr "attr") ""
507 | --> Err "Node: \ncould not convert string 'value' to a Float"
508 |
509 | -}
510 | floatAttr : String -> Decoder Float
511 | floatAttr name_ =
512 | cdataAttr name_ (convertCdata String.toFloat "a Float")
513 |
514 |
515 | {-| Decodes an attribute value into `Bool`.
516 |
517 | run (boolAttr "attr") ""
518 | --> Ok True
519 |
520 | run (boolAttr "attr") ""
521 | --> Err "Node: \nNot a valid boolean value."
522 |
523 | -}
524 | boolAttr : String -> Decoder Bool
525 | boolAttr name_ =
526 | cdataAttr name_ toBool
527 |
528 |
529 |
530 | -- LIST DECODERS
531 |
532 |
533 | {-| Composes [`ListDecoder`](#ListDecoder) that results in a singular value.
534 |
535 | It fails if:
536 |
537 | - there are multiple nodes, or,
538 | - there are no nodes.
539 |
540 | Examples:
541 |
542 | run (path [ "tag" ] (single string)) "string"
543 | --> Ok "string"
544 |
545 | run (path [ "tag" ] (single string)) ""
546 | --> Err "Path: /tag\nNode: \nNode not found."
547 |
548 | run (path [ "tag" ] (single string)) "string1string2"
549 | --> Err "Path: /tag\nNode: string1string2\nMultiple nodes found."
550 |
551 | -}
552 | single : Decoder a -> ListDecoder a
553 | single decoder =
554 | ListDecoder (singleImpl decoder)
555 |
556 |
557 | singleImpl : Decoder a -> ( List Node, Node ) -> Result Error a
558 | singleImpl (Decoder decoder) ( nodes, ancestor ) =
559 | case nodes of
560 | [] ->
561 | Err (Failure "Node not found." ancestor)
562 |
563 | [ singleton_ ] ->
564 | decoder singleton_
565 |
566 | _ :: _ ->
567 | Err (Failure "Multiple nodes found." ancestor)
568 |
569 |
570 | {-| Composes [`ListDecoder`](#ListDecoder) that results in a list of values.
571 |
572 | This [`ListDecoder`](#ListDecoder) fails if any incoming items cannot be decoded.
573 |
574 | run (path [ "tag" ] (list string)) "string1string2"
575 | --> Ok [ "string1", "string2" ]
576 |
577 | run (path [ "tag" ] (list int)) "1nonInt"
578 | --> Err "Path: /tag\nNode: nonInt\ncould not convert string 'nonInt' to an Int"
579 |
580 | -}
581 | list : Decoder a -> ListDecoder (List a)
582 | list decoder =
583 | ListDecoder (listImpl decoder [])
584 |
585 |
586 | listImpl : Decoder a -> List a -> ( List Node, Node ) -> Result Error (List a)
587 | listImpl (Decoder decoder) acc ( nodes, ancestor ) =
588 | case nodes of
589 | [] ->
590 | Ok (List.reverse acc)
591 |
592 | n :: ns ->
593 | case decoder n of
594 | Ok item ->
595 | listImpl (Decoder decoder) (item :: acc) ( ns, ancestor )
596 |
597 | Err e ->
598 | Err e
599 |
600 |
601 | {-| Variation of [`list`](#list), which ignores items that cannot be decoded.
602 |
603 | run (path [ "tag" ] (leakyList int)) "1nonInt"
604 | --> Ok [ 1 ]
605 |
606 | -}
607 | leakyList : Decoder a -> ListDecoder (List a)
608 | leakyList (Decoder decoder) =
609 | ListDecoder (Tuple.first >> List.foldr (decoder >> accumlateOk) (Ok []))
610 |
611 |
612 | accumlateOk : Result x a -> Result x (List a) -> Result x (List a)
613 | accumlateOk result acc =
614 | case result of
615 | Err _ ->
616 | acc
617 |
618 | Ok a ->
619 | Result.map ((::) a) acc
620 |
621 |
622 | {-| Similar to `Json.Decode.index`, decode from list of nodes at some index.
623 |
624 | Useful for "narrowing down" your search paths.
625 |
626 | Fails if there are not enough nodes.
627 |
628 | run (path [ "tag" ] (index 1 int)) "01"
629 | --> Ok 1
630 |
631 | -}
632 | index : Int -> Decoder a -> ListDecoder a
633 | index index_ decoder =
634 | ListDecoder (indexImpl 0 index_ decoder)
635 |
636 |
637 | indexImpl : Int -> Int -> Decoder a -> ( List Node, Node ) -> Result Error a
638 | indexImpl found index_ (Decoder dec) ( nodes, ancestor ) =
639 | case nodes of
640 | [] ->
641 | Err <|
642 | Failure
643 | ("Expected a node at index ["
644 | ++ String.fromInt index_
645 | ++ "], but only see "
646 | ++ String.fromInt found
647 | ++ " nodes."
648 | )
649 | ancestor
650 |
651 | aNode :: ns ->
652 | if found == index_ then
653 | dec aNode
654 |
655 | else
656 | indexImpl (found + 1) index_ (Decoder dec) ( ns, ancestor )
657 |
658 |
659 |
660 | -- DECODER UTILITIES
661 |
662 |
663 | {-| Decoder that always succeed with the given value.
664 | -}
665 | succeed : a -> Decoder a
666 | succeed a =
667 | Decoder (\_ -> Ok a)
668 |
669 |
670 | {-| Decoder that always fail with the given message.
671 | -}
672 | fail : String -> Decoder a
673 | fail message =
674 | Decoder (failImpl message)
675 |
676 |
677 | failImpl : String -> Node -> Result Error a
678 | failImpl message aNode =
679 | Err (Failure message aNode)
680 |
681 |
682 | {-| Try a list of decoders.
683 |
684 | Fails if all given decoders failed, or no decoders are given.
685 |
686 | run (oneOf [ int, succeed 0 ]) "nonInt"
687 | --> Ok 0
688 |
689 | run (oneOf [ int ]) "nonInt"
690 | --> Err "All decoders failed:\n 1) Node: nonInt\n could not convert string 'nonInt' to an Int"
691 |
692 | -}
693 | oneOf : List (Decoder a) -> Decoder a
694 | oneOf decoders =
695 | Decoder (oneOfImpl decoders [])
696 |
697 |
698 | oneOfImpl : List (Decoder a) -> List Error -> Node -> Result Error a
699 | oneOfImpl decoders errors aNode =
700 | case decoders of
701 | [] ->
702 | Err (OneOf (List.reverse errors))
703 |
704 | (Decoder d) :: ds ->
705 | case d aNode of
706 | Ok val ->
707 | Ok val
708 |
709 | Err e ->
710 | oneOfImpl ds (e :: errors) aNode
711 |
712 |
713 | {-| Generates a decoder that depends on previous value.
714 | -}
715 | andThen : (a -> Decoder b) -> Decoder a -> Decoder b
716 | andThen decoderBGen decoderA =
717 | Decoder (andThenImpl decoderBGen decoderA)
718 |
719 |
720 | andThenImpl : (a -> Decoder b) -> Decoder a -> Node -> Result Error b
721 | andThenImpl decoderBGen (Decoder decoderA) aNode =
722 | case decoderA aNode of
723 | Ok valA ->
724 | let
725 | (Decoder decoderB) =
726 | decoderBGen valA
727 | in
728 | decoderB aNode
729 |
730 | Err e ->
731 | Err e
732 |
733 |
734 | {-| Flipped `andThen`.
735 |
736 | Why do we want this? It allows us to write decoders in Cotinuation-Passing Style (CPS)!
737 |
738 | run
739 | (
740 | with (path ["string"] (single string)) <| \s ->
741 | with (path ["int"] (single int)) <| \i ->
742 | succeed ( s, i )
743 | )
744 | "string1"
745 | --> Ok ("string", 1)
746 |
747 | This style is being discussed in Elm community, and sometimes it makes sense to adopt one,
748 | especially when you are trying to decode complex data.
749 |
750 |
751 |
752 | - Although more verbose, it is explicit so you won't lost track of which decoder generates which value
753 | - It does not depends on `mapN` family, so you can easily add/remove fields (similar pros to pipeline style)
754 | - You can always use previously decoded values, so it is easy to construct value-dependent decoders.
755 | E.g. Data such that part of its decoder changes depends on values of `` tag
756 |
757 | This style is not yet formatted nicely by `elm-format` as of writing this,
758 | but the proposal is already filed!
759 |
760 |
761 |
762 | -}
763 | with : Decoder a -> (a -> Decoder b) -> Decoder b
764 | with d cont =
765 | andThen cont d
766 |
767 |
768 | {-| Transform a decoder.
769 |
770 | run (map String.length string) "string"
771 | --> Ok 6
772 |
773 | -}
774 | map : (a -> value) -> Decoder a -> Decoder value
775 | map valueGen decoder =
776 | Decoder (mapImpl valueGen decoder)
777 |
778 |
779 | mapImpl : (a -> value) -> Decoder a -> Node -> Result Error value
780 | mapImpl valueGen (Decoder decoder) aNode =
781 | aNode |> decoder |> Result.map valueGen
782 |
783 |
784 | {-| Generates a decoder that combines results from two decoders.
785 |
786 | It can be used for generating a decoder for a data type that takes two inputs.
787 | Also this is used as a building block of decoder composition helpers.
788 |
789 | run (map2 Tuple.pair string string) "string"
790 | --> Ok ( "string", "string" )
791 |
792 | -}
793 | map2 : (a -> b -> value) -> Decoder a -> Decoder b -> Decoder value
794 | map2 valueGen decoderA decoderB =
795 | Decoder (map2Impl valueGen decoderA decoderB)
796 |
797 |
798 | map2Impl : (a -> b -> value) -> Decoder a -> Decoder b -> Node -> Result Error value
799 | map2Impl valueGen (Decoder decoderA) (Decoder decoderB) aNode =
800 | Result.map2 valueGen (decoderA aNode) (decoderB aNode)
801 |
802 |
803 | {-| -}
804 | map3 : (a -> b -> c -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder value
805 | map3 toVal dA dB dC =
806 | Decoder (map3Impl toVal dA dB dC)
807 |
808 |
809 | map3Impl : (a -> b -> c -> value) -> Decoder a -> Decoder b -> Decoder c -> Node -> Result Error value
810 | map3Impl toVal (Decoder dA) (Decoder dB) (Decoder dC) aNode =
811 | Result.map3 toVal (dA aNode) (dB aNode) (dC aNode)
812 |
813 |
814 | {-| -}
815 | map4 : (a -> b -> c -> d -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder value
816 | map4 toVal dA dB dC dD =
817 | Decoder (map4Impl toVal dA dB dC dD)
818 |
819 |
820 | map4Impl : (a -> b -> c -> d -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Node -> Result Error value
821 | map4Impl toVal (Decoder dA) (Decoder dB) (Decoder dC) (Decoder dD) aNode =
822 | Result.map4 toVal (dA aNode) (dB aNode) (dC aNode) (dD aNode)
823 |
824 |
825 | {-| -}
826 | map5 :
827 | (a -> b -> c -> d -> e -> value)
828 | -> Decoder a
829 | -> Decoder b
830 | -> Decoder c
831 | -> Decoder d
832 | -> Decoder e
833 | -> Decoder value
834 | map5 toVal dA dB dC dD dE =
835 | Decoder (map5Impl toVal dA dB dC dD dE)
836 |
837 |
838 | map5Impl :
839 | (a -> b -> c -> d -> e -> value)
840 | -> Decoder a
841 | -> Decoder b
842 | -> Decoder c
843 | -> Decoder d
844 | -> Decoder e
845 | -> Node
846 | -> Result Error value
847 | map5Impl toVal (Decoder dA) (Decoder dB) (Decoder dC) (Decoder dD) (Decoder dE) aNode =
848 | Result.map5 toVal (dA aNode) (dB aNode) (dC aNode) (dD aNode) (dE aNode)
849 |
850 |
851 | {-| Equivalent to [`Json.Decode.Extra.andMap`][jdeam], allows writing XML decoders in sequential style.
852 |
853 | [jdeam]: http://package.elm-lang.org/packages/elm-community/json-extra/latest/Json-Decode-Extra#andMap
854 |
855 | run
856 | (succeed Tuple.pair
857 | |> andMap (path ["string"] (single string))
858 | |> andMap (path ["int"] (single int))
859 | )
860 | "string1"
861 | --> Ok ("string", 1)
862 |
863 | -}
864 | andMap : Decoder a -> Decoder (a -> b) -> Decoder b
865 | andMap =
866 | map2 (|>)
867 |
868 |
869 | {-| Generates a decoder that results in the default value on failure.
870 |
871 | run (withDefault 0 int) "1"
872 | --> Ok 1
873 |
874 | run (withDefault 0 int) "Non Int value"
875 | --> Ok 0
876 |
877 | -}
878 | withDefault : a -> Decoder a -> Decoder a
879 | withDefault default decoder =
880 | oneOf
881 | [ decoder
882 | , succeed default
883 | ]
884 |
885 |
886 | {-| Generates a decoder that results in a `Maybe` value.
887 |
888 | If the given decoder resulted in `Err`, it succeeds with `Nothing`.
889 | Otherwise (in cases of `Ok`,) it succeeds with `Just` value.
890 |
891 | run (maybe int) "1"
892 | --> Ok (Just 1)
893 |
894 | run (maybe int) "Non Int value"
895 | --> Ok Nothing
896 |
897 | -}
898 | maybe : Decoder a -> Decoder (Maybe a)
899 | maybe decoder =
900 | oneOf
901 | [ map Just decoder
902 | , succeed Nothing
903 | ]
904 |
905 |
906 | {-| Generates a lazy decoder.
907 |
908 | Similar to [`Json.Decode.lazy`][jdl].
909 |
910 | someRecordDecoder : Decoder SomeRecord
911 | someRecordDecoder =
912 | map2 SomeRecord
913 | (path [ "path", "to", "string", "value" ] (single string))
914 | (path [ "path", "to", "list", "of", "someRecord" ] (list (lazy (\_ -> someRecordDecoder))))
915 |
916 | With this, you can avoid "bad-recursion" error on compilation
917 | which happens when you define nested part of the above decoder as `(list someRecordDecoder)`
918 |
919 | [jdl]: http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode#lazy
920 |
921 | -}
922 | lazy : (() -> Decoder a) -> Decoder a
923 | lazy =
924 | \a -> andThen a (succeed ())
925 |
926 |
927 |
928 | -- NODE LOCATER
929 |
930 |
931 | {-| Generates a [`Decoder`](#Decoder) that applies a [`ListDecoder`](#ListDecoder) at specified XML path.
932 |
933 | Typical usage:
934 |
935 | someRecordDecoder : Decoder SomeRecord
936 | someRecordDecoder =
937 | map2 SomeRecord
938 | (path [ "string", "value" ] (single string))
939 | (path [ "int", "values" ] (list int))
940 |
941 | Due to the nature of XML, you cannot distinguish a particular tag or tags hold
942 | whether "singular value" or "list of values", from the structure of XML document itself.
943 | This is opposite to JSON, where there can be only one field of a paticular key in a level,
944 | and its quantization is obvious from the shape of the value.
945 |
946 | For this reason, this function always produce list of [`XmlParser.Node`][xpn]s.
947 | Then they must be decoded using special decoder parts: [`ListDecoder`](#ListDecoder).
948 | In the above example, [`single`](#single) and [`list`](#list) are [`ListDecoder`](#ListDecoder) generators.
949 |
950 | [xpn]: http://package.elm-lang.org/packages/jinjor/elm-xml-parser/latest/XmlParser#Node
951 |
952 | It collects ALL nodes matching the path in breadth-first manner.
953 | If you need to collect nodes only from a specific intermediate node that fulfills some conditions,
954 | (e.g. `path [ "a", "b" ]`, but only in 3rd `"..."`)
955 | you need to split the path and explicitly define a Decoder that narrows down the path.
956 | Be careful not to accidentally include nodes from not-targeted ancestors.
957 |
958 | Note that in the path, you must "start" at the root scope.
959 | For instance, to work with an XML document like:
960 |
961 |
962 |
963 |
964 | Value
965 |
966 |
967 |
968 |
969 | You should specify:
970 |
971 | path [ "Path", "Target" ] (single string)
972 |
973 | Basic usages:
974 |
975 | run (path [ "tag", "nested" ] (single string)) "string1"
976 | --> Ok "string1"
977 |
978 | run (path [ "tag", "nested" ] (list string)) "string1string2"
979 | --> Ok [ "string1", "string2" ]
980 |
981 | run (path [ "tag", "nested" ] (single (stringAttr "value"))) ""
982 | --> Ok "attr1"
983 |
984 | Decoders will report errors with path at which error happened as well as nearest node:
985 |
986 | run (path [ "tag", "nested" ] (single int)) "string1"
987 | --> Err "Path: /tag/nested\nNode: string1\ncould not convert string 'string1' to an Int"
988 |
989 | -}
990 | path : List String -> ListDecoder a -> Decoder a
991 | path path_ listDecoder =
992 | Decoder (pathImpl path_ listDecoder)
993 |
994 |
995 | pathImpl : List String -> ListDecoder a -> Node -> Result Error a
996 | pathImpl path_ (ListDecoder listDecoder) aNode =
997 | aNode
998 | |> children
999 | |> query path_ aNode
1000 | |> listDecoder
1001 | |> Result.mapError (concatPath path_)
1002 |
1003 |
1004 | children : Node -> List Node
1005 | children aNode =
1006 | case aNode of
1007 | Element _ _ nodes ->
1008 | nodes
1009 |
1010 | Text _ ->
1011 | []
1012 |
1013 |
1014 | query : List String -> Node -> List Node -> ( List Node, Node )
1015 | query path_ ancestor collected =
1016 | case path_ of
1017 | [] ->
1018 | ( collected, ancestor )
1019 |
1020 | [ segment ] ->
1021 | -- This clause is necessary in order to keep "empty" node as is, like "".
1022 | -- Without special care, such nodes are silently eliminated by `List.concatMap children`.
1023 | ( List.filter (hasName segment) collected, ancestor )
1024 |
1025 | segment :: ss ->
1026 | case List.filter (hasName segment) collected of
1027 | [] ->
1028 | -- It is pointless to dig any deeper
1029 | ( [], ancestor )
1030 |
1031 | [ onlyOne ] ->
1032 | -- This is the only node that produced path-matching element,
1033 | -- effectively "narrowing down" pathfinding context for more consice error messages
1034 | query ss onlyOne (children onlyOne)
1035 |
1036 | many ->
1037 | query ss ancestor (List.concatMap children many)
1038 |
1039 |
1040 | hasName : String -> Node -> Bool
1041 | hasName name aNode =
1042 | case aNode of
1043 | Element nodeName _ _ ->
1044 | name == nodeName
1045 |
1046 | Text _ ->
1047 | False
1048 |
1049 |
1050 | concatPath : List String -> Error -> Error
1051 | concatPath path_ error =
1052 | case error of
1053 | Path innerPath innerError ->
1054 | Path (path_ ++ innerPath) innerError
1055 |
1056 | otherwise ->
1057 | Path path_ otherwise
1058 |
1059 |
1060 |
1061 | -- PIPELINE APIS
1062 |
1063 |
1064 | {-| Decodes value at required XML path.
1065 |
1066 | pipelineDecoder : Decoder ( String, List Int )
1067 | pipelineDecoder =
1068 | succeed Tuple.pair
1069 | |> requiredPath [ "path", "to", "string", "value" ] (single string)
1070 | |> requiredPath [ "path", "to", "int", "values" ] (list int)
1071 |
1072 | run pipelineDecoder
1073 | """
1074 |
1075 |
1076 |
1077 |
1078 | SomeString
1079 |
1080 |
1081 | 1
1082 | 2
1083 |
1084 |
1085 |
1086 |
1087 | """
1088 | --> Ok ( "SomeString", [ 1, 2 ] )
1089 |
1090 | -}
1091 | requiredPath : List String -> ListDecoder a -> Decoder (a -> b) -> Decoder b
1092 | requiredPath path_ listDecoderA =
1093 | map2 (|>) (path path_ listDecoderA)
1094 |
1095 |
1096 | {-| Tries to decode value at optional XML path. Uses default value if the node is missing.
1097 |
1098 | decoderWithDefault : Decoder String
1099 | decoderWithDefault =
1100 | succeed identity
1101 | |> optionalPath [ "optional", "path" ] (single string) "default"
1102 |
1103 | run decoderWithDefault "string"
1104 | --> Ok "string"
1105 |
1106 | run decoderWithDefault ""
1107 | --> Ok "default"
1108 |
1109 | -}
1110 | optionalPath : List String -> ListDecoder a -> a -> Decoder (a -> b) -> Decoder b
1111 | optionalPath path_ listDecoderA default =
1112 | map2 (|>) (withDefault default (path path_ listDecoderA))
1113 |
1114 |
1115 | {-| Decodes value at possible XML path into `Maybe` value.
1116 |
1117 | maybeDecoder : Decoder (Maybe String)
1118 | maybeDecoder =
1119 | succeed identity
1120 | |> possiblePath [ "possible", "path" ] (single string)
1121 |
1122 | run maybeDecoder "string"
1123 | --> Ok (Just "string")
1124 |
1125 | run maybeDecoder ""
1126 | --> Ok Nothing
1127 |
1128 | If you want to apply default value when the node is missing, use [`optionalPath`](#optionalPath).
1129 |
1130 | -}
1131 | possiblePath : List String -> ListDecoder a -> Decoder (Maybe a -> b) -> Decoder b
1132 | possiblePath path_ listDecoderA =
1133 | map2 (|>) (maybe (path path_ listDecoderA))
1134 |
1135 |
1136 |
1137 | -- ERROR UTILITY
1138 |
1139 |
1140 | {-| Convert [`Error`](#Error) to a formatted string.
1141 | -}
1142 | errorToString : Error -> String
1143 | errorToString error =
1144 | errorToRows error |> String.join "\n"
1145 |
1146 |
1147 | errorToRows : Error -> List String
1148 | errorToRows error =
1149 | case error of
1150 | Path path_ innerError ->
1151 | ("Path: /" ++ String.join "/" path_) :: errorToRows innerError
1152 |
1153 | OneOf [] ->
1154 | [ "No decoders available." ]
1155 |
1156 | OneOf innerErrors ->
1157 | let
1158 | innerRows =
1159 | innerErrors |> List.indexedMap genChildRows |> List.concat
1160 |
1161 | genChildRows outerIndex =
1162 | errorToRows >> List.indexedMap (indentRow (outerIndex + 1))
1163 |
1164 | indentRow outerIndex innerIndex row =
1165 | if innerIndex == 0 then
1166 | String.padLeft 2 ' ' (String.fromInt outerIndex) ++ ") " ++ row
1167 |
1168 | else
1169 | " " ++ row
1170 | in
1171 | "All decoders failed:" :: innerRows
1172 |
1173 | Failure problem aNode ->
1174 | [ "Node: " ++ formatNode aNode
1175 | , problem
1176 | ]
1177 |
--------------------------------------------------------------------------------