Simple script: does every dependency in library and executable stanzas have an upper bound?

pvp-compliance.hs

#!/usr/bin/env stack
-- stack --resolver lts-10.3 script --optimize
{-# LANGUAGE OverloadedStrings, NoImplicitPrelude #-}
import ClassyPrelude.Conduit
import Data.Conduit.Tar
import System.Directory
import System.FilePath
import Distribution.Types.CondTree
import Distribution.Types.Dependency
import Distribution.Types.PackageName
import Distribution.Version
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse
import Data.Text.Encoding (decodeUtf8')

main :: IO ()
main = do
  stackDir <- getAppUserDataDirectory "stack"
  let indexTar = stackDir </> "indices" </> "Hackage" </> "01-index.tar"
  res <- runConduitRes
       $ sourceFile indexTar
      .| untar
      .| withEntries onEntry
      .| foldC
  print res

data Stat = Stat
  { allUpperBounded :: !Int
  , total :: !Int
  , failed :: !Int
  }
  deriving Show
instance Monoid Stat where
  mempty = Stat 0 0 0
  mappend (Stat a b c) (Stat x y z) = Stat (a + x) (b + y) (c + z)

onEntry :: Monad m => Header -> ConduitM ByteString Stat m ()
onEntry header = when (takeExtension fp == ".cabal") $ do
    lbs <- sinkLazy
    case decodeUtf8' $ toStrict lbs of
      Left _ -> yield mempty { failed = 1 }
      Right textWithBOM -> do
        let text = fromMaybe textWithBOM $ stripPrefix "\xFEFF" textWithBOM
        case parseGenericPackageDescription $ unpack text of
          ParseFailed _ -> yield mempty { failed = 1 }
          ParseOk _ gpd -> unless (isRevision gpd) $ yield mempty
            { allUpperBounded = if hasUpperBounds gpd then 1 else 0
            , total = 1
            }
  where
    fp = headerFilePath header

isRevision :: GenericPackageDescription -> Bool
isRevision = ("x-revision" `elem`)
           . map fst
           . customFieldsPD
           . packageDescription

hasUpperBounds :: GenericPackageDescription -> Bool
hasUpperBounds gpd = all hasUpperBound $ unionsDepMaps
  $ maybe mempty getDepMap (condLibrary gpd)
  : map (getDepMap . snd) (condExecutables gpd)

unionsDepMaps :: [Map PackageName VersionRange]
              -> Map PackageName VersionRange
unionsDepMaps = unionsWith intersectVersionRanges

getDepMap :: CondTree ConfVar [Dependency] a -> Map PackageName VersionRange
getDepMap (CondNode _a deps branches) = unionsDepMaps
  [ unionsDepMaps [singletonMap k v | Dependency k v <- deps]
  , unionsDepMaps $ map getBranches branches
  ]

getBranches :: CondBranch ConfVar [Dependency] a
            -> Map PackageName VersionRange
getBranches (CondBranch _cond onTrue onFalse) = unionsDepMaps
    [ getDepMap onTrue
    , maybe mempty getDepMap onFalse
    ]

results.txt

$ ./pvp-compliance.hs 
Stat {allUpperBounded = 27972, total = 87731, failed = 1}

Or: 32%