Add helpers in Lookup and return a Maybe from lookup. (#84)

This commit is contained in:
Connor Prussin 2017-10-23 18:50:27 -04:00 committed by GitHub
parent f38c5987ee
commit 133b98c9c6
8 changed files with 90 additions and 53 deletions

View File

@ -4,7 +4,7 @@ import Prelude
import Control.Monad.Eff.Console as Console import Control.Monad.Eff.Console as Console
import HTTPure as HTTPure import HTTPure as HTTPure
import HTTPure ((!!)) import HTTPure ((!@))
-- | Serve the example server on this port -- | Serve the example server on this port
port :: Int port :: Int
@ -20,7 +20,7 @@ responseHeaders = HTTPure.header "X-Example" "hello world!"
-- | Route to the correct handler -- | Route to the correct handler
router :: forall e. HTTPure.Request -> HTTPure.ResponseM e router :: forall e. HTTPure.Request -> HTTPure.ResponseM e
router { headers } = HTTPure.ok' responseHeaders $ headers !! "X-Input" router { headers } = HTTPure.ok' responseHeaders $ headers !@ "X-Input"
-- | Boot up the server -- | Boot up the server
main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)

View File

@ -4,7 +4,7 @@ import Prelude
import Control.Monad.Eff.Console as Console import Control.Monad.Eff.Console as Console
import HTTPure as HTTPure import HTTPure as HTTPure
import HTTPure ((!!)) import HTTPure ((!@))
-- | Serve the example server on this port -- | Serve the example server on this port
port :: Int port :: Int
@ -17,7 +17,7 @@ portS = show port
-- | Specify the routes -- | Specify the routes
router :: forall e. HTTPure.Request -> HTTPure.ResponseM e router :: forall e. HTTPure.Request -> HTTPure.ResponseM e
router { path } router { path }
| path !! 0 == "segment" = HTTPure.ok $ path !! 1 | path !@ 0 == "segment" = HTTPure.ok $ path !@ 1
| otherwise = HTTPure.ok $ show path | otherwise = HTTPure.ok $ show path
-- | Boot up the server -- | Boot up the server

View File

@ -4,7 +4,7 @@ import Prelude
import Control.Monad.Eff.Console as Console import Control.Monad.Eff.Console as Console
import HTTPure as HTTPure import HTTPure as HTTPure
import HTTPure ((!!)) import HTTPure ((!@), (!?))
-- | Serve the example server on this port -- | Serve the example server on this port
port :: Int port :: Int
@ -17,9 +17,9 @@ portS = show port
-- | Specify the routes -- | Specify the routes
router :: forall e. HTTPure.Request -> HTTPure.ResponseM e router :: forall e. HTTPure.Request -> HTTPure.ResponseM e
router { query } router { query }
| query !! "foo" /= "" = HTTPure.ok $ "foo" | query !? "foo" = HTTPure.ok "foo"
| query !! "bar" == "test" = HTTPure.ok $ "bar" | query !@ "bar" == "test" = HTTPure.ok "bar"
| otherwise = HTTPure.ok $ query !! "baz" | otherwise = HTTPure.ok $ query !@ "baz"
-- | Boot up the server -- | Boot up the server
main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)

View File

@ -9,7 +9,7 @@ module HTTPure
) where ) where
import HTTPure.Headers (Headers, empty, header, headers) import HTTPure.Headers (Headers, empty, header, headers)
import HTTPure.Lookup (lookup, (!!)) import HTTPure.Lookup (at, (!@), has, (!?), lookup, (!!))
import HTTPure.Method (Method(..)) import HTTPure.Method (Method(..))
import HTTPure.Path (Path) import HTTPure.Path (Path)
import HTTPure.Request (Request, fullPath) import HTTPure.Request (Request, fullPath)

View File

@ -10,7 +10,6 @@ module HTTPure.Headers
import Prelude import Prelude
import Control.Monad.Eff as Eff import Control.Monad.Eff as Eff
import Data.Maybe as Maybe
import Data.String as StringUtil import Data.String as StringUtil
import Data.StrMap as StrMap import Data.StrMap as StrMap
import Data.TraversableWithIndex as TraversableWithIndex import Data.TraversableWithIndex as TraversableWithIndex
@ -18,31 +17,31 @@ import Data.Tuple as Tuple
import Node.HTTP as HTTP import Node.HTTP as HTTP
import HTTPure.Lookup as Lookup import HTTPure.Lookup as Lookup
import HTTPure.Lookup ((!!))
-- | The `Headers` type is just sugar for a `StrMap` of `Strings` that -- | The `Headers` type is just sugar for a `StrMap` of `Strings` that
-- | represents the set of headers in an HTTP request or response. -- | represents the set of headers in an HTTP request or response.
newtype Headers = Headers (StrMap.StrMap String) newtype Headers = Headers (StrMap.StrMap String)
-- | Given a string, return the value of the matching header, or an empty string -- | Given a string, return a `Maybe` containing the value of the matching
-- | if no match exists. This search is case-insensitive. -- | header, if there is any.
instance lookupHeaders :: Lookup.Lookup Headers String String where instance lookup :: Lookup.Lookup Headers String String where
lookup (Headers headers') = lookup (Headers headers') key = headers' !! StringUtil.toLower key
Maybe.fromMaybe "" <<< flip StrMap.lookup headers' <<< StringUtil.toLower
-- | Allow a `Headers` to be represented as a string. This string is formatted -- | Allow a `Headers` to be represented as a string. This string is formatted
-- | in HTTP headers format. -- | in HTTP headers format.
instance showHeaders :: Show Headers where instance show :: Show Headers where
show (Headers headers') = show (Headers headers') =
StrMap.foldMap showField headers' <> "\n" StrMap.foldMap showField headers' <> "\n"
where where
showField key value = key <> ": " <> value <> "\n" showField key value = key <> ": " <> value <> "\n"
-- | Compare two `Headers` objects by comparing the underlying `StrMaps`. -- | Compare two `Headers` objects by comparing the underlying `StrMaps`.
instance eqHeaders :: Eq Headers where instance eq :: Eq Headers where
eq (Headers a) (Headers b) = eq a b eq (Headers a) (Headers b) = eq a b
-- | Allow one `Headers` objects to be appended to another. -- | Allow one `Headers` objects to be appended to another.
instance semigroupHeaders :: Semigroup Headers where instance semigroup :: Semigroup Headers where
append (Headers a) (Headers b) = Headers $ StrMap.union b a append (Headers a) (Headers b) = Headers $ StrMap.union b a
-- | Get the headers out of a HTTP `Request` object. -- | Get the headers out of a HTTP `Request` object.

View File

@ -1,5 +1,7 @@
module HTTPure.Lookup module HTTPure.Lookup
( class Lookup ( class Lookup
, at, (!@)
, has, (!?)
, lookup, (!!) , lookup, (!!)
) where ) where
@ -12,31 +14,45 @@ import Data.StrMap as StrMap
-- | Types that implement the `Lookup` class can be looked up by some key to -- | 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 -- | retrieve some value. For instance, you could have an implementation for
-- | `String (Maybe String) Int` where `lookup s i` returns `Just` the -- | `String Int String` where `lookup s i` returns `Just` a `String` containing
-- | character in `s` at `i`, or `Nothing` if `i` is out of bounds. -- | the character in `s` at `i`, or `Nothing` if `i` is out of bounds.
class Lookup a v k where class Lookup c k r where
-- | Given some type and a key on that type, extract some value that -- | Given some type and a key on that type, extract some value that
-- | corresponds to that key. -- | corresponds to that key.
lookup :: a -> k -> v lookup :: c -> k -> Maybe.Maybe r
-- | `!!` is inspired by `!!` in `Data.Array`, but note that it differs from -- | `!!` is inspired by `!!` in `Data.Array`, but note that it differs from
-- | `!!` in `Data.Array` in that the default instance for `Arrays` with `Int` -- | `!!` in `Data.Array` in that you can use `!!` for any other instance of
-- | key types is defined on `Arrays` of some members of `Monoids`, and will -- | `Lookup`.
-- | always return a value and will not return `Maybes`. If the requested index
-- | is out of bounds, then this implementation will return `mempty` instead of
-- | `Nothing`.
infixl 8 lookup as !! infixl 8 lookup as !!
-- | A default instance of `Lookup` for an `Array` of some type of `Monoid`. -- | The instance of `Lookup` for an `Array` is just `!!` as defined in
-- | Note that this is different from `!!` defined in `Data.Array` in that it -- | `Data.Array`.
-- | does not return a `Maybe`. If the index is out of bounds, the return value instance lookupArray :: Lookup (Array t) Int t where
-- | is `mempty`. lookup = Array.index
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 instance of `Lookup` for a `StrMap` just uses `StrMap.lookup` (but
-- | the key does not exist in the `StrMap`, then the return value is `mempty`. -- | flipped, because `StrMap.lookup` expects the key first, which would end up
instance lookupStrMap :: Monoid.Monoid m => -- | with a really weird API for `!!`).
Lookup (StrMap.StrMap m) m String where instance lookupStrMap :: Lookup (StrMap.StrMap t) String t where
lookup strMap = Maybe.fromMaybe Monoid.mempty <<< flip StrMap.lookup strMap lookup = flip StrMap.lookup
-- | This simple helper works on any `Lookup` instance where the return type is
-- | a `Monoid`, and is the same as `lookup` except that it returns a `t`
-- | instead of a `Maybe t`. If `lookup` would return `Nothing`, then `at`
-- | returns `mempty`.
at :: forall c k r. Monoid.Monoid r => Lookup c k r => c -> k -> r
at set = Maybe.fromMaybe Monoid.mempty <<< lookup set
-- | Expose `at` as the infix operator `!@`
infixl 8 at as !@
-- | This simple helper works on any `Lookup` instance, where the container set
-- | has a single type variable, and returns a `Boolean` indicating if the given
-- | key matches any value in the given container.
has :: forall c k r. Lookup (c r) k r => c r -> k -> Boolean
has set key = Maybe.isJust ((lookup set key) :: Maybe.Maybe r)
-- | Expose `has` as the infix operator `!?`
infixl 8 has as !?

View File

@ -3,6 +3,7 @@ module HTTPure.HeadersSpec where
import Prelude import Prelude
import Control.Monad.Eff.Class as EffClass import Control.Monad.Eff.Class as EffClass
import Data.Maybe as Maybe
import Data.Tuple as Tuple import Data.Tuple as Tuple
import Test.Spec as Spec import Test.Spec as Spec
@ -16,14 +17,14 @@ lookupSpec :: SpecHelpers.Test
lookupSpec = Spec.describe "lookup" do lookupSpec = Spec.describe "lookup" do
Spec.describe "when the string is in the header set" do Spec.describe "when the string is in the header set" do
Spec.describe "when searching with lowercase" do Spec.describe "when searching with lowercase" do
Spec.it "is the string" do Spec.it "is Just the string" do
Headers.header "x-test" "test" !! "x-test" ?= "test" Headers.header "x-test" "test" !! "x-test" ?= Maybe.Just "test"
Spec.describe "when searching with uppercase" do Spec.describe "when searching with uppercase" do
Spec.it "is the string" do Spec.it "is Just the string" do
Headers.header "x-test" "test" !! "X-Test" ?= "test" Headers.header "x-test" "test" !! "X-Test" ?= Maybe.Just "test"
Spec.describe "when the string is not in the header set" do Spec.describe "when the string is not in the header set" do
Spec.it "is an empty string" do Spec.it "is Nothing" do
Headers.empty !! "X-Test" ?= "" ((Headers.empty !! "X-Test") :: Maybe.Maybe String) ?= Maybe.Nothing
showSpec :: SpecHelpers.Test showSpec :: SpecHelpers.Test
showSpec = Spec.describe "show" do showSpec = Spec.describe "show" do

View File

@ -2,36 +2,57 @@ module HTTPure.LookupSpec where
import Prelude import Prelude
import Data.Maybe as Maybe
import Data.StrMap as StrMap import Data.StrMap as StrMap
import Test.Spec as Spec import Test.Spec as Spec
import HTTPure.Lookup ((!!)) import HTTPure.Lookup ((!!), (!@), (!?))
import HTTPure.SpecHelpers as SpecHelpers import HTTPure.SpecHelpers as SpecHelpers
import HTTPure.SpecHelpers ((?=)) import HTTPure.SpecHelpers ((?=))
atSpec :: SpecHelpers.Test
atSpec = Spec.describe "at" do
Spec.describe "when the lookup returns a Just" do
Spec.it "is the value inside the Just" do
[ "one", "two", "three" ] !@ 1 ?= "two"
Spec.describe "when the lookup returns a Nothing" do
Spec.it "is mempty" do
[ "one", "two", "three" ] !@ 4 ?= ""
hasSpec :: SpecHelpers.Test
hasSpec = Spec.describe "has" do
Spec.describe "when the lookup returns a Just" do
Spec.it "is true" do
[ "one", "two", "three" ] !? 1 ?= true
Spec.describe "when the lookup returns a Nothing" do
Spec.it "is false" do
[ "one", "two", "three" ] !? 4 ?= false
lookupArraySpec :: SpecHelpers.Test lookupArraySpec :: SpecHelpers.Test
lookupArraySpec = Spec.describe "lookupArray" do lookupArraySpec = Spec.describe "lookupArray" do
Spec.describe "when the index is in bounds" do Spec.describe "when the index is in bounds" do
Spec.it "is the segment at the index" do Spec.it "is Just the value at the index" do
[ "one", "two", "three" ] !! 1 ?= "two" [ "one", "two", "three" ] !! 1 ?= Maybe.Just "two"
Spec.describe "when the index is out of bounds" do Spec.describe "when the index is out of bounds" do
Spec.it "is an empty monoid" do Spec.it "is Nothing" do
[ "one", "two", "three" ] !! 4 ?= "" (([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing
lookupStrMapSpec :: SpecHelpers.Test lookupStrMapSpec :: SpecHelpers.Test
lookupStrMapSpec = Spec.describe "lookupStrMap" do lookupStrMapSpec = Spec.describe "lookupStrMap" do
Spec.describe "when the key is in the StrMap" do Spec.describe "when the key is in the StrMap" do
Spec.it "is the value at the given key" do Spec.it "is Just the value at the given key" do
mockStrMap !! "foo" ?= "bar" mockStrMap !! "foo" ?= Maybe.Just "bar"
Spec.describe "when the key is not in the StrMap" do Spec.describe "when the key is not in the StrMap" do
Spec.it "is an empty monoid" do Spec.it "is Nothing" do
mockStrMap !! "baz" ?= "" ((mockStrMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing
where where
mockStrMap = StrMap.singleton "foo" "bar" mockStrMap = StrMap.singleton "foo" "bar"
lookupSpec :: SpecHelpers.Test lookupSpec :: SpecHelpers.Test
lookupSpec = Spec.describe "Lookup" do lookupSpec = Spec.describe "Lookup" do
atSpec
hasSpec
lookupArraySpec lookupArraySpec
lookupStrMapSpec lookupStrMapSpec