@@ -64,22 +64,8 @@ tshow :: Show a => a -> Text
6464tshow = T.pack . show
6565
6666-- | Like `shelly` but used when running `ob` commands
67−--
68−-- This tests the NIX_REMOTE workaround, whether that gets printed
69−-- on failure, and whether retrying with the suggested workaround
70−-- leads to the test succeeding.
7167shellyOb :: MonadIO m => (Sh a -> Sh a) -> Sh a -> m a
72−shellyOb f obTest = shelly $ f $ do
73− obTest `catch_sh` \(e :: RunFailed) -> do
74− obStderr <- lastStderr
75− if T.isInfixOf "export NIX_REMOTE" obStderr
76− then do
77− runCli $ do
78− putLog Notice "Detected NIX_REMOTE suggestion in stderr of failed ob"
79− putLog Warning "Retrying this test with NIX_REMOTE=daemon"
80− setenv "NIX_REMOTE" "daemon"
81− f obTest
82− else throw e
68+shellyOb f obTest = shelly $ f obTest
8369
8470main :: IO ()
8571main = do
@@ -90,15 +76,21 @@ main = do
9076 let verbosity = bool silently verbosely isVerbose
9177 obeliskImpl <- fromString <$> getEnv "OBELISK_IMPL"
9278 httpManager <- HTTP.newManager HTTP.defaultManagerSettings
93− withSystemTempDirectory "blank-project" $ \blankProject ->
94− hspec $ do
79+ [p0, p1, p2, p3] <- liftIO $ getFreePorts 4
80+ withSystemTempDirectory "initCache" $ \initCache -> do
81+ -- Setup the ob init cache
82+ void . shellyOb verbosity $ chdir (fromString initCache) $ do
83+ run_ "ob" ["init"]
84+ run_ "git" ["init"]
85+ hspec $ parallel $ do
9586 let shelly_ = void . shellyOb verbosity
9687
97− inProj :: Sh a -> IO ()
98− inProj = shelly_ . chdir (fromString blankProject)
99−
10088 inTmp :: (Shelly.FilePath -> Sh a) -> IO ()
101− inTmp f = shelly_ . withSystemTempDirectory "ob-init" $ (chdir <*> f) . fromString
89+ inTmp f = shelly_ . withSystemTempDirectory "test" $ (chdir <*> f) . fromString
90+
91+ inTmpObInit f = inTmp $ \dir -> do
92+ run_ "cp" ["-a", fromString $ initCache <> "/.", toTextIgnore dir]
93+ f dir
10294
10395 assertRevEQ a b = liftIO . assertEqual "" "" =<< diff a b
10496 assertRevNE a b = liftIO . assertBool "" . (/= "") =<< diff a b
@@ -117,7 +109,7 @@ main = do
117109
118110 diff a b = run "git" ["diff", a, b]
119111
120− describe "ob init" $ do
112+ describe "ob init" $ parallel $ do
121113 it "works with default impl" $ inTmp $ \_ -> run "ob" ["init"]
122114 it "works with master branch impl" $ inTmp $ \_ -> run "ob" ["init", "--branch", "master"]
123115 it "works with symlink" $ inTmp $ \_ -> run "ob" ["init", "--symlink", obeliskImpl]
@@ -132,17 +124,16 @@ main = do
132124 void $ errExit False $ run "ob" ["init", "--symlink", "/dev/null"]
133125 ls tmp >>= liftIO . assertEqual "" []
134126
135− it "produces a valid route config" $ inTmp $ \tmp -> do
136− run_ "ob" ["init"]
127+ it "produces a valid route config" $ inTmpObInit $ \tmp -> do
137128 liftIO $ withCurrentDirectory (T.unpack $ toTextIgnore tmp) $ getConfigRoute `shouldNotReturn` Nothing
138129
139− describe "ob run" $ do
140− it "works in root directory" $ inTmp $ \_ -> do
141− run_ "ob" ["init"]
142− testObRunInDir Nothing httpManager
143− it "works in sub directory" $ inTmp $ \_ -> do
144− run_ "ob" ["init"]
145− testObRunInDir (Just "frontend") httpManager
130+ -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"
131+ -- when not run by 'nix-build --attr selftest'
132+ describe "ob run" $ parallel $ do
133+ it "works in root directory" $ inTmpObInit $ \_ -> do
134+ testObRunInDir p0 p1 Nothing httpManager
135+ it "works in sub directory" $ inTmpObInit $ \_ -> do
136+ testObRunInDir p2 p3 (Just "frontend") httpManager
146137
147138 describe "obelisk project" $ parallel $ do
148139 it "can build obelisk command" $ shelly_ $ run "nix-build" ["-A", "command" , obeliskImpl]
@@ -151,38 +142,35 @@ main = do
151142 -- See https://github.com/obsidiansystems/obelisk/issues/101
152143 -- it "can build everything" $ shelly_ $ run "nix-build" [obeliskImpl]
153144
154− describe "blank initialized project" $ do
155− it "can be created" $ inProj $ do
156− run_ "ob" ["init"]
157− run_ "git" ["init"]
158− commitAll
145+ describe "blank initialized project" $ parallel $ do
159146
160− it "can build ghc.backend" $ inProj $ do
147+ it "can build ghc.backend" $ inTmpObInit $ \_ -> do
161148 run "nix-build" ["--no-out-link", "-A", "ghc.backend"]
162− it "can build ghcjs.frontend" $ inProj $ do
149+ it "can build ghcjs.frontend" $ inTmpObInit $ \_ -> do
163150 run "nix-build" ["--no-out-link", "-A", "ghcjs.frontend"]
164151
165152 if os == "darwin"
166− then it "can build ios" $ inProj $ run "nix-build" ["--no-out-link", "-A", "ios.frontend" ]
167− else it "can build android" $ inProj $ run "nix-build" ["--no-out-link", "-A", "android.frontend"]
153+ then it "can build ios" $ inTmpObInit $ \_ -> run "nix-build" ["--no-out-link", "-A", "ios.frontend" ]
154+ else it "can build android" $ inTmpObInit $ \_ -> run "nix-build" ["--no-out-link", "-A", "android.frontend"]
168155
169156 forM_ ["ghc", "ghcjs"] $ \compiler -> do
170157 let
171158 shell = "shells." <> compiler
172159 inShell cmd' = run "nix-shell" ["-A", fromString shell, "--run", cmd']
173− it ("can enter " <> shell) $ inProj $ inShell "exit"
174− it ("can build in " <> shell) $ inProj $ inShell $ "cabal new-build --" <> fromString compiler <> " all"
160+ it ("can enter " <> shell) $ inTmpObInit $ \_ -> inShell "exit"
161+ it ("can build in " <> shell) $ inTmpObInit $ \_ -> inShell $ "cabal new-build --" <> fromString compiler <> " all"
175162
176− it "can build reflex project" $ inProj $ do
163+ it "can build reflex project" $ inTmpObInit $ \_ -> do
177164 run "nix-build" []
178165
179− it "has idempotent thunk update" $ inProj $ do
166+ it "has idempotent thunk update" $ inTmpObInit $ \_ -> do
180167 u <- update
181168 uu <- update
182169 assertRevEQ u uu
183170
184− describe "ob thunk pack/unpack" $ do
185− it "has thunk pack and unpack inverses" $ inProj $ do
171+ describe "ob thunk pack/unpack" $ parallel $ do
172+ it "has thunk pack and unpack inverses" $ inTmpObInit $ \_ -> do
173+
186174 e <- commitAll
187175 eu <- unpack
188176 eup <- pack
@@ -193,6 +181,14 @@ main = do
193181 assertRevEQ eu eupu
194182 assertRevNE e eu
195183
184+ it "unpacks the correct branch" $ inTmp $ \dir -> do
185+ let branch = "master"
186+ run_ "git" ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch]
187+ run_ "ob" ["thunk", "pack", toTextIgnore dir]
188+ run_ "ob" ["thunk", "unpack", toTextIgnore dir]
189+ branch' <- run "git" ["rev-parse", "--abbrev-ref", "HEAD"]
190+ liftIO $ assertEqual "" branch (T.strip branch')
191+
196192 it "can pack and unpack plain git repos" $ do
197193 shelly_ $ withSystemTempDirectory "git-repo" $ \dir -> do
198194 let repo = toTextIgnore $ dir </> ("repo" :: String)
@@ -211,19 +207,18 @@ main = do
211207
212208 testThunkPack $ fromText repo
213209
214− it "aborts thunk pack when there are uncommitted files" $ inProj $ do
210+ it "aborts thunk pack when there are uncommitted files" $ inTmpObInit $ \dir -> do
215211 void $ unpack
216− testThunkPack (blankProject </> thunk)
212+ testThunkPack (dir </> thunk)
217213
218214-- | Run `ob run` in the given directory (maximum of one level deep)
219−testObRunInDir :: Maybe Shelly.FilePath -> HTTP.Manager -> Sh ()
220−testObRunInDir mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
215+testObRunInDir :: Socket.PortNumber -> Socket.PortNumber -> Maybe Shelly.FilePath -> HTTP.Manager -> Sh ()
216+testObRunInDir p0 p1 mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do
221217 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison
222− writefile "config/common/route" . uri =<< liftIO getFreePort -- Use a free port initially
218+ writefile "config/common/route" $ uri p0
223219 maybe id chdir mdir $ runHandle "ob" ["run"] $ \stdout -> do
224− freePort <- liftIO getFreePort
225220 firstUri <- handleObRunStdout httpManager stdout
226− let newUri = uri freePort
221+ let newUri = uri p1
227222 when (firstUri == newUri) $ errorExit $
228223 "Startup URI (" <> firstUri <> ") is the same as test URI (" <> newUri <> ")"
229224 maybe id (\_ -> chdir "..") mdir $ alterRouteTo newUri stdout
@@ -248,7 +243,7 @@ testThunkPack path' = withTempFile (T.unpack $ toTextIgnore path') "test-file" $
248243 ensureThunkPackFails "unsaved"
249244 chdir path' $ commit "test commit"
250245 -- Non-pushed commits in any branch
251− ensureThunkPackFails "not been pushed"
246+ ensureThunkPackFails "not yet pushed"
252247 -- Uncommitted files (unstaged)
253248 liftIO $ T.hPutStrLn handle "test file" >> hClose handle
254249 ensureThunkPackFails "modified"
@@ -275,12 +270,12 @@ alterRouteTo uri stdout = do
275270
276271-- | Handle stdout of `ob run`: check that the frontend and backend servers are started correctly
277272handleObRunStdout :: HTTP.Manager -> Handle -> Sh Text
278−handleObRunStdout httpManager stdout = flip fix ObRunState_Init $ \loop state -> do
273+handleObRunStdout httpManager stdout = flip fix (ObRunState_Init, []) $ \loop (state, msgs) -> do
279274 liftIO (T.hGetLine stdout) >>= \t -> case state of
280275 ObRunState_Init
281− | "Running test..." `T.isPrefixOf` t -> loop ObRunState_BackendStarted
276+ | "Running test..." `T.isPrefixOf` t -> loop (ObRunState_BackendStarted, msgs)
282277 ObRunState_Startup
283− | t == "backend stopped; make a change to your code to reload" -> loop ObRunState_Startup
278+ | t == "backend stopped; make a change to your code to reload" -> loop (ObRunState_Startup, msgs)
284279 -- | Just port <- "Backend running on port " `T.stripPrefix` t -> loop $ ObRunState_BackendStarted port
285280 | not (T.null t) -> errorExit $ "Startup: " <> t -- If theres any other output here, startup failed
286281 ObRunState_BackendStarted
@@ -288,7 +283,8 @@ handleObRunStdout httpManager stdout = flip fix ObRunState_Init $ \loop state ->
288283 obRunCheck httpManager stdout uri
289284 pure uri
290285 | not (T.null t) -> errorExit $ "Started: " <> t -- If theres any other output here, startup failed
291− _ -> loop state
286+ _ | "Failed" `T.isPrefixOf` t -> errorExit $ "ob run failed: " <> T.unlines (reverse $ t : msgs)
287+ | otherwise -> loop (state, t : msgs)
292288
293289-- | Make requests to frontend/backend servers to check they are working properly
294290obRunCheck :: HTTP.Manager -> Handle -> Text -> Sh ()
@@ -297,10 +293,11 @@ obRunCheck httpManager _stdout frontendUri = do
297293 req frontendUri >>= \r -> when (HTTP.responseStatus r /= HTTP.ok200) $ errorExit $
298294 "Request to frontend server failed: " <> T.pack (show r)
299295
300−getFreePort :: IO Socket.PortNumber
301−getFreePort = Socket.withSocketsDo $ do
296+getFreePorts :: Int -> IO [Socket.PortNumber]
297+getFreePorts 0 = pure []
298+getFreePorts n = Socket.withSocketsDo $ do
302299 addr:_ <- Socket.getAddrInfo (Just Socket.defaultHints) (Just "127.0.0.1") (Just "0")
303− bracket (open addr) Socket.close Socket.socketPort
300+ bracket (open addr) Socket.close $ \s -> (:) <$> Socket.socketPort s <*> getFreePorts (n - 1)
304301 where
305302 open addr = do
306303 sock <- Socket.socket (Socket.addrFamily addr) (Socket.addrSocketType addr) (Socket.addrProtocol addr)