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:
parent
cb7b7eabf1
commit
7112d7321e
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user