Add tooling for working with query parameters (#69)

docs/Examples/QueryParameters/Main.purs

@@ -0,0 +1,37 @@
+module QueryParameters where
+
+import Prelude
+
+import Control.Monad.Eff.Console as Console
+import HTTPure as HTTPure
+import HTTPure ((!!))
+
+-- | Serve the example server on this port
+port :: Int
+port = 8087
+
+-- | Shortcut for `show port`
+portS :: String
+portS = show port
+
+-- | Specify the routes
+router :: forall e. HTTPure.Request -> HTTPure.ResponseM e
+router { query }
+  | query !! "foo" /= ""     = HTTPure.ok $ "foo"
+  | query !! "bar" == "test" = HTTPure.ok $ "bar"
+  | otherwise                = HTTPure.ok $ query !! "baz"
+
+-- | Boot up the server
+main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)
+main = HTTPure.serve port router do
+  Console.log $ " ┌────────────────────────────────────────┐"
+  Console.log $ " │ Server now up on port " <> portS <> "             │"
+  Console.log $ " │                                        │"
+  Console.log $ " │ To test, run:                          │"
+  Console.log $ " │  > curl localhost:" <> portS <> "?foo             │"
+  Console.log $ " │    # => foo                            │"
+  Console.log $ " │  > curl localhost:" <> portS <> "?bar=test        │"
+  Console.log $ " │    # => bar                            │"
+  Console.log $ " │  > curl localhost:" <> portS <> "?baz=<anything>  │"
+  Console.log $ " │    # => <anything>                     │"
+  Console.log $ " └────────────────────────────────────────┘"

docs/Examples/QueryParameters/Readme.md

@@ -0,0 +1,12 @@
+# Query Parameters Example
+
+This is a basic example that demonstrates working with URL query parameters. It
+includes an example of routing based on the _existence_ of a query parameter, an
+example of routing based on the _value_ of a given query parameter, and an
+example where the response is driven by the contents of a query parameter.
+
+To run the example server, run:
+
+```bash
+make example EXAMPLE=QueryParameters
+```

src/HTTPure/Lookup.purs

@@ -8,6 +8,7 @@ import Prelude
 import Data.Array as Array
 import Data.Maybe as Maybe
 import Data.Monoid as Monoid
+import Data.StrMap as StrMap
 
 -- | Types that implement the Lookup class can be looked up by some key to
 -- | retrieve some value. For instance, you could have an implementation for
@@ -24,3 +25,9 @@ infixl 8 lookup as !!
 -- | return a Maybe. If the index is out of bounds, the return value is mempty.
 instance lookupArray :: Monoid.Monoid m => Lookup (Array m) m Int where
   lookup arr = Maybe.fromMaybe Monoid.mempty <<< Array.index arr
+
+-- | A default instance of Lookup for a StrMap of some type of Monoid. If the
+-- | key does not exist in the StrMap, then the return value is mempty.
+instance lookupStrMap :: Monoid.Monoid m =>
+                         Lookup (StrMap.StrMap m) m String where
+  lookup strMap = Maybe.fromMaybe Monoid.mempty <<< flip StrMap.lookup strMap

src/HTTPure/Query.purs

@@ -3,12 +3,36 @@ module HTTPure.Query
   , read
   ) where
 
+import Prelude
+
+import Data.Array as Array
+import Data.Maybe as Maybe
+import Data.String as String
 import Data.StrMap as StrMap
+import Data.Tuple as Tuple
 import Node.HTTP as HTTP
 
+-- | The Query type is a StrMap of Strings, with one entry per query parameter
+-- | in the request. For any query parameters that don't have values
+-- | (`/some/path?query`), the value in the StrMap for that parameter will be
+-- | the string "true". Note that this type has an implementation of Lookup for
+-- | `String` keys defined by `lookpStrMap` in `Lookup.purs` because
+-- | `lookupStrMap` is defined for any `StrMap` of `Monoids`. So you can do
+-- | something like `query !! "foo"` to get the value of the query parameter
+-- | "foo".
 type Query = StrMap.StrMap String
 
 -- | The StrMap of query segments in the given HTTP Request.
--- | TODO fill in this stub
 read :: HTTP.Request -> Query
-read _ = StrMap.empty
+read =
+  HTTP.requestURL >>> split "?" >>> last >>> split "&" >>> nonempty >>> toStrMap
+  where
+    toStrMap = map toTuple >>> StrMap.fromFoldable
+    nonempty = Array.filter ((/=) "")
+    split = String.Pattern >>> String.split
+    first = Array.head >>> Maybe.fromMaybe ""
+    last = Array.tail >>> Maybe.fromMaybe [] >>> String.joinWith ""
+    toTuple item = Tuple.Tuple (first itemParts) $ value $ last itemParts
+      where
+        value val = if val == "" then "true" else val
+        itemParts = split "=" item

test/HTTPure/IntegrationSpec.purs

@@ -13,6 +13,7 @@ import Headers as Headers
 import HelloWorld as HelloWorld
 import MultiRoute as MultiRoute
 import PathSegments as PathSegments
+import QueryParameters as QueryParameters
 import Post as Post
 import SSL as SSL
 
@@ -50,6 +51,19 @@ pathSegmentsSpec = Spec.it "runs the path segments example" do
   somebars ?= "[\"some\",\"bars\"]"
   where port = PathSegments.port
 
+queryParametersSpec :: SpecHelpers.Test
+queryParametersSpec = Spec.it "runs the query parameters example" do
+  EffClass.liftEff QueryParameters.main
+  foo <- SpecHelpers.get port StrMap.empty "/?foo"
+  foo ?= "foo"
+  bar <- SpecHelpers.get port StrMap.empty "/?bar=test"
+  bar ?= "bar"
+  notbar <- SpecHelpers.get port StrMap.empty "/?bar=nottest"
+  notbar ?= ""
+  baz <- SpecHelpers.get port StrMap.empty "/?baz=test"
+  baz ?= "test"
+  where port = QueryParameters.port
+
 postSpec :: SpecHelpers.Test
 postSpec = Spec.it "runs the post example" do
   EffClass.liftEff Post.main
@@ -70,5 +84,6 @@ integrationSpec = Spec.describe "Integration" do
   helloWorldSpec
   multiRouteSpec
   pathSegmentsSpec
+  queryParametersSpec
   postSpec
   sslSpec

test/HTTPure/LookupSpec.purs

@@ -2,6 +2,8 @@ module HTTPure.LookupSpec where
 
 import Prelude
 
+import Data.StrMap as StrMap
+
 import Test.Spec as Spec
 
 import HTTPure.Lookup ((!!))
@@ -18,6 +20,18 @@ lookupArraySpec = Spec.describe "lookupArray" do
     Spec.it "is an empty monoid" do
       [ "one", "two", "three" ] !! 4 ?= ""
 
+lookupStrMapSpec :: SpecHelpers.Test
+lookupStrMapSpec = Spec.describe "lookupStrMap" do
+  Spec.describe "when the key is in the StrMap" do
+    Spec.it "is the value at the given key" do
+      mockStrMap !! "foo" ?= "bar"
+  Spec.describe "when the key is not in the StrMap" do
+    Spec.it "is an empty monoid" do
+      mockStrMap !! "baz" ?= ""
+  where
+    mockStrMap = StrMap.singleton "foo" "bar"
+
 lookupSpec :: SpecHelpers.Test
 lookupSpec = Spec.describe "Lookup" do
   lookupArraySpec
+  lookupStrMapSpec

test/HTTPure/QuerySpec.purs

@@ -3,6 +3,7 @@ module HTTPure.QuerySpec where
 import Prelude
 
 import Data.StrMap as StrMap
+import Data.Tuple as Tuple
 import Test.Spec as Spec
 
 import HTTPure.Query as Query
@@ -12,9 +13,42 @@ import HTTPure.SpecHelpers ((?=))
 
 readSpec :: SpecHelpers.Test
 readSpec = Spec.describe "read" do
-  Spec.it "is always an empty StrMap (until the stub is fully implemented)" do
+  Spec.describe "with no query string" do
-    req <- SpecHelpers.mockRequest "" "" "" []
+    Spec.it "is an empty StrMap" do
+      req <- SpecHelpers.mockRequest "" "/test" "" []
       Query.read req ?= StrMap.empty
+  Spec.describe "with an empty query string" do
+    Spec.it "is an empty StrMap" do
+      req <- SpecHelpers.mockRequest "" "/test?" "" []
+      Query.read req ?= StrMap.empty
+  Spec.describe "with a query parameter in the query string" do
+    Spec.it "is a correct StrMap" do
+      req <- SpecHelpers.mockRequest "" "/test?a=b" "" []
+      Query.read req ?= StrMap.singleton "a" "b"
+  Spec.describe "with empty fields in the query string" do
+    Spec.it "ignores the empty fields" do
+      req <- SpecHelpers.mockRequest "" "/test?&&a=b&&" "" []
+      Query.read req ?= StrMap.singleton "a" "b"
+  Spec.describe "with duplicated params" do
+    Spec.it "takes the last param value" do
+      req <- SpecHelpers.mockRequest "" "/test?a=b&a=c" "" []
+      Query.read req ?= StrMap.singleton "a" "c"
+  Spec.describe "with empty params" do
+    Spec.it "uses 'true' as the value" do
+      req <- SpecHelpers.mockRequest "" "/test?a" "" []
+      Query.read req ?= StrMap.singleton "a" "true"
+  Spec.describe "with complex params" do
+    Spec.it "is the correct StrMap" do
+      req <- SpecHelpers.mockRequest "" "/test?&&a&b=c&b=d&&&e=f&g=&" "" []
+      Query.read req ?=  expectedComplexResult
+  where
+      expectedComplexResult =
+        StrMap.fromFoldable
+          [ Tuple.Tuple "a" "true"
+          , Tuple.Tuple "b" "d"
+          , Tuple.Tuple "e" "f"
+          , Tuple.Tuple "g" "true"
+          ]
 
 querySpec :: SpecHelpers.Test
 querySpec = Spec.describe "Query" do

test/HTTPure/RequestSpec.purs

@@ -23,7 +23,7 @@ fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do
     mock.path ?= [ "test" ]
   Spec.it "contains the correct query" do
     mock <- mockRequest
-    mock.query ?= StrMap.empty
+    mock.query ?= StrMap.singleton "a" "b"
   Spec.it "contains the correct headers" do
     mock <- mockRequest
     mock.headers ?= Headers.headers mockHeaders