@@ -38,6 +38,7 @@ import Data.Maybe
3838import Data.Set (Set)
3939import qualified Data.Set as Set
4040import Data.String.Here.Interpolated (i)
41+import Data.String.Here.Uninterpolated (here)
4142import Data.Text (Text)
4243import qualified Data.Text as T
4344import Data.Text.Encoding
@@ -479,8 +480,9 @@ setThunk thunkConfig target gs branch = do
479480-- This tool will only ever produce the newest one when it writes a thunk.
480481gitHubThunkSpecs :: NonEmpty ThunkSpec
481482gitHubThunkSpecs =
482− gitHubThunkSpecV4 :|
483− [ gitHubThunkSpecV3
483+ gitHubThunkSpecV5 :|
484+ [ gitHubThunkSpecV4
485+ , gitHubThunkSpecV3
484486 , gitHubThunkSpecV2
485487 , gitHubThunkSpecV1
486488 ]
@@ -535,15 +537,31 @@ gitHubThunkSpecV4 = legacyGitHubThunkSpec "github-v4" $ T.unlines
535537legacyGitHubThunkSpec :: Text -> Text -> ThunkSpec
536538legacyGitHubThunkSpec name loader = ThunkSpec name $ Map.fromList
537539 [ ("default.nix", ThunkFileSpec_FileMatches $ T.strip loader)
538− , ("github.json" , ThunkFileSpec_Ptr $ parseJsonObject $ parseThunkPtr $ \v ->
539− ThunkSource_GitHub <$> parseGitHubSource v <|> ThunkSource_Git <$> parseGitSource v)
540+ , ("github.json" , ThunkFileSpec_Ptr parseGitHubJsonBytes)
540541 , (attrCacheFileName, ThunkFileSpec_AttrCache)
541542 ]
542543
544+gitHubThunkSpecV5 :: ThunkSpec
545+gitHubThunkSpecV5 = mkThunkSpec "github-v5" "github.json" parseGitHubJsonBytes [here|
546+# DO NOT HAND-EDIT THIS FILE
547+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
548+ if !fetchSubmodules && !private then builtins.fetchTarball {
549+ url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
550+ } else (import <nixpkgs> {}).fetchFromGitHub {
551+ inherit owner repo rev sha256 fetchSubmodules private;
552+ };
553+in if builtins.pathExists ./_ then ./_ else fetch (builtins.fromJSON (builtins.readFile ./github.json))
554+|]
555+
556+parseGitHubJsonBytes :: LBS.ByteString -> Either String ThunkPtr
557+parseGitHubJsonBytes = parseJsonObject $ parseThunkPtr $ \v ->
558+ ThunkSource_GitHub <$> parseGitHubSource v <|> ThunkSource_Git <$> parseGitSource v
559+
543560gitThunkSpecs :: NonEmpty ThunkSpec
544561gitThunkSpecs =
545− gitThunkSpecV4 :|
546− [ gitThunkSpecV3
562+ gitThunkSpecV5 :|
563+ [ gitThunkSpecV4
564+ , gitThunkSpecV3
547565 , gitThunkSpecV2
548566 , gitThunkSpecV1
549567 ]
@@ -604,10 +622,44 @@ gitThunkSpecV4 = legacyGitThunkSpec "git-v4" $ T.unlines
604622legacyGitThunkSpec :: Text -> Text -> ThunkSpec
605623legacyGitThunkSpec name loader = ThunkSpec name $ Map.fromList
606624 [ ("default.nix", ThunkFileSpec_FileMatches $ T.strip loader)
607− , ("git.json" , ThunkFileSpec_Ptr $ parseJsonObject $ parseThunkPtr $ fmap ThunkSource_Git . parseGitSource)
625+ , ("git.json" , ThunkFileSpec_Ptr parseGitJsonBytes)
608626 , (attrCacheFileName, ThunkFileSpec_AttrCache)
609627 ]
610628
629+gitThunkSpecV5 :: ThunkSpec
630+gitThunkSpecV5 = mkThunkSpec "git-v5" "git.json" parseGitJsonBytes [here|
631+# DO NOT HAND-EDIT THIS FILE
632+let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}:
633+ let realUrl = let firstChar = builtins.substring 0 1 url; in
634+ if firstChar == "/" then /. + url
635+ else if firstChar == "." then ./. + url
636+ else url;
637+ in if !fetchSubmodules && private then builtins.fetchGit {
638+ url = realUrl; inherit rev;
639+ ${if branch == null then null else "ref"} = branch;
640+ } else (import <nixpkgs> {}).fetchgit {
641+ url = realUrl; inherit rev sha256;
642+ };
643+in if builtins.pathExists ./_ then ./_ else fetch (builtins.fromJSON (builtins.readFile ./git.json))
644+|]
645+
646+parseGitJsonBytes :: LBS.ByteString -> Either String ThunkPtr
647+parseGitJsonBytes = parseJsonObject $ parseThunkPtr $ fmap ThunkSource_Git . parseGitSource
648+
649+mkThunkSpec :: Text -> FilePath -> (LBS.ByteString -> Either String ThunkPtr) -> Text -> ThunkSpec
650+mkThunkSpec name jsonFileName parser srcNix = ThunkSpec name $ Map.fromList
651+ [ ("default.nix", ThunkFileSpec_FileMatches defaultNixViaSrc)
652+ , ("src.nix", ThunkFileSpec_FileMatches srcNix)
653+ , (jsonFileName, ThunkFileSpec_Ptr parser)
654+ , (attrCacheFileName, ThunkFileSpec_AttrCache)
655+ ]
656+ where
657+ defaultNixViaSrc = [here|
658+# DO NOT HAND-EDIT THIS FILE
659+import (import ./src.nix)
660+|]
661+
662+
611663parseJsonObject :: (Aeson.Object -> Aeson.Parser a) -> LBS.ByteString -> Either String a
612664parseJsonObject p bytes = Aeson.parseEither p =<< Aeson.eitherDecode bytes
613665
@@ -731,15 +783,15 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with
731783 Right (ThunkData_Packed (_, tptr)) -> do
732784 let (thunkParent, thunkName) = splitFileName thunkDir
733785 withTempDirectory thunkParent thunkName $ \tmpRepo -> do
734− let obGitDir = tmpRepo </> ".git" </> "obelisk"
735− s = case _thunkPtr_source tptr of
736− ThunkSource_GitHub s' -> forgetGithub False s'
737− ThunkSource_Git s' -> s'
786+ let
787+ s = case _thunkPtr_source tptr of
788+ ThunkSource_GitHub s' -> forgetGithub False s'
789+ ThunkSource_Git s' -> s'
738790 withSpinner' ("Fetching thunk " <> T.pack thunkName)
739791 (finalMsg noTrail $ const $ "Fetched thunk " <> T.pack thunkName) $ do
740792 let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo
741793 git $ [ "clone" ]
742− ++ ("--recursive" <$ guard (_gitSource_fetchSubmodules s))
794+ ++ ["--recursive" | _gitSource_fetchSubmodules s]
743795 ++ [ T.unpack $ gitUriToText $ _gitSource_url s ]
744796 ++ do branch <- maybeToList $ _gitSource_branch s
745797 [ "--branch", T.unpack $ untagName branch ]
@@ -747,13 +799,9 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with
747799 when (_gitSource_fetchSubmodules s) $
748800 git ["submodule", "update", "--recursive", "--init"]
749801
750− liftIO $ createDirectory obGitDir
751− callProcessAndLogOutput (Notice, Error) $
752− proc cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]
753− callProcessAndLogOutput (Notice, Error) $
754− proc rmPath ["-r", thunkDir]
755− callProcessAndLogOutput (Notice, Error) $
756− proc "mv" ["-T", tmpRepo, thunkDir]
802+ let unpackedPath = thunkDir </> unpackedDirName
803+ liftIO $ createDirectoryIfMissing True (takeDirectory unpackedPath)
804+ callProcessAndLogOutput (Notice, Error) $ proc mvPath [tmpRepo, unpackedPath]
757805
758806--TODO: add a rollback mode to pack to the original thunk
759807packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr
@@ -766,8 +814,8 @@ packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDire
766814 Right (ThunkData_Checkout _) -> do
767815 withSpinner' ("Packing thunk " <> T.pack thunkDir)
768816 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do
769− thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) thunkDir (_thunkConfig_private thunkConfig)
770− callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-r", thunkDir] -- thunkDir may be a symlink
817+ thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) (thunkDir </> unpackedDirName) (_thunkConfig_private thunkConfig)
818+ callProcessAndLogOutput (Debug, Error) $ proc rmPath ["-rf", thunkDir </> unpackedDirName] -- thunkDir may be a symlink
771819 createThunk thunkDir thunkPtr
772820 pure thunkPtr
773821