Add function for parsing request URIs

Author: no-longer-on-githu-b

src/Hyper/Form/Urlencoded.purs

@@ -6,6 +6,7 @@ module Hyper.Form.Urlencoded
 
 import Prelude
 import Control.Monad.Error.Class (throwError)
+import Data.Array as Array
 import Data.Either (Either)
 import Data.Maybe (Maybe(Just, Nothing))
 import Data.String (split, joinWith, Pattern(Pattern))
@@ -26,6 +27,7 @@ toTuple kv =
 
 parseUrlencoded :: String → Either String (Array (Tuple String (Maybe String)))
 parseUrlencoded = split (Pattern "&")
+                  >>> Array.filter (_ /= "")
                   >>> map (split (Pattern "="))
                   >>> map toTuple
                   >>> sequence

src/Hyper/Node/Server.purs

@@ -27,14 +27,15 @@ import Control.Monad.Eff.Console (CONSOLE, log)
 import Control.Monad.Eff.Exception (EXCEPTION, Error, catchException, error)
 import Control.Monad.Error.Class (throwError)
 import Data.Either (Either(..), either)
+import Data.Lazy (defer)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
 import Data.Tuple (Tuple(..))
 import Hyper.Conn (Conn)
 import Hyper.Middleware (Middleware, evalMiddleware, lift')
 import Hyper.Middleware.Class (getConn, modifyConn)
 import Hyper.Port (Port(..))
-import Hyper.Request (class ReadableBody, class Request, class StreamableBody, RequestData, readBody)
+import Hyper.Request (class ReadableBody, class Request, class StreamableBody, RequestData, parseUrl, readBody)
 import Hyper.Response (class ResponseWritable, class Response, ResponseEnded, StatusLineOpen)
 import Hyper.Status (Status(..))
 import Node.Buffer (BUFFER, Buffer)
@@ -245,6 +246,7 @@ mkHttpRequest request =
     headers = HTTP.requestHeaders request
     requestData =
       { url: HTTP.requestURL request
+      , parsedUrl: defer \_ -> parseUrl (HTTP.requestURL request)
       , headers: headers
       , method: Method.fromString (HTTP.requestMethod request)
       , contentLength: StrMap.lookup "content-length" headers

src/Hyper/Request.purs

@@ -1,6 +1,8 @@
 module Hyper.Request
   ( class Request
   , RequestData
+  , ParsedUrl
+  , parseUrl
   , getRequestData
   , class BaseRequest
   , class ReadableBody
@@ -9,20 +11,44 @@ module Hyper.Request
   , streamBody
   ) where
 
+import Prelude
+import Data.Array as Array
+import Data.String as String
+import Data.Bifunctor (lmap)
 import Data.Either (Either)
 import Data.HTTP.Method (CustomMethod, Method)
-import Data.Maybe (Maybe)
+import Data.Lazy (Lazy)
+import Data.Maybe (Maybe, fromMaybe)
 import Data.StrMap (StrMap)
+import Data.Tuple (Tuple)
 import Hyper.Conn (Conn)
+import Hyper.Form.Urlencoded (parseUrlencoded)
 import Hyper.Middleware (Middleware)
 
 type RequestData =
   { url :: String
+  , parsedUrl :: Lazy ParsedUrl
   , contentLength :: Maybe Int
   , headers :: StrMap String
   , method :: Either Method CustomMethod
   }
 
+type ParsedUrl =
+  { path :: Array String
+  , query :: Either String (Array (Tuple String (Maybe String)))
+  }
+
+parseUrl :: String -> ParsedUrl
+parseUrl url =
+  let
+    idx = fromMaybe (String.length url) $ String.indexOf (String.Pattern "?") url
+    rawPath = String.take idx url
+    rawQuery = String.drop (idx + 1) url
+    path = Array.filter (_ /= "") $ String.split (String.Pattern "/") rawPath
+    query = lmap (const rawQuery) $ parseUrlencoded rawQuery
+  in
+    {path, query}
+
 class Request req m where
   getRequestData
     :: forall res c

src/Hyper/Test/TestServer.purs

@@ -13,6 +13,7 @@ import Data.Foldable (fold)
 import Data.Function ((<<<))
 import Data.Functor (map)
 import Data.HTTP.Method (CustomMethod, Method(..))
+import Data.Lazy (defer)
 import Data.Maybe (Maybe(Nothing, Just))
 import Data.Monoid (mempty, class Monoid)
 import Data.Newtype (class Newtype, unwrap)
@@ -22,7 +23,7 @@ import Hyper.Conn (Conn)
 import Hyper.Header (Header)
 import Hyper.Middleware (lift')
 import Hyper.Middleware.Class (getConn, modifyConn)
-import Hyper.Request (class ReadableBody, class Request)
+import Hyper.Request (class ReadableBody, class Request, parseUrl)
 import Hyper.Response (class ResponseWritable, class Response)
 import Hyper.Status (Status)
 
@@ -55,6 +56,7 @@ instance requestTestRequest :: Monad m => Request TestRequest m where
   getRequestData =
     getConn :>>= \{ request: TestRequest r } ->
     ipure { url: r.url
+          , parsedUrl: defer \_ -> parseUrl r.url
           , contentLength: Just (String.length r.body)
           , method: r.method
           , headers: r.headers

test/Hyper/RequestSpec.purs

@@ -0,0 +1,32 @@
+module Hyper.RequestSpec where
+
+import Prelude
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested ((/\))
+import Hyper.Request (parseUrl)
+import Test.Spec (Spec, it, describe)
+import Test.Spec.Assertions (shouldEqual)
+
+spec :: forall e. Spec e Unit
+spec =
+  describe "Hyper.Request" do
+    it "parses the root URL" do
+      let result = parseUrl "/"
+      result.path `shouldEqual` []
+      result.query `shouldEqual` Right []
+
+    it "parses non-root URLs" do
+      let result = parseUrl "/foo/bar"
+      result.path `shouldEqual` ["foo", "bar"]
+      result.query `shouldEqual` Right []
+
+    it "parses URLs with query strings" do
+      let result = parseUrl "/foo/bar?abc=def=ghi"
+      result.path `shouldEqual` ["foo", "bar"]
+      result.query `shouldEqual` Left "abc=def=ghi"
+
+    it "parses URLs with formatted query strings" do
+      let result = parseUrl "/foo/bar?abc=def&ghi"
+      result.path `shouldEqual` ["foo", "bar"]
+      result.query `shouldEqual` Right ["abc" /\ Just "def", "ghi" /\ Nothing]