git.iko.soy/obelisk
on master help sign in
preserve initial project state by checking to see if branch exists before making changes
commit6ea4544ddcda2eed3271c887a7651f57df227615 authorhsloan <ishaqsloan@gmail.com> dateTue 27 Nov 2018, 22:02 (8 years ago) parent6f77657
2 files changed+37−8
compare with master
unifiedsplit
lib/command/src/Obelisk/Command/Thunk.hs+21−8 lib/command/src/Obelisk/Command/Utils.hs+16
lib/command/src/Obelisk/Command/Thunk.hs+21−8
@@ -67,6 +67,7 @@ import GitHub
6767import GitHub.Data.Name
6868import Obelisk.Command.Nix
6969import System.Directory
70+import System.Exit
7071import System.FilePath
7172import System.IO.Error
7273import System.IO.Temp
@@ -629,14 +630,26 @@ setThunk = setThunk' False
629630setThunk' :: MonadObelisk m => Bool -> String -> FilePath -> m ()
630631setThunk' noTrail branch thunkDir = checkThunkDirectory thunkDir >> readThunk thunkDir >>= \case
631632 Left err -> failWith $ T.pack $ "thunk set : " <> show err
632− Right (ThunkData_Packed _) -> do
633− -- TODO: create a ThunkPtr from the branch name
634− _ <- unpackThunk' noTrail thunkDir
635− -- TODO: if git checkout branch errors out, the directory should be restored back to it's previous state
636− callProcessAndLogOutput (Debug, Error) $ gitProc thunkDir ["checkout", branch]
637− _ <- packThunk' noTrail thunkDir
638− updateThunkToLatest thunkDir
639− -- TODO: use overwriteThunk thunkDir (someThunkPtr)
633+ Right (ThunkData_Packed thunkptr) -> do
634+ let thunkSrc = _thunkPtr_source thunkptr
635+ repository = case thunkSrc of
636+ ThunkSource_Git gitSource -> (T.unpack $ render $ _gitSource_url gitSource)
637+ ThunkSource_GitHub gitHubSource -> T.unpack $ "git@github.com:"
638+ <> (untagName $ _gitHubSource_owner gitHubSource)
639+ <> "/"
640+ <> (untagName $ _gitHubSource_repo gitHubSource)
641+ <> ".git"
642+ -- check to see if branch exists before modifying directory
643+ (exitCode, _) <- gitLsRemoteExitCode repository branch
644+ case exitCode of
645+ ExitSuccess -> do
646+ _ <- unpackThunk' noTrail thunkDir
647+ callProcessAndLogOutput (Debug, Error) $ gitProc thunkDir ["checkout", branch]
648+ _ <- packThunk' noTrail thunkDir
649+ updateThunkToLatest thunkDir
650+ ExitFailure errNum -> failWith $ T.pack $ if errNum == 2
651+ then "Error: branch not found"
652+ else ("Error Code: " <> show errNum <> "issue checking out the desired branch")
640653 Right (ThunkData_Checkout _) -> do
641654 callProcessAndLogOutput (Debug, Error) $ gitProc thunkDir ["checkout", branch]
642655 _ <- packThunk' noTrail thunkDir
lib/command/src/Obelisk/Command/Utils.hs+16
@@ -22,6 +22,7 @@ import qualified Data.Text as T
2222import Data.Void (Void)
2323import System.Directory (canonicalizePath)
2424import System.Environment (getExecutablePath)
25+import System.Exit (ExitCode)
2526import qualified System.Process as P
2627import Text.Megaparsec as MP
2728import Text.Megaparsec.Char as MP
@@ -130,6 +131,21 @@ gitLsRemote repository mRef = do
130131 putLog Debug $ "git ls-remote maps: " <> T.pack (show maps)
131132 pure maps
132133
134+gitLsRemoteExitCode
135+ :: MonadObelisk m
136+ => String
137+ -> String
138+ -> m (ExitCode, GitLsRemoteMaps)
139+gitLsRemoteExitCode repository branchName = do
140+ (exitCode, out, _err) <- readCreateProcessWithExitCode $ gitProcNoRepo $
141+ ["ls-remote", "--exit-code", repository, branchName]
142+ let t = T.pack out
143+ maps <- case MP.runParser parseLsRemote "" t of
144+ Left err -> failWith $ T.pack $ MP.parseErrorPretty' t err
145+ Right table -> pure $ bimap M.fromList M.fromList $ partitionEithers $ table
146+ putLog Debug $ "git ls-remote maps: " <> T.pack (show maps)
147+ pure (exitCode, maps)
148+
133149lexeme :: Parsec Void Text a -> Parsec Void Text a
134150lexeme = ML.lexeme $ void $ MP.takeWhileP (Just "within-line white space") $
135151 flip elem [' ', '\t']