windows: adds Bazel's MANIFEST file lookup to DA.Bazel.Runfiles (#801)

build.ps1

@@ -90,10 +90,7 @@ function build-full() {
         //ledger/ledger-api-server-example/... `
         //ledger/participant-state/... `
         //ledger/participant-state-index/... `
-        //ledger/sandbox:sandbox `
-        //ledger/sandbox:sandbox-binary `
-        //ledger/sandbox:sandbox-tarball `
-        //ledger/sandbox:sandbox-head-tarball `
+        //ledger/sandbox/... `
         //ledger-api/... `
         //navigator/backend/... `
         //navigator/frontend/... `

daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Options.hs

@@ -23,6 +23,7 @@ import DA.Daml.GHC.Compiler.Preprocessor
 
 import           Control.Monad.Reader
 import qualified Data.List.Extra as List
+import Data.Foldable (toList)
 import Data.Maybe
 import Data.Tuple.Extra
 import "ghc-lib-parser" DynFlags
@@ -122,9 +123,9 @@ basePackages = ["daml-prim", "daml-stdlib"]
 mkOptions :: Options -> IO Options
 mkOptions opts@Options {..} = do
     mapM_ checkDirExists $ optImportPath <> optPackageDbs
-    defaultPkgDbDir <- locateRunfiles (mainWorkspace </> "daml-foundations" </> "daml-ghc" </> "package-database")
-    let defaultPkgDb = defaultPkgDbDir </> "package-db_dir"
-    pkgDbs <- filterM Dir.doesDirectoryExist [defaultPkgDb, projectPackageDatabase]
+    mbDefaultPkgDb <- locateRunfilesMb (mainWorkspace </> "daml-foundations" </> "daml-ghc" </> "package-database")
+    let mbDefaultPkgDbDir = fmap (</> "package-db_dir") mbDefaultPkgDb
+    pkgDbs <- filterM Dir.doesDirectoryExist (toList mbDefaultPkgDbDir ++ [projectPackageDatabase])
     pure opts {optPackageDbs = map (</> versionSuffix) $ pkgDbs ++ optPackageDbs}
   where checkDirExists f =
           Dir.doesDirectoryExist f >>= \ok ->

libs-haskell/bazel-runfiles/BUILD.bazel

@@ -1,7 +1,7 @@
 # Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
 # SPDX-License-Identifier: Apache-2.0
 
-load("//bazel_tools:haskell.bzl", "da_haskell_library")
+load("//bazel_tools:haskell.bzl", "da_haskell_library", "da_haskell_test")
 
 da_haskell_library(
     name = "bazel-runfiles",
@@ -10,9 +10,25 @@ da_haskell_library(
         "base",
         "directory",
         "filepath",
+        "split",
         "transformers",
     ],
     src_strip_prefix = "src",
     visibility = ["//visibility:public"],
     deps = [],
 )
+
+da_haskell_test(
+    name = "bazel-runfiles-test",
+    srcs = glob(["test/DA/Bazel/RunfilesTest.hs"]),
+    data = glob(["test/resources/**"]),
+    hazel_deps = [
+        "base",
+        "directory",
+        "filepath",
+        "tasty",
+        "tasty-hunit",
+    ],
+    visibility = ["//visibility:public"],
+    deps = [":bazel-runfiles"],
+)

libs-haskell/bazel-runfiles/src/DA/Bazel/Runfiles.hs

@@ -6,11 +6,14 @@
 -- it is simpler to have all code located here.
 module DA.Bazel.Runfiles
   ( locateRunfiles
+  , locateRunfilesMb
   , mainWorkspace
   ) where
 
 import Control.Monad.Trans.Maybe
 import Data.Foldable
+import Data.List
+import Data.List.Split (splitOn)
 import System.Directory
 import System.Environment
 import System.FilePath
@@ -20,19 +23,53 @@ mainWorkspace = "com_github_digital_asset_daml"
 
 locateRunfiles :: FilePath -> IO FilePath
 locateRunfiles target = do
+    dirOrError <- locateRunfilesMb target
+    case dirOrError of
+        Left e -> error e
+        Right d -> pure d
+
+locateRunfilesMb :: FilePath -> IO (Either String FilePath)
+locateRunfilesMb target = do
     execPath <- getExecutablePath
-    mbDir <-runMaybeT . asum . map MaybeT $
+    mbDir <- runMaybeT . asum . map MaybeT $
         [ do let jarResources = takeDirectory execPath </> "resources"
              hasJarResources <- doesDirectoryExist jarResources
              pure $ if hasJarResources
                  then Just jarResources
                  else Nothing
         , do let runfilesDir = execPath <> ".runfiles"
-             hasRunfiles <- doesDirectoryExist runfilesDir
-             pure $ if hasRunfiles
-                 then Just (runfilesDir </> target)
-                 else Nothing
+             hasTarget <- doesPathExist (runfilesDir </> target)
+             hasManifest <- doesFileExist (runfilesDir </> "MANIFEST")
+             if hasTarget
+                then pure $ Just(runfilesDir </> target)
+             else if hasManifest
+                then lookupTargetInManifestFile (runfilesDir </> "MANIFEST") target
+             else pure Nothing
         , do mbDir <- lookupEnv "RUNFILES_DIR"
              pure (fmap (</> target) mbDir)
         ]
-    maybe (error "Could not locate runfiles") pure mbDir
+    pure $ maybe (Left $ "Could not locate runfiles for target: " <> target) Right mbDir
+
+lookupTargetInManifestFile :: FilePath -> FilePath -> IO (Maybe FilePath)
+lookupTargetInManifestFile manifestPath target = do
+    manifestFile <- readFile manifestPath
+    let manifest = map lineToTuple (lines manifestFile)
+    let targetNormalised = intercalate "/" (splitOn "\\" (normalise target))
+    pure $ asum [findExact targetNormalised manifest, findDir targetNormalised manifest]
+
+lineToTuple :: FilePath -> (FilePath, FilePath)
+lineToTuple line = case splitOn " " line of
+    [a, b] -> (a, b)
+    _ -> error $ "Expected a line with two entries separated by space but got " <> show line
+
+-- | Given a list of entries in the `MANIFEST` file, try to find an exact match for the given path.
+findExact :: FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
+findExact path entries = fmap snd (find (\(k,_) -> k == path) entries)
+
+-- | The `MANIFEST` file only contains file paths not directories so use this to lookup a directory.
+findDir :: FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
+findDir path entries = do
+    (k, v) <- find (\(k, v) -> path `isPrefixOf` k && drop (length path) k `isSuffixOf` v) entries
+    -- The length of the file suffix after the directory
+    let fileLength = length k - length path
+    pure $ take (length v - fileLength) v

libs-haskell/bazel-runfiles/test/DA/Bazel/RunfilesTest.hs

@@ -0,0 +1,51 @@
+-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module Main (main) where
+
+import           System.Directory
+import           System.FilePath
+import           Test.Tasty
+import           Test.Tasty.HUnit
+import           DA.Bazel.Runfiles
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Bazel runfiles tests"
+  [
+    fileExistsTest,
+    filePathIsAbsoluteTest,
+    dirExistsTest,
+    dirPathIsAbsoluteTest,
+    dirContainsExpectedFilesTest
+  ]
+
+fileExistsTest :: TestTree
+fileExistsTest = testCase "File path returned by locateRunfiles should exist" $ do
+  file <- locateRunfiles (mainWorkspace </> "libs-haskell" </> "bazel-runfiles" </> "test" </> "resources" </> "file.txt")
+  fileExist <- doesFileExist file
+  assertBool "Pointed file should exist" fileExist
+
+filePathIsAbsoluteTest :: TestTree
+filePathIsAbsoluteTest = testCase "File path returned by locateRunfiles should be absolute" $ do
+  file <- locateRunfiles (mainWorkspace </> "libs-haskell" </> "bazel-runfiles" </> "test" </> "resources" </> "file.txt")
+  assertBool "Returned file path should be absolute" (isAbsolute file)
+
+dirExistsTest :: TestTree
+dirExistsTest = testCase "Directory path returned by locateRunfiles should exist" $ do
+  dir <- locateRunfiles (mainWorkspace </> "libs-haskell" </> "bazel-runfiles" </> "test" </> "resources" </> "dir")
+  dirExist <- doesDirectoryExist dir
+  assertBool "Pointed directory should exist" dirExist
+
+dirPathIsAbsoluteTest :: TestTree
+dirPathIsAbsoluteTest = testCase "Directory path returned by locateRunfiles should be absolute" $ do
+  dir <- locateRunfiles (mainWorkspace </> "libs-haskell" </> "bazel-runfiles" </> "test" </> "resources" </> "dir")
+  assertBool "Returned directory path should be absolute" (isAbsolute dir)
+
+dirContainsExpectedFilesTest :: TestTree
+dirContainsExpectedFilesTest = testCase "Directory returned by locateRunfiles should contain expected files" $ do
+  dir <- locateRunfiles (mainWorkspace </> "libs-haskell" </> "bazel-runfiles" </> "test" </> "resources" </> "dir")
+  files <- listDirectory dir
+  assertEqual "Returned directory should contain expected # of files" 2 (length files)