fixed #6

test/MainSpec.hs

@@ -11,13 +11,11 @@ import Test.QuickCheck.Instances
 
 import UrlPath
 
-import Lucid
-import Lucid.Base
-
 import qualified Data.Text as T
 
+import Data.String
 import Data.Monoid
-
+import Data.Functor.Identity
 
 main :: IO ()
 main = hspec spec
@@ -31,37 +29,63 @@ spec = do
   describe "deploying" deploy
 
 deploy :: Spec
-deploy =
- it "should intercalate `?` and `&`" $ property $
-   testPath runRelativeUrl Rel
- it "should intercalate `?` and `&` and prepend `/`" $ property $
-   testPath runGroundedUrl Gro
+deploy = do
+ it "should intercalate `?` and `&`" ( property $
+   testPath (\m h -> runIdentity $ runRelativeUrlT m h) Rel
+   )
+ it "should intercalate `?` and `&` and prepend `/`" ( property $
+   testPath (\m h -> runIdentity $ runGroundedUrlT m h) Gro
+   )
  it "should intercalate `?` and `&` and prepend the host" $ property $
-   testPath runAbsoluteUrl Abs
+   testPath (\m h -> runIdentity $ runAbsoluteUrlT m h) Abs
 
 
+-- | Render arbitrary Url combinations, with an abstracted deployment method
 testPath :: ( UrlReader T.Text m
             , Url T.Text m ) =>
-            ( m T.Text T.Text
+            ( m T.Text
            -> T.Text
            -> T.Text ) -- runner
          -> Deploy -- deployment scheme
          -> T.Text -- Host
          -> T.Text -- Target
          -> [(T.Text, T.Text)] -- Keys and Values
          -> Property
-testPath renderPath d host target kvs = do
-  not (T.null host) ==>
-    not (T.null target) ==>
-       --- | TODO
-              let host' = case d of
-                            Rel -> ""
-                            Gro -> "/"
-                            Abs -> host <> "/"
-              in
-
-              runTest host'
+testPath pathRunner d host target keyval = do
+  let host' = case d of
+                Rel -> ""
+                Gro -> "/"
+                Abs -> host <> "/"
+
+  (pathRunner (url $ urlStringTail target keyval) host)
+    === (rawRender host' target keyval)
+
+  where
+    urlStringTail :: ( IsString a
+                     , Monoid a
+                     ) => a -> [(a,a)] -> UrlString a
+
+    urlStringTail t [] = UrlString t []
+    urlStringTail t [kv] = t <?> kv
+    urlStringTail t (kv:kvs) =
+      foldl (<&>) (t <?> kv) kvs
+
+
+-- | Manual Url rendering
+rawRender :: ( IsString a
+             , Monoid a
+             ) => a -> a -> [(a,a)] -> a
+rawRender rawHost target kvs =
+  rawHost <> target <> rawUrlTail kvs
+
+
+-- | Manually intercalate characters
+rawUrlTail :: ( IsString a
+              , Monoid a
+              ) => [(a,a)] -> a
+rawUrlTail [] = ""
+rawUrlTail [(k,v)] = "?" <> k <> "=" <> v
+rawUrlTail ((k,v):kvs) =
+  foldl urlTail ("?" <> k <> "=" <> v) kvs
   where
-    runTest host' = do
-      (renderPath (url $ target <?> (key1, val1) <&> (key2, val2)) host)
-      === (host' <> target <> "?" <> key1 <> "=" <> val1 <> "&" <> key2 <> "=" <> val2)
+    urlTail acc (x,y) = acc <> "&" <> x <> "=" <> y

urlpath.cabal

@@ -1,5 +1,5 @@
 Name:                   urlpath
-Version:                0.1.0.1
+Version:                0.1.1
 Author:                 Athan Clark <athan.clark@gmail.com>
 Maintainer:             Athan Clark <athan.clark@gmail.com>
 License:                MIT