1
1
mirror of https://github.com/aelve/guide.git synced 2024-11-29 14:35:35 +03:00

Fixed '-' parsing in package name bug and added Tasty HUint tests

This commit is contained in:
Boris M. Yartsev 2017-06-04 16:32:07 +03:00
parent cb7b7eabf1
commit 7112d7321e
3 changed files with 46 additions and 5 deletions

View File

@ -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

View File

@ -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

View File

@ -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