nix-tools: share the git-fetch cache between plan2nix and stack2nix (#1689)

nix-tools/nix-tools/lib/NixTools/Cache.hs

@@ -0,0 +1,53 @@
+-- | The git-fetch cache shared by @plan-to-nix@ and @stack-to-nix@.
+--
+-- This used to be two copies (@Plan2Nix.Cache@ and @Stack2nix.Cache@) that
+-- drifted apart: the Plan2Nix copy stored a @NOHASH@ placeholder for empty
+-- hashes so that the whitespace-delimited format still round-trips through
+-- 'words', while the Stack2nix copy wrote a raw empty string (corrupting the
+-- cache-file format for local packages), and only the Stack2nix copy forced
+-- the reads/writes strictly.  This module keeps the union of the correct
+-- behaviours: the @NOHASH@ placeholder *and* the strict IO.
+module NixTools.Cache
+  ( readCache
+  , appendCache
+  , cacheHits
+  ) where
+
+import Control.DeepSeq ((<$!!>))
+import Control.Exception (catch, SomeException(..))
+import Data.Maybe (mapMaybe)
+
+readCache :: FilePath
+          -> IO [( String -- url
+                 , String -- rev
+                 , String -- subdir
+                 , String -- sha256
+                 , String -- pkgname
+                 , String -- nixexpr-path
+                 )]
+readCache f = mapMaybe (toTuple . words) . lines <$!!> readFile f
+  where
+    -- The cache is advisory, so skip any line we cannot make sense of (a blank
+    -- line, or a truncated one from an interrupted `appendCache`) instead of
+    -- letting an incomplete pattern match abort the whole read and throw away
+    -- every other entry.  A skipped entry just means we fetch it again.
+    toTuple [ url, rev, subdir, sha256, pkgname, exprPath ]
+      = Just ( url, rev, subdir, if sha256 == "NOHASH" then "" else sha256, pkgname, exprPath )
+    toTuple _ = Nothing
+
+-- When we do not need a hash (when the files are local) we store "NOHASH" instead of ""
+-- in the file so that the use of `words` function in `readCache` still works.
+appendCache :: FilePath -> String -> String -> String -> String -> String -> String -> IO ()
+appendCache f url rev subdir sha256 pkgname exprPath = do
+  appendFile f $! unwords [ url, rev, subdir, if null sha256 then "NOHASH" else sha256, pkgname, exprPath ] ++ "\n"
+
+cacheHits :: FilePath -> String -> String -> String -> IO [ (String, String) ]
+cacheHits f url rev subdir
+  = do cache <- catch' (readCache f) (const (pure []))
+       return [ ( pkgname, exprPath )
+              | ( url', rev', subdir', _sha256, pkgname, exprPath ) <- cache
+              , url == url'
+              , rev == rev'
+              , subdir == subdir' ]
+  where catch' :: IO a -> (SomeException -> IO a) -> IO a
+        catch' = catch

nix-tools/nix-tools/lib/Stack2nix.hs

@@ -35,7 +35,7 @@ import Cabal2Nix hiding (Git)
 import qualified Cabal2Nix as C2N
 import Cabal2Nix.Util
 
-import Stack2nix.Cache (appendCache, cacheHits)
+import NixTools.Cache (appendCache, cacheHits)
 import Stack2nix.CLI (Args(..))
 import Stack2nix.Project
 import Stack2nix.Stack (Stack(..), Dependency(..), Location(..), PackageFlags, GhcOptions)

nix-tools/nix-tools/nix-tools.cabal

@@ -59,7 +59,7 @@ library
                      , StackRepos
                      , StackRepos.CLI
                      , Stack2nix
-                     , Stack2nix.Cache
+                     , NixTools.Cache
                      , Stack2nix.CLI
                      , Stack2nix.External.Resolve
                      , Stack2nix.Project
@@ -141,7 +141,6 @@ executable plan-to-nix
                      , vector
   main-is:             Main.hs
   other-modules:       Plan2Nix
-                     , Plan2Nix.Cache
                      , Plan2Nix.CLI
                      , Plan2Nix.Project
                      , Plan2Nix.Plan

nix-tools/nix-tools/plan2nix/Plan2Nix.hs

@@ -48,7 +48,7 @@ import Cabal2Nix.Util
 import Plan2Nix.CLI (Args(..))
 import Plan2Nix.Plan (Plan(..), PkgSrc(..), Package(..), Location(..))
 
-import Plan2Nix.Cache (appendCache, cacheHits)
+import NixTools.Cache (appendCache, cacheHits)
 import Plan2Nix.Project
 
 import System.FilePath ((<.>), (</>), takeDirectory, dropFileName)