Merge pull request #55 from slamdata/nes-match

Add matcher for `NonEmptyString`

Author: garyb

bower.json

@@ -43,7 +43,8 @@
   },
   "devDependencies": {
     "purescript-console": "^3.0.0",
-    "purescript-assert": "^3.0.0",
-    "purescript-record": "^0.2.6"
+    "purescript-assert": "^3.1.0",
+    "purescript-record": "^0.2.6",
+    "purescript-generics-rep": "^5.4.0"
   }
 }

src/Routing/Match.purs

@@ -1,25 +1,27 @@
-module Routing.Match where
+module Routing.Match
+  ( module Routing.Match
+  , module Routing.Match.Class
+  ) where
 
 import Prelude
 
 import Control.Alt (class Alt, (<|>))
 import Control.Alternative (class Alternative)
 import Control.Plus (class Plus)
-
 import Data.Either (Either(..))
 import Data.Foldable (foldl)
 import Data.Int (fromString)
 import Data.List (List(..), reverse)
 import Data.Map as M
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (class Newtype, unwrap)
 import Data.Semiring.Free (Free, free)
+import Data.String.NonEmpty (NonEmptyString)
+import Data.String.NonEmpty as NES
 import Data.Tuple (Tuple(..), snd)
 import Data.Validation.Semiring (V, invalid, unV)
-
 import Global (readFloat, isNaN)
-
-import Routing.Match.Class (class MatchClass)
+import Routing.Match.Class (class MatchClass, bool, end, fail, int, lit, num, param, params, root, str)
 import Routing.Match.Error (MatchError(..), showMatchError)
 import Routing.Types (Route, RoutePart(..))
 
@@ -125,6 +127,11 @@ instance matchApply :: Apply Match where
 instance matchApplicative :: Applicative Match where
   pure a = Match \r -> pure $ Tuple r a
 
+-- | Matches a non-empty string.
+nonempty :: Match NonEmptyString
+nonempty =
+  eitherMatch $ maybe (Left "Empty string") Right <<< NES.fromString <$> str
+
 -- | Matches list of matchers. Useful when argument can easy fail (not `str`)
 -- | returns `Match Nil` if no matches
 list :: forall a. Match a -> Match (List a)
@@ -137,9 +144,6 @@ list (Match r2a) =
           (\(Tuple rs a) -> go (Cons a accum) rs)
           (r2a r)
 
-
-
-
 -- It groups `Free MatchError` -> [[MatchError]] -map with showMatchError ->
 -- [[String]] -fold with semicolon-> [String] -fold with newline-> String
 runMatch :: forall a. Match a -> Route -> Either String a

test/Test/Main.purs

@@ -2,68 +2,111 @@ module Test.Main where
 
 import Prelude
 
-import Control.Alt ((<|>))
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.Eff.Console (CONSOLE)
+import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
+import Data.Foldable (oneOf)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
 import Data.List (List)
 import Data.List as L
 import Data.Map as M
+import Data.String.NonEmpty (NonEmptyString)
+import Data.String.NonEmpty as NES
 import Data.Tuple (Tuple(..))
+import Partial.Unsafe (unsafePartial)
 import Routing (match)
-import Routing.Match (Match, list)
-import Routing.Match.Class (bool, end, int, lit, num, str, param, params)
-import Test.Assert (ASSERT, assert')
+import Routing.Match (Match, bool, end, int, list, lit, nonempty, num, param, params, str)
+import Test.Assert (ASSERT, assertEqual)
 
-data FooBar
+data MyRoutes
   = Foo Number (M.Map String String)
   | Bar Boolean String
   | Baz (List Number)
   | Quux Int
   | Corge String
+  | Corge' NonEmptyString
   | End Int
 
-derive instance eqFooBar :: Eq FooBar
-
-instance showFooBar :: Show FooBar where
-  show (Foo num q) = "(Foo " <> show num <> " " <> show q <> ")"
-  show (Bar bool str) = "(Bar " <> show bool <> " " <> show str <> ")"
-  show (Baz lst) = "(Baz " <> show lst <> ")"
-  show (Quux i) = "(Quux " <> show i <> ")"
-  show (Corge str) = "(Corge " <> show str <> ")"
-  show (End i) = "(End " <> show i <> ")"
-
-routing :: Match FooBar
-routing =
-  Foo <$> (lit "foo" *> num) <*> params
-    <|> Bar <$> (lit "bar" *> bool) <*> (param "baz")
-    <|> Quux <$> (lit "" *> lit "quux" *> int)
-    <|> Corge <$> (lit "corge" *> str)
-    -- Order matters here.  `list` is greedy, and `end` wont match after it
-    <|> End <$> (lit "" *> int <* end)
-    <|> Baz <$> (list num)
+derive instance eqMyRoutes :: Eq MyRoutes
+derive instance genericMyRoutes :: Generic MyRoutes _
+instance showMyRoutes :: Show MyRoutes where show = genericShow
 
+routing :: Match MyRoutes
+routing = oneOf
+  [ Foo <$> (lit "foo" *> num) <*> params
+  , Bar <$> (lit "bar" *> bool) <*> (param "baz")
+  , Baz <$> (lit "list" *> list num)
+  , Quux <$> (lit "" *> lit "quux" *> int)
+  , Corge <$> (lit "corge" *> str)
+  , Corge' <$> (lit "corge'" *> nonempty)
+  , End <$> (lit "" *> int <* end)
+  ]
 
 main :: Eff (assert :: ASSERT, console :: CONSOLE) Unit
 main = do
-  assertEq (match routing "foo/12/?welp='hi'&b=false") (Right (Foo 12.0 (M.fromFoldable [Tuple "welp" "'hi'", Tuple "b" "false"])))
-  assertEq (match routing "foo/12?welp='hi'&b=false") (Right (Foo 12.0 (M.fromFoldable [Tuple "welp" "'hi'", Tuple "b" "false"])))
-  assertEq (match routing "bar/true?baz=test") (Right (Bar true "test"))
-  assertEq (match routing "bar/false?baz=%D0%B2%D1%80%D0%B5%D0%BC%D0%B5%D0%BD%D0%BD%D1%8B%D0%B9%20%D1%84%D0%B0%D0%B9%D0%BB") (Right (Bar false "временный файл"))
-  assertEq (match routing "corge/test") (Right (Corge "test"))
-  assertEq (match routing "corge/%D0%B2%D1%80%D0%B5%D0%BC%D0%B5%D0%BD%D0%BD%D1%8B%D0%B9%20%D1%84%D0%B0%D0%B9%D0%BB") (Right (Corge "временный файл"))
-  assertEq (match routing "/quux/42") (Right (Quux 42))
-  assertEq (match routing "123/") (Right (Baz (L.fromFoldable [123.0])))
-  assertEq (match routing "/1") (Right (End 1))
-  assertEq (match routing "foo/0/?test=a/b/c") (Right (Foo 0.0 (M.fromFoldable [Tuple "test" "a/b/c"])))
-
-assertEq
-  :: forall a eff
-  . Eq a
-  => Show a
-  => a
-  -> a
-  -> Eff (assert :: ASSERT, console :: CONSOLE | eff) Unit
-assertEq actual expected
-  | actual /= expected = assert' ("Equality assertion failed\n\nActual: " <> show actual <> "\n\nExpected: " <> show expected) false
-  | otherwise = log ("Equality assertion passed for " <> show actual)
+  assertEqual
+    { actual: match routing "foo/12/?welp='hi'&b=false"
+    , expected: Right (Foo 12.0 (M.fromFoldable [Tuple "welp" "'hi'", Tuple "b" "false"]))
+    }
+  assertEqual
+    { actual: match routing "foo/12?welp='hi'&b=false"
+    , expected: Right (Foo 12.0 (M.fromFoldable [Tuple "welp" "'hi'", Tuple "b" "false"]))
+    }
+  assertEqual
+    { actual: match routing "bar/true?baz=test"
+    , expected: Right (Bar true "test")
+    }
+  assertEqual
+    { actual: match routing "bar/false?baz=%D0%B2%D1%80%D0%B5%D0%BC%D0%B5%D0%BD%D0%BD%D1%8B%D0%B9%20%D1%84%D0%B0%D0%B9%D0%BB"
+    , expected: Right (Bar false "временный файл")
+    }
+  assertEqual
+    { actual: match routing "corge/test"
+    , expected: Right (Corge "test")
+    }
+  assertEqual
+    { actual: match routing "corge/%D0%B2%D1%80%D0%B5%D0%BC%D0%B5%D0%BD%D0%BD%D1%8B%D0%B9%20%D1%84%D0%B0%D0%B9%D0%BB"
+    , expected: Right (Corge "временный файл")
+    }
+  assertEqual
+    { actual: match routing "corge'/test"
+    , expected: Right (Corge' (unsafePartial NES.unsafeFromString "test"))
+    }
+  assertEqual
+    { actual: match routing "corge'/%D0%B2%D1%80%D0%B5%D0%BC%D0%B5%D0%BD%D0%BD%D1%8B%D0%B9%20%D1%84%D0%B0%D0%B9%D0%BB"
+    , expected: Right (Corge' (unsafePartial NES.unsafeFromString "временный файл"))
+    }
+  assertEqual
+    { actual: lmap (const unit) (match routing "corge'/")
+    , expected: Left unit
+    }
+  assertEqual
+    { actual: match routing "/quux/42"
+    , expected: Right (Quux 42)
+    }
+  assertEqual
+    { actual: match routing "list/123/"
+    , expected: Right (Baz (L.fromFoldable [123.0]))
+    }
+  assertEqual
+    { actual: match routing "list/123/456"
+    , expected: Right (Baz (L.fromFoldable [123.0, 456.0]))
+    }
+  assertEqual
+    { actual: match routing "list/"
+    , expected: Right (Baz (L.fromFoldable []))
+    }
+  assertEqual
+    { actual: match routing "list"
+    , expected: Right (Baz (L.fromFoldable []))
+    }
+  assertEqual
+    { actual: match routing "/1"
+    , expected: Right (End 1)
+    }
+  assertEqual
+    { actual: match routing "foo/0/?test=a/b/c"
+    , expected: Right (Foo 0.0 (M.fromFoldable [Tuple "test" "a/b/c"]))
+    }