module HaskellCI.TestedWith (
TestedWithJobs (..),
checkVersions,
) where
import Prelude ()
import Prelude.Compat
import Control.Applicative ((<|>))
import Data.List (intercalate)
import qualified Data.Foldable as F
import qualified Data.Set as S
import qualified Distribution.Compat.CharParsing as C
import qualified Distribution.Parsec as C
import qualified Distribution.Pretty as C
import qualified Text.PrettyPrint as PP
import Cabal.Project
import HaskellCI.Compiler
import HaskellCI.Package
data TestedWithJobs
= TestedWithUniform
| TestedWithAny
deriving (TestedWithJobs -> TestedWithJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestedWithJobs -> TestedWithJobs -> Bool
$c/= :: TestedWithJobs -> TestedWithJobs -> Bool
== :: TestedWithJobs -> TestedWithJobs -> Bool
$c== :: TestedWithJobs -> TestedWithJobs -> Bool
Eq, Int -> TestedWithJobs -> ShowS
[TestedWithJobs] -> ShowS
TestedWithJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestedWithJobs] -> ShowS
$cshowList :: [TestedWithJobs] -> ShowS
show :: TestedWithJobs -> String
$cshow :: TestedWithJobs -> String
showsPrec :: Int -> TestedWithJobs -> ShowS
$cshowsPrec :: Int -> TestedWithJobs -> ShowS
Show)
instance C.Parsec TestedWithJobs where
parsec :: forall (m :: * -> *). CabalParsing m => m TestedWithJobs
parsec = TestedWithJobs
TestedWithUniform forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => String -> m String
C.string String
"uniform"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TestedWithJobs
TestedWithAny forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). CharParsing m => String -> m String
C.string String
"any"
instance C.Pretty TestedWithJobs where
pretty :: TestedWithJobs -> Doc
pretty TestedWithJobs
TestedWithUniform = String -> Doc
PP.text String
"uniform"
pretty TestedWithJobs
TestedWithAny = String -> Doc
PP.text String
"any"
checkVersions
:: TestedWithJobs
-> Project a b Package
-> Either [String] (S.Set CompilerVersion, Project a b Package)
checkVersions :: forall a b.
TestedWithJobs
-> Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
checkVersions TestedWithJobs
TestedWithUniform = forall a b.
Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
checkVersionsUniform
checkVersions TestedWithJobs
TestedWithAny = forall a b.
Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
checkVersionsAny
checkVersionsUniform
:: Project a b Package
-> Either [String] (S.Set CompilerVersion, Project a b Package)
checkVersionsUniform :: forall a b.
Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
checkVersionsUniform Project a b Package
prj | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project a b Package
prj) = forall a b. a -> Either a b
Left [String
"Error reading cabal file(s)!"]
checkVersionsUniform Project a b Package
prj = do
let ([String]
errors, [Package]
names) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ([String], [Package]) -> Package -> ([String], [Package])
collectConfig forall a. Monoid a => a
mempty Project a b Package
prj
if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors)
then forall a b. a -> Either a b
Left [String]
errors
else forall a b. b -> Either a b
Right (Set CompilerVersion
allVersions, Project a b Package
prj { prjPackages :: [Package]
prjPackages = [Package]
names, prjOptPackages :: [b]
prjOptPackages = [] })
where
allVersions :: S.Set CompilerVersion
allVersions :: Set CompilerVersion
allVersions = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Package -> Set CompilerVersion
pkgJobs Project a b Package
prj
collectConfig
:: ([String], [Package])
-> Package
-> ([String], [Package])
collectConfig :: ([String], [Package]) -> Package -> ([String], [Package])
collectConfig ([String], [Package])
aggregate Package
pkg =
([String], [Package])
aggregate forall a. Semigroup a => a -> a -> a
<> ([String]
errors, [Package
pkg])
where
testWith :: Set CompilerVersion
testWith = Package -> Set CompilerVersion
pkgJobs Package
pkg
symDiff :: Set a -> Set a -> Set a
symDiff Set a
a Set a
b = forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
a Set a
b forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set a
a Set a
b
diff :: Set CompilerVersion
diff = forall a. Ord a => Set a -> Set a -> Set a
symDiff Set CompilerVersion
testWith Set CompilerVersion
allVersions
missingVersions :: [String]
missingVersions = forall a b. (a -> b) -> [a] -> [b]
map CompilerVersion -> String
dispGhcVersion forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set CompilerVersion
diff
errors :: [String]
errors | forall a. Set a -> Bool
S.null Set CompilerVersion
diff = []
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Package -> String
pkgName Package
pkg
, String
" is missing tested-with annotations for: "
] forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
missingVersions
checkVersionsAny
:: Project a b Package
-> Either [String] (S.Set CompilerVersion, Project a b Package)
checkVersionsAny :: forall a b.
Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
checkVersionsAny Project a b Package
prj | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project a b Package
prj) = forall a b. a -> Either a b
Left [String
"Error reading cabal file(s)!"]
checkVersionsAny Project a b Package
prj =
forall a b. b -> Either a b
Right (Set CompilerVersion
allVersions, Project a b Package
prj)
where
allVersions :: S.Set CompilerVersion
allVersions :: Set CompilerVersion
allVersions = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Package -> Set CompilerVersion
pkgJobs Project a b Package
prj