69bd563 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

command: Add new thunk type for Git and GitHub supporting private and local repos

69bd563Elliot Cameron7 years ago

lib/command/src/Obelisk/Command.hs+26−10

compare with master

unifiedsplit

@@ -13,6 +13,7 @@ import qualified Data.Binary as Binary

13import Data.Bool (bool)

14import qualified Data.ByteString.Base16 as Base16

15import qualified Data.ByteString.Lazy as LBS

16+import Data.Foldable (for_)

16import Data.List

17import Data.List

17import Data.Maybe (catMaybes)

18import Data.Maybe (catMaybes)

18import qualified Data.Text as T

19import qualified Data.Text as T

@@ -220,20 +221,35 @@ thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgumen

220 , help "Path to directory containing thunk data"

221 , help "Path to directory containing thunk data"

221 ]

222 ]

222

223

224+thunkConfig :: Parser ThunkConfig

225+thunkConfig = ThunkConfig

226+ <$>

227+ ( flag' (Just True) (long "private" <> help "Mark thunks as pointing to a private repository")

228+ <|> flag' (Just False) (long "public" <> help "Mark thunks as pointing to a public repository")

229+ <|> pure Nothing

230+ )

231+

232+thunkUpdateConfig :: Parser ThunkUpdateConfig

233+thunkUpdateConfig = ThunkUpdateConfig

234+ <$> optional (strOption (long "branch" <> metavar "BRANCH" <> help "Use the given branch when looking for the latest revision"))

235+ <*> thunkConfig

236+

237+thunkPackConfig :: Parser ThunkPackConfig

238+thunkPackConfig = ThunkPackConfig

239+ <$> switch (long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes. This will cause changes that have not been pushed upstream to be lost; use with care.")

240+ <*> thunkConfig

241+

223data ThunkCommand

242data ThunkCommand

224− = ThunkCommand_Update [FilePath] (Maybe String)

243+ = ThunkCommand_Update [FilePath] ThunkUpdateConfig

225 | ThunkCommand_Unpack [FilePath]

244 | ThunkCommand_Unpack [FilePath]

226− | ThunkCommand_Pack [FilePath] Bool

245+ | ThunkCommand_Pack [FilePath] ThunkPackConfig

227 deriving Show

246 deriving Show

228

247

229−forceFlag :: Parser Bool

230−forceFlag = switch $ long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes. This will cause changes that have not been pushed upstream to be lost; use with care."

231−

232thunkCommand :: Parser ThunkCommand

248thunkCommand :: Parser ThunkCommand

233thunkCommand = hsubparser $ mconcat

249thunkCommand = hsubparser $ mconcat

234− [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> optional (strOption (long "branch" <> metavar "BRANCH"))) $ progDesc "Update thunk to latest revision available"

250+ [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> thunkUpdateConfig) $ progDesc "Update thunk to latest revision available"

235 , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"

251 , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"

236− , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> forceFlag) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"

252+ , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> thunkPackConfig) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"

237 ]

253 ]

238

254

239data ShellOpts

255data ShellOpts

@@ -375,9 +391,9 @@ ob = \case

375 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs

391 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs

376 ObCommand_Run -> inNixShell' $ static run

392 ObCommand_Run -> inNixShell' $ static run

377 ObCommand_Thunk tc -> case tc of

393 ObCommand_Thunk tc -> case tc of

378− ThunkCommand_Update thunks mBranch -> mapM_ ((flip updateThunkToLatest) mBranch) thunks

394+ ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)

379− ThunkCommand_Unpack thunks -> mapM_ unpackThunk thunks

395+ ThunkCommand_Unpack thunks -> for_ thunks unpackThunk

380− ThunkCommand_Pack thunks force -> forM_ thunks (packThunk force)

396+ ThunkCommand_Pack thunks config -> for_ thunks (packThunk config)

381 ObCommand_Repl -> runRepl

397 ObCommand_Repl -> runRepl

382 ObCommand_Watch -> inNixShell' $ static runWatch

398 ObCommand_Watch -> inNixShell' $ static runWatch

383 ObCommand_Shell so -> withProjectRoot "." $ \root ->

399 ObCommand_Shell so -> withProjectRoot "." $ \root ->

lib/command/src/Obelisk/Command/Deploy.hs+2−2

@@ -107,7 +107,7 @@ deployPush deployPath getNixBuilders = do

107 Right (ThunkData_Packed ptr) -> return ptr

108 Right (ThunkData_Checkout _) -> do

109 checkGitCleanStatus srcPath True >>= \case

110− True -> packThunk False srcPath

110+ True -> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath

111 False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."

112 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)

113 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr

@@ -170,7 +170,7 @@ deployPush deployPath getNixBuilders = do

170 callProcessAndLogOutput (Notice, Notice) p

171

172deployUpdate :: MonadObelisk m => FilePath -> m ()

173−deployUpdate deployPath = updateThunkToLatest (deployPath </> "src") Nothing

173+deployUpdate deployPath = updateThunkToLatest (ThunkUpdateConfig Nothing (ThunkConfig Nothing)) (deployPath </> "src")

174

175keytoolToAndroidConfig :: KeytoolConfig -> HM.HashMap Text (NValue t Identity m)

176keytoolToAndroidConfig conf =

lib/command/src/Obelisk/Command/Project.hs+1

@@ -53,6 +53,7 @@ obeliskSourceWithBranch branch = ThunkSource_GitHub $ GitHubSource

53 { _gitHubSource_owner = "obsidiansystems"

54 , _gitHubSource_repo = "obelisk"

55 , _gitHubSource_branch = Just branch

56+ , _gitHubSource_private = False

56 }

57 }

58data InitSource

59data InitSource

lib/command/src/Obelisk/Command/Thunk.hs+79−32

@@ -8,12 +8,15 @@

8{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE TypeApplications #-}

10module Obelisk.Command.Thunk

11+ ( GitHubSource (..)

12+ , ReadThunkError (..)

13+ , ThunkConfig (..)

14+ , ThunkData (..)

15+ , ThunkPackConfig (..)

11− ( ThunkPtr (..)

16+ , ThunkPtr (..)

12 , ThunkRev (..)

17 , ThunkRev (..)

13 , ThunkSource (..)

18 , ThunkSource (..)

14− , ThunkData (..)

19+ , ThunkUpdateConfig (..)

15− , ReadThunkError (..)

16− , GitHubSource (..)

17 , getThunkGitBranch

20 , getThunkGitBranch

18 , getLatestRev

21 , getLatestRev

19 , updateThunkToLatest

22 , updateThunkToLatest

@@ -111,6 +114,7 @@ data GitHubSource = GitHubSource

111 { _gitHubSource_owner :: Name Owner

114 { _gitHubSource_owner :: Name Owner

112 , _gitHubSource_repo :: Name Repo

115 , _gitHubSource_repo :: Name Repo

113 , _gitHubSource_branch :: Maybe (Name Branch)

116 , _gitHubSource_branch :: Maybe (Name Branch)

117+ , _gitHubSource_private :: Bool

114 }

118 }

115 deriving (Show, Eq, Ord)

119 deriving (Show, Eq, Ord)

116

120

@@ -118,9 +122,24 @@ data GitSource = GitSource

118 { _gitSource_url :: URI

122 { _gitSource_url :: URI

119 , _gitSource_branch :: Maybe (Name Branch)

123 , _gitSource_branch :: Maybe (Name Branch)

120 , _gitSource_fetchSubmodules :: Bool

124 , _gitSource_fetchSubmodules :: Bool

125+ , _gitSource_private :: Bool

121 }

126 }

122 deriving (Show, Eq, Ord)

127 deriving (Show, Eq, Ord)

123

128

129+newtype ThunkConfig = ThunkConfig

130+ { _thunkConfig_private :: Maybe Bool

131+ } deriving Show

132+

133+data ThunkUpdateConfig = ThunkUpdateConfig

134+ { _thunkUpdateConfig_branch :: Maybe String

135+ , _thunkUpdateConfig_config :: ThunkConfig

136+ } deriving Show

137+

138+data ThunkPackConfig = ThunkPackConfig

139+ { _thunkPackConfig_force :: Bool

140+ , _thunkPackConfig_config :: ThunkConfig

141+ } deriving Show

142+

124-- | Convert a GitHub source to a regular Git source. Assumes no submodules.

143-- | Convert a GitHub source to a regular Git source. Assumes no submodules.

125forgetGithub :: Bool -> GitHubSource -> GitSource

144forgetGithub :: Bool -> GitHubSource -> GitSource

126forgetGithub useSsh s = GitSource

145forgetGithub useSsh s = GitSource

@@ -142,6 +161,7 @@ forgetGithub useSsh s = GitSource

142 }

161 }

143 , _gitSource_branch = _gitHubSource_branch s

162 , _gitSource_branch = _gitHubSource_branch s

144 , _gitSource_fetchSubmodules = False

163 , _gitSource_fetchSubmodules = False

164+ , _gitSource_private = _gitHubSource_private s

145 }

165 }

146

166

147getThunkGitBranch :: ThunkPtr -> Maybe Text

167getThunkGitBranch :: ThunkPtr -> Maybe Text

@@ -286,10 +306,12 @@ parseGitHubSource v = do

286 owner <- v Aeson..: "owner"

306 owner <- v Aeson..: "owner"

287 repo <- v Aeson..: "repo"

307 repo <- v Aeson..: "repo"

288 branch <- v Aeson..:! "branch"

308 branch <- v Aeson..:! "branch"

309+ private <- v Aeson..:? "private"

289 pure $ GitHubSource

310 pure $ GitHubSource

290 { _gitHubSource_owner = owner

311 { _gitHubSource_owner = owner

291 , _gitHubSource_repo = repo

312 , _gitHubSource_repo = repo

292 , _gitHubSource_branch = branch

313 , _gitHubSource_branch = branch

314+ , _gitHubSource_private = fromMaybe False private

293 }

315 }

294

316

295parseGitSource :: Aeson.Object -> Aeson.Parser GitSource

317parseGitSource :: Aeson.Object -> Aeson.Parser GitSource

@@ -297,10 +319,12 @@ parseGitSource v = do

297 Just url <- parseGitUri <$> v Aeson..: "url"

319 Just url <- parseGitUri <$> v Aeson..: "url"

298 branch <- v Aeson..:! "branch"

320 branch <- v Aeson..:! "branch"

299 fetchSubmodules <- v Aeson..:! "fetchSubmodules"

321 fetchSubmodules <- v Aeson..:! "fetchSubmodules"

322+ private <- v Aeson..:? "private"

300 pure $ GitSource

323 pure $ GitSource

301 { _gitSource_url = url

324 { _gitSource_url = url

302 , _gitSource_branch = branch

325 , _gitSource_branch = branch

303 , _gitSource_fetchSubmodules = fromMaybe False fetchSubmodules

326 , _gitSource_fetchSubmodules = fromMaybe False fetchSubmodules

327+ , _gitSource_private = fromMaybe False private

304 }

328 }

305

329

306overwriteThunk :: MonadObelisk m => FilePath -> ThunkPtr -> m ()

330overwriteThunk :: MonadObelisk m => FilePath -> ThunkPtr -> m ()

@@ -327,6 +351,7 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

327 , ("branch" .=) <$> _gitHubSource_branch s

351 , ("branch" .=) <$> _gitHubSource_branch s

328 , Just $ "rev" .= Ref.toHexString (_thunkRev_commit rev)

352 , Just $ "rev" .= Ref.toHexString (_thunkRev_commit rev)

329 , Just $ "sha256" .= _thunkRev_nixSha256 rev

353 , Just $ "sha256" .= _thunkRev_nixSha256 rev

354+ , Just $ "private" .= _gitHubSource_private s

330 ]

355 ]

331 ThunkSource_Git s -> encodePretty' plainGitCfg $ Aeson.object $ catMaybes

356 ThunkSource_Git s -> encodePretty' plainGitCfg $ Aeson.object $ catMaybes

332 [ Just $ "url" .= render (_gitSource_url s)

357 [ Just $ "url" .= render (_gitSource_url s)

@@ -334,6 +359,7 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

334 , ("branch" .=) <$> _gitSource_branch s

359 , ("branch" .=) <$> _gitSource_branch s

335 , Just $ "sha256" .= _thunkRev_nixSha256 rev

360 , Just $ "sha256" .= _thunkRev_nixSha256 rev

336 , Just $ "fetchSubmodules" .= _gitSource_fetchSubmodules s

361 , Just $ "fetchSubmodules" .= _gitSource_fetchSubmodules s

362+ , Just $ "private" .= _gitSource_private s

337 ]

363 ]

338 where

364 where

339 githubCfg = defConfig

365 githubCfg = defConfig

@@ -354,6 +380,7 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

354 [ "url"

380 [ "url"

355 , "rev"

381 , "rev"

356 , "sha256"

382 , "sha256"

383+ , "private"

357 , "fetchSubmodules"

384 , "fetchSubmodules"

358 ] <> compare

385 ] <> compare

359 , confTrailingNewline = True

386 , confTrailingNewline = True

@@ -377,8 +404,8 @@ createThunkWithLatest target s = do

377 , _thunkPtr_rev = rev

404 , _thunkPtr_rev = rev

378 }

405 }

379

406

380−updateThunkToLatest :: MonadObelisk m => FilePath -> Maybe String -> m ()

407+updateThunkToLatest :: MonadObelisk m => ThunkUpdateConfig -> FilePath -> m ()

381−updateThunkToLatest target mBranch = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest") $ do

408+updateThunkToLatest (ThunkUpdateConfig mBranch thunkConfig) target = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest") $ do

382 checkThunkDirectory "ob thunk update directory cannot be '.'" target

409 checkThunkDirectory "ob thunk update directory cannot be '.'" target

383 -- check to see if thunk should be updated to a specific branch or just update it's current branch

410 -- check to see if thunk should be updated to a specific branch or just update it's current branch

384 case mBranch of

411 case mBranch of

@@ -390,7 +417,7 @@ updateThunkToLatest target mBranch = withSpinner' ("Updating thunk " <> T.pack t

390 ThunkData_Checkout _ -> failWith "cannot update an unpacked thunk"

417 ThunkData_Checkout _ -> failWith "cannot update an unpacked thunk"

391 let src = _thunkPtr_source ptr

418 let src = _thunkPtr_source ptr

392 rev <- getLatestRev src

419 rev <- getLatestRev src

393− overwriteThunk overwrite $ ThunkPtr

420+ overwriteThunk overwrite $ modifyThunkPtrByConfig thunkConfig $ ThunkPtr

394 { _thunkPtr_source = src

421 { _thunkPtr_source = src

395 , _thunkPtr_rev = rev

422 , _thunkPtr_rev = rev

396 }

423 }

@@ -398,17 +425,17 @@ updateThunkToLatest target mBranch = withSpinner' ("Updating thunk " <> T.pack t

398 Left err -> failWith $ T.pack $ "thunk update: " <> show err

425 Left err -> failWith $ T.pack $ "thunk update: " <> show err

399 Right c -> case c of

426 Right c -> case c of

400 ThunkData_Packed t -> case _thunkPtr_source t of

427 ThunkData_Packed t -> case _thunkPtr_source t of

401− ThunkSource_Git tsg -> setThunk target tsg branch

428+ ThunkSource_Git tsg -> setThunk thunkConfig target tsg branch

402 ThunkSource_GitHub tsgh -> do

429 ThunkSource_GitHub tsgh -> do

403 let tsg = forgetGithub False tsgh

430 let tsg = forgetGithub False tsgh

404− setThunk target tsg branch

431+ setThunk thunkConfig target tsg branch

405 ThunkData_Checkout _ -> failWith $ T.pack $ "thunk located at " <> show target <> " is unpacked. Use ob thunk pack on the desired directory and then try ob thunk update again."

432 ThunkData_Checkout _ -> failWith $ T.pack $ "thunk located at " <> show target <> " is unpacked. Use ob thunk pack on the desired directory and then try ob thunk update again."

406

433

407−setThunk :: MonadObelisk m => FilePath -> GitSource -> String -> m ()

434+setThunk :: MonadObelisk m => ThunkConfig -> FilePath -> GitSource -> String -> m ()

408−setThunk target gs branch = do

435+setThunk thunkConfig target gs branch = do

409 newThunkPtr <- uriThunkPtr (_gitSource_url gs) (Just $ T.pack branch) Nothing

436 newThunkPtr <- uriThunkPtr (_gitSource_url gs) (Just $ T.pack branch) Nothing

410 overwriteThunk target newThunkPtr

437 overwriteThunk target newThunkPtr

411− updateThunkToLatest target Nothing

438+ updateThunkToLatest (ThunkUpdateConfig Nothing thunkConfig) target

412

439

413-- | All recognized github standalone loaders, ordered from newest to oldest.

440-- | All recognized github standalone loaders, ordered from newest to oldest.

414-- This tool will only ever produce the newest one when it writes a thunk.

441-- This tool will only ever produce the newest one when it writes a thunk.

@@ -459,26 +486,20 @@ gitHubStandaloneLoaderV3 = T.unlines

459gitHubStandaloneLoaderV4 :: Text

486gitHubStandaloneLoaderV4 :: Text

460gitHubStandaloneLoaderV4 = T.unlines

487gitHubStandaloneLoaderV4 = T.unlines

461 [ "# DO NOT HAND-EDIT THIS FILE"

488 [ "# DO NOT HAND-EDIT THIS FILE"

462− , "let"

463− , " fetch = { private ? false, ... }@args:"

489+ , "let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:"

464− , " if private && builtins.hasAttr \"fetchGit\" builtins"

465− , " then fetchFromGitHubPrivate args"

466− , " else fetchFromGitHub (builtins.removeAttrs args [\"branch\"]);"

467− , " fetchFromGitHub = if builtins.hasAttr \"fetchTarball\" builtins then"

468− , " ({ owner, repo, rev, sha256, ... }: builtins.fetchTarball {"

490+ , " if !fetchSubmodules && !private then builtins.fetchTarball {"

469− , " url = \"https://github.com/${owner}/${repo}/archive/${rev}.tar.gz\";"

491+ , " url = \"https://github.com/${owner}/${repo}/archive/${rev}.tar.gz\"; inherit sha256;"

470− , " inherit sha256; })"

471− , " else (import <nixpkgs> {}).fetchFromGitHub;"

492+ , " } else (import <nixpkgs> {}).fetchFromGitHub {"

472− , " fetchFromGitHubPrivate = { owner, repo, rev, sha256, ... }:"

493+ , " inherit owner repo rev sha256 fetchSubmodules private;"

473− , " (import <nixpkgs> {}).fetchFromGitHub"

494+ , " };"

474− , " { inherit owner repo rev sha256; private = true; }"

475 , "in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))"

495 , "in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))"

476 ]

496 ]

477

497

478plainGitStandaloneLoaders :: NonEmpty Text

498plainGitStandaloneLoaders :: NonEmpty Text

479plainGitStandaloneLoaders =

499plainGitStandaloneLoaders =

480− plainGitStandaloneLoaderV1 :|

500+ plainGitStandaloneLoaderV3 :|

501+ [ plainGitStandaloneLoaderV1

481− [ plainGitStandaloneLoaderV2

502+ , plainGitStandaloneLoaderV2

482 ]

503 ]

483

504

484plainGitStandaloneLoaderV1 :: Text

505plainGitStandaloneLoaderV1 :: Text

@@ -499,6 +520,22 @@ plainGitStandaloneLoaderV2 = T.unlines

499 , "in import (fetchGit (builtins.fromJSON (builtins.readFile ./git.json)))"

520 , "in import (fetchGit (builtins.fromJSON (builtins.readFile ./git.json)))"

500 ]

521 ]

501

522

523+plainGitStandaloneLoaderV3 :: Text

524+plainGitStandaloneLoaderV3 = T.unlines

525+ [ "# DO NOT HAND-EDIT THIS FILE"

526+ , "let fetch = {url, rev, ref ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}:"

527+ , " let realUrl = let firstChar = builtins.substring 0 1 url; in"

528+ , " if firstChar == \"/\" then /. + url"

529+ , " else if firstChar == \".\" then ./. + url"

530+ , " else url;"

531+ , " in if !fetchSubmodules && private then builtins.fetchGit {"

532+ , " url = realUrl; inherit rev;"

533+ , " } else (import <nixpkgs> {}).fetchgit {"

534+ , " url = realUrl; inherit rev sha256;"

535+ , " };"

536+ , "in import (fetch (builtins.fromJSON (builtins.readFile ./git.json)))"

537+ ]

538+

502thunkFileNames :: [FilePath]

539thunkFileNames :: [FilePath]

503thunkFileNames = ["default.nix", "github.json", "git.json"]

540thunkFileNames = ["default.nix", "github.json", "git.json"]

504

541

@@ -592,7 +629,7 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do

592 return tmpThunk

629 return tmpThunk

593 Right _ -> failWith "Thunk is not packed"

630 Right _ -> failWith "Thunk is not packed"

594 updateThunkFromTmp p' = do

631 updateThunkFromTmp p' = do

595− _ <- packThunk' True False p'

632+ _ <- packThunk' True (ThunkPackConfig False (ThunkConfig Nothing)) p'

596 callProcessAndLogOutput (Notice, Error) $

633 callProcessAndLogOutput (Notice, Error) $

597 proc "cp" ["-r", "-T", p', p]

634 proc "cp" ["-r", "-T", p', p]

598

635

@@ -642,21 +679,29 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with

642 proc "mv" ["-T", tmpRepo, thunkDir]

679 proc "mv" ["-T", tmpRepo, thunkDir]

643

680

644--TODO: add a rollback mode to pack to the original thunk

681--TODO: add a rollback mode to pack to the original thunk

645−packThunk :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr

682+packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr

646packThunk = packThunk' False

683packThunk = packThunk' False

647

684

648−packThunk' :: MonadObelisk m => Bool -> Bool -> FilePath -> m ThunkPtr

685+packThunk' :: MonadObelisk m => Bool -> ThunkPackConfig -> FilePath -> m ThunkPtr

649−packThunk' noTrail force thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case

686+packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case

650 Left err -> failWith $ T.pack $ "thunk pack: " <> show err

687 Left err -> failWith $ T.pack $ "thunk pack: " <> show err

651 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"

688 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"

652 Right (ThunkData_Checkout _) -> do

689 Right (ThunkData_Checkout _) -> do

653 withSpinner' ("Packing thunk " <> T.pack thunkDir)

690 withSpinner' ("Packing thunk " <> T.pack thunkDir)

654 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do

691 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do

655− thunkPtr <- getThunkPtr (not force) thunkDir

692+ thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) thunkDir

656 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]

693 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]

657 liftIO $ createThunk thunkDir thunkPtr

694 liftIO $ createThunk thunkDir thunkPtr

658 pure thunkPtr

695 pure thunkPtr

659

696

697+modifyThunkPtrByConfig :: ThunkConfig -> ThunkPtr -> ThunkPtr

698+modifyThunkPtrByConfig (ThunkConfig markPrivate') ptr = case markPrivate' of

699+ Nothing -> ptr

700+ Just markPrivate -> ptr { _thunkPtr_source = case _thunkPtr_source ptr of

701+ ThunkSource_Git s -> ThunkSource_Git $ s { _gitSource_private = markPrivate }

702+ ThunkSource_GitHub s -> ThunkSource_GitHub $ s { _gitHubSource_private = markPrivate }

703+ }

704+

660getThunkPtr :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr

705getThunkPtr :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr

661getThunkPtr checkClean thunkDir = do

706getThunkPtr checkClean thunkDir = do

662 when checkClean $ ensureCleanGitRepo thunkDir True

707 when checkClean $ ensureCleanGitRepo thunkDir True

@@ -840,12 +885,14 @@ uriToThunkSource u

840 repoish' = unRText repoish

885 repoish' = unRText repoish

841 in fromMaybe repoish' $ T.stripSuffix ".git" repoish'

886 in fromMaybe repoish' $ T.stripSuffix ".git" repoish'

842 , _gitHubSource_branch = N <$> mbranch

887 , _gitHubSource_branch = N <$> mbranch

888+ , _gitHubSource_private = False -- TODO: Can we try something to infer this?

843 }

889 }

844

890

845 | otherwise = \mbranch -> ThunkSource_Git $ GitSource

891 | otherwise = \mbranch -> ThunkSource_Git $ GitSource

846 { _gitSource_url = u

892 { _gitSource_url = u

847 , _gitSource_branch = N <$> mbranch

893 , _gitSource_branch = N <$> mbranch

848 , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?

894 , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?

895+ , _gitSource_private = False -- TODO: Can we try something to infer this?

849 }

896 }

850

897

851-- Funny signature indicates no effects depend on the optional branch name.

898-- Funny signature indicates no effects depend on the optional branch name.