@@ -25,7 +25,7 @@ import qualified Data.ByteString.Lazy as LBS
2525import Data.Containers.ListUtils (nubOrd)
2626import Data.Default
2727import Data.Either.Combinators (fromRight', rightToMaybe)
28−import Data.Foldable (for_, toList)
28+import Data.Foldable (toList)
2929import Data.Function ((&))
3030import Data.Functor ((<&>))
3131import Data.Git.Ref (Ref)
@@ -352,7 +352,7 @@ overwriteThunk target thunk = do
352352
353353 --TODO: Is there a safer way to do this overwriting?
354354 callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", target] -- target may be a symlink
355− createThunk True target thunk
355+ createThunk target $ Right thunk
356356
357357thunkPtrToSpec :: ThunkPtr -> ThunkSpec
358358thunkPtrToSpec thunk = case _thunkPtr_source thunk of
@@ -413,20 +413,22 @@ initThunk target = withSpinner [i|Initializing thunk at ${target}|] $ do
413413 let tempThunkDir = target <.> "thunk-init"
414414 whenM (liftIO $ doesPathExist tempThunkDir) $
415415 failWith [i|A previous 'thunk init' left unfinished state at ${tempThunkDir}. You will need to rename or remove that path before trying again.|]
416− createThunk False tempThunkDir ptr
416+ createThunk tempThunkDir $ Left (thunkPtrToSpec ptr) -- Only write the skeleton, but skip the ptr itself since it's unpacked
417417 liftIO $ do
418418 renameDirectory target (tempThunkDir </> unpackedDirName)
419419 removePathForcibly target
420420 renameDirectory tempThunkDir target
421421
422−createThunk :: MonadObelisk m => Bool -> FilePath -> ThunkPtr -> m ()
423−createThunk writePtr target ptr =
424− ifor_ (_thunkSpec_files $ thunkPtrToSpec ptr) $ \path -> \case
422+createThunk :: MonadObelisk m => FilePath -> Either ThunkSpec ThunkPtr -> m ()
423+createThunk target ptrInfo =
424+ ifor_ (_thunkSpec_files spec) $ \path -> \case
425425 ThunkFileSpec_FileMatches content -> withReadyPath path $ \p -> liftIO $ T.writeFile p content
426− ThunkFileSpec_Ptr _ -> when writePtr $
427− withReadyPath path $ \p -> liftIO $ LBS.writeFile p (encodeThunkPtrData ptr)
426+ ThunkFileSpec_Ptr _ -> case ptrInfo of
427+ Left _ -> pure () -- We can't write the ptr without it
428+ Right ptr -> withReadyPath path $ \p -> liftIO $ LBS.writeFile p (encodeThunkPtrData ptr)
428429 _ -> pure ()
429430 where
431+ spec = either id thunkPtrToSpec ptrInfo
430432 withReadyPath path f = do
431433 let fullPath = target </> path
432434 putLog Debug $ "Writing thunk file " <> T.pack fullPath
@@ -436,7 +438,7 @@ createThunk writePtr target ptr =
436438createThunkWithLatest :: MonadObelisk m => FilePath -> ThunkSource -> m ()
437439createThunkWithLatest target s = do
438440 rev <- getLatestRev s
439− createThunk True target $ ThunkPtr
441+ createThunk target $ Right $ ThunkPtr
440442 { _thunkPtr_source = s
441443 , _thunkPtr_rev = rev
442444 }
@@ -792,34 +794,31 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir *> readThunk thunkD
792794 Left err -> failWith [i|Invalid thunk at ${thunkDir}: ${err}|]
793795 --TODO: Overwrite option that rechecks out thunk; force option to do so even if working directory is dirty
794796 Right ThunkData_Checkout -> failWith [i|Thunk at ${thunkDir} is already unpacked|]
795− Right (ThunkData_Packed thunkSpec tptr) -> do
797+ Right (ThunkData_Packed _ tptr) -> do
796798 let (thunkParent, thunkName) = splitFileName thunkDir
797− withTempDirectory thunkParent thunkName $ \tmpRepo -> do
799+ withTempDirectory thunkParent thunkName $ \tmpThunk -> do
798800 let
799− s = case _thunkPtr_source tptr of
800− ThunkSource_GitHub s' -> forgetGithub False s'
801− ThunkSource_Git s' -> s'
801+ (gitSrc, newSpec) = case _thunkPtr_source tptr of
802+ ThunkSource_GitHub s' -> (forgetGithub False s', NonEmpty.head gitHubThunkSpecs)
803+ ThunkSource_Git s' -> (s', NonEmpty.head gitThunkSpecs)
802804 withSpinner' ("Fetching thunk " <> T.pack thunkName)
803805 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do
804− let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo
806+ let git = callProcessAndLogOutput (Notice, Notice) . gitProc (tmpThunk </> unpackedDirName)
805807 git $ [ "clone" ]
806− ++ ["--recursive" | _gitSource_fetchSubmodules s]
807− ++ [ T.unpack $ gitUriToText $ _gitSource_url s ]
808− ++ do branch <- maybeToList $ _gitSource_branch s
808+ ++ ["--recursive" | _gitSource_fetchSubmodules gitSrc]
809+ ++ [ T.unpack $ gitUriToText $ _gitSource_url gitSrc ]
810+ ++ do branch <- maybeToList $ _gitSource_branch gitSrc
809811 [ "--branch", T.unpack $ untagName branch ]
810812 git ["reset", "--hard", Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr]
811− when (_gitSource_fetchSubmodules s) $
813+ when (_gitSource_fetchSubmodules gitSrc) $
812814 git ["submodule", "update", "--recursive", "--init"]
813815
814− let unpackedPath = thunkDir </> unpackedDirName
815− liftIO $ createDirectoryIfMissing True (takeDirectory unpackedPath)
816− callProcessAndLogOutput (Notice, Error) $ proc mvPath [tmpRepo, unpackedPath]
816+ createThunk tmpThunk $ Left newSpec
817+
818+ liftIO $ do
819+ removePathForcibly thunkDir
820+ renameDirectory tmpThunk thunkDir
817821
818− -- Remove thunk ptrs
819− let ptrFiles = Map.filter (\case ThunkFileSpec_Ptr _ -> True; _ -> False) $ _thunkSpec_files thunkSpec
820− liftIO $ for_ (Map.keys ptrFiles) $ \f -> do
821− let p = thunkDir </> f
822− whenM (doesFileExist p) $ removeFile p
823822
824823--TODO: add a rollback mode to pack to the original thunk
825824packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr
@@ -834,7 +833,7 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire
834833 do
835834 thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) thunkDir (_thunkConfig_private thunkConfig)
836835 callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-rf", thunkDir] -- thunkDir may be a symlink
837− createThunk True thunkDir thunkPtr
836+ createThunk thunkDir $ Right thunkPtr
838837 pure thunkPtr
839838
840839modifyThunkPtrByConfig :: ThunkConfig -> ThunkPtr -> ThunkPtr