@@ -24,6 +24,7 @@ import System.IO.Temp
2424import System.Timeout
2525import Test.Hspec
2626import Test.HUnit.Base
27+import System.Process (readProcessWithExitCode)
2728
2829data ObRunState
2930 = ObRunState_Init
@@ -92,34 +93,18 @@ main = do
9293 origHash <- run_ "git" ["clone", "https://git.haskell.org/packages/primitive.git", repo] *> hashDir repo
9394
9495 run_ "ob" ["thunk", "pack", repo]
95− packedFiles <- Set.fromList <$> ls (repo </> ("" :: String))
96+ packedFiles <- Set.fromList <$> ls (fromText repo)
9697 liftIO $ assertEqual "" packedFiles $
9798 Set.fromList $ (repo </>) <$> ["default.nix", "git.json", ".attr-cache" :: String]
9899
99100 unpackHash <- run_ "ob" ["thunk", "unpack", repo] *> hashDir repo
100101 liftIO $ assertEqual "" origHash unpackHash
101102
103+ testThunkPack $ fromText repo
104+
102105 it "aborts thunk pack when there are uncommitted files" $ inProj $ do
103− withTempFile (T.unpack $ toTextIgnore $ blankProject </> thunk) "test-file" $ \file handle -> do
104− let try_sh :: Exception e => Sh a -> Sh (Either e a)
105− try_sh a = catch_sh (a >>= pure . Right) (pure . Left)
106− ensureThunkPackFails = try_sh pack >>= \case
107− Left (RunFailed _ _ status _) | status /= 0 -> pure ()
108− _ -> fail "ob thunk pack succeeded when it should have failed"
109− -- Untracked files
110− ensureThunkPackFails
111− run "git" ["add", T.pack file]
112− -- Uncommitted files (staged)
113− ensureThunkPackFails
114− run "git" ["commit", "-m", "test commit"]
115− -- Non-pushed commits in any branch
116− ensureThunkPackFails
117− -- Uncommitted files (unstaged)
118− liftIO $ T.hPutStrLn handle "test file" >> hClose handle
119− ensureThunkPackFails
120− -- Existing stashes
121− run "git" ["stash"]
122− ensureThunkPackFails
106+ unpack
107+ testThunkPack (blankProject </> thunk)
123108
124109 it "can use ob run" $ inProj $ handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
125110 runHandle "ob" ["run"] $ \stdout -> do
@@ -133,6 +118,32 @@ main = do
133118 then errorExit $ "Reloading failed: expected " <> newUri <> " but got " <> runningUri
134119 else exit 0
135120
121+testThunkPack :: Shelly.FilePath -> Sh ()
122+testThunkPack path = withTempFile (T.unpack $ toTextIgnore path) "test-file" $ \file handle -> do
123+ let try_sh :: Exception e => Sh a -> Sh (Either e a)
124+ try_sh a = catch_sh (a >>= pure . Right) (pure . Left)
125+ pack' = readProcessWithExitCode "ob" ["thunk", "pack", T.unpack $ toTextIgnore path] ""
126+ ensureThunkPackFails err = liftIO $ pack' >>= \case
127+ (code, out, _err)
128+ | code == ExitSuccess -> fail "ob thunk pack succeeded when it should have failed"
129+ | err `T.isInfixOf` T.pack out -> pure ()
130+ | otherwise -> fail $ "ob thunk pack failed for an unexpected reason: " <> show out
131+ git = chdir path . run "git"
132+ -- Untracked files
133+ ensureThunkPackFails "unsaved modifications"
134+ git ["add", T.pack file]
135+ -- Uncommitted files (staged)
136+ ensureThunkPackFails "unsaved modifications"
137+ git ["commit", "-m", "test commit"]
138+ -- Non-pushed commits in any branch
139+ ensureThunkPackFails "not been pushed"
140+ -- Uncommitted files (unstaged)
141+ liftIO $ T.hPutStrLn handle "test file" >> hClose handle
142+ ensureThunkPackFails "unsaved modifications"
143+ -- Existing stashes
144+ git ["stash"]
145+ ensureThunkPackFails "has stashes"
146+
136147-- | Blocks until a non-empty line is available
137148hGetLineSkipBlanks :: MonadIO m => Handle -> m Text
138149hGetLineSkipBlanks h = liftIO $ fix $ \loop -> T.hGetLine h >>= \case