From 6df0ce9987e5bd4d5b4ba4b9800d266373438037 Mon Sep 17 00:00:00 2001
From: Dillon Kearns <dillon@incrementalelm.com>
Date: Wed, 22 Dec 2021 14:42:35 -0800
Subject: [PATCH] Add cookie parser.

---
 elm.json                  |  3 +-
 examples/pokedex/elm.json |  2 +-
 src/CookieParser.elm      | 84 +++++++++++++++++++++++++++++++++++++++
 tests/CookieTest.elm      | 84 +++++++++++++++++++++++++++++++++++++++
 4 files changed, 171 insertions(+), 2 deletions(-)
 create mode 100644 src/CookieParser.elm
 create mode 100644 tests/CookieTest.elm

diff --git a/elm.json b/elm.json
index 8d277d5c..b7289cfc 100644
--- a/elm.json
+++ b/elm.json
@@ -36,6 +36,7 @@
         "elm/html": "1.0.0 <= v < 2.0.0",
         "elm/http": "2.0.0 <= v < 3.0.0",
         "elm/json": "1.1.3 <= v < 2.0.0",
+        "elm/parser": "1.1.0 <= v < 2.0.0",
         "elm/regex": "1.0.0 <= v < 2.0.0",
         "elm/url": "1.0.0 <= v < 2.0.0",
         "elm/virtual-dom": "1.0.2 <= v < 2.0.0",
@@ -54,4 +55,4 @@
         "avh4/elm-program-test": "3.1.0 <= v < 4.0.0",
         "elm-explorations/test": "1.2.2 <= v < 2.0.0"
     }
-}
\ No newline at end of file
+}
diff --git a/examples/pokedex/elm.json b/examples/pokedex/elm.json
index d25b9d17..534031e4 100644
--- a/examples/pokedex/elm.json
+++ b/examples/pokedex/elm.json
@@ -20,6 +20,7 @@
             "elm/html": "1.0.0",
             "elm/http": "2.0.0",
             "elm/json": "1.1.3",
+            "elm/parser": "1.1.0",
             "elm/regex": "1.0.0",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
@@ -42,7 +43,6 @@
             "danfishgold/base64-bytes": "1.1.0",
             "elm/bytes": "1.0.8",
             "elm/file": "1.0.5",
-            "elm/parser": "1.1.0",
             "elm/random": "1.0.0",
             "fredcy/elm-parseint": "2.0.1",
             "mgold/elm-nonempty-list": "4.2.0",
diff --git a/src/CookieParser.elm b/src/CookieParser.elm
new file mode 100644
index 00000000..bc5743ef
--- /dev/null
+++ b/src/CookieParser.elm
@@ -0,0 +1,84 @@
+module CookieParser exposing (parse)
+
+import Dict exposing (Dict)
+import Parser exposing (..)
+import Url
+
+
+parse : String -> Dict String String
+parse input =
+    Parser.run parser input
+        |> Result.withDefault Dict.empty
+
+
+parser : Parser (Dict String String)
+parser =
+    loop [] keyValuePair
+        |> Parser.map Dict.fromList
+
+
+keyValuePair : List ( String, String ) -> Parser (Step (List ( String, String )) (List ( String, String )))
+keyValuePair revChunks =
+    oneOf
+        [ end
+            |> map (\_ -> Done (List.reverse revChunks))
+        , succeed (Loop revChunks)
+            |. chompIf isSpace
+            |. chompWhile isSpace
+        , succeed Tuple.pair
+            |= parseKey
+            |= oneOf
+                [ succeed Nothing
+                    |. token ";"
+                , succeed Just
+                    |. token "="
+                    |= valueParser
+                    |. oneOf
+                        [ token ";"
+                        , succeed ()
+                        ]
+                ]
+            |> andThen
+                (\( key, maybeValue ) ->
+                    case maybeValue of
+                        Just value ->
+                            succeed (Loop (( key, value ) :: revChunks))
+
+                        Nothing ->
+                            succeed (Loop revChunks)
+                )
+        ]
+
+
+valueParser : Parser String
+valueParser =
+    succeed identity
+        |. chompWhile isSpace
+        |= oneOf
+            [ succeed ""
+                |. token ";"
+            , succeed identity
+                |. token "\""
+                |= (chompUntil "\""
+                        |> getChompedString
+                   )
+                |. token "\""
+            , chompWhile (\c -> c /= ';')
+                |> getChompedString
+            ]
+        |> map String.trim
+        |> map (\value -> value |> Url.percentDecode |> Maybe.withDefault "")
+
+
+parseKey : Parser String
+parseKey =
+    succeed identity
+        |= (chompWhile (\c -> c /= '=' && c /= ';')
+                |> getChompedString
+                |> map String.trim
+           )
+
+
+isSpace : Char -> Bool
+isSpace c =
+    c == ' '
diff --git a/tests/CookieTest.elm b/tests/CookieTest.elm
new file mode 100644
index 00000000..57e21e01
--- /dev/null
+++ b/tests/CookieTest.elm
@@ -0,0 +1,84 @@
+module CookieTest exposing (all)
+
+import CookieParser
+import Dict
+import Expect
+import Test exposing (Test, describe, test)
+
+
+
+-- source: https://github.com/jshttp/cookie/blob/0b519534a5d0bea176f8422aeb93f7d9fce8d683/test/parse.js
+
+
+all : Test
+all =
+    describe "Cookie"
+        [ test "no special characters or spaces" <|
+            \() ->
+                "foo=bar"
+                    |> CookieParser.parse
+                    |> Expect.equalDicts
+                        (Dict.fromList
+                            [ ( "foo", "bar" )
+                            ]
+                        )
+        , test "no special characters or spaces, numeric value" <|
+            \() ->
+                "foo=123"
+                    |> CookieParser.parse
+                    |> Expect.equalDicts
+                        (Dict.fromList
+                            [ ( "foo", "123" )
+                            ]
+                        )
+        , test "with spaces" <|
+            \() ->
+                "FOO    = bar;   baz  =   raz"
+                    |> CookieParser.parse
+                    |> Expect.equalDicts
+                        (Dict.fromList
+                            [ ( "FOO", "bar" )
+                            , ( "baz", "raz" )
+                            ]
+                        )
+        , test "quoted value" <|
+            \() ->
+                "foo=\"bar=123456789&name=Magic+Mouse\""
+                    |> CookieParser.parse
+                    |> Expect.equalDicts
+                        (Dict.fromList
+                            [ ( "foo", "bar=123456789&name=Magic+Mouse" )
+                            ]
+                        )
+        , test "escaped characters" <|
+            \() ->
+                "email=%20%22%2c%3b%2f"
+                    |> CookieParser.parse
+                    |> Expect.equalDicts
+                        (Dict.fromList
+                            [ ( "email", " \",;/" )
+                            ]
+                        )
+        , test "dates" <|
+            \() ->
+                "priority=true; expires=Wed, 29 Jan 2014 17:43:25 GMT; Path=/"
+                    |> CookieParser.parse
+                    |> Expect.equalDicts
+                        (Dict.fromList
+                            [ ( "priority", "true" )
+                            , ( "Path", "/" )
+                            , ( "expires", "Wed, 29 Jan 2014 17:43:25 GMT" )
+                            ]
+                        )
+        , test "missing value" <|
+            \() ->
+                "foo; bar=1; fizz= ; buzz=2"
+                    |> CookieParser.parse
+                    |> Expect.equalDicts
+                        (Dict.fromList
+                            [ ( "bar", "1" )
+                            , ( "fizz", "" )
+                            , ( "buzz", "2" )
+                            ]
+                        )
+        ]