├── examples
├── app
│ ├── .gitignore
│ ├── posts.json
│ ├── index.html
│ ├── README.md
│ ├── elm-package.json
│ ├── src
│ │ ├── Data.elm
│ │ ├── Routes.elm
│ │ └── Main.elm
│ └── server.py
└── Custom.elm
├── tests
├── .gitignore
├── elm-package.json
└── Tests.elm
├── .gitignore
├── elm-package.json
├── CHANGELOG.md
├── .travis.yml
├── LICENSE
├── README.md
└── src
└── Route.elm
/examples/app/.gitignore:
--------------------------------------------------------------------------------
1 | /elm-stuff
2 | /elm.js
--------------------------------------------------------------------------------
/tests/.gitignore:
--------------------------------------------------------------------------------
1 | /elm-stuff
2 | elm.js
3 | index.html
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | /elm-stuff
2 | /elm.js
3 | /tests/elm-stuff
4 | /tests/tests.js
5 |
--------------------------------------------------------------------------------
/examples/app/posts.json:
--------------------------------------------------------------------------------
1 | [{"id": 1, "title": "First Post", "body": "This is the first post"},
2 | {"id": 2, "title": "Second Post", "body": "This is the second post"}]
3 |
--------------------------------------------------------------------------------
/examples/app/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | Route Example
4 |
5 |
6 |
7 |
8 |
9 |
10 |
--------------------------------------------------------------------------------
/examples/app/README.md:
--------------------------------------------------------------------------------
1 | # Example app
2 |
3 | This is a simple example demonstrating client-side routing using the
4 | `elm-route` parser. To run it locally do the following after cloning
5 | the repository:
6 |
7 | ``` shell
8 | $ elm make src/Main.elm --output=elm.js
9 | $ python3 server.py
10 | ```
11 |
12 | Visit http://localhost:8000 in your browser.
13 |
--------------------------------------------------------------------------------
/elm-package.json:
--------------------------------------------------------------------------------
1 | {
2 | "version": "1.0.1",
3 | "summary": "A route parsing library",
4 | "repository": "https://github.com/elm-community/elm-route.git",
5 | "license": "BSD3",
6 | "source-directories": [
7 | "examples",
8 | "src"
9 | ],
10 | "exposed-modules": [
11 | "Route"
12 | ],
13 | "dependencies": {
14 | "Bogdanp/elm-combine": "3.0.0 <= v < 4.0.0",
15 | "elm-lang/core": "5.0.0 <= v < 6.0.0"
16 | },
17 | "elm-version": "0.18.0 <= v < 0.19.0"
18 | }
19 |
--------------------------------------------------------------------------------
/tests/elm-package.json:
--------------------------------------------------------------------------------
1 | {
2 | "version": "1.0.0",
3 | "summary": "helpful summary of your project, less than 80 characters",
4 | "repository": "https://github.com/user/project.git",
5 | "license": "BSD3",
6 | "source-directories": [
7 | ".",
8 | "../src"
9 | ],
10 | "exposed-modules": [],
11 | "dependencies": {
12 | "Bogdanp/elm-combine": "3.0.0 <= v < 4.0.0",
13 | "elm-community/elm-test": "4.0.0 <= v < 5.0.0",
14 | "elm-lang/core": "5.0.0 <= v < 6.0.0"
15 | },
16 | "elm-version": "0.18.0 <= v < 0.19.0"
17 | }
18 |
--------------------------------------------------------------------------------
/examples/app/elm-package.json:
--------------------------------------------------------------------------------
1 | {
2 | "version": "1.0.0",
3 | "summary": "elm-route example app",
4 | "repository": "https://github.com/Bogdanp/elm-route.git",
5 | "license": "BSD3",
6 | "source-directories": [
7 | "src"
8 | ],
9 | "exposed-modules": [],
10 | "dependencies": {
11 | "Bogdanp/elm-route": "4.0.0 <= v < 5.0.0",
12 | "elm-lang/core": "5.0.0 <= v < 6.0.0",
13 | "elm-lang/html": "2.0.0 <= v < 3.0.0",
14 | "elm-lang/navigation": "2.0.0 <= v < 3.0.0",
15 | "elm-lang/http": "1.0.0 <= v < 2.0.0"
16 | },
17 | "elm-version": "0.18.0 <= v < 0.19.0"
18 | }
19 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # elm-route changelog
2 |
3 | ## elm-route 4.0.0 (TBD)
4 |
5 | ### Changes
6 |
7 | * Upgraded to Elm 0.18
8 | * `Route.QueryString` has been extracted into its own package: `Bogdanp/elm-querystring`
9 | * `map` has been removed
10 |
11 | ## elm-route 2.0.1 (2016-05-11)
12 |
13 | ### Changes
14 |
15 | * Upgraded to Elm 0.17
16 |
17 | ## elm-route 2.0.0 (2016-03-20)
18 |
19 | ### Changes
20 |
21 | * Merged `Route` and `RouteComponent` types to improve composability of `Route`s
22 |
23 | ### Upgrading
24 |
25 | * Replace all instances of `RouteComponent` with `Route` in your code
26 |
27 | ## elm-route 1.1.0 (2016-02-28)
28 |
29 | ### Additions
30 |
31 | * Added `Route.QueryString` module
32 |
--------------------------------------------------------------------------------
/examples/app/src/Data.elm:
--------------------------------------------------------------------------------
1 | module Data exposing (Post, fetchPosts, lookupPost)
2 |
3 | import Http
4 | import Json.Decode as JD exposing (Decoder, int, string)
5 | import Task exposing (Task)
6 |
7 |
8 | type alias Post =
9 | { id : Int
10 | , title : String
11 | , body : String
12 | }
13 |
14 |
15 | lookupPost : Int -> List Post -> Maybe Post
16 | lookupPost id posts =
17 | List.filter (\p -> p.id == id) posts
18 | |> List.head
19 |
20 |
21 | posts : Decoder (List Post)
22 | posts =
23 | let
24 | post =
25 | JD.map3 Post
26 | (JD.field "id" int)
27 | (JD.field "title" string)
28 | (JD.field "body" string)
29 | in
30 | JD.list post
31 |
32 |
33 | fetchPosts : Task Http.Error (List Post)
34 | fetchPosts =
35 | Http.get "/api/posts" posts
36 | |> Http.toTask
37 |
--------------------------------------------------------------------------------
/examples/app/server.py:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env python3
2 | from http.server import HTTPServer, BaseHTTPRequestHandler
3 | from time import sleep
4 |
5 |
6 | class Handler(BaseHTTPRequestHandler):
7 | def serve_file(self, filename, content_type="text/html"):
8 | self.send_response(200)
9 | self.send_header("Content-type", content_type)
10 | self.end_headers()
11 |
12 | with open(filename, "rb") as f:
13 | self.wfile.write(f.read())
14 |
15 | def do_GET(self):
16 | if self.path == "/api/posts":
17 | sleep(1)
18 | return self.serve_file("posts.json", "application/json")
19 | if self.path == "/elm.js":
20 | return self.serve_file("elm.js", "application/javascript")
21 | return self.serve_file("index.html")
22 |
23 | print("Listening on port 8000...")
24 | httpd = HTTPServer(("", 8000), Handler)
25 | httpd.serve_forever()
26 |
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | language: node_js
2 | node_js:
3 | - "7"
4 |
5 |
6 | cache:
7 | directories:
8 | - elm-stuff/build-artifacts
9 | - elm-stuff/packages
10 | - sysconfcpus
11 | os:
12 | - linux
13 |
14 |
15 | before_install:
16 | - echo -e "Host github.com\n\tStrictHostKeyChecking no\n" >> ~/.ssh/config
17 |
18 | install:
19 | - npm install -g elm elm-test
20 | - |
21 | if [ ! -d sysconfcpus/bin ];
22 | then
23 | git clone https://github.com/obmarg/libsysconfcpus.git;
24 | cd libsysconfcpus;
25 | ./configure --prefix=$TRAVIS_BUILD_DIR/sysconfcpus;
26 | make && make install;
27 | cd ..;
28 | fi
29 |
30 |
31 | before_script:
32 | - $TRAVIS_BUILD_DIR/sysconfcpus/bin/sysconfcpus -n 2 elm-make --yes src/Route.elm
33 | - cd tests && $TRAVIS_BUILD_DIR/sysconfcpus/bin/sysconfcpus -n 2 elm-make --yes Tests.elm && cd ..
34 |
35 | script:
36 | - $TRAVIS_BUILD_DIR/sysconfcpus/bin/sysconfcpus -n 2 elm-test
37 |
--------------------------------------------------------------------------------
/examples/app/src/Routes.elm:
--------------------------------------------------------------------------------
1 | module Routes exposing (Sitemap(..), parsePath, navigateTo, toString)
2 |
3 | import Navigation exposing (Location)
4 | import Route exposing (..)
5 |
6 |
7 | type Sitemap
8 | = HomeR
9 | | PostsR
10 | | PostR Int
11 | | AboutR
12 | | NotFoundR
13 |
14 |
15 | homeR =
16 | HomeR := static ""
17 |
18 |
19 | postsR =
20 | PostsR := static "posts"
21 |
22 |
23 | postR =
24 | PostR := static "posts" int
25 |
26 |
27 | aboutR =
28 | AboutR := static "about"
29 |
30 |
31 | sitemap =
32 | router [ homeR, postsR, postR, aboutR ]
33 |
34 |
35 | match : String -> Sitemap
36 | match =
37 | Route.match sitemap
38 | >> Maybe.withDefault NotFoundR
39 |
40 |
41 | toString : Sitemap -> String
42 | toString r =
43 | case r of
44 | HomeR ->
45 | reverse homeR []
46 |
47 | PostsR ->
48 | reverse postsR []
49 |
50 | PostR id ->
51 | reverse postR [ Basics.toString id ]
52 |
53 | AboutR ->
54 | reverse aboutR []
55 |
56 | NotFoundR ->
57 | Debug.crash "cannot render NotFound"
58 |
59 |
60 | parsePath : Location -> Sitemap
61 | parsePath =
62 | .pathname >> match
63 |
64 |
65 | navigateTo : Sitemap -> Cmd msg
66 | navigateTo =
67 | toString >> Navigation.newUrl
68 |
--------------------------------------------------------------------------------
/examples/Custom.elm:
--------------------------------------------------------------------------------
1 | module Custom exposing (Category(..), Sitemap(..), match, route)
2 |
3 | {-| This module demonstrates how you can use custom parsers to parse
4 | paths. This example parses routes like `/categories/snippet` and
5 | `/categories/post/5` into `CategoryR Snippet` and `CategoryR (Post 5)`,
6 | respectively.
7 | -}
8 |
9 | import Combine exposing (..)
10 | import Combine.Num
11 | import Route exposing (..)
12 |
13 |
14 | type Category
15 | = Snippet
16 | | Post Int
17 |
18 |
19 | category : Parser s Category
20 | category =
21 | choice
22 | [ Snippet <$ Combine.string "snippet"
23 | , Post <$> (Combine.string "post/" *> Combine.Num.int)
24 | ]
25 |
26 |
27 | show : Category -> String
28 | show c =
29 | case c of
30 | Snippet ->
31 | "snippet"
32 |
33 | Post id ->
34 | "post/" ++ Basics.toString id
35 |
36 |
37 | type Sitemap
38 | = CategoryR Category
39 |
40 |
41 | categoryR =
42 | CategoryR := static "categories" custom category
43 |
44 |
45 | sitemap : Router Sitemap
46 | sitemap =
47 | router [ categoryR ]
48 |
49 |
50 | match : String -> Maybe Sitemap
51 | match =
52 | Route.match sitemap
53 |
54 |
55 | route : Sitemap -> String
56 | route r =
57 | case r of
58 | CategoryR c ->
59 | reverse categoryR [ show c ]
60 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2016, Bogdan Paul Popa
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
7 | notice, this list of conditions and the following disclaimer.
8 | * Redistributions in binary form must reproduce the above copyright
9 | notice, this list of conditions and the following disclaimer in the
10 | documentation and/or other materials provided with the distribution.
11 | * Neither the name of the nor the
12 | names of its contributors may be used to endorse or promote products
13 | derived from this software 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.
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # elm-route [](https://travis-ci.org/elm-community/elm-route)
2 |
3 | ``` shell
4 | elm package install elm-community/elm-route
5 | ```
6 |
7 | This library defines functions for constructing route parsers. See
8 | the documentation of the [Route][route] module for more information.
9 | A full example is available at `examples/app`.
10 |
11 | ## Usage
12 |
13 | First define your routes:
14 |
15 | ```elm
16 | module App.Routes exposing ( Route(..), match, route )
17 |
18 | import Route exposing (..)
19 |
20 | type Route
21 | = Home
22 | | About
23 | | Users
24 | | User Int
25 | | UserPosts Int
26 | | UserPost Int String
27 | | NotFound
28 |
29 | home = Home := static ""
30 | about = About := static "about"
31 | users = Users := static "users"
32 | user = User := static "users" int
33 | userPosts = UserPosts := static "users" int static "posts"
34 | userPost = UserPost := static "users" int string
35 | routes = router [home, about, users, user, userPosts, userPost]
36 |
37 | match : String -> Maybe Route
38 | match = Route.match routes
39 |
40 | toString : Route -> String
41 | toString route =
42 | case route of
43 | Home -> reverse home []
44 | About -> reverse about []
45 | Users -> reverse users []
46 | User id -> reverse user [toString id]
47 | UserPosts id -> reverse userPosts [toString id]
48 | UserPost uid pid -> reverse userPost [toString uid, pid]
49 | NotFound -> Debug.crash "cannot route to NotFound"
50 | ```
51 |
52 | You may then use them to match routes:
53 |
54 | ```elm
55 | > import App.Routes as Routes exposing (Route(..), match)
56 |
57 | > match "/"
58 | Just Home : Maybe Route
59 |
60 | > match "/users"
61 | Just Users : Maybe Route
62 |
63 | > match "/i-dont-exist"
64 | Nothing : Maybe Route
65 |
66 | > match "/users/a"
67 | Nothing : Maybe Route
68 |
69 | > match "/users/1"
70 | Just (User 1) : Maybe Route
71 |
72 | > match "/users/1/hello-world"
73 | Just (UserPost 1 "hello-world") : Maybe Route
74 | ```
75 |
76 | And to convert routes to strings:
77 |
78 | ```elm
79 | > import App.Routes as Routes
80 |
81 | > Routes.toString Home
82 | "/" : String
83 |
84 | > Routes.toString About
85 | "/about" : String
86 |
87 | > Routes.toString (UserPost 1 "hello")
88 | "/users/1/hello" : String
89 | ```
90 |
91 | To use it with [Navigation][nav], define `match` in terms of `Location`
92 |
93 | ``` elm
94 | match : Location -> Route
95 | match location =
96 | location.pathname
97 | |> Routes.match routes
98 | |> Maybe.withDefault NotFound
99 | ```
100 |
101 | then use it in your `Program`:
102 |
103 | ``` elm
104 | import App.Routes as Routes
105 | import Navigation exposing (Location)
106 |
107 | type Msg
108 | = ChangeRoute Route
109 |
110 | parseRoute : Location -> Msg
111 | parseRoute =
112 | Routes.match >> ChangeRoute
113 |
114 | main : Program Never Model Msg
115 | main =
116 | Navigation.program parseRoute
117 | { init = init
118 | , update = update
119 | , view = view
120 | , subscriptions = subscriptions
121 | }
122 | ```
123 |
124 | See the `examples` directory and `tests/Tests.elm` for more.
125 |
126 |
127 | [route]: http://package.elm-lang.org/packages/elm-community/elm-route/latest/Route
128 | [nav]: http://package.elm-lang.org/packages/elm-lang/navigation/latest
129 |
--------------------------------------------------------------------------------
/examples/app/src/Main.elm:
--------------------------------------------------------------------------------
1 | module Main exposing (main)
2 |
3 | import Data exposing (Post)
4 | import Html as H exposing (Html)
5 | import Html.Attributes as A
6 | import Html.Events as E
7 | import Http
8 | import Json.Decode as JD
9 | import Navigation exposing (Location)
10 | import Routes exposing (Sitemap(..))
11 | import Task
12 |
13 |
14 | -- Update
15 | -- ------
16 |
17 |
18 | type alias Model =
19 | { route : Sitemap
20 | , ready : Bool
21 | , posts : List Post
22 | , post : Maybe Post
23 | , error : Maybe String
24 | }
25 |
26 |
27 | type Msg
28 | = RouteChanged Sitemap
29 | | RouteTo Sitemap
30 | | Fetch (Result Http.Error (List Post))
31 |
32 |
33 | parseRoute : Location -> Msg
34 | parseRoute =
35 | Routes.parsePath >> RouteChanged
36 |
37 |
38 | init : Location -> ( Model, Cmd Msg )
39 | init location =
40 | let
41 | route =
42 | Routes.parsePath location
43 | in
44 | handleRoute route
45 | { route = route
46 | , ready = False
47 | , posts = []
48 | , post = Nothing
49 | , error = Nothing
50 | }
51 |
52 |
53 | update : Msg -> Model -> ( Model, Cmd Msg )
54 | update msg model =
55 | case msg of
56 | RouteChanged route ->
57 | handleRoute route model
58 |
59 | RouteTo route ->
60 | model ! [ Routes.navigateTo route ]
61 |
62 | Fetch (Err error) ->
63 | { model | error = Just (toString error) } ! []
64 |
65 | Fetch (Ok posts) ->
66 | handleRoute model.route
67 | { model
68 | | ready = True
69 | , error = Nothing
70 | , posts = posts
71 | }
72 |
73 |
74 | handleRoute : Sitemap -> Model -> ( Model, Cmd Msg )
75 | handleRoute route ({ ready } as m) =
76 | let
77 | model =
78 | { m | route = route }
79 | in
80 | case route of
81 | PostsR ->
82 | if ready then
83 | model ! []
84 | else
85 | model ! [ fetchPosts ]
86 |
87 | PostR id ->
88 | if ready then
89 | { model | post = Data.lookupPost id model.posts } ! []
90 | else
91 | model ! [ fetchPosts ]
92 |
93 | _ ->
94 | model ! []
95 |
96 |
97 | fetchPosts : Cmd Msg
98 | fetchPosts =
99 | Task.attempt Fetch Data.fetchPosts
100 |
101 |
102 | subscriptions : Model -> Sub Msg
103 | subscriptions model =
104 | Sub.none
105 |
106 |
107 |
108 | -- View
109 | -- ----
110 |
111 |
112 | notFound : Html Msg
113 | notFound =
114 | H.h1 [] [ H.text "Page not found" ]
115 |
116 |
117 | home : Html Msg
118 | home =
119 | H.div []
120 | [ H.h1 [] [ H.text "Home Page" ]
121 | , H.p [] [ link (PostR 123) "This post does not exist" ]
122 | ]
123 |
124 |
125 | about : Html Msg
126 | about =
127 | H.h1 [] [ H.text "About" ]
128 |
129 |
130 | loading : Html Msg
131 | loading =
132 | H.h1 [] [ H.text "Loading..." ]
133 |
134 |
135 | post : Data.Post -> Html Msg
136 | post post =
137 | H.div []
138 | [ H.h1 [] [ H.text post.title ]
139 | , H.p [] [ H.text post.body ]
140 | ]
141 |
142 |
143 | posts : List Data.Post -> Html Msg
144 | posts posts =
145 | let
146 | postLink post =
147 | H.li [] [ link (PostR post.id) post.title ]
148 | in
149 | H.div []
150 | [ H.h1 [] [ H.text "Posts" ]
151 | , H.ul [] (List.map postLink posts)
152 | ]
153 |
154 |
155 | view : Model -> Html Msg
156 | view model =
157 | H.div []
158 | [ nav
159 | , content model
160 | ]
161 |
162 |
163 | nav : Html Msg
164 | nav =
165 | H.ul []
166 | [ H.li [] [ link HomeR "Home" ]
167 | , H.li [] [ link PostsR "Posts" ]
168 | , H.li [] [ link AboutR "About" ]
169 | ]
170 |
171 |
172 | content : Model -> Html Msg
173 | content ({ route } as model) =
174 | case model.route of
175 | HomeR ->
176 | home
177 |
178 | PostsR ->
179 | if model.ready then
180 | posts model.posts
181 | else
182 | loading
183 |
184 | PostR id ->
185 | case ( model.ready, model.post ) of
186 | ( False, _ ) ->
187 | loading
188 |
189 | ( True, Nothing ) ->
190 | notFound
191 |
192 | ( True, Just p ) ->
193 | post p
194 |
195 | AboutR ->
196 | about
197 |
198 | NotFoundR ->
199 | notFound
200 |
201 |
202 | link : Sitemap -> String -> Html Msg
203 | link route label =
204 | let
205 | opts =
206 | { preventDefault = True, stopPropagation = True }
207 | in
208 | H.a
209 | [ A.href (Routes.toString route)
210 | , E.onWithOptions "click" opts (JD.succeed <| RouteTo route)
211 | ]
212 | [ H.text label ]
213 |
214 |
215 |
216 | -- Main
217 | -- ----
218 |
219 |
220 | main : Program Never Model Msg
221 | main =
222 | Navigation.program parseRoute
223 | { init = init
224 | , update = update
225 | , view = view
226 | , subscriptions = subscriptions
227 | }
228 |
--------------------------------------------------------------------------------
/tests/Tests.elm:
--------------------------------------------------------------------------------
1 | module Tests exposing (..)
2 |
3 | import Combine exposing ((<$))
4 | import Expect
5 | import Fuzz exposing (Fuzzer, tuple, tuple3)
6 | import Route exposing (..)
7 | import String
8 | import Test exposing (..)
9 |
10 |
11 | type Sitemap
12 | = Home
13 | | Users
14 | | User Int
15 | | UserEmails Int
16 | | UserEmail Int Int
17 | | Deep Int Int Int
18 | | CustomR Foo
19 |
20 |
21 | type Foo
22 | = Foo
23 | | Bar
24 |
25 |
26 | fooP =
27 | Combine.choice
28 | [ Foo <$ Combine.string "Foo"
29 | , Bar <$ Combine.string "Bar"
30 | ]
31 |
32 |
33 | homeR : Route Sitemap
34 | homeR =
35 | Home := static ""
36 |
37 |
38 | usersR : Route Sitemap
39 | usersR =
40 | Users := static "users"
41 |
42 |
43 | userR : Route Sitemap
44 | userR =
45 | User := static "users" int
46 |
47 |
48 | userEmailsR : Route Sitemap
49 | userEmailsR =
50 | UserEmails := static "users" int static "emails"
51 |
52 |
53 | userEmailR : Route Sitemap
54 | userEmailR =
55 | UserEmail := static "users" int static "emails" int
56 |
57 |
58 | deepR : Route Sitemap
59 | deepR =
60 | Deep := static "deep" int int int
61 |
62 |
63 | customR : Route Sitemap
64 | customR =
65 | CustomR := static "custom" custom fooP
66 |
67 |
68 | routes : Router Sitemap
69 | routes =
70 | router
71 | [ homeR
72 | , usersR
73 | , userR
74 | , userEmailsR
75 | , userEmailR
76 | , deepR
77 | , customR
78 | ]
79 |
80 |
81 | render : Sitemap -> String
82 | render r =
83 | case r of
84 | Home ->
85 | reverse homeR []
86 |
87 | Users ->
88 | reverse usersR []
89 |
90 | User id ->
91 | reverse userR [ toString id ]
92 |
93 | UserEmails id ->
94 | reverse userEmailsR [ toString id ]
95 |
96 | UserEmail uid eid ->
97 | reverse userEmailR [ toString uid, toString eid ]
98 |
99 | Deep x y z ->
100 | reverse deepR [ toString x, toString y, toString z ]
101 |
102 | CustomR x ->
103 | reverse customR [ toString x ]
104 |
105 |
106 | ints1 : Fuzzer Int
107 | ints1 =
108 | Fuzz.int
109 |
110 |
111 | ints2 : Fuzzer ( Int, Int )
112 | ints2 =
113 | tuple ( Fuzz.int, Fuzz.int )
114 |
115 |
116 | ints3 : Fuzzer ( Int, Int, Int )
117 | ints3 =
118 | tuple3 ( Fuzz.int, Fuzz.int, Fuzz.int )
119 |
120 |
121 | matching : Test
122 | matching =
123 | let
124 | equal x path _ =
125 | Expect.equal x (match routes path)
126 |
127 | matches =
128 | Just >> equal
129 |
130 | matches_ x path =
131 | matches x path ()
132 |
133 | fails =
134 | equal Nothing
135 | in
136 | describe "match"
137 | [ test
138 | "fails to match on parse failure"
139 | (fails "/users/a")
140 | , test
141 | "fails to match on custom parse failure"
142 | (fails "/custom/abc")
143 | , test
144 | "fails to match nonexistent paths"
145 | (fails "/i-dont-exist")
146 | , test
147 | "matches the root path"
148 | (matches Home "/")
149 | , test
150 | "matches static paths"
151 | (matches Users "/users")
152 | , test
153 | "matches custom ADT routes - Foo constructor"
154 | (matches (CustomR Foo) "/custom/Foo")
155 | , test
156 | "matches custom ADT routes - Bar constructor"
157 | (matches (CustomR Bar) "/custom/Bar")
158 | , fuzz ints1
159 | "matches one dynamic segment"
160 | (\x -> matches_ (User x) ("/users/" ++ toString x))
161 | , fuzz ints1
162 | "matches one suffixed dynamic segment"
163 | (\x -> matches_ (UserEmails x) ("/users/" ++ toString x ++ "/emails"))
164 | , fuzz ints2
165 | "matches two dynamic segments around a static segment"
166 | (\( x, y ) -> matches_ (UserEmail x y) ("/users/" ++ toString x ++ "/emails/" ++ toString y))
167 | , fuzz ints3
168 | "matches many dynamic segments"
169 | (\( x, y, z ) -> matches_ (Deep x y z) ("/deep/" ++ String.join "/" (List.map toString [ x, y, z ])))
170 | ]
171 |
172 |
173 | reversing : Test
174 | reversing =
175 | let
176 | compare parts route params _ =
177 | Expect.equal
178 | ("/" ++ String.join "/" parts)
179 | (reverse route params)
180 | in
181 | describe "reverse"
182 | [ test
183 | "reverses the root route"
184 | (compare [] homeR [])
185 | , test
186 | "reverses custom routes"
187 | (\x -> compare [ "custom", "Foo" ] customR [ "Foo" ] ())
188 | , fuzz ints1
189 | "reverses dynamic routes"
190 | (\x -> compare [ "users", toString x ] userR [ toString x ] ())
191 | ]
192 |
193 |
194 | rendering : Test
195 | rendering =
196 | let
197 | compare parts route _ =
198 | Expect.equal
199 | ("/" ++ String.join "/" parts)
200 | (render route)
201 | in
202 | describe "render"
203 | [ test
204 | "renders the root route"
205 | (compare [] Home)
206 | , test
207 | "renders static routes"
208 | (compare [ "users" ] Users)
209 | , test
210 | "renders custom parser routes"
211 | (compare [ "custom", "Foo" ] (CustomR Foo))
212 | , fuzz ints1
213 | "renders dynamic routes"
214 | (\x -> compare [ "users", toString x ] (User x) ())
215 | , fuzz ints3
216 | "renders deep dynamic routes"
217 | (\( x, y, z ) -> compare [ "deep", toString x, toString y, toString z ] (Deep x y z) ())
218 | ]
219 |
220 |
221 | all : Test
222 | all =
223 | describe "elm-route"
224 | [ matching
225 | , reversing
226 | , rendering
227 | ]
228 |
--------------------------------------------------------------------------------
/src/Route.elm:
--------------------------------------------------------------------------------
1 | module Route
2 | exposing
3 | ( Router
4 | , Route
5 | , route
6 | , (:=)
7 | , router
8 | , match
9 | , reverse
10 | , static
11 | , custom
12 | , string
13 | , int
14 | , and
15 | , ()
16 | )
17 |
18 | {-| This module exposes combinators for creating route parsers.
19 |
20 | @docs Route, Router
21 |
22 | ## Routing
23 | @docs route, (:=), router, match, reverse
24 |
25 | ## Route combinators
26 | @docs static, custom, string, int, and, ()
27 | -}
28 |
29 | import Combine exposing (..)
30 | import Combine.Num
31 | import String
32 |
33 |
34 | type Component
35 | = CStatic String
36 | | CCustom (String -> Result String ())
37 | | CString
38 | | CInt
39 |
40 |
41 | {-| Routes represent concrete parsers for paths. Routes can be combined
42 | and they keep track of their path components in order to provide
43 | automatic reverse routing.
44 | -}
45 | type Route a
46 | = Route
47 | { parser : Parser () a
48 | , components : List Component
49 | }
50 |
51 |
52 | {-| A Router is, at its core, a List of Routes.
53 |
54 | sitemap : Router a
55 | sitemap = router [routeA, routeB]
56 |
57 | -}
58 | type Router a
59 | = Router (Parser () a)
60 |
61 |
62 | {-| Declare a Route.
63 |
64 | type Sitemap
65 | = HomeR
66 |
67 | homeR : Route Sitemap
68 | homeR = route HomeR (static "")
69 |
70 | -}
71 | route : a -> Route (a -> b) -> Route b
72 | route x (Route r) =
73 | Route
74 | { parser = r.parser >>= (\k -> Combine.succeed <| k x)
75 | , components = r.components
76 | }
77 |
78 |
79 | {-| A synonym for `route`.
80 |
81 | type Sitemap
82 | = HomeR
83 |
84 | homeR : Route Sitemap
85 | homeR = HomeR := static ""
86 |
87 | -}
88 | (:=) : a -> Route (a -> b) -> Route b
89 | (:=) =
90 | route
91 | infixl 7 :=
92 |
93 |
94 | {-| Construct a Router from a list of Routes.
95 |
96 | type Sitemap
97 | = HomeR
98 | | BlogR
99 |
100 | homeR = HomeR := static ""
101 | blogR = BlogR := static "blog"
102 | sitemap = router [homeR, blogR]
103 |
104 | -}
105 | router : List (Route a) -> Router a
106 | router rs =
107 | List.map (\(Route r) -> r.parser <* Combine.end) rs
108 | |> Combine.choice
109 | |> Router
110 |
111 |
112 | {-| Create a Route that matches a static String.
113 |
114 | type Sitemap
115 | = BlogR
116 |
117 | blogR = BlogR := static "blog"
118 | sitemap = router [blogR]
119 |
120 | > match sitemap "/blog"
121 | Just BlogR : Maybe Sitemap
122 |
123 | -}
124 | static : String -> Route (a -> a)
125 | static s =
126 | Route
127 | { parser = identity <$ Combine.string s
128 | , components = [ CStatic s ]
129 | }
130 |
131 |
132 | {-| Create a Route with a custom Parser.
133 |
134 | import Combine exposing (..)
135 | import Combine.Infix exposing (..)
136 |
137 | type Category
138 | = Snippet
139 | | Post Int
140 |
141 | type Sitemap
142 | = CategoryR Category
143 |
144 | categoryR = CategoryR := static "categories" custom categoryParser
145 | sitemap = router [categoryR]
146 |
147 | > match sitemap "/categories/a"
148 | Nothing : Maybe Sitemap
149 |
150 | > match sitemap "/categories/Post/5"
151 | Just (CategoryR (Post 5)) : Maybe Sitemap
152 |
153 | > match sitemap "/categories/Snippet"
154 | Just (CategoryR Snippet) : Maybe Sitemap
155 |
156 | See `examples/Custom.elm` for a complete example.
157 |
158 | -}
159 | custom : Parser () a -> Route ((a -> b) -> b)
160 | custom p =
161 | let
162 | validator s =
163 | case Combine.parse p s of
164 | Ok _ ->
165 | Ok ()
166 |
167 | Err ( _, _, ms ) ->
168 | Err (String.join " or " ms)
169 | in
170 | Route
171 | { parser = (|>) <$> p
172 | , components = [ CCustom validator ]
173 | }
174 |
175 |
176 | {-| A Route that matches any string.
177 |
178 | type Sitemap
179 | = PostR String
180 |
181 | postR = PostR := static "posts" string
182 | sitemap = router [postR]
183 |
184 | > match sitemap "/posts/"
185 | Nothing : Maybe Sitemap
186 |
187 | > match sitemap "/posts/hello-world/test"
188 | Nothing : Maybe Sitemap
189 |
190 | > match sitemap "/posts/hello-world"
191 | Just (PostR "hello-world") : Maybe Sitemap
192 |
193 | -}
194 | string : Route ((String -> a) -> a)
195 | string =
196 | Route
197 | { parser = (|>) <$> Combine.regex "[^/]+"
198 | , components = [ CString ]
199 | }
200 |
201 |
202 | {-| A Route that matches any integer.
203 |
204 | type Sitemap
205 | = UserR Int
206 |
207 | userR = UserR := static "users" int
208 | sitemap = router [userR]
209 |
210 | > match sitemap "/users/a"
211 | Nothing : Maybe Sitemap
212 |
213 | > match sitemap "/users/1"
214 | Just (UserR 1) : Maybe Sitemap
215 |
216 | > match sitemap "/users/-1"
217 | Just (UserR -1) : Maybe Sitemap
218 |
219 | -}
220 | int : Route ((Int -> a) -> a)
221 | int =
222 | Route
223 | { parser = (|>) <$> Combine.Num.int
224 | , components = [ CInt ]
225 | }
226 |
227 |
228 | {-| Compose two Routes.
229 |
230 | type Sitemap
231 | = AddR Int Int
232 |
233 | addR = AddR := int `and` int
234 | sitemap = router [addR]
235 |
236 | > match sitemap "/1/2"
237 | Just (AddR 1 2) : Maybe Sitemap
238 |
239 | -}
240 | and : Route (a -> b) -> Route (b -> c) -> Route (a -> c)
241 | and (Route l) (Route r) =
242 | Route
243 | { parser = (>>) <$> l.parser <*> (Combine.string "/" *> r.parser)
244 | , components = l.components ++ r.components
245 | }
246 |
247 |
248 | {-| A synonym for `and`.
249 |
250 | type Sitemap
251 | = AddR Int Int
252 |
253 | addR = AddR := int int
254 | sitemap = router [addR]
255 |
256 | > match sitemap "/1/2"
257 | Just (AddR 1 2) : Maybe Sitemap
258 |
259 | -}
260 | () : Route (a -> b) -> Route (b -> c) -> Route (a -> c)
261 | () =
262 | and
263 | infixl 8
264 |
265 |
266 | {-| Given a Router and an arbitrary String representing a path, this
267 | function will return the first Route that matches that path.
268 |
269 | type Sitemap
270 | = HomeR
271 | | UsersR
272 | | UserR Int
273 |
274 | homeR = HomeR := static ""
275 | usersR = UsersR := static "users"
276 | usersR = UserR := static "users" int
277 | sitemap = router [homeR, userR, usersR]
278 |
279 | > match sitemap "/a"
280 | Nothing : Maybe Sitemap
281 |
282 | > match sitemap "/"
283 | Just HomeR : Maybe Sitemap
284 |
285 | > match sitemap "/users"
286 | Just UsersR : Maybe Sitemap
287 |
288 | > match sitemap "/users/1"
289 | Just (UserR 1) : Maybe Sitemap
290 |
291 | > match sitemap "/users/1"
292 | Just (UserR 1) : Maybe Sitemap
293 |
294 | -}
295 | match : Router a -> String -> Maybe a
296 | match (Router r) path =
297 | case String.uncons path of
298 | Just ( '/', path ) ->
299 | Combine.parse r path
300 | |> Result.toMaybe
301 | |> Maybe.map (\( _, _, x ) -> x)
302 |
303 | _ ->
304 | Nothing
305 |
306 |
307 | {-| Render a path given a Route and a list of route components.
308 |
309 | type Sitemap
310 | = HomeR
311 | | UsersR
312 | | UserR Int
313 |
314 | homeR = HomeR := static ""
315 | usersR = UsersR := static "users"
316 | usersR = UserR := static "users" int
317 | sitemap = router [homeR, userR, usersR]
318 |
319 | > reverse homeR []
320 | "/"
321 |
322 | > reverse usersR []
323 | "/users"
324 |
325 | > reverse userR ["1"]
326 | "/users/1"
327 |
328 | If you are willing to write some boilerplate, `reverse` can be used to
329 | construct a type safe reverse routing function specific to your
330 | application:
331 |
332 | toString : Sitemap -> String
333 | toString r =
334 | case r of
335 | HomeR -> reverse homeR []
336 | UsersR -> reverse usersR []
337 | UserR uid -> reverse userR [toString uid]
338 |
339 | > toString HomeR
340 | "/"
341 |
342 | > toString UsersR
343 | "/users"
344 |
345 | > toString (UserR 1)
346 | "/users/1"
347 |
348 | `reverse` will crash at runtime if there is a mismatch between the
349 | route and the list of arguments that is passed in. For example:
350 |
351 | > reverse deepR []
352 | Error: Ran into a `Debug.crash` in module `Route`
353 |
354 | This was caused by the `case` expression between lines 145 and 175.
355 | One of the branches ended with a crash and the following value got through:
356 |
357 | ([],[CInt,CInt,CInt])
358 |
359 | The message provided by the code author is:
360 |
361 | 'reverse' called with an unexpected number of arguments
362 |
363 | > reverse deepR ["a"]
364 | Error: Ran into a `Debug.crash` in module `Route`
365 |
366 | This was caused by the `case` expression between lines 171 and 176.
367 | One of the branches ended with a crash and the following value got through:
368 |
369 | Err ("could not convert string 'a' to an Int")
370 |
371 | The message provided by the code author is:
372 |
373 | could not convert string 'a' to an Int in a call to 'reverse'
374 |
375 | -}
376 | reverse : Route a -> List String -> String
377 | reverse (Route r) inputs =
378 | let
379 | accumulate cs is xs =
380 | case ( is, xs ) of
381 | ( [], [] ) ->
382 | "/" ++ (String.join "/" (List.reverse cs))
383 |
384 | ( _, (CStatic c) :: xs ) ->
385 | accumulate (c :: cs) is xs
386 |
387 | ( i :: is, (CCustom p) :: xs ) ->
388 | case p i of
389 | Ok _ ->
390 | accumulate (i :: cs) is xs
391 |
392 | Err m ->
393 | Debug.crash (m ++ " in a call to 'reverse' but received '" ++ i ++ "'")
394 |
395 | ( i :: is, CString :: xs ) ->
396 | accumulate (i :: cs) is xs
397 |
398 | ( i :: is, CInt :: xs ) ->
399 | case String.toInt i of
400 | Ok _ ->
401 | accumulate (i :: cs) is xs
402 |
403 | Err m ->
404 | Debug.crash m ++ " in a call to 'reverse'"
405 |
406 | _ ->
407 | Debug.crash "'reverse' called with an unexpected number of arguments"
408 | in
409 | accumulate [] inputs r.components
410 |
--------------------------------------------------------------------------------