@@ -1,114 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE LambdaCase #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−{-# LANGUAGE TupleSections #-}
6−-- | Hash a git repo or arbitrary directory using nix-hash.
7−module Obelisk.Command.Upgrade.Hash
8− ( getDirectoryHash
9− , getHashAtGitRevision
10− ) where
11−
12−import Control.Monad (forM, forM_)
13−import Control.Monad.IO.Class (liftIO)
14−import Data.Bool (bool)
15−import Data.Maybe (catMaybes)
16−import Data.Semigroup ((<>))
17−import Data.Text (Text)
18−import qualified Data.Text as T
19−import System.Directory
20−import System.FilePath
21−import System.IO.Temp
22−import System.Process (cwd, proc)
23−
24−import Obelisk.App (MonadObelisk)
25−import Obelisk.CliApp
26−import Obelisk.Command.Utils
27−
28−import Obelisk.Migration
29−
30−-- | Get the unique hash of the given directory
31−--
32−-- Excludes the following before computing the hash:
33−-- * the specified top-level files/ directories.
34−-- * .git directory
35−-- * untracked Git files
36−-- * ignored Git files
37−-- * empty directories
38−--
39−-- Uses the same predictive algorithm as that of Nix (`nix-hash`).
40−--
41−-- This function will do a full copy of the directory to a temporary location before
42−-- computing the hash. Because it will be deleting the files in exclude list, and
43−-- other files if the directory is a git repo, which needs to be done as `nix-hash`
44−-- doesn't support taking an excludes list.
45−getDirectoryHash :: MonadObelisk m => [FilePath] -> FilePath -> m Hash
46−getDirectoryHash excludes dir = withSystemTempDirectory "obelisk-hash-" $ \tmpDir -> do
47− withSpinnerNoTrail (T.pack $ "Copying " <> dir <> " to " <> tmpDir) $ do
48− runProc $ copyDir dir tmpDir
49− getDirectoryHashDestructive excludes tmpDir
50−
51−getDirectoryHashDestructive :: MonadObelisk m => [FilePath] -> FilePath -> m Hash
52−getDirectoryHashDestructive excludes dir = do
53− liftIO (doesDirectoryExist $ dir </> ".git") >>= \case
54− True -> do
55− tidyUpGitWorkingCopy dir
56− withSpinnerNoTrail "Removing .git directory" $
57− liftIO $ removePathForcibly $ dir </> ".git"
58− False -> pure ()
59− withSpinnerNoTrail "Removing excluded paths" $ do
60− forM_ (fmap (dir </>) excludes) $
61− liftIO . removePathForcibly
62− nixHash dir
63−
64−getHashAtGitRevision :: MonadObelisk m => [Text] -> [FilePath] -> FilePath -> m [Hash]
65−getHashAtGitRevision revs excludes dir = withSystemTempDirectory "obelisk-hashrev-" $ \tmpDir -> do
66− withSpinnerNoTrail (T.pack $ "Copying " <> dir <> " to " <> tmpDir) $ do
67− runProc $ copyDir dir tmpDir
68− tidyUpGitWorkingCopy tmpDir
69− -- Discard changes to tracked files
70− runProcSilently $ gitProc tmpDir ["reset", "--hard"]
71− forM revs $ \rev -> do
72− runProcSilently $ gitProc tmpDir ["checkout", T.unpack rev]
73− -- Checking out an arbitrary revision can leave untracked files (from
74− -- previous revison) around, so tidy them up.
75− tidyUpGitWorkingCopy tmpDir
76− withFilesStashed tmpDir (excludes <> [".git"]) $
77− nixHash tmpDir
78− where
79− withFilesStashed base fs m = withSystemTempDirectory "obelisk-hashrev-stash-" $ \stashDir -> do
80− existingPaths <- fmap catMaybes $ forM fs $ \p -> do
81− liftIO (doesPathExist $ base </> p) >>= pure . bool Nothing (Just p)
82− forM_ existingPaths $ \p ->
83− liftIO $ renamePath (base </> p) (stashDir </> p)
84− result <- m
85− forM_ existingPaths $ \p ->
86− liftIO $ renamePath (stashDir </> p) (base </> p)
87− return result
88−
89−nixHash :: MonadObelisk m => FilePath -> m Hash
90−nixHash dir = withSpinnerNoTrail "Running `nix-hash`" $
91− readProc $ proc "nix-hash" [dir]
92−
93−-- | Clean up the following files in the git working copy
94−--
95−-- * Paths ignored by .gitignore, and still present
96−-- * Untracked files (not added to git index)
97−-- * Any empty directories (these are not tracked by git)
98−--
99−-- Note that this leaves modified (staged or unstaged) files as they are.
100−tidyUpGitWorkingCopy :: MonadObelisk m => FilePath -> m ()
101−tidyUpGitWorkingCopy dir = withSpinnerNoTrail "Tidying up git working copy" $ do
102− ignored <- gitLsFiles dir ["--ignored", "--exclude-standard", "--others"]
103− untracked <- gitLsFiles dir ["--exclude-standard", "--others"]
104− putLog Debug $ "Ignored: " <> T.pack (show $ length ignored) <> " files."
105− putLog Debug $ "Untracked files:\n" <> T.unlines untracked
106− withSpinnerNoTrail "Removing untracked and ignored files" $ do
107− forM_ (fmap ((dir </>) . T.unpack) $ ignored <> untracked) $
108− liftIO . removePathForcibly
109− -- Empty directories won't be included in these lists. Git doesn't track them
110− -- So we must delete these separately.
111− runProc $ proc "find" [dir, "-depth", "-empty", "-type", "d", "-delete"]
112− where
113− gitLsFiles pwd opts = fmap T.lines $ readProc $
114− (proc "git" $ ["ls-files", "."] <> opts) { cwd = Just pwd }