version 0.0.1.1HEAD0.0.1.1master

5 files changed, 79 insertions, 9 deletions

diff --git a/ChangeLog.md b/ChangeLog.md
index 06b8bd3..2f4d5fd 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,6 @@
-# Changelog for rowdy
+# Changelog for rowdy-yesod
 
-## Unreleased changes
+## 0.0.1.1
+
+- Fixed a bug where path components were being merged, resulting in dropped
+  routes.
diff --git a/rowdy-yesod.cabal b/rowdy-yesod.cabal
index d7b4c8b..db196c8 100644
--- a/rowdy-yesod.cabal
+++ b/rowdy-yesod.cabal
@@ -1,11 +1,13 @@
--- This file has been generated from package.yaml by hpack version 0.20.0.
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 9d563ed5769651d2cdd6c0ad047d961c424e9a91a4826688362cb02679399f62
+-- hash: 086fe6aeae68ba318303b5279097f6c53f278815f782926c25a2eb7ed55234f4
 
 name:           rowdy-yesod
-version:        0.0.1.0
+version:        0.0.1.1
 synopsis:       An EDSL for web application routes.
 description:    Please see the README on Github at <https://github.com/parsonsmatt/rowdy#readme>
 category:       Web
@@ -17,11 +19,9 @@ copyright:      2018 Matt Parsons
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
-cabal-version:  >= 1.10
-
 extra-source-files:
-    ChangeLog.md
     README.md
+    ChangeLog.md
 
 source-repository head
   type: git
@@ -55,5 +55,6 @@ test-suite specs
     , rowdy-yesod
     , yesod-core
   other-modules:
+      Rowdy.YesodSpec
       Paths_rowdy_yesod
   default-language: Haskell2010
diff --git a/src/Rowdy/Yesod/Internal.hs b/src/Rowdy/Yesod/Internal.hs
index 9400912..f670972 100644
--- a/src/Rowdy/Yesod/Internal.hs
+++ b/src/Rowdy/Yesod/Internal.hs
@@ -80,6 +80,8 @@ routeTreeToResourceTree =
     go pcs (Leaf term) (ResourceLeaf Resource {..} : acc)
         | listEq eqPieceStr (rights (reverse pcs)) resourcePieces
         , Methods multi methods <- resourceDispatch
+        , MkResource _ endpointName <- term
+        , resourceName == endpointName
         =
         flip (:) acc . ResourceLeaf $
             case term of
diff --git a/test/Rowdy/YesodSpec.hs b/test/Rowdy/YesodSpec.hs
new file mode 100644
index 0000000..f79277b
--- /dev/null
+++ b/test/Rowdy/YesodSpec.hs
@@ -0,0 +1,65 @@
+{-# language TypeApplications, OverloadedStrings, StandaloneDeriving, FlexibleInstances #-}
+
+module Rowdy.YesodSpec where
+
+import Data.Proxy
+import Rowdy
+import Rowdy.Yesod
+import Yesod.Routes.TH.Types
+import Test.Hspec
+
+deriving instance Eq (ResourceTree String)
+deriving instance Eq (Resource String)
+deriving instance Eq (Piece String)
+deriving instance Eq (Dispatch String)
+
+router = do
+    get "RootR"
+    "weight" // do
+        get "WeightsR"
+        "record" // do
+            resource "RecordWeightR" [get, post]
+        capture @Int // do
+            delete "WeightR"
+
+    "auth" // do
+        resource "LoginR" [get, post]
+        post "LogoutR"
+
+
+spec :: Spec
+spec = do
+    describe "routes" $ do
+        it "works" $ do
+            runRouteDsl router
+                `shouldBe`
+                    [ Leaf (MkResource Get "RootR")
+                    , PathComponent (Literal "weight")
+                        $ Leaf (MkResource Get "WeightsR")
+                    , PathComponent (Literal "weight")
+                        $ PathComponent (Literal "record")
+                        $ Leaf (MkResource Get "RecordWeightR")
+                    , PathComponent (Literal "weight")
+                        $ PathComponent (Literal "record")
+                        $ Leaf (MkResource Post "RecordWeightR")
+                    , PathComponent (Literal "weight")
+                        $ PathComponent (Capture (Type (Proxy @Int)))
+                        $ Leaf (MkResource Delete "WeightR")
+                    , PathComponent (Literal "auth")
+                        $ Leaf (MkResource Get "LoginR")
+                    , PathComponent (Literal "auth")
+                        $ Leaf (MkResource Post "LoginR")
+                    , PathComponent (Literal "auth")
+                        $ Leaf (MkResource Post "LogoutR")
+                    ]
+
+        it "toYesod works" $ do
+            toYesod router
+                `shouldBe`
+                    [ ResourceLeaf (Resource "RootR" [] (Methods Nothing ["GET"]) [] True)
+                    , ResourceLeaf (Resource "WeightsR" [Static "weight"] (Methods Nothing ["GET"]) [] True)
+                    , ResourceLeaf (Resource "RecordWeightR" [Static "weight", Static "record"] (Methods Nothing ["GET", "POST"]) [] True)
+                    , ResourceLeaf (Resource "WeightR" [Static "weight", Dynamic "Int"] (Methods Nothing ["DELETE"]) [] True)
+                    , ResourceLeaf (Resource "LoginR" [Static "auth"] (Methods Nothing ["GET", "POST"]) [] True)
+                    , ResourceLeaf (Resource "LogoutR" [Static "auth"] (Methods Nothing ["POST"]) [] True)
+                    ]
diff --git a/test/Spec.hs b/test/Spec.hs
index 038e7c8..a824f8c 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,2 +1 @@
 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
-