@@ -3,7 +3,7 @@
33{-# LANGUAGE TypeApplications #-}
44module Obelisk.SelfTest where
55
6−import Control.Exception (throw)
6+import Control.Exception (Exception, throw)
77import Control.Monad
88import Control.Monad.IO.Class
99import Data.Function (fix)
@@ -19,7 +19,7 @@ import Shelly
1919import System.Environment
2020import System.Exit (ExitCode (..))
2121import System.Info
22−import System.IO (Handle)
22+import System.IO (Handle, hClose)
2323import System.IO.Temp
2424import System.Timeout
2525import Test.Hspec
@@ -71,33 +71,55 @@ main = do
7171 uu <- update
7272 liftIO $ assertEqual "" u uu
7373
74− it "has thunk pack and unpack inverses" $ inProj $ do
75− let pack = run_ "ob" ["thunk", "pack", thunk] *> hash
76− unpack = run_ "ob" ["thunk", "unpack", thunk] *> hash
77−
78− e <- hash
79− eu <- unpack
80− eup <- pack
81− eupu <- unpack
82− _ <- pack
83−
84− liftIO $ do
85− assertEqual "" e eup
86− assertEqual "" eu eupu
87− assertBool "" (e /= eu)
88−
89− it "can pack and unpack plain git repos" $ do
90− withSystemTempDirectory "git-repo" $ \dir -> shelly @IO $ silently $ do
91− let repo = toTextIgnore $ dir </> ("repo" :: String)
92− origHash <- run_ "git" ["clone", "https://git.haskell.org/packages/primitive.git", repo] *> hashDir repo
93−
94− run_ "ob" ["thunk", "pack", repo]
95− packedFiles <- Set.fromList <$> ls (repo </> ("" :: String))
96− liftIO $ assertEqual "" packedFiles $
97− Set.fromList $ (repo </>) <$> ["default.nix", "git.json", ".attr-cache" :: String]
98−
99− unpackHash <- run_ "ob" ["thunk", "unpack", repo] *> hashDir repo
100− liftIO $ assertEqual "" origHash unpackHash
74+ describe "ob thunk pack/unpack" $ do
75+ let pack = run "ob" ["thunk", "pack", thunk] *> hash
76+ unpack = run "ob" ["thunk", "unpack", thunk] *> hash
77+
78+ it "has thunk pack and unpack inverses" $ inProj $ do
79+ e <- hash
80+ eu <- unpack
81+ eup <- pack
82+ eupu <- unpack
83+ _ <- pack
84+ liftIO $ do
85+ assertEqual "" e eup
86+ assertEqual "" eu eupu
87+ assertBool "" (e /= eu)
88+
89+ it "can pack and unpack plain git repos" $ do
90+ withSystemTempDirectory "git-repo" $ \dir -> shelly @IO $ silently $ do
91+ let repo = toTextIgnore $ dir </> ("repo" :: String)
92+ origHash <- run_ "git" ["clone", "https://git.haskell.org/packages/primitive.git", repo] *> hashDir repo
93+
94+ run_ "ob" ["thunk", "pack", repo]
95+ packedFiles <- Set.fromList <$> ls (repo </> ("" :: String))
96+ liftIO $ assertEqual "" packedFiles $
97+ Set.fromList $ (repo </>) <$> ["default.nix", "git.json", ".attr-cache" :: String]
98+
99+ unpackHash <- run_ "ob" ["thunk", "unpack", repo] *> hashDir repo
100+ liftIO $ assertEqual "" origHash unpackHash
101+
102+ 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 unpack 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
101123
102124 it "can use ob run" $ inProj $ handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
103125 runHandle "ob" ["run"] $ \stdout -> do