diff --git a/docs/Examples/Headers/Main.purs b/docs/Examples/Headers/Main.purs index 2e875f8..0e3b469 100644 --- a/docs/Examples/Headers/Main.purs +++ b/docs/Examples/Headers/Main.purs @@ -4,7 +4,7 @@ import Prelude import Control.Monad.Eff.Console as Console import HTTPure as HTTPure -import HTTPure ((!!)) +import HTTPure ((!@)) -- | Serve the example server on this port port :: Int @@ -20,7 +20,7 @@ responseHeaders = HTTPure.header "X-Example" "hello world!" -- | Route to the correct handler 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 main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) diff --git a/docs/Examples/PathSegments/Main.purs b/docs/Examples/PathSegments/Main.purs index 78570d4..a793b13 100644 --- a/docs/Examples/PathSegments/Main.purs +++ b/docs/Examples/PathSegments/Main.purs @@ -4,7 +4,7 @@ import Prelude import Control.Monad.Eff.Console as Console import HTTPure as HTTPure -import HTTPure ((!!)) +import HTTPure ((!@)) -- | Serve the example server on this port port :: Int @@ -17,7 +17,7 @@ portS = show port -- | Specify the routes router :: forall e. HTTPure.Request -> HTTPure.ResponseM e router { path } - | path !! 0 == "segment" = HTTPure.ok $ path !! 1 + | path !@ 0 == "segment" = HTTPure.ok $ path !@ 1 | otherwise = HTTPure.ok $ show path -- | Boot up the server diff --git a/docs/Examples/QueryParameters/Main.purs b/docs/Examples/QueryParameters/Main.purs index 4230d70..a59e88b 100644 --- a/docs/Examples/QueryParameters/Main.purs +++ b/docs/Examples/QueryParameters/Main.purs @@ -4,7 +4,7 @@ import Prelude import Control.Monad.Eff.Console as Console import HTTPure as HTTPure -import HTTPure ((!!)) +import HTTPure ((!@), (!?)) -- | Serve the example server on this port port :: Int @@ -17,9 +17,9 @@ 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" + | 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) diff --git a/src/HTTPure.purs b/src/HTTPure.purs index f8bccbf..619929c 100644 --- a/src/HTTPure.purs +++ b/src/HTTPure.purs @@ -9,7 +9,7 @@ module HTTPure ) where import HTTPure.Headers (Headers, empty, header, headers) -import HTTPure.Lookup (lookup, (!!)) +import HTTPure.Lookup (at, (!@), has, (!?), lookup, (!!)) import HTTPure.Method (Method(..)) import HTTPure.Path (Path) import HTTPure.Request (Request, fullPath) diff --git a/src/HTTPure/Headers.purs b/src/HTTPure/Headers.purs index f0644dc..bc5caa7 100644 --- a/src/HTTPure/Headers.purs +++ b/src/HTTPure/Headers.purs @@ -10,7 +10,6 @@ module HTTPure.Headers import Prelude import Control.Monad.Eff as Eff -import Data.Maybe as Maybe import Data.String as StringUtil import Data.StrMap as StrMap import Data.TraversableWithIndex as TraversableWithIndex @@ -18,31 +17,31 @@ import Data.Tuple as Tuple import Node.HTTP as HTTP import HTTPure.Lookup as Lookup +import HTTPure.Lookup ((!!)) -- | The `Headers` type is just sugar for a `StrMap` of `Strings` that -- | represents the set of headers in an HTTP request or response. newtype Headers = Headers (StrMap.StrMap String) --- | Given a string, return the value of the matching header, or an empty string --- | if no match exists. This search is case-insensitive. -instance lookupHeaders :: Lookup.Lookup Headers String String where - lookup (Headers headers') = - Maybe.fromMaybe "" <<< flip StrMap.lookup headers' <<< StringUtil.toLower +-- | Given a string, return a `Maybe` containing the value of the matching +-- | header, if there is any. +instance lookup :: Lookup.Lookup Headers String String where + lookup (Headers headers') key = headers' !! StringUtil.toLower key -- | Allow a `Headers` to be represented as a string. This string is formatted -- | in HTTP headers format. -instance showHeaders :: Show Headers where +instance show :: Show Headers where show (Headers headers') = StrMap.foldMap showField headers' <> "\n" where showField key value = key <> ": " <> value <> "\n" -- | 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 -- | 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 -- | Get the headers out of a HTTP `Request` object. diff --git a/src/HTTPure/Lookup.purs b/src/HTTPure/Lookup.purs index d969750..34e2d04 100644 --- a/src/HTTPure/Lookup.purs +++ b/src/HTTPure/Lookup.purs @@ -1,5 +1,7 @@ module HTTPure.Lookup ( class Lookup + , at, (!@) + , has, (!?) , lookup, (!!) ) where @@ -12,31 +14,45 @@ 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 --- | `String (Maybe String) Int` where `lookup s i` returns `Just` the --- | character in `s` at `i`, or `Nothing` if `i` is out of bounds. -class Lookup a v k where +-- | `String Int String` where `lookup s i` returns `Just` a `String` containing +-- | the character in `s` at `i`, or `Nothing` if `i` is out of bounds. +class Lookup c k r where -- | Given some type and a key on that type, extract some value that -- | 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 --- | `!!` in `Data.Array` in that the default instance for `Arrays` with `Int` --- | key types is defined on `Arrays` of some members of `Monoids`, and will --- | 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`. +-- | `!!` in `Data.Array` in that you can use `!!` for any other instance of +-- | `Lookup`. infixl 8 lookup as !! --- | A default instance of `Lookup` for an `Array` of some type of `Monoid`. --- | Note that this is different from `!!` defined in `Data.Array` in that it --- | does not 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 +-- | The instance of `Lookup` for an `Array` is just `!!` as defined in +-- | `Data.Array`. +instance lookupArray :: Lookup (Array t) Int t where + lookup = Array.index --- | 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 +-- | The instance of `Lookup` for a `StrMap` just uses `StrMap.lookup` (but +-- | flipped, because `StrMap.lookup` expects the key first, which would end up +-- | with a really weird API for `!!`). +instance lookupStrMap :: Lookup (StrMap.StrMap t) String t where + 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 !? diff --git a/test/HTTPure/HeadersSpec.purs b/test/HTTPure/HeadersSpec.purs index 0e8ec10..e7854c5 100644 --- a/test/HTTPure/HeadersSpec.purs +++ b/test/HTTPure/HeadersSpec.purs @@ -3,6 +3,7 @@ module HTTPure.HeadersSpec where import Prelude import Control.Monad.Eff.Class as EffClass +import Data.Maybe as Maybe import Data.Tuple as Tuple import Test.Spec as Spec @@ -16,14 +17,14 @@ lookupSpec :: SpecHelpers.Test lookupSpec = Spec.describe "lookup" do Spec.describe "when the string is in the header set" do Spec.describe "when searching with lowercase" do - Spec.it "is the string" do - Headers.header "x-test" "test" !! "x-test" ?= "test" + Spec.it "is Just the string" do + Headers.header "x-test" "test" !! "x-test" ?= Maybe.Just "test" Spec.describe "when searching with uppercase" do - Spec.it "is the string" do - Headers.header "x-test" "test" !! "X-Test" ?= "test" + Spec.it "is Just the string" do + Headers.header "x-test" "test" !! "X-Test" ?= Maybe.Just "test" Spec.describe "when the string is not in the header set" do - Spec.it "is an empty string" do - Headers.empty !! "X-Test" ?= "" + Spec.it "is Nothing" do + ((Headers.empty !! "X-Test") :: Maybe.Maybe String) ?= Maybe.Nothing showSpec :: SpecHelpers.Test showSpec = Spec.describe "show" do diff --git a/test/HTTPure/LookupSpec.purs b/test/HTTPure/LookupSpec.purs index 26cc2da..7676dfe 100644 --- a/test/HTTPure/LookupSpec.purs +++ b/test/HTTPure/LookupSpec.purs @@ -2,36 +2,57 @@ module HTTPure.LookupSpec where import Prelude +import Data.Maybe as Maybe import Data.StrMap as StrMap import Test.Spec as Spec -import HTTPure.Lookup ((!!)) +import HTTPure.Lookup ((!!), (!@), (!?)) import HTTPure.SpecHelpers as 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 = Spec.describe "lookupArray" do Spec.describe "when the index is in bounds" do - Spec.it "is the segment at the index" do - [ "one", "two", "three" ] !! 1 ?= "two" + Spec.it "is Just the value at the index" do + [ "one", "two", "three" ] !! 1 ?= Maybe.Just "two" Spec.describe "when the index is out of bounds" do - Spec.it "is an empty monoid" do - [ "one", "two", "three" ] !! 4 ?= "" + Spec.it "is Nothing" do + (([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing 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.it "is Just the value at the given key" do + mockStrMap !! "foo" ?= Maybe.Just "bar" Spec.describe "when the key is not in the StrMap" do - Spec.it "is an empty monoid" do - mockStrMap !! "baz" ?= "" + Spec.it "is Nothing" do + ((mockStrMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing where mockStrMap = StrMap.singleton "foo" "bar" lookupSpec :: SpecHelpers.Test lookupSpec = Spec.describe "Lookup" do + atSpec + hasSpec lookupArraySpec lookupStrMapSpec