From 7112d7321e73ad4f522fac4a5296c13a07e9d9cb Mon Sep 17 00:00:00 2001
From: "Boris M. Yartsev" <borboss@gmail.com>
Date: Sun, 4 Jun 2017 16:32:07 +0300
Subject: [PATCH] Fixed '-' parsing in package name bug and added Tasty HUint
 tests

---
 REPL/index-project.cabal |  2 ++
 REPL/src/TarUtil.hs      |  8 +++++---
 REPL/test/Spec.hs        | 41 ++++++++++++++++++++++++++++++++++++++--
 3 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/REPL/index-project.cabal b/REPL/index-project.cabal
index 50039f8..0116eb4 100644
--- a/REPL/index-project.cabal
+++ b/REPL/index-project.cabal
@@ -59,6 +59,8 @@ test-suite index-project-test
   main-is:             Spec.hs
   build-depends:       base
                      , index-project
+                     , tasty
+                     , tasty-hunit
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
 
diff --git a/REPL/src/TarUtil.hs b/REPL/src/TarUtil.hs
index 1b5835b..dda0444 100644
--- a/REPL/src/TarUtil.hs
+++ b/REPL/src/TarUtil.hs
@@ -4,7 +4,8 @@ module TarUtil (
                 buildDifferenceMap,
                 buildHackageMap,
                 buildPreHackageMap,
-                loadTar
+                loadTar,
+                parsePath
                 ) where
 
 import qualified Codec.Archive.Tar as Tar
@@ -61,15 +62,16 @@ type HPPathData = (String, DV.Version)
 -- Parses the file path of the cabal file to get version and package name
 parseCabalFilePath :: RP.ReadP HPPathData
 parseCabalFilePath = do
-  package <- RP.munch1 DC.isLetter
+  package <- RP.munch1 phi
   RP.char '/'
   version <- DV.parseVersion
   RP.char '/'
-  name <- RP.munch1 (\l -> DC.isLetter l || l == '-')
+  name <- RP.munch1 phi
   guard (name == package)
   suff <- RP.string ".cabal"
   RP.eof
   pure $ (package, version)
+  where phi l = DC.isLetter l || l == '-'
 
 updateMapCompare :: (Ord a) => String -> a -> M.Map String a -> M.Map String a
 updateMapCompare key value map = case M.lookup key map of
diff --git a/REPL/test/Spec.hs b/REPL/test/Spec.hs
index cd4753f..58e59f2 100644
--- a/REPL/test/Spec.hs
+++ b/REPL/test/Spec.hs
@@ -1,2 +1,39 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+import Test.Tasty
+import Test.Tasty.HUnit
+import Data.Ord
+
+import TarUtil as TU
+
+parseTests = testGroup "Different parsing tests"
+  [
+--    testCase "'-' chat in package name parsing" $
+--    (fst <$> parsePath "file-collection/0.1.1.9/file-collection.cabal") 
+--      `compare` (Just "file-collection") @?= EQ,
+
+    testCase "Package name parsing" $
+    (fst <$> parsePath "filecollection/0.1.1.9/filecollection.cabal") == (Just "filecollection") @?= True
+    
+    , testCase "Package name parsing" $
+    (fst <$> parsePath "filecollection/0.1.1.9/filecollection.cabal") == (Just "filecollectionz") @?= False
+    
+    , testCase "Package name parsing" $
+    (fst <$> parsePath "file-collection/0.1.1.9/file-collection.cabal") == (Just "file-collection") @?= True
+
+    , testCase "Package name parsing" $
+    (fst <$> parsePath "file-collection/0.1.1.9/file-collection.cabal") == (Just "filecollection") @?= False
+  ]
+{-
+  [ testCase "List comparison (different length)" $
+      [1, 2, 3] `compare` [1,2] @?= GT
+
+  -- the following test does not hold
+  , testCase "List comparison (same length)" $
+      [1, 2, 3] `compare` [1,2,2] @?= LT
+  ]
+-}
+
+tests :: TestTree
+tests = testGroup "REPL tests" [parseTests]
+
+
+main = defaultMain parseTests