Add helpers in Lookup and return a Maybe from lookup
. (#84)
This commit is contained in:
parent
f38c5987ee
commit
133b98c9c6
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -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)
|
||||||
|
@ -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.
|
||||||
|
@ -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 !?
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user