guide/REPL/test/Spec.hs

{-# 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 Stackage

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 "constraints: abstract-deque ==0.3," True
    , testParse parsePackageLine "constraints: abstract-deque ==0.3" True
    , testParse parsePackageLine "constraints: abstract-deque ==0." False
    , testParse parsePackageLine "constraints: abstract-deque ==" False
    , testParse parsePackageLine "constraints: abst3453#$%#ract-deque ==0.3" False
    , testParse parsePackageLine "constraints: abstract-deque ==0.3," True
-}
    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 "sometestfile.cnf"
  ]

testStackagePackageLines file = testFileParse (testWorkingDir </> file) 
  parseStackageLTS countPackageLines matchWithStackageLTS


-- refactor isComment
countPackageLines :: T.Text -> Int
countPackageLines text = length $ filter isComment lns
  where lns = T.lines text
        isComment ln = not ("--" `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" [parseStackageTests, parseTests, parseCabalConfig]

main = defaultMain tests