add testcoverage target using hpc

added a test for key read and show

1 files changed, 18 insertions, 0 deletions

diff --git a/TypeInternals.hs b/TypeInternals.hs
index 9acc06bb3..fe6e562f9 100644
--- a/TypeInternals.hs
+++ b/TypeInternals.hs
@@ -12,6 +12,7 @@ module TypeInternals where
 import Control.Monad.State (StateT)
 import Data.String.Utils
 import qualified Data.Map as M
+import Test.QuickCheck
 
 import qualified GitRepo as Git
 import qualified GitQueue
@@ -57,6 +58,23 @@ instance Read Key where
 			b = head l
 			k = join ":" $ drop 1 l
 
+-- for quickcheck
+instance Arbitrary Key where
+	arbitrary = do
+		backendname <- arbitrary
+		keyname <- arbitrary
+		return $ Key (backendname, keyname)
+
+prop_idempotent_key_read_show :: Key -> Bool
+prop_idempotent_key_read_show k
+	-- filter out empty key or backend names
+	-- also backend names will not contain colons
+	| null kname || null bname || elem ':' bname = True
+	| otherwise = k == (read $ show k)
+	where
+		bname = backendName k
+		kname = keyName k
+
 backendName :: Key -> BackendName
 backendName (Key (b,_)) = b
 keyName :: Key -> KeyName