mirror of
https://github.com/aelve/guide.git
synced 2024-11-29 06:23:17 +03:00
99 lines
4.0 KiB
Haskell
99 lines
4.0 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
import Data.Ord
|
|
import Text.Megaparsec
|
|
import Text.Megaparsec.Text
|
|
import Data.Either (isRight, either)
|
|
import qualified Data.Text as T
|
|
import Data.Monoid ((<>))
|
|
import System.FilePath((</>))
|
|
import HackageArchive
|
|
import Common
|
|
|
|
import qualified Data.Text.IO as TIO
|
|
|
|
testWorkingDir :: String
|
|
testWorkingDir = "testworkdir"
|
|
|
|
parseTests = testGroup "Hackage archive parsing tests"
|
|
[
|
|
testPath "filecollection/0.1.1.9/filecollection.cabal" "filecollection" True
|
|
, testPath "filecollection/0.1.1.9/filecollection.cabal" "filecollectionz" False
|
|
, testPath "file-collection/0.1.1.9/file-collection.cabal" "file-collection" True
|
|
, testPath "file-collection/0.1.1.9/file-collection.cabal" "filecollection" False
|
|
]
|
|
|
|
testPath :: T.Text -> T.Text -> Bool -> TestTree
|
|
testPath text val match = testCase (T.unpack ("Parsing " <> expect match <> " \'" <> text <> "\'")) $
|
|
assertBool "Failed" $ ((fst <$> parsePath (T.unpack text)) == Just (T.unpack val)) == match
|
|
|
|
{-
|
|
parseStackageTests = testGroup "Stackage parsing tests"
|
|
[
|
|
testParse parsePackageLine " ztail ==1.2" True
|
|
, testParse parsePackageLine " adjunctions ==4.3," True
|
|
, testParse parsePackageLine "ztail ==1.2" True
|
|
, testParse parsePackageLine "adjunctions ==4.3," True
|
|
|
|
, testParse parseLTS "-- Stackage snapshot from: http://www.stackage.org/snapshot/lts-2.10" True
|
|
, testParse parseLTS "-- Stackage snapshot from: http://www.stackage.org/snapshot/lts-2.$10" True
|
|
, testParse parseLTS "-- Please place this file next to your .cabal file as cabal.config" False
|
|
, testParse parseLTS "-- To only use tested packages, uncomment the following line:" False
|
|
, testParse parseLTS "-- remote-repo: stackage-lts-2.10:http://www.stackage.org/lts-2.10" False
|
|
, testParse parseLTS "constraints: abstract-deque ==0.3," False
|
|
, testParse parseLTS "abstract-par ==0.3.3," False
|
|
, testParse parseLTS "zlib-lens ==0.1.2" False
|
|
, testParse parseLTS "-- Stackage snapshot from: http://www.stackage.org/snapshot/nightly-2017-06-10" True
|
|
]
|
|
|
|
parseCabalConfig = testGroup "Cabal config parsing tests"
|
|
[
|
|
testStackagePackageLines parseStackageLTS "sometestfile.cnf"
|
|
, testStackagePackageLines parseStackageLTS "sometestfile2.cnf"
|
|
, testFileJustParse parseStackageLTS "sometestfile3.cnf" True
|
|
]
|
|
-}
|
|
|
|
-- Well this is code duplication. Somehow need to use testParse function here
|
|
|
|
testFileJustParse :: Parser a -> FilePath -> Bool -> TestTree
|
|
testFileJustParse p file match = testCase ("Testing file: " ++ file) $ do
|
|
fileText <- TIO.readFile (testWorkingDir </> file)
|
|
assertBool "Failed" (isRight (runParser p "" fileText) == match)
|
|
|
|
testStackagePackageLines :: Parser StackageLTS -> FilePath -> TestTree
|
|
testStackagePackageLines p file = testFileParse (testWorkingDir </> file)
|
|
p countPackageLines matchWithStackageLTS
|
|
|
|
countPackageLines :: T.Text -> Int
|
|
countPackageLines text = length $ filter isPackageLine lns
|
|
where lns = T.lines text
|
|
isPackageLine ln = not ("--" `T.isInfixOf` ln)
|
|
&& (("installed" `T.isInfixOf` ln) || ("==" `T.isInfixOf` ln))
|
|
|
|
matchWithStackageLTS :: Int -> StackageLTS -> Bool
|
|
matchWithStackageLTS count1 stackage = count1 == (length.snd) stackage
|
|
|
|
expect :: Bool -> T.Text
|
|
expect True = "expect success"
|
|
expect False = "expect fail"
|
|
|
|
testParse :: Parser a -> T.Text -> Bool -> TestTree
|
|
testParse p text match = testCase (T.unpack ("Parsing " <> expect match <> " \'" <> text <> "\'")) $
|
|
assertBool "Failed" (isRight (runParser p "" text) == match)
|
|
|
|
testFileParse :: FilePath -> Parser a -> (T.Text -> b) -> (b -> a -> Bool) -> TestTree
|
|
testFileParse file p textFunc matchFunc =
|
|
testCase ("Testing file: " ++ file) $ do
|
|
fileText <- TIO.readFile file -- got the file
|
|
let textVal = textFunc fileText
|
|
let eVal = matchFunc textVal <$> runParser p "" fileText
|
|
assertBool "Failed" (either (const False) id eVal)
|
|
|
|
tests :: TestTree
|
|
tests = testGroup "REPL tests" [parseTests]
|
|
|
|
main = defaultMain tests
|