Implement quickcheck on path utilities and fix a bug.

pkg/king/lib/Noun/Conversions.hs

@@ -592,11 +592,12 @@ pathToFilePath p = joinPath components
 filePathToPath :: FilePath -> Path
 filePathToPath fp = Path path
   where
+    path = map (MkKnot . pack) (dir ++ file)
     dir = case (splitDirectories $ (takeDirectory fp)) of
+      ["."]    -> []
       ("/":xs) -> xs
       x        -> x
-    file = [takeBaseName fp, ext]
-    path = map (MkKnot . pack) (dir ++ file)
+    file = if ext /= "" then [takeBaseName fp, ext] else [takeBaseName fp]
     ext = case takeExtension fp of
       ('.':xs) -> xs
       x        -> x

pkg/king/test/ClayTests.hs

@@ -0,0 +1,28 @@
+module ClayTests (tests) where
+
+import Noun.Conversions
+import UrbitPrelude
+
+import Test.QuickCheck       hiding ((.&.))
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.TH
+
+instance Arbitrary Knot where
+  arbitrary = (MkKnot . pack) <$> sublistOf ['a'..'z']
+
+nonEmptyList :: (Arbitrary a) => Gen [a]
+nonEmptyList = sized $ \n ->
+  do k <- choose (1, max 1 n)
+     vector k
+
+instance Arbitrary Path where
+  arbitrary = Path <$> nonEmptyList
+
+testPathRoundTrip :: Path -> Property
+testPathRoundTrip p =
+  classify (1 == (length $ unPath p)) "singleton" $
+  (filePathToPath (pathToFilePath p)) === p
+
+tests = testGroup "Clay"
+  [ testProperty "Path round trip" $ testPathRoundTrip ]

pkg/king/test/Main.hs

@@ -14,6 +14,7 @@ import System.Environment (setEnv)
 import qualified AmesTests
 import qualified ArvoTests
 import qualified BehnTests
+import qualified ClayTests
 import qualified DawnTests
 import qualified DeriveNounTests
 import qualified HoonMapSetTests
@@ -29,6 +30,7 @@ main = do
         [ AmesTests.tests
         , ArvoTests.tests
         , BehnTests.tests
+        , ClayTests.tests
         , DawnTests.tests
         , DeriveNounTests.tests
         , HoonMapSetTests.tests