Merge pull request #6349 from commercialhaskell/commenter-automation-2

commenter: Find disabled packages that may need newer dependencies

etc/commenter/Cargo.lock

@@ -54,7 +54,7 @@ dependencies = [
 
 [[package]]
 name = "commenter"
-version = "0.1.0"
+version = "0.2.0"
 dependencies = [
  "lazy-regex",
  "regex",

etc/commenter/latest-version/LICENSE

@@ -0,0 +1,30 @@
+Copyright Adam Bergmark (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

etc/commenter/latest-version/README.md

@@ -0,0 +1 @@
+# latest-version

etc/commenter/latest-version/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

etc/commenter/latest-version/cabal.project

@@ -0,0 +1,6 @@
+source-repository-package
+  type: git
+  location: git://github.com/commercialhaskell/pantry.git
+
+packages: ./latest-version.cabal
+with-compiler: ghc-8.10.7

etc/commenter/latest-version/latest-version.cabal

@@ -0,0 +1,23 @@
+name:                latest-version
+version:             0.1.0.0
+homepage:            https://github.com/githubuser/latest-version#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Adam Bergmark
+maintainer:          adam@bergmark.nl
+copyright:           2021 Adam Bergmark
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md
+
+executable latest-version
+  ghc-options:         -Wall
+  hs-source-dirs:      src
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , pantry
+                     , Cabal
+                     , rio
+                     , containers

etc/commenter/latest-version/src/Main.hs

@@ -0,0 +1,18 @@
+module Main where
+
+import Data.List
+import Distribution.Types.PackageName
+import Distribution.Types.Version
+import Pantry
+import RIO
+import System.Environment
+import qualified Data.Map as Map
+
+main :: IO ()
+main =
+  runPantryApp $
+    liftIO . putStrLn
+    . intercalate "." . map show . versionNumbers
+    . fst . head . Map.toDescList
+    =<< getHackagePackageVersions YesRequireHackageIndex IgnorePreferredVersions
+    . mkPackageName =<< head <$> liftIO getArgs

etc/commenter/latest-version/stack.yaml

@@ -0,0 +1,4 @@
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/18.yaml
+packages:
+- .

etc/commenter/src/lib.rs

@@ -1,9 +1,13 @@
+use std::collections::{BTreeMap, BTreeSet};
 use std::fs::File;
 use std::io::{BufRead, BufReader, LineWriter, Lines, Write};
 use std::path::Path;
+use std::process::Command;
+
+use lazy_regex::regex;
 
 pub fn clear() {
-    handle(|loc, _lines| match loc {
+    handle(true, |loc, _lines| match loc {
         // Add empty array to keep yaml valid
         Location::Lib => vec!["        []".to_owned()],
         Location::Test | Location::Bench => vec![],
@@ -11,7 +15,7 @@ pub fn clear() {
 }
 
 pub fn add(lib: Vec<String>, test: Vec<String>, bench: Vec<String>) {
-    handle(|loc, mut lines| {
+    handle(true, |loc, mut lines| {
         lines.extend(match loc {
             Location::Lib => lib.clone(),
             Location::Test => test.clone(),
@@ -22,6 +26,82 @@ pub fn add(lib: Vec<String>, test: Vec<String>, bench: Vec<String>) {
     })
 }
 
+pub fn outdated() {
+    let mut all = vec![];
+    handle(false, |_loc, lines| {
+        all.extend(lines);
+        vec![]
+    });
+    let mut map = BTreeMap::new();
+    let mut support: BTreeMap<(String, String), BTreeSet<(String, String)>> = BTreeMap::new();
+    for v in all.into_iter() {
+        let caps = regex!("tried ([^ ]+)-([^,-]+),").captures(&v).unwrap();
+        let package = caps.get(1).unwrap().as_str().to_owned();
+        let version = caps.get(2).unwrap().as_str().to_owned();
+        map.insert(package.clone(), version.clone());
+
+        if let Some(caps) = regex!("does not support: ([^ ]+)-([^-]+)").captures(&v) {
+            let dep_package = caps.get(1).unwrap().as_str().to_owned();
+            let dep_version = caps.get(2).unwrap().as_str().to_owned();
+            let entry = support
+                .entry((dep_package, dep_version))
+                .or_default();
+            entry.insert((package, version));
+        }
+    }
+
+    let entries = map.len() + support.len();
+    let mut i = 0;
+
+    for (package, version) in map {
+        if i % 100 == 0 {
+            println!("{:02}%", ((i as f64 / entries as f64) * 100.0).floor());
+        }
+        i += 1;
+        let latest = latest_version(&package);
+        if version != latest {
+            println!(
+                "{} mismatch, snapshot: {}, hackage: {}",
+                package, version, latest
+            );
+        }
+    }
+
+    for ((package, version), dependents) in support {
+        if i % 100 == 0 {
+            println!("{:02}%", ((i as f64 / entries as f64) * 100.0).floor());
+        }
+        i += 1;
+        let latest = latest_version(&package);
+        if version != latest {
+            println!(
+                "{} mismatch, snapshot: {}, hackage: {}, dependents: {}",
+                package,
+                version,
+                latest,
+                dependents
+                    .into_iter()
+                    .map(|(p, v)| format!("{}-{}", p, v))
+                    .collect::<Vec<String>>()
+                    .join(", "),
+            );
+        }
+    }
+}
+
+fn latest_version(pkg: &str) -> String {
+    String::from_utf8(
+        Command::new("latest-version")
+            .args([pkg])
+            .output()
+            .unwrap()
+            .stdout,
+    )
+    .unwrap()
+    .trim()
+    .to_owned()
+}
+
 enum State {
     LookingForLibBounds,
     ProcessingLibBounds,
@@ -32,9 +112,9 @@ enum State {
     Done,
 }
 
-fn handle<F>(f: F)
+fn handle<F>(write: bool, mut f: F)
 where
-    F: Fn(Location, Vec<String>) -> Vec<String>,
+    F: FnMut(Location, Vec<String>) -> Vec<String>,
 {
     let path = "build-constraints.yaml";
     let mut new_lines: Vec<String> = vec![];
@@ -100,13 +180,15 @@ where
         }
     }
 
-    let file = File::create(path).unwrap();
-    let mut file = LineWriter::new(file);
+    if write {
+        let file = File::create(path).unwrap();
+        let mut file = LineWriter::new(file);
 
-    for line in new_lines {
-        file.write_all((line + "\n").as_bytes()).unwrap();
+        for line in new_lines {
+            file.write_all((line + "\n").as_bytes()).unwrap();
+        }
+        file.flush().unwrap();
     }
-    file.flush().unwrap();
 }
 
 enum Location {

etc/commenter/src/main.rs

@@ -21,6 +21,7 @@ enum Header {
 enum Opt {
     Clear,
     Add,
+    Outdated,
 }
 
 fn main() {
@@ -28,6 +29,7 @@ fn main() {
     match opt {
         Opt::Clear => clear(),
         Opt::Add => add(),
+        Opt::Outdated => outdated(),
     }
 }
 
@@ -35,6 +37,10 @@ fn clear() {
     commenter::clear();
 }
 
+fn outdated() {
+    commenter::outdated();
+}
+
 fn add() {
     let mut lib_exes: H = Default::default();
     let mut tests: H = Default::default();