From 133b98c9c6398f38aca68a173b35c3f34f4c6bb7 Mon Sep 17 00:00:00 2001
From: Connor Prussin <connor@prussin.net>
Date: Mon, 23 Oct 2017 18:50:27 -0400
Subject: [PATCH] Add helpers in Lookup and return a Maybe from `lookup`. (#84)

---
 docs/Examples/Headers/Main.purs         |  4 +-
 docs/Examples/PathSegments/Main.purs    |  4 +-
 docs/Examples/QueryParameters/Main.purs |  8 ++--
 src/HTTPure.purs                        |  2 +-
 src/HTTPure/Headers.purs                | 17 ++++----
 src/HTTPure/Lookup.purs                 | 56 ++++++++++++++++---------
 test/HTTPure/HeadersSpec.purs           | 13 +++---
 test/HTTPure/LookupSpec.purs            | 39 +++++++++++++----
 8 files changed, 90 insertions(+), 53 deletions(-)

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