started implementing git fetcher builtin

nmattia · Jun 25, 2024 · 1e5cab7 · 1e5cab7
1 parent 6cf78a4
commit 1e5cab7
Show file tree

Hide file tree

Showing 2 changed files with 47 additions and 8 deletions.
diff --git a/nix/sources.nix b/nix/sources.nix
@@ -24,7 +24,7 @@ let
     else
       pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
 
-  fetch_git = name: spec:
+  fetch_git = pkgs: name: spec:
     let
       ref =
         spec.ref or (
@@ -52,8 +52,9 @@ let
         then { inherit submodules; }
         else emptyArgWithWarning;
     in
-    builtins.fetchGit
-      ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg);
+      if spec.builtin or true
+      then builtins.fetchGit ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg)
+      else pkgs.fetchgit (builtins.removeAttrs spec ["type" "repo" "builtin" "branch" "tag" "ref"] // {url = spec.repo;});
 
   fetch_local = spec: spec.path;
 
@@ -105,7 +106,7 @@ let
       abort "ERROR: niv spec ${name} does not have a 'type' attribute"
     else if spec.type == "file" then fetch_file pkgs name spec
     else if spec.type == "tarball" then fetch_tarball pkgs name spec
-    else if spec.type == "git" then fetch_git name spec
+    else if spec.type == "git" then fetch_git pkgs name spec
     else if spec.type == "local" then fetch_local spec
     else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
     else if spec.type == "builtin-url" then fetch_builtin-url name

diff --git a/src/Niv/Git/Cmd.hs b/src/Niv/Git/Cmd.hs
@@ -23,7 +23,7 @@ import Niv.Sources
 import Niv.Update
 import qualified Options.Applicative as Opts
 import qualified Options.Applicative.Help.Pretty as Opts
-import System.Exit (ExitCode (ExitSuccess))
+import System.Exit (ExitCode (..))
 import System.Process (readProcessWithExitCode)
 
 gitCmd :: Cmd
@@ -152,18 +152,24 @@ gitUpdate ::
 gitUpdate latestRev' defaultBranchAndRev' = proc () -> do
   useOrSet "type" -< ("git" :: Box T.Text)
   repository <- load "repo" -< ()
-  discoverRev <+> discoverRefAndRev -< repository
+  newRev <- discoverRev <+> discoverRefAndRev -< repository
+  deepClone <- loadDefault "deepClone" -< pure False
+  leaveDotGit <- loadDefault "leaveDotGit" -< pure False
+  fetchLfs <- loadDefault "fetchLFS" -< pure False
+  fetchSubmodules <- loadDefault "fetchDubmodules" -< pure False
+  hash <- run nixPrefetchGit' -< (,,,,,) <$> repository <*> newRev <*> deepClone <*> leaveDotGit <*> fetchLfs <*> fetchSubmodules
+  update "hash" -< hash -- TODO: make depend on builtin
+  returnA -< ()
   where
     discoverRefAndRev = proc repository -> do
       branchAndRev <- run defaultBranchAndRev' -< repository
       update "branch" -< fst <$> branchAndRev
       update "rev" -< snd <$> branchAndRev
-      returnA -< ()
     discoverRev = proc repository -> do
       branch <- load "branch" -< ()
       rev <- run' (uncurry latestRev') -< (,) <$> repository <*> branch
       update "rev" -< rev
-      returnA -< ()
+    nixPrefetchGit' (a, b, c, d, e, f) = nixPrefetchGit a b c d e f -- uncurried version
 
 -- | The "real" (IO) update
 gitUpdate' :: Update () ()
@@ -265,3 +271,35 @@ abortGitBug args msg =
           T.unwords ("command:" : "git" : args),
           msg
         ]
+
+nixPrefetchGit :: T.Text -> T.Text -> Bool -> Bool -> Bool -> Bool -> IO T.Text
+nixPrefetchGit (T.unpack -> url) (T.unpack -> rev) deepClone leaveDotGit fetchLfs fetchSubmodules = do
+  (exitCode, stdout, stderr) <- runNixPrefetch
+  case exitCode of
+    ExitFailure _ -> abortNixPrefetchGitBug (T.pack <$> args) $ T.unlines ["stdout:" <> T.pack stdout, "stderr:" <> T.pack stderr]
+    ExitSuccess -> case getHash stdout of
+      Nothing -> abort "Could not decode output of 'nix-prefetch-git'."
+      Just hash -> pure hash
+  where
+    args =
+      ["--deepClone" | deepClone]
+        <> ["--leave-dotGit" | leaveDotGit]
+        <> ["--fetch-lfs" | fetchLfs]
+        <> ["--fetch-submodules" | fetchSubmodules]
+        <> [url, rev]
+    runNixPrefetch = readProcessWithExitCode "nix-prefetch-git" args ""
+    getHash input = do
+      obj :: Aeson.Object <- Aeson.decodeStrict $ B8.pack input
+      case KM.lookup "hash" obj of
+        Just (Aeson.String hash) -> pure hash
+        _ -> Nothing
+
+abortNixPrefetchGitBug :: [T.Text] -> T.Text -> IO a
+abortNixPrefetchGitBug args msg =
+  abort $
+    bug $
+      T.unlines
+        [ "Could not read the output of 'git'.",
+          T.unwords ("command:" : "nix-prefetch-git" : args),
+          msg
+        ]