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 main-is: Spec.hs
build-depends: base build-depends: base
, index-project , index-project
, tasty
, tasty-hunit
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010 default-language: Haskell2010

View File

@ -4,7 +4,8 @@ module TarUtil (
buildDifferenceMap, buildDifferenceMap,
buildHackageMap, buildHackageMap,
buildPreHackageMap, buildPreHackageMap,
loadTar loadTar,
parsePath
) where ) where
import qualified Codec.Archive.Tar as Tar 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 -- Parses the file path of the cabal file to get version and package name
parseCabalFilePath :: RP.ReadP HPPathData parseCabalFilePath :: RP.ReadP HPPathData
parseCabalFilePath = do parseCabalFilePath = do
package <- RP.munch1 DC.isLetter package <- RP.munch1 phi
RP.char '/' RP.char '/'
version <- DV.parseVersion version <- DV.parseVersion
RP.char '/' RP.char '/'
name <- RP.munch1 (\l -> DC.isLetter l || l == '-') name <- RP.munch1 phi
guard (name == package) guard (name == package)
suff <- RP.string ".cabal" suff <- RP.string ".cabal"
RP.eof RP.eof
pure $ (package, version) pure $ (package, version)
where phi l = DC.isLetter l || l == '-'
updateMapCompare :: (Ord a) => String -> a -> M.Map String a -> M.Map String a updateMapCompare :: (Ord a) => String -> a -> M.Map String a -> M.Map String a
updateMapCompare key value map = case M.lookup key map of updateMapCompare key value map = case M.lookup key map of

View File

@ -1,2 +1,39 @@
main :: IO () import Test.Tasty
main = putStrLn "Test suite not yet implemented" 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