Skip to content

Commit

Permalink
Support newer versions of Cabal
Browse files Browse the repository at this point in the history
  • Loading branch information
sevanspowell committed Aug 12, 2020
1 parent 80d8c82 commit 2e3057c
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 12 deletions.
37 changes: 27 additions & 10 deletions src/Trace/Hpc/Coveralls/Cabal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,18 +11,35 @@

module Trace.Hpc.Coveralls.Cabal (getPackageId, getPackageNameVersion, getPackageFromDir, getPackages, readTestSuiteNames) where

#if MIN_VERSION_Cabal (2,2,0)
import Distribution.PackageDescription.Parsec
#else
import Distribution.PackageDescription.Parse
#endif

import Control.Applicative
import Control.Monad
import Data.String (fromString)
import Data.List (intercalate, isSuffixOf)
import Data.Semigroup ((<>))
import Distribution.Package (unPackageName, pkgName, pkgVersion)
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
import Distribution.Types.UnqualComponentName (unUnqualComponentName)
import Distribution.Version
import System.Directory
import Trace.Hpc.Coveralls.Types

parsePackageDescription' :: String -> Maybe GenericPackageDescription
parsePackageDescription' =
#if MIN_VERSION_Cabal (2,2,0)
parseGenericPackageDescriptionMaybe . fromString
#else
toMaybe . parsePackageDescription
where
toMaybe (ParseFailed _) = Nothing
toMaybe (ParseOk _ x) = Just x
#endif

getCabalFile :: FilePath -> IO (Maybe FilePath)
getCabalFile dir = do
cabalFilesInDir <- filter isCabal <$> getDirectoryContents dir
Expand All @@ -39,9 +56,9 @@ getCabalFile dir = do
getPackageNameVersion :: FilePath -> IO (Maybe String)
getPackageNameVersion file = do
orig <- readFile file
case parsePackageDescription orig of
ParseFailed _ -> return Nothing
ParseOk _warnings gpd -> return $ Just $ name ++ "-" ++ version
case parsePackageDescription' orig of
Nothing -> return Nothing
Just gpd -> return $ Just $ name ++ "-" ++ version
where pkg = package . packageDescription $ gpd
name = unPackageName $ pkgName pkg
version = showVersion (pkgVersion pkg)
Expand All @@ -50,9 +67,9 @@ getPackageNameVersion file = do
getPackageId :: FilePath -> IO (Maybe PackageIdentifier)
getPackageId cabalFile = do
orig <- readFile cabalFile
case parsePackageDescription orig of
ParseFailed _ -> return Nothing
ParseOk _warnings gpd -> return . Just $ PackageIdentifier name version
case parsePackageDescription' orig of
Nothing -> return Nothing
Just gpd -> return . Just $ PackageIdentifier name version
where pkg = package . packageDescription $ gpd
name = unPackageName $ pkgName pkg
version = showVersion (pkgVersion pkg)
Expand Down Expand Up @@ -111,9 +128,9 @@ versionNumbers = versionBranch
readTestSuiteNames :: FilePath -> IO [String]
readTestSuiteNames cabalFile = do
contents <- readFile cabalFile
case parsePackageDescription contents of
ParseFailed _ -> return []
ParseOk _warnings gpd -> return $ getTestSuiteNames gpd
case parsePackageDescription' contents of
Nothing -> return []
Just gpd -> return $ getTestSuiteNames gpd

getTestSuiteNames :: GenericPackageDescription -> [String]
getTestSuiteNames = foldMap ((:[]) . unUnqualComponentName . fst) . condTestSuites
4 changes: 2 additions & 2 deletions src/Trace/Hpc/Coveralls/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,9 +65,9 @@ data Package
type FindPackageRequest
= [
( FilePath
-- ^ Project root directory
-- Project root directory
, Maybe FilePath
-- ^ Optional explicit path to cabal file
-- Optional explicit path to cabal file
)
]

Expand Down

0 comments on commit 2e3057c

Please sign in to comment.