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
(TestedWithJobs -> TestedWithJobs -> Bool)
-> (TestedWithJobs -> TestedWithJobs -> Bool) -> Eq TestedWithJobs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestedWithJobs -> TestedWithJobs -> Bool
== :: TestedWithJobs -> TestedWithJobs -> Bool
$c/= :: TestedWithJobs -> TestedWithJobs -> Bool
/= :: TestedWithJobs -> TestedWithJobs -> Bool
Eq, Int -> TestedWithJobs -> ShowS
[TestedWithJobs] -> ShowS
TestedWithJobs -> String
(Int -> TestedWithJobs -> ShowS)
-> (TestedWithJobs -> String)
-> ([TestedWithJobs] -> ShowS)
-> Show TestedWithJobs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestedWithJobs -> ShowS
showsPrec :: Int -> TestedWithJobs -> ShowS
$cshow :: TestedWithJobs -> String
show :: TestedWithJobs -> String
$cshowList :: [TestedWithJobs] -> ShowS
showList :: [TestedWithJobs] -> ShowS
Show)

instance C.Parsec TestedWithJobs where
    parsec :: forall (m :: * -> *). CabalParsing m => m TestedWithJobs
parsec = TestedWithJobs
TestedWithUniform TestedWithJobs -> m String -> m TestedWithJobs
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
C.string String
"uniform"
        m TestedWithJobs -> m TestedWithJobs -> m TestedWithJobs
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TestedWithJobs
TestedWithAny TestedWithJobs -> m String -> m TestedWithJobs
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
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"

-------------------------------------------------------------------------------
-- Selection
-------------------------------------------------------------------------------

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 = Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
forall a b.
Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
checkVersionsUniform
checkVersions TestedWithJobs
TestedWithAny     = Project a b Package
-> Either [String] (Set CompilerVersion, Project a b Package)
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 | [Package] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Project a b Package -> [Package]
forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project a b Package
prj) = [String]
-> Either [String] (Set CompilerVersion, Project a b Package)
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) = (([String], [Package]) -> Package -> ([String], [Package]))
-> ([String], [Package])
-> Project a b Package
-> ([String], [Package])
forall b a. (b -> a -> b) -> b -> Project a b a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ([String], [Package]) -> Package -> ([String], [Package])
collectConfig ([String], [Package])
forall a. Monoid a => a
mempty Project a b Package
prj
    if Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors)
    then [String]
-> Either [String] (Set CompilerVersion, Project a b Package)
forall a b. a -> Either a b
Left [String]
errors
    else (Set CompilerVersion, Project a b Package)
-> Either [String] (Set CompilerVersion, Project a b Package)
forall a b. b -> Either a b
Right (Set CompilerVersion
allVersions, Project a b Package
prj { prjPackages = names, prjOptPackages = [] })
  where
    allVersions :: S.Set CompilerVersion
    allVersions :: Set CompilerVersion
allVersions = (Package -> Set CompilerVersion)
-> Project a b Package -> Set CompilerVersion
forall m a. Monoid m => (a -> m) -> Project a b a -> m
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 ([String], [Package])
-> ([String], [Package]) -> ([String], [Package])
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 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
a Set a
b Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set a
a Set a
b
        diff :: Set CompilerVersion
diff = Set CompilerVersion -> Set CompilerVersion -> Set CompilerVersion
forall a. Ord a => Set a -> Set a -> Set a
symDiff Set CompilerVersion
testWith Set CompilerVersion
allVersions
        missingVersions :: [String]
missingVersions = (CompilerVersion -> String) -> [CompilerVersion] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CompilerVersion -> String
dispGhcVersion ([CompilerVersion] -> [String]) -> [CompilerVersion] -> [String]
forall a b. (a -> b) -> a -> b
$ Set CompilerVersion -> [CompilerVersion]
forall a. Set a -> [a]
S.toList Set CompilerVersion
diff
        errors :: [String]
errors | Set CompilerVersion -> Bool
forall a. Set a -> Bool
S.null Set CompilerVersion
diff = []
               | Bool
otherwise = String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                    [ Package -> String
pkgName Package
pkg
                    , String
" is missing tested-with annotations for: "
                    ] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
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 | [Package] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Project a b Package -> [Package]
forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project a b Package
prj) = [String]
-> Either [String] (Set CompilerVersion, Project a b Package)
forall a b. a -> Either a b
Left [String
"Error reading cabal file(s)!"]
checkVersionsAny Project a b Package
prj =
    (Set CompilerVersion, Project a b Package)
-> Either [String] (Set CompilerVersion, Project a b Package)
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 = (Package -> Set CompilerVersion)
-> Project a b Package -> Set CompilerVersion
forall m a. Monoid m => (a -> m) -> Project a b a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Package -> Set CompilerVersion
pkgJobs Project a b Package
prj