From f588861523292af414bc07ef1e5936ff5bc9960d Mon Sep 17 00:00:00 2001 From: "Boris M. Yartsev" Date: Sat, 10 Jun 2017 21:06:37 +0200 Subject: [PATCH] Parsed the cabal.config finally. Issue to stackage on github was created, because some of the packages are marked as 'installed' --- REPL/index-project.cabal | 2 ++ REPL/src/Stackage.hs | 50 +++++++++++++++------------------------- REPL/test/Spec.hs | 45 ++++++++++++++++++++++++------------ 3 files changed, 51 insertions(+), 46 deletions(-) diff --git a/REPL/index-project.cabal b/REPL/index-project.cabal index 68e38a9..fe04aa5 100644 --- a/REPL/index-project.cabal +++ b/REPL/index-project.cabal @@ -70,6 +70,8 @@ test-suite index-project-test , tasty-hunit , megaparsec , text + , filepath + ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 diff --git a/REPL/src/Stackage.hs b/REPL/src/Stackage.hs index 164b0ae..7294161 100644 --- a/REPL/src/Stackage.hs +++ b/REPL/src/Stackage.hs @@ -1,8 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module Stackage( - parseLTSLine, - parsePackageLine) where + parseLTS, + parsePackageLine, + parseStackageLTS, + StackageLTS) where import qualified Data.Map as M import Text.Megaparsec @@ -31,47 +33,33 @@ type StackageLTS = (LongSnapshotName, [PackageData]) parseStackageLTS :: Parser StackageLTS parseStackageLTS = do - many (try (manyTill anyChar eol >> notFollowedBy parseLTSLine)) - ltsName <- parseLTSLine - --packages = - pure (ltsName, []) + ltsName <- parseLTS + manyTill anyChar (string "constraints:") + packages <- many parsePackageLine + pure (ltsName, packages) -parseLTSLine :: Parser LongSnapshotName -parseLTSLine = do - -- destroy everything +parseLTS :: Parser LongSnapshotName +parseLTS = do manyTill anyChar (string "http://www.stackage.org/snapshot/") name <- some (letterChar <|> digitChar <|> char '.' <|> char '-') - space - void eol <|> eof pure name parsePackageLine :: Parser PackageData parsePackageLine = do - packageData <- try parsePackageConst <|> parsePackageEmpty - space - manyTill anyChar (void eol <|> eof) - pure packageData - -parsePackageConst :: Parser PackageData -parsePackageConst = do - manyTill anyChar (char ':') -- chop the 'constraints:' in the beginning - parsePackageEmpty - -parsePackageEmpty :: Parser PackageData -parsePackageEmpty = do - space - parsePackageData - -parsePackageData :: Parser PackageData -parsePackageData = do + space name <- some (letterChar <|> digitChar <|> char '-') space - string "==" + version <- parseVersionVer + many (char ',') space - version <- parseVersion - many (char ',') pure (name, version) +-- unfortunately the cabal.config does not provide versions for several packages +-- And writes tehn in form 'binary installed' +-- Don't know what to do with this situation now +parseVersionVer :: Parser DV.Version +parseVersionVer = (string "==" >> parseVersion) <|> (string "installed" >> return (DV.Version [6,6,6] [])) + parseVersion :: Parser DV.Version parseVersion = do numbers <- sepBy1 L.integer (char '.') diff --git a/REPL/test/Spec.hs b/REPL/test/Spec.hs index 344b215..c3e4e75 100644 --- a/REPL/test/Spec.hs +++ b/REPL/test/Spec.hs @@ -8,6 +8,7 @@ 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 @@ -30,33 +31,47 @@ testPath text val match = testCase (T.unpack ("Parsing " <> expect 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 " ztail ==1.2" True , testParse parsePackageLine " adjunctions ==4.3," True , testParse parsePackageLine "ztail ==1.2" True , testParse parsePackageLine "adjunctions ==4.3," True - , testParse parseLTSLine "-- Stackage snapshot from: http://www.stackage.org/snapshot/lts-2.10" True - , testParse parseLTSLine "-- Stackage snapshot from: http://www.stackage.org/snapshot/lts-2.$10" False - , testParse parseLTSLine "-- Please place this file next to your .cabal file as cabal.config" False - , testParse parseLTSLine "-- To only use tested packages, uncomment the following line:" False - , testParse parseLTSLine "-- remote-repo: stackage-lts-2.10:http://www.stackage.org/lts-2.10" False - , testParse parseLTSLine "constraints: abstract-deque ==0.3," False - , testParse parseLTSLine "abstract-par ==0.3.3," False - , testParse parseLTSLine "zlib-lens ==0.1.2" False - , testParse parseLTSLine "-- Stackage snapshot from: http://www.stackage.org/snapshot/nightly-2017-06-10" 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 = (testWorkDir "sometestfile.cnf") testGroup "Cabal config parser tests" + +parseCabalConfig = testGroup "Cabal config parsing tests" [ - testFileParse parseStackageLTS + 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" @@ -75,6 +90,6 @@ testFileParse file p textFunc matchFunc = assertBool "Failed" (either (const False) id eVal) tests :: TestTree -tests = testGroup "REPL tests" [parseStackageTests, parseTests] +tests = testGroup "REPL tests" [parseStackageTests, parseTests, parseCabalConfig] main = defaultMain tests