Merge pull request #328 from leungbk/cabal-freeze

Add cabal-freeze support

examples/haskell_cabal-freeze/flake.nix

@@ -0,0 +1,23 @@
+{
+  inputs = {
+    dream2nix.url = "github:nix-community/dream2nix";
+    src.url = "github:leungbk/unordered-containers/cabal-freeze-test";
+    src.flake = false;
+  };
+
+  outputs = {
+    self,
+    dream2nix,
+    src,
+  } @ inp: (dream2nix.lib.makeFlakeOutputs {
+    systems = ["x86_64-linux"];
+    config.projectRoot = ./.;
+    source = src;
+    settings = [
+      {
+        translator = "cabal-freeze";
+      }
+      {subsystemInfo = {defaultPackageName = "unordered-containers";};}
+    ];
+  });
+}

flake.lock

@@ -124,6 +124,22 @@
         "type": "github"
       }
     },
+    "ghc-utils": {
+      "flake": false,
+      "locked": {
+        "lastModified": 1662774800,
+        "narHash": "sha256-1Rd2eohGUw/s1tfvkepeYpg8kCEXiIot0RijapUjAkE=",
+        "ref": "refs/heads/master",
+        "rev": "bb3a2d3dc52ff0253fb9c2812bd7aa2da03e0fea",
+        "revCount": 1072,
+        "type": "git",
+        "url": "https://gitlab.haskell.org/bgamari/ghc-utils"
+      },
+      "original": {
+        "type": "git",
+        "url": "https://gitlab.haskell.org/bgamari/ghc-utils"
+      }
+    },
     "gomod2nix": {
       "flake": false,
       "locked": {
@@ -217,6 +233,7 @@
         "crane": "crane",
         "devshell": "devshell",
         "flake-utils-pre-commit": "flake-utils-pre-commit",
+        "ghc-utils": "ghc-utils",
         "gomod2nix": "gomod2nix",
         "mach-nix": "mach-nix",
         "nixpkgs": "nixpkgs",

flake.nix

@@ -53,6 +53,11 @@
       url = "github:nix-community/all-cabal-json/hackage";
       flake = false;
     };
+
+    ghc-utils = {
+      url = "git+https://gitlab.haskell.org/bgamari/ghc-utils";
+      flake = false;
+    };
   };
 
   outputs = {
@@ -66,6 +71,7 @@
     pre-commit-hooks,
     crane,
     all-cabal-json,
+    ghc-utils,
     ...
   } @ inp: let
     b = builtins;

src/specifications/subsystems/haskell/dream.lock.example.json

@@ -4,6 +4,12 @@
       "name": "ghc",
       "version": "8.10.7"
     },
+    "cabalFlags": {
+      "darcs": [
+        "-fforce-char8-encoding",
+        "-flibrary"
+      ]
+    },
     "cabal-files": {
       "aeson": {
         "1.2.2.0": {

src/subsystems/haskell/builders/simple-haskell/default.nix

@@ -2,6 +2,7 @@
   pkgs,
   utils,
   externals,
+  inputs,
   lib,
   ...
 }: let
@@ -124,6 +125,9 @@ in {
           doCheck = false;
           doBenchmark = false;
 
+          # FIXME: this skips over the default package if its name isn't set properly
+          configureFlags = subsystemAttrs.cabalFlags."${name}"."${version}" or [];
+
           libraryToolDepends = libraryHaskellDepends;
           executableHaskellDepends = libraryHaskellDepends;
           testHaskellDepends = libraryHaskellDepends;
@@ -139,15 +143,16 @@ in {
         specified in the dream-lock
         */
         // (
-          l.optionalAttrs
-          (
-            (name != defaultPackageName)
-            && cabalFiles ? "${name}#${version}"
-          )
+          l.optionalAttrs (name != defaultPackageName)
           {
-            preConfigure = ''
-              cp ${cabalFiles."${name}#${version}"} ./${name}.cabal
-            '';
+            preConfigure =
+              if cabalFiles ? "${name}#${version}"
+              then ''
+                cp ${cabalFiles."${name}#${version}"} ./${name}.cabal
+              ''
+              else ''
+                cp ${inputs.all-cabal-json}/${name}/${version}/${name}.cabal ./
+              '';
           }
         )
         # enable tests only for the top-level package

src/subsystems/haskell/translators/cabal-freeze/default.nix

@@ -0,0 +1,295 @@
+{
+  dlib,
+  lib,
+  name,
+  pkgs,
+  inputs,
+  ...
+}: let
+  l = lib // builtins;
+in {
+  type = "pure";
+
+  /*
+  Automatically generate unit tests for this translator using project sources
+  from the specified list.
+
+  !!! Your first action should be adding a project here. This will simplify
+  your work because you will be able to use `nix run .#tests-unit` to
+  test your implementation for correctness.
+  */
+  generateUnitTestsForProjects = [
+    (builtins.fetchTarball {
+      url = "https://github.com/leungbk/ghcid/tarball/1a1aa2f3ee409a0044340f2759d21b64b56b0010";
+      sha256 = "sha256:1mp33xkyyb4jqqriczai80sqwlrjcwd94l7bv709ngwjqy56h2n9";
+    })
+  ];
+
+  /*
+  Allow dream2nix to detect if a given directory contains a project
+  which can be translated with this translator.
+  Usually this can be done by checking for the existence of specific
+  file names or file endings.
+
+  Alternatively a fully featured discoverer can be implemented under
+  `src/subsystems/{subsystem}/discoverers`.
+  This is recommended if more complex project structures need to be
+  discovered like, for example, workspace projects spanning over multiple
+  sub-directories
+
+  If a fully featured discoverer exists, do not define `discoverProject`.
+  */
+  discoverProject = tree:
+  # Example
+  # Returns true if given directory contains a file ending with .freeze
+    l.any
+    (filename: l.hasSuffix ".freeze" filename)
+    (l.attrNames tree.files);
+
+  # translate from a given source and a project specification to a dream-lock.
+  translate = {
+    /*
+    A project returned by `discoverProjects`
+    Example:
+
+    {
+      "dreamLockPath": "packages/optimism/dream-lock.json",
+      "name": "optimism",
+      "relPath": "",
+      "subsystem": "nodejs",
+      "subsystemInfo": {
+        "workspaces": [
+          "packages/common-ts",
+          "packages/contracts",
+          "packages/core-utils",
+        ]
+      },
+      "translator": "yarn-lock",
+      "translators": [
+        "yarn-lock",
+        "package-json"
+      ]
+    }
+
+    */
+    project,
+    /*
+    Entire source tree represented as deep attribute set.
+    (produced by `prepareSourceTree`)
+
+    This has the advantage that files will only be read once, even when
+    accessed multiple times or by multiple translators.
+
+    Example:
+      {
+        files = {
+          "package.json" = {
+            relPath = "package.json"
+            fullPath = "${source}/package.json"
+            content = ;
+            jsonContent = ;
+            tomlContent = ;
+          }
+        };
+
+        directories = {
+          "packages" = {
+            relPath = "packages";
+            fullPath = "${source}/packages";
+            files = {
+
+            };
+            directories = {
+
+            };
+          };
+        };
+
+        # returns the tree object of the given sub-path
+        getNodeFromPath = path: ...
+      }
+    */
+    tree,
+    # arguments defined in `extraArgs` (see below) specified by user
+    ghcVersion,
+    defaultPackageName,
+    defaultPackageVersion,
+    ...
+  } @ args: let
+    # get the root source and project source
+    rootSource = tree.fullPath;
+    projectSource = "${tree.fullPath}/${project.relPath}";
+    projectTree = tree.getNodeFromPath project.relPath;
+
+    parsedCabalFreeze = l.pipe projectTree.files [
+      l.attrNames
+      (
+        l.findFirst (l.hasSuffix ".freeze")
+        (throw "No cabal.project.freeze file in the tree")
+      )
+      projectTree.getNodeFromPath
+      (l.attrByPath ["fullPath"] "")
+      (import ./parser.nix {inherit dlib lib;})
+    ];
+
+    haskellUtils = import ../utils.nix {inherit inputs lib pkgs;};
+
+    hiddenPackages = haskellUtils.ghcVersionToHiddenPackages."${ghcVersion}";
+
+    serializedRawObjects = l.filter ({name, ...}: (! hiddenPackages ? ${name})) parsedCabalFreeze.packagesAndVersionsList;
+
+    cabalData =
+      haskellUtils.batchFindJsonFromCabalCandidates
+      serializedRawObjects;
+
+    cabalFreezeFlags = l.pipe serializedRawObjects [
+      (l.map ({
+        name,
+        version,
+      }:
+        l.nameValuePair name {"${version}" = parsedCabalFreeze.cabalFlags."${name}" or [];}))
+      (flagsAlist: [(l.nameValuePair defaultPackageName {"${defaultPackageVersion}" = parsedCabalFreeze.cabalFlags."${defaultPackageName}" or [];})] ++ flagsAlist)
+      l.listToAttrs
+    ];
+  in
+    dlib.simpleTranslate2.translate
+    ({objectsByKey, ...}: rec {
+      translatorName = name;
+
+      # relative path of the project within the source tree.
+      location = project.relPath;
+
+      # the name of the subsystem
+      subsystemName = "haskell";
+
+      # Extract subsystem specific attributes.
+      # The structure of this should be defined in:
+      #   ./src/specifications/{subsystem}
+      subsystemAttrs = {
+        cabalFlags = cabalFreezeFlags;
+
+        compiler = {
+          name = "ghc";
+          version = ghcVersion;
+        };
+      };
+
+      # name of the default package
+      defaultPackage = defaultPackageName;
+
+      /*
+      List the package candidates which should be exposed to the user.
+      Only top-level packages should be listed here.
+      Users will not be interested in all individual dependencies.
+      */
+      exportedPackages = {
+        "${defaultPackage}" = defaultPackageVersion;
+      };
+
+      /*
+      a list of raw package objects
+      If the upstream format is a deep attrset, this list should contain
+      a flattened representation of all entries.
+      */
+      inherit serializedRawObjects;
+
+      /*
+      Define extractor functions which each extract one property from
+      a given raw object.
+      (Each rawObj comes from serializedRawObjects).
+
+      Extractors can access the fields extracted by other extractors
+      by accessing finalObj.
+      */
+      extractors = {
+        name = rawObj: finalObj:
+          rawObj.name;
+
+        version = rawObj: finalObj:
+          rawObj.version;
+
+        dependencies = rawObj: finalObj:
+          l.pipe cabalData
+          [
+            (haskellUtils.getDependencyNames finalObj)
+            (l.filter (name:
+              # Keep only .cabal dependencies present in the freeze file
+              (objectsByKey.name ? ${name})))
+            (l.map
+              (depName: {
+                name = depName;
+                version = objectsByKey.name.${depName}.version;
+              }))
+          ];
+
+        sourceSpec = rawObj: finalObj:
+        # example
+        {
+          type = "http";
+          url = haskellUtils.getHackageUrl finalObj;
+          hash = "sha256:${haskellUtils.findSha256FromCabalCandidate finalObj.name finalObj.version}";
+        };
+      };
+
+      /*
+      Optionally define extra extractors which will be used to key all
+      final objects, so objects can be accessed via:
+      `objectsByKey.${keyName}.${value}`
+      */
+      keys = {
+        name = rawObj: finalObj:
+          finalObj.name;
+      };
+
+      /*
+      Optionally add extra objects (list of `finalObj`) to be added to
+      the dream-lock.
+      */
+      # TODO: support multiple top-level packages; this requires parsing the "packages" heading in cabal.project
+      extraObjects = [
+        {
+          name = defaultPackage;
+          version = exportedPackages."${defaultPackage}";
+          # XXX: some of these are transitive dependencies, but
+          # including only direct deps requires that we either parse
+          # the Cabal file or use a potentially outdated one from
+          # all-cabal-json
+          dependencies = serializedRawObjects;
+          sourceSpec = {
+            type = "path";
+            path = projectTree.fullPath;
+          };
+        }
+      ];
+    });
+
+  # If the translator requires additional arguments, specify them here.
+  # Users will be able to set these arguments via `settings`.
+  # There are only two types of arguments:
+  #   - string argument (type = "argument")
+  #   - boolean flag (type = "flag")
+  # String arguments contain a default value and examples. Flags do not.
+  # Flags are false by default.
+  extraArgs = {
+    ghcVersion = {
+      description = "GHC version";
+      default = "9.0.2";
+      examples = ["9.0.2" "9.4.1"];
+      type = "argument";
+    };
+
+    defaultPackageName = {
+      description = "Name of default package";
+      default = "main";
+      examples = ["main" "default"];
+      type = "argument";
+    };
+
+    defaultPackageVersion = {
+      description = "Version of default package";
+      default = "unknown";
+      examples = ["unknown" "1.2.0"];
+      type = "argument";
+    };
+  };
+}

src/subsystems/haskell/translators/cabal-freeze/parser.nix

@@ -0,0 +1,96 @@
+{
+  dlib,
+  lib,
+}: cabalFreezeFile: let
+  l = lib // builtins;
+
+  cabalFreezeFileText = dlib.readTextFile cabalFreezeFile;
+
+  sectionNamesAndContents = l.tail (l.split "\n([^ \t:]+):" (
+    "\n" + (trimSurroundingWhitespace cabalFreezeFileText)
+  ));
+
+  sectionNames = l.pipe sectionNamesAndContents [
+    (l.filter l.isList)
+    (l.map l.head)
+  ];
+
+  sectionContents = l.pipe sectionNamesAndContents [
+    (l.filter l.isString)
+    (l.map
+      (str:
+        l.pipe str [
+          (l.splitString "\n")
+          l.concatStrings
+          (l.splitString ",")
+          (l.map trimSurroundingWhitespace)
+        ]))
+  ];
+
+  trimSurroundingWhitespace = str:
+    l.pipe str [
+      (l.split "^[[:space:]]*")
+      l.flatten
+      l.concatStrings
+      (l.split "[[:space:]]*$")
+      l.flatten
+      l.concatStrings
+    ];
+
+  sectionNamesWithContents = l.listToAttrs (l.zipListsWith l.nameValuePair sectionNames sectionContents);
+
+  cabalPackageNameVersionRegexp = "any\.([a-zA-Z0-9_-]+) ==([^, \t]+)";
+
+  partitionedConstraints = l.partition (str: l.match cabalPackageNameVersionRegexp str != null) sectionNamesWithContents.constraints;
+in {
+  packagesAndVersionsList =
+    l.map
+    (str:
+      l.pipe str
+      [
+        (l.match cabalPackageNameVersionRegexp)
+        (packageAndVersion: dlib.nameVersionPair (l.head packageAndVersion) (l.last packageAndVersion))
+      ])
+    partitionedConstraints.right;
+
+  packagesAndVersionsAttrSet =
+    l.pipe
+    partitionedConstraints.right
+    [
+      (l.map
+        (str:
+          l.pipe str
+          [
+            (l.match cabalPackageNameVersionRegexp)
+            (packageAndVersion: l.nameValuePair (l.head packageAndVersion) (l.last packageAndVersion))
+          ]))
+      l.listToAttrs
+    ];
+
+  cabalFlags = l.pipe partitionedConstraints.wrong [
+    (l.map (l.splitString " "))
+    (
+      l.map
+      (words: let
+        packageName = l.head words;
+        configureFlags = l.pipe words [
+          l.tail
+          (l.map (s: let
+            matchList = l.match "([+-])(.+)" s;
+            polarity = l.head matchList;
+            flagName = l.last matchList;
+          in
+            "-f"
+            + (
+              l.optionalString (polarity == "-") "-"
+            )
+            + flagName))
+        ];
+      in
+        l.nameValuePair packageName configureFlags)
+    )
+    l.listToAttrs
+  ];
+
+  # TODO: maybe use the index-state?
+}

src/subsystems/haskell/translators/stack-lock/default.nix

@@ -8,53 +8,6 @@
   ...
 }: let
   l = lib // builtins;
-
-  hiddenPackagesDefault = {
-    # TODO: unblock these packages and implement actual logic to interpret the
-    # flags found in cabal files
-    Win32 = null;
-
-    # These are the packages which are already contained in the ghc package.
-    # This list actually depends on the ghc version used.
-    # see: https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/libraries/version-history
-    # and: https://gitlab.haskell.org/bgamari/ghc-utils/-/blob/master/library-versions/pkg_versions.txt
-    # TODO: Generate this list dynamically for the given ghc version via pkg_versions.txt
-    array = null;
-    base = null;
-    binary = null;
-    bytestring = null;
-    Cabal = null;
-    containers = null;
-    deepseq = null;
-    directory = null;
-    dns-internal = null;
-    fast-digits-internal = null;
-    filepath = null;
-    ghc = null;
-    ghc-boot = null;
-    ghc-boot-th = null;
-    ghc-compact = null;
-    ghc-heap = null;
-    ghc-prim = null;
-    ghci = null;
-    haskeline = null;
-    hpc = null;
-    integer-gmp = null;
-    libiserv = null;
-    mtl = null;
-    parsec = null;
-    pretty = null;
-    process = null;
-    rts = null;
-    stm = null;
-    template-haskell = null;
-    terminfo = null;
-    text = null;
-    time = null;
-    transformers = null;
-    unix = null;
-    xhtml = null;
-  };
 in {
   type = "ifd";
 
@@ -71,7 +24,7 @@ in {
 
   discoverProject = tree:
     l.any
-    (filename: l.hasSuffix ".cabal" filename)
+    (filename: l.hasSuffix "stack.yaml.lock" filename)
     (l.attrNames tree.files);
 
   # translate from a given source and a project specification to a dream-lock.
@@ -134,7 +87,7 @@ in {
       compilerVersion = l.last compilerSplit;
 
       hidden =
-        hiddenPackagesDefault;
+        haskellUtils.ghcVersionToHiddenPackages."${compilerVersion}" or haskellUtils.ghcVersionToHiddenPackages."9.0.2";
       # TODO: find out what to do with the hidden packages from the snapshot
       # Currently it looks like those should not be included
       # // (
@@ -183,45 +136,6 @@ in {
       in {
         inherit name version hash;
       };
-
-      getDependencyNames = finalObj: objectsByName: let
-        cabal = cabalData.${finalObj.name}.${finalObj.version};
-
-        targetBuildDepends =
-          cabal.library.condTreeData.build-info.targetBuildDepends or [];
-
-        buildToolDepends =
-          cabal.library.condTreeData.build-info.buildToolDepends or [];
-
-        defaultFlags = l.filter (flag: flag.default) cabal.package-flags;
-
-        defaultFlagNames = l.map (flag: flag.name) defaultFlags;
-
-        collectBuildDepends = condTreeComponent:
-          l.concatMap
-          (attrs: attrs.targetBuildDepends)
-          (l.collect
-            (x: x ? targetBuildDepends)
-            condTreeComponent);
-
-        # TODO: use flags to determine which conditional deps are required
-        condBuildDepends =
-          l.concatMap
-          (component: collectBuildDepends component)
-          cabal.library.condTreeComponents or [];
-
-        depNames =
-          l.map
-          (dep: dep.package-name)
-          (targetBuildDepends ++ buildToolDepends ++ condBuildDepends);
-      in
-        l.filter
-        (name:
-          # ensure package is not a hidden package
-            (! hidden ? ${name})
-            # ignore packages which are not part of the snapshot or lock file
-            && (objectsByName ? ${name}))
-        depNames;
     in
       dlib.simpleTranslate2.translate
       ({objectsByKey, ...}: rec {
@@ -287,15 +201,22 @@ in {
           version = rawObj: finalObj:
             rawObj.version;
 
-          dependencies = rawObj: finalObj: let
-            depNames = getDependencyNames finalObj objectsByKey.name;
-          in
-            l.map
-            (depName: {
-              name = depName;
-              version = objectsByKey.name.${depName}.version;
-            })
-            depNames;
+          dependencies = rawObj: finalObj:
+            l.pipe cabalData
+            [
+              (haskellUtils.getDependencyNames finalObj)
+              (l.filter
+                (name:
+                  # ensure package is not a hidden package
+                    (! hidden ? ${name})
+                    # ignore packages which are not part of the snapshot or lock file
+                    && (objectsByKey.name ? ${name})))
+              (l.map
+                (depName: {
+                  name = depName;
+                  version = objectsByKey.name.${depName}.version;
+                }))
+            ];
 
           sourceSpec = rawObj: finalObj:
           # example

src/subsystems/haskell/translators/utils.nix

@@ -11,7 +11,7 @@
     jsonCabalFile = "${all-cabal-json}/${name}/${version}/${name}.json";
   in
     if (! (l.pathExists jsonCabalFile))
-    then throw ''"all-cabal-json" seems to be outdated''
+    then throw ''Cannot find JSON for version ${version} of package ${name}. "all-cabal-json" may be outdated.''
     else l.fromJSON (l.readFile jsonCabalFile);
 in {
   inherit findJsonFromCabalCandidate;
@@ -20,7 +20,7 @@ in {
     hashFile = "${all-cabal-json}/${name}/${version}/${name}.hashes.json";
   in
     if (! (l.pathExists hashFile))
-    then throw ''"all-cabal-json" seems to be outdated''
+    then throw ''Cannot find JSON for version ${version} of package ${name}. "all-cabal-json" may be outdated.''
     else (l.fromJSON (l.readFile hashFile)).package-hashes.SHA256;
 
   /*
@@ -45,4 +45,73 @@ in {
     version,
     ...
   }: "https://hackage.haskell.org/package/${name}-${version}.tar.gz";
+
+  getDependencyNames = finalObj: cabalDataAsJson: let
+    cabal = with finalObj;
+      cabalDataAsJson.${name}.${version};
+
+    targetBuildDepends =
+      cabal.library.condTreeData.build-info.targetBuildDepends or [];
+
+    buildToolDepends =
+      cabal.library.condTreeData.build-info.buildToolDepends or [];
+
+    buildTools = cabal.library.condTreeData.build-info.buildTools or [];
+
+    defaultFlags = l.filter (flag: flag.default) cabal.package-flags;
+
+    defaultFlagNames = l.map (flag: flag.name) defaultFlags;
+
+    collectBuildDepends = condTreeComponent:
+      l.concatMap
+      (attrs: attrs.targetBuildDepends)
+      (l.collect
+        (x: x ? targetBuildDepends)
+        condTreeComponent);
+
+    # TODO: use flags to determine which conditional deps are required
+    condBuildDepends =
+      l.concatMap
+      (component: collectBuildDepends component)
+      cabal.library.condTreeComponents or [];
+
+    depNames =
+      l.map
+      (dep: dep.package-name)
+      (targetBuildDepends ++ buildToolDepends ++ buildTools ++ condBuildDepends);
+  in
+    depNames;
+
+  # XXX: This might be better as a function.  See
+  # https://github.com/nixos/nixpkgs/blob/773c2a7afa4cc94f91d53d8cb35245cbf216082b/pkgs/development/haskell-modules/configuration-ghc-9.4.x.nix#L49-L56
+  # Packages we shouldn't always overwrite with null, but presently do anyway, are
+  # 1) terminfo, when we cross-compile
+  # 2) xhtml, when ghc.hasHaddock is set to false
+  ghcVersionToHiddenPackages = l.pipe "${inputs.ghc-utils}/library-versions/pkg_versions.txt" [
+    l.readFile
+    (l.split "\n#+\n# GHC [^\n]+")
+    l.tail
+    (l.filter l.isString)
+    (l.concatMap (l.splitString "\n"))
+    (l.filter (s: s != "" && !(l.hasPrefix "HEAD" s)))
+    (l.map (
+      s: let
+        ghcVersionAndHiddenPackages = l.match "([^[:space:]]+)[[:space:]]+(.+)" s;
+        ghcVersion = l.head ghcVersionAndHiddenPackages;
+        hiddenPackages = l.pipe (l.last ghcVersionAndHiddenPackages) [
+          (l.splitString " ")
+          (l.map (packageAndVersion:
+            l.pipe packageAndVersion [
+              (l.match "([^/]+)/.+")
+              l.head
+              (packageName: l.nameValuePair packageName null)
+            ]))
+          (pkgNames: [(l.nameValuePair "Win32" null)] ++ pkgNames)
+          l.listToAttrs
+        ];
+      in
+        l.nameValuePair ghcVersion hiddenPackages
+    ))
+    l.listToAttrs
+  ];
 }

tests/unit/default.nix

@@ -3,6 +3,7 @@
   lib,
   coreutils,
   nix,
+  git,
   python3,
   utils,
   dream2nixWithExternals,
@@ -20,8 +21,9 @@ in
   [
     coreutils
     nix
+    git
   ]
   ''
-    export dream2nixSrc=${dream2nixWithExternals}
+    export dream2nixSrc=${../../.}/src
     ${pythonEnv}/bin/pytest ${self}/tests/unit -n $(nproc) -v "$@"
   ''