git.iko.soy/obelisk
on master help sign in
Merge pull request #675 from obsidiansystems/eac@fix-selftest-again
ea70fcdElliot Cameron
default.nix+1
compare with master
unifiedsplit
@@ -82,6 +82,7 @@ let
82 pkgs.coreutils
82 pkgs.coreutils
83 pkgs.git
83 pkgs.git
84 pkgs.nix
84 pkgs.nix
85+ pkgs.rsync
85 ];
86 ];
86 };
87 };
87 obelisk-snap-extras = self.callCabal2nix "obelisk-snap-extras" (cleanSource ./lib/snap-extras) {};
88 obelisk-snap-extras = self.callCabal2nix "obelisk-snap-extras" (cleanSource ./lib/snap-extras) {};
lib/selftest/obelisk-selftest.cabal−1
@@ -17,7 +17,6 @@ library
17 , http-types
17 , http-types
18 , HUnit
18 , HUnit
19 , network
19 , network
20− , obelisk-cliapp
21 , obelisk-executable-config-lookup
20 , obelisk-executable-config-lookup
22 , obelisk-run
21 , obelisk-run
23 , which
22 , which
lib/selftest/src/Obelisk/SelfTest.hs+236−217
@@ -4,8 +4,8 @@
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE PatternGuards #-}
5{-# LANGUAGE PatternGuards #-}
6{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7−{-# LANGUAGE ViewPatterns #-}
8{-# LANGUAGE TemplateHaskell #-}
7{-# LANGUAGE TemplateHaskell #-}
8+{-# LANGUAGE ViewPatterns #-}
9module Obelisk.SelfTest where
9module Obelisk.SelfTest where
10
10
11import Control.Exception (bracket, throw)
11import Control.Exception (bracket, throw)
@@ -17,26 +17,24 @@ import Data.Semigroup ((<>))
17import qualified Data.Set as Set
17import qualified Data.Set as Set
18import Data.String
18import Data.String
19import Data.Text (Text)
19import Data.Text (Text)
20−import Data.Void
21import qualified Data.Text as T
20import qualified Data.Text as T
22import qualified Data.Text.IO as T
21import qualified Data.Text.IO as T
23import qualified Network.HTTP.Client as HTTP
22import qualified Network.HTTP.Client as HTTP
24import qualified Network.HTTP.Types as HTTP
23import qualified Network.HTTP.Types as HTTP
25import qualified Network.Socket as Socket
24import qualified Network.Socket as Socket
26−import Shelly hiding (cp)
25+import Shelly
27import System.Directory (getCurrentDirectory, withCurrentDirectory, getDirectoryContents)
26import System.Directory (getCurrentDirectory, withCurrentDirectory, getDirectoryContents)
28import System.Environment
27import System.Environment
29import System.Exit (ExitCode (..))
28import System.Exit (ExitCode (..))
30−import System.Which (staticWhich)
29+import System.FilePath (addTrailingPathSeparator)
31import qualified System.Info
30import qualified System.Info
32import System.IO (Handle, hClose, hIsEOF, hGetContents)
31import System.IO (Handle, hClose, hIsEOF, hGetContents)
33import System.IO.Temp
32import System.IO.Temp
34−import System.Process (readProcessWithExitCode, CreateProcess(cwd), readCreateProcessWithExitCode, proc)
33+import System.Process (readProcessWithExitCode)
34+import System.Which (staticWhich)
35import Test.Hspec
35import Test.Hspec
36import Test.HUnit.Base
36import Test.HUnit.Base
37
37
38−import Obelisk.CliApp hiding (runCli, readCreateProcessWithExitCode)
39−import qualified Obelisk.CliApp as CliApp
40import Obelisk.ExecutableConfig.Lookup (getConfigs)
38import Obelisk.ExecutableConfig.Lookup (getConfigs)
41import Obelisk.Run (getConfigRoute)
39import Obelisk.Run (getConfigRoute)
42
40
@@ -46,8 +44,8 @@ data ObRunState
46 | ObRunState_BackendStarted
44 | ObRunState_BackendStarted
47 deriving (Eq, Show)
45 deriving (Eq, Show)
48
46
49−cp :: FilePath
47+cpPath :: FilePath
50−cp = $(staticWhich "cp")
48+cpPath = $(staticWhich "cp")
51
49
52cabalPath :: FilePath
50cabalPath :: FilePath
53cabalPath = $(staticWhich "cabal")
51cabalPath = $(staticWhich "cabal")
@@ -73,6 +71,9 @@ lnPath = $(staticWhich "ln")
73rmPath :: FilePath
71rmPath :: FilePath
74rmPath = $(staticWhich "rm")
72rmPath = $(staticWhich "rm")
75
73
74+rsyncPath :: FilePath
75+rsyncPath = $(staticWhich "rsync")
76+
76gitUserConfig :: [Text]
77gitUserConfig :: [Text]
77gitUserConfig = ["-c", "user.name=Obelisk Selftest", "-c", "user.email=noreply@example.com"]
78gitUserConfig = ["-c", "user.name=Obelisk Selftest", "-c", "user.email=noreply@example.com"]
78
79
@@ -84,12 +85,6 @@ commit msg = void $ run gitPath $ gitUserConfig <> [ "commit"
84 , msg
85 , msg
85 ]
86 ]
86
87
87−-- TODO replace Void and stop using loosely typed synchronous exceptions
88−runCli :: MonadIO m => CliT Void IO a -> m a
89−runCli f = liftIO $ do
90− c <- newCliConfig Notice False False (\case {})
91− CliApp.runCli c f
92−
93tshow :: Show a => a -> Text
88tshow :: Show a => a -> Text
94tshow = T.pack . show
89tshow = T.pack . show
95
90
@@ -106,228 +101,252 @@ ob = "ob"
106augmentWithVerbosity :: (String -> [Text] -> a) -> String -> Bool -> [Text] -> a
101augmentWithVerbosity :: (String -> [Text] -> a) -> String -> Bool -> [Text] -> a
107augmentWithVerbosity runner executable isVerbose args = runner executable $ (if isVerbose then ("-v" :) else id) args
102augmentWithVerbosity runner executable isVerbose args = runner executable $ (if isVerbose then ("-v" :) else id) args
108
103
104+-- | Copies a git repo to a new location and "resets" the git history to include
105+-- exactly one commit with all files added. It then restricts writing and reading
106+-- for group and user to make the repo ideal for being a valid git remote for thunks.
107+--
108+-- Using this allows dirty repos to be used as git remotes during the test since 'git clone'ing
109+-- a dirty repo will not include the uncommitted changes.
110+copyForGitRemote :: Bool -> FilePath -> FilePath -> IO ()
111+copyForGitRemote isVerbose origDir copyDir = shelly $ bool silently verbosely isVerbose $ do
112+ setenv "HOME" "/dev/null"
113+ setenv "GIT_CONFIG_NOSYSTEM" "1"
114+ run_ rsyncPath
115+ [ "-r", "--no-perms", "--no-owner", "--no-group", "--exclude", ".git"
116+ , toTextIgnore (addTrailingPathSeparator origDir), toTextIgnore copyDir
117+ ]
118+ git ["init"]
119+ git ["config", "user.name", "SelfTest"]
120+ git ["config", "user.email", "self@test"]
121+ git ["add", "--all"]
122+ git ["commit", "-m", "Copy repo"]
123+ run_ chmodPath ["-R", "u-w,g-rw,o-rw", toTextIgnore copyDir] -- Freeze this state
124+ where
125+ git args = run_ gitPath $ ["-C", toTextIgnore copyDir] <> args
126+
109main :: IO ()
127main :: IO ()
110main = do
128main = do
111 -- Note: you can pass hspec arguments as well, eg: `-m <pattern>`
129 -- Note: you can pass hspec arguments as well, eg: `-m <pattern>`
112 isVerbose <- elem "-v" <$> getArgs
130 isVerbose <- elem "-v" <$> getArgs
113 unless isVerbose $
131 unless isVerbose $
114 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"
132 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"
115− let verbosity = bool silently verbosely isVerbose
133+
116− nixBuild args = run nixBuildPath ("--no-out-link" : args)
134+ obeliskImplDirtyReadOnly <- getCurrentDirectory
117− obeliskImplDirtyReadOnly <- fromString <$> getCurrentDirectory
135+ httpManager <- HTTP.newManager HTTP.defaultManagerSettings
118− let runOb_ = augmentWithVerbosity run_ ob isVerbose
136+
119− let runOb = augmentWithVerbosity run ob isVerbose
137+ withSystemTempDirectory "obelisk-repo-git-remote" $ \copyDir -> do
120− let testObRunInDir' = augmentWithVerbosity testObRunInDir ob isVerbose ["run"]
138+ copyForGitRemote isVerbose obeliskImplDirtyReadOnly copyDir
121− let testThunkPack' = augmentWithVerbosity testThunkPack ob isVerbose []
139+ main' isVerbose httpManager copyDir
140+
141+main' :: Bool -> HTTP.Manager -> FilePath -> IO ()
142+main' isVerbose httpManager obeliskRepoReadOnly = withInitCache $ \initCache -> hspec $ parallel $ do
122 let
143 let
144+ inTmpObInit' dirname f = inTmp' dirname $ \dir -> do
145+ run_ cpPath ["-rT", fromString initCache, toTextIgnore dir]
146+ f dir
147+ inTmpObInit = inTmpObInit' defaultTmpDirName
148+
149+ -- To be used in tests that change the obelisk impl directory
150+ inTmpObInitWithImplCopy f = inTmpObInit $ \dir ->
123− withObeliskImplClean f =
151+ withObeliskImplClean $ \(fromString -> implClean) -> do
152+ run_ rmPath [thunk]
153+ run_ lnPath ["-s", implClean, thunk]
154+ f dir
155+
156+ describe "ob init" $ parallel $ do
157+ it "works with default impl" $ inTmp $ \_ -> runOb ["init"]
158+ it "works with master branch impl" $ inTmp $ \_ -> runOb ["init", "--branch", "master"]
159+ it "works with symlink" $ inTmp $ \_ -> runOb ["init", "--symlink", toTextIgnore obeliskRepoReadOnly]
160+ it "doesn't silently overwrite existing files" $ inTmp $ \_ -> do
161+ let p force = errExit False $ do
162+ run_ ob $ "--no-handoff" : "-v" : "init" : ["--force"|force]
163+ (== 0) <$> lastExitCode
164+
165+ True <- p False
166+ False <- p False
167+ True <- p True
168+ pure ()
169+
170+ it "doesn't create anything when given an invalid impl" $ inTmp $ \tmp -> do
171+ void $ errExit False $ runOb ["init", "--symlink", "/dev/null"]
172+ ls tmp >>= liftIO . assertEqual "" []
173+
174+ it "produces a valid route config" $ inTmpObInit $ \tmp -> liftIO $
175+ withCurrentDirectory (T.unpack $ toTextIgnore tmp) $ do
176+ configs <- getConfigs
177+ return (either (const Nothing) Just $ getConfigRoute configs) `shouldNotReturn` Nothing
178+
179+ -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"
180+ -- when not run by 'nix-build --attr selftest'
181+ describe "ob run" $ {- NOT parallel $ -} do
182+ it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager
183+ it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager
184+
185+ describe "obelisk project" $ parallel $ do
186+ it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskRepoReadOnly]
187+ it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskRepoReadOnly]
188+ it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskRepoReadOnly]
189+ it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskRepoReadOnly]
190+
191+ describe "blank initialized project" $ parallel $ do
192+
193+ it "can build ghc.backend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghc.backend"]
194+ it "can build ghcjs.frontend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghcjs.frontend"]
195+
196+ if System.Info.os == "darwin"
197+ then it "can build ios" $ inTmpObInit $ \_ -> nixBuild ["-A", "ios.frontend"]
198+ else it "can build android after accepting license" $ inTmpObInit $ \dir -> do
199+ let defaultNixPath = dir </> ("default.nix" :: FilePath)
200+ writefile defaultNixPath
201+ =<< T.replace
202+ "# config.android_sdk.accept_license = false;"
203+ "config.android_sdk.accept_license = true;"
204+ <$> readfile defaultNixPath
205+ nixBuild ["-A", "android.frontend"]
206+
207+ forM_ ["ghc", "ghcjs"] $ \compiler -> do
208+ let
209+ shellName = "shells." <> compiler
210+ inShell cmd' = run_ "nix-shell" ["default.nix", "-A", fromString shellName, "--run", cmd']
211+ it ("can enter " <> shellName) $ inTmpObInit $ \_ -> inShell "exit"
212+ -- NOTE: We override the temporary directory name because cabal has a bug preventing new-build from working
213+ -- in a path that has unicode characters.
214+ it ("can build in " <> shellName) $ inTmpObInit' "test" $ \_ -> inShell $
215+ T.pack cabalPath <> " --version; " <> T.pack cabalPath <> " new-build --" <> T.pack compiler <> " all"
216+
217+ it "has idempotent thunk update" $ inTmpObInitWithImplCopy $ \_ -> do
218+ _ <- pack
219+ u <- update
220+ uu <- update
221+ assertRevEQ u uu
222+
223+ describe "ob thunk pack/unpack" $ parallel $ do
224+ it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do
225+
226+ _ <- pack
227+ e <- commitAll
228+ eu <- unpack
229+ eup <- pack
230+ eupu <- unpack
231+ _ <- pack
232+
233+ assertRevEQ e eup
234+ assertRevEQ eu eupu
235+ assertRevNE e eu
236+
237+ it "unpacks the correct branch" $ withTmp $ \dir -> do
238+ let branch = "master"
239+ run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch]
240+ runOb_ ["thunk", "pack", toTextIgnore dir]
241+ runOb_ ["thunk", "unpack", toTextIgnore dir]
242+ branch' <- chdir dir $ run gitPath ["rev-parse", "--abbrev-ref", "HEAD"]
243+ liftIO $ assertEqual "" branch (T.strip branch')
244+
245+ it "can pack and unpack plain git repos" $
124− withSystemTempDirectory "obelisk-impl-clean" $ \(fromString -> obeliskImpl) -> do
246+ shelly_ $ withSystemTempDirectory "git-repo" $ \dir -> do
125− void . shellyOb verbosity $ chdir obeliskImpl $ do
247+ let repo = toTextIgnore $ dir </> ("repo" :: FilePath)
126− run_ gitPath ["clone", "file://" <> toTextIgnore obeliskImplDirtyReadOnly, toTextIgnore obeliskImpl]
248+ run_ gitPath ["clone", "https://github.com/haskell/process.git", repo]
127− f obeliskImpl
249+ origHash <- chdir (fromText repo) revParseHead
250+
251+ runOb_ ["thunk", "pack", repo]
252+ packedFiles <- Set.fromList <$> ls (fromText repo)
253+ liftIO $ assertEqual "" packedFiles $ Set.fromList $ (repo </>) <$>
254+ ["default.nix", "github.json", ".attr-cache" :: FilePath]
255+
256+ runOb_ ["thunk", "unpack", repo]
257+ chdir (fromText repo) $ do
258+ unpackHash <- revParseHead
259+ assertRevEQ origHash unpackHash
260+
261+ testThunkPack' $ fromText repo
262+
263+ it "aborts thunk pack when there are uncommitted files" $ inTmpObInitWithImplCopy $ \dir -> do
264+ testThunkPack' (dir </> thunk)
265+
266+ describe "ob thunk update --branch" $ parallel $ do
267+ it "can change a thunk to the latest version of a desired branch" $ withTmp $ \dir -> do
268+ let branch1 = "master"
269+ branch2 = "develop"
270+ run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch1]
271+ runOb_ ["thunk" , "pack", toTextIgnore dir]
272+ runOb_ ["thunk", "update", toTextIgnore dir, "--branch", branch2]
273+
274+ it "doesn't create anything when given an invalid branch" $ withTmp $ \dir -> do
275+ let checkDir dir' = liftIO $ getDirectoryContents $ T.unpack $ toTextIgnore dir'
276+ run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", "master"]
277+ runOb_ ["thunk" , "pack", toTextIgnore dir]
278+ startingContents <- checkDir dir
279+ void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]
280+ checkDir dir >>= liftIO . assertEqual "" startingContents
281+
282+ describe "ob hoogle" $ {- NOT parallel -} do
283+ it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do
284+ [p0] <- liftIO $ getFreePorts 1
285+ maskExitSuccess $ runHandle "ob" ["hoogle", "--port", T.pack (show p0)] $ \stdout -> fix $ \loop -> do
286+ ln <- liftIO $ T.hGetLine stdout
287+ echo ln
288+ let search = "Server starting on port " <> T.pack (show p0)
289+ case search `T.isInfixOf` ln of
290+ False -> loop -- keep waiting
291+ True -> do
292+ let req uri = liftIO $ HTTP.parseRequest uri >>= flip HTTP.httpLbs httpManager
293+ req ("http://127.0.0.1:" <> show p0) >>= \r -> case HTTP.responseStatus r == HTTP.ok200 of
294+ False -> errorExit $ "Request to hoogle server failed: " <> T.pack (show r)
295+ True -> exit 0
296+ where
297+ verbosity = bool silently verbosely isVerbose
298+ nixBuild args = run nixBuildPath ("--no-out-link" : args)
299+
300+ runOb_ = augmentWithVerbosity run_ ob isVerbose
301+ runOb = augmentWithVerbosity run ob isVerbose
302+ testObRunInDir' = augmentWithVerbosity testObRunInDir ob isVerbose ["run"]
303+ testThunkPack' = augmentWithVerbosity testThunkPack ob isVerbose []
128
304
129− withObeliskImplDirty f =
305+ withObeliskImplClean f =
130− withSystemTempDirectory "obelisk-impl-copy" $ \(fromString -> obeliskImpl) -> do
306+ withSystemTempDirectory "obelisk-impl-clean" $ \obeliskImpl -> do
131 void . shellyOb verbosity $ chdir obeliskImpl $ do
307 void . shellyOb verbosity $ chdir obeliskImpl $ do
132− user <- T.strip <$> run whoamiPath []
308+ dirtyFiles <- T.strip <$> run gitPath ["-C", toTextIgnore obeliskRepoReadOnly, "diff", "--stat"]
133− run_ cp ["-rT", "--no-preserve=mode", toTextIgnore obeliskImplDirtyReadOnly, toTextIgnore obeliskImpl]
309+ () <- when (dirtyFiles /= "") $ error "SelfTest does not work correctly with dirty obelisk repos as remote"
134− run_ chownPath ["-R", user, toTextIgnore obeliskImpl]
135− run_ chmodPath ["-R", "g-rw,o-rw", toTextIgnore obeliskImpl]
310+ run_ gitPath ["clone", "file://" <> toTextIgnore obeliskRepoReadOnly, toTextIgnore obeliskImpl]
136 f obeliskImpl
311 f obeliskImpl
137
312
138− withInitCache f obeliskImpl =
313+ withInitCache f =
139 withSystemTempDirectory "init Cache λ" $ \initCache -> do
314 withSystemTempDirectory "init Cache λ" $ \initCache -> do
140 -- Setup the ob init cache
315 -- Setup the ob init cache
141 void . shellyOb verbosity $ chdir initCache $ do
316 void . shellyOb verbosity $ chdir initCache $ do
142− runOb_ ["init", "--symlink", toTextIgnore obeliskImpl]
317+ runOb_ ["init", "--symlink", toTextIgnore obeliskRepoReadOnly]
143 run_ gitPath ["init"]
318 run_ gitPath ["init"]
144
319
145 f initCache
320 f initCache
146
321
147− withObeliskImplDirtyAndInitCache f =
322+ shelly_ = void . shellyOb verbosity
148− withObeliskImplDirty $ \impl -> withInitCache (f impl) impl
149
323
150− httpManager <- HTTP.newManager HTTP.defaultManagerSettings
324+ defaultTmpDirName = "test λ"
325+
326+ inTmp' :: FilePath -> (FilePath -> Sh a) -> IO ()
327+ inTmp' dirname f = withTmp' dirname (chdir <*> f)
328+ inTmp = inTmp' defaultTmpDirName
329+
330+ withTmp' dirname f = shelly_ . withSystemTempDirectory dirname $ f . fromString
331+ withTmp = withTmp' defaultTmpDirName
332+
333+ assertRevEQ a b = liftIO . assertEqual "" "" =<< diff a b
334+ assertRevNE a b = liftIO . assertBool "" . (/= "") =<< diff a b
335+
336+ revParseHead = T.strip <$> run gitPath ["rev-parse", "HEAD"]
337+
338+ commitAll = do
339+ run_ gitPath ["add", "."]
340+ commit "checkpoint"
341+ revParseHead
342+
343+ thunk = ".obelisk/impl"
344+ update = runOb ["thunk", "update", thunk] *> commitAll
345+ pack = runOb ["thunk", "pack", thunk] *> commitAll
346+ unpack = runOb ["thunk", "unpack", thunk] *> commitAll
347+
348+ diff a b = run gitPath ["diff", a, b]
151
349
152− withObeliskImplDirtyAndInitCache $ \obeliskImplDirty initCache ->
153− hspec $ parallel $ do
154− let shelly_ = void . shellyOb verbosity
155−
156− defaultTmpDirName = "test λ"
157−
158− inTmp' :: FilePath -> (FilePath -> Sh a) -> IO ()
159− inTmp' dirname f = withTmp' dirname (chdir <*> f)
160− inTmp = inTmp' defaultTmpDirName
161−
162− withTmp' dirname f = shelly_ . withSystemTempDirectory dirname $ f . fromString
163− withTmp = withTmp' defaultTmpDirName
164−
165− inTmpObInit' dirname f = inTmp' dirname $ \dir -> do
166− run_ cp ["-rT", fromString initCache, toTextIgnore dir]
167− f dir
168− inTmpObInit = inTmpObInit' defaultTmpDirName
169−
170− -- To be used in tests that change the obelisk impl directory
171− inTmpObInitWithImplCopy f = inTmpObInit $ \dir ->
172− withObeliskImplClean $ \(fromString -> implClean) -> do
173− run_ rmPath [thunk]
174− run_ lnPath ["-s", implClean, thunk]
175− f dir
176−
177− assertRevEQ a b = liftIO . assertEqual "" "" =<< diff a b
178− assertRevNE a b = liftIO . assertBool "" . (/= "") =<< diff a b
179−
180− revParseHead = T.strip <$> run gitPath ["rev-parse", "HEAD"]
181−
182− commitAll = do
183− run_ gitPath ["add", "."]
184− commit "checkpoint"
185− revParseHead
186−
187− thunk = ".obelisk/impl"
188− update = runOb ["thunk", "update", thunk] >> commitAll
189− pack = runOb ["thunk", "pack", thunk] >> commitAll
190− unpack = runOb ["thunk", "unpack", thunk] >> commitAll
191−
192− diff a b = run gitPath ["diff", a, b]
193−
194− describe "ob init" $ parallel $ do
195− it "works with default impl" $ inTmp $ \_ -> runOb ["init"]
196− it "works with master branch impl" $ inTmp $ \_ -> runOb ["init", "--branch", "master"]
197− it "works with symlink" $ inTmp $ \_ -> runOb ["init", "--symlink", toTextIgnore obeliskImplDirty]
198− it "doesn't silently overwrite existing files" $ withSystemTempDirectory "ob-init λ" $ \dir -> do
199− let p force = (System.Process.proc ob $ "--no-handoff" : "-v" : "init" : ["--force"|force]) { cwd = Just dir }
200− (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p False) ""
201− (ExitFailure _, _, _) <- readCreateProcessWithExitCode (p False) ""
202− (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p True) ""
203− pure ()
204−
205− it "doesn't create anything when given an invalid impl" $ inTmp $ \tmp -> do
206− void $ errExit False $ runOb ["init", "--symlink", "/dev/null"]
207− ls tmp >>= liftIO . assertEqual "" []
208−
209− it "produces a valid route config" $ inTmpObInit $ \tmp -> liftIO $
210− withCurrentDirectory (T.unpack $ toTextIgnore tmp) $ do
211− configs <- getConfigs
212− return (either (const Nothing) Just $ getConfigRoute configs) `shouldNotReturn` Nothing
213−
214− -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"
215− -- when not run by 'nix-build --attr selftest'
216− describe "ob run" $ {- NOT parallel $ -} do
217− it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir' Nothing httpManager
218− it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir' (Just "frontend") httpManager
219−
220− describe "obelisk project" $ parallel $ do
221− it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskImplDirty]
222− it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskImplDirty]
223− it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskImplDirty]
224− it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskImplDirty]
225−
226− describe "blank initialized project" $ parallel $ do
227−
228− it "can build ghc.backend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghc.backend"]
229− it "can build ghcjs.frontend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghcjs.frontend"]
230−
231− if System.Info.os == "darwin"
232− then it "can build ios" $ inTmpObInit $ \_ -> nixBuild ["-A", "ios.frontend"]
233− else it "can build android after accepting license" $ inTmpObInit $ \dir -> do
234− let defaultNixPath = dir </> ("default.nix" :: FilePath)
235− writefile defaultNixPath
236− =<< T.replace
237− "# config.android_sdk.accept_license = false;"
238− "config.android_sdk.accept_license = true;"
239− <$> readfile defaultNixPath
240− nixBuild ["-A", "android.frontend"]
241−
242− forM_ ["ghc", "ghcjs"] $ \compiler -> do
243− let
244− shellName = "shells." <> compiler
245− inShell cmd' = run_ "nix-shell" ["default.nix", "-A", fromString shellName, "--run", cmd']
246− it ("can enter " <> shellName) $ inTmpObInit $ \_ -> inShell "exit"
247− -- NOTE: We override the temporary directory name because cabal has a bug preventing new-build from working
248− -- in a path that has unicode characters.
249− it ("can build in " <> shellName) $ inTmpObInit' "test" $ \_ -> inShell $
250− T.pack cabalPath <> " --version; " <> T.pack cabalPath <> " new-build --" <> T.pack compiler <> " all"
251−
252− it "has idempotent thunk update" $ inTmpObInitWithImplCopy $ \_ -> do
253− _ <- pack
254− u <- update
255− uu <- update
256− assertRevEQ u uu
257−
258− describe "ob thunk pack/unpack" $ parallel $ do
259− it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do
260−
261− _ <- pack
262− e <- commitAll
263− eu <- unpack
264− eup <- pack
265− eupu <- unpack
266− _ <- pack
267−
268− assertRevEQ e eup
269− assertRevEQ eu eupu
270− assertRevNE e eu
271−
272− it "unpacks the correct branch" $ withTmp $ \dir -> do
273− let branch = "master"
274− run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch]
275− runOb_ ["thunk", "pack", toTextIgnore dir]
276− runOb_ ["thunk", "unpack", toTextIgnore dir]
277− branch' <- chdir dir $ run gitPath ["rev-parse", "--abbrev-ref", "HEAD"]
278− liftIO $ assertEqual "" branch (T.strip branch')
279−
280− it "can pack and unpack plain git repos" $
281− shelly_ $ withSystemTempDirectory "git-repo" $ \dir -> do
282− let repo = toTextIgnore $ dir </> ("repo" :: String)
283− run_ gitPath ["clone", "https://github.com/haskell/process.git", repo]
284− origHash <- chdir (fromText repo) revParseHead
285−
286− runOb_ ["thunk", "pack", repo]
287− packedFiles <- Set.fromList <$> ls (fromText repo)
288− liftIO $ assertEqual "" packedFiles $ Set.fromList $ (repo </>) <$>
289− ["default.nix", "github.json", ".attr-cache" :: String]
290−
291− runOb_ ["thunk", "unpack", repo]
292− chdir (fromText repo) $ do
293− unpackHash <- revParseHead
294− assertRevEQ origHash unpackHash
295−
296− testThunkPack' $ fromText repo
297−
298− it "aborts thunk pack when there are uncommitted files" $ inTmpObInitWithImplCopy $ \dir -> do
299− testThunkPack' (dir </> thunk)
300−
301− describe "ob thunk update --branch" $ parallel $ do
302− it "can change a thunk to the latest version of a desired branch" $ withTmp $ \dir -> do
303− let branch1 = "master"
304− branch2 = "develop"
305− run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", branch1]
306− runOb_ ["thunk" , "pack", toTextIgnore dir]
307− runOb_ ["thunk", "update", toTextIgnore dir, "--branch", branch2]
308−
309− it "doesn't create anything when given an invalid branch" $ withTmp $ \dir -> do
310− let checkDir dir' = liftIO $ getDirectoryContents $ T.unpack $ toTextIgnore dir'
311− run_ gitPath ["clone", "https://github.com/reflex-frp/reflex.git", toTextIgnore dir, "--branch", "master"]
312− runOb_ ["thunk" , "pack", toTextIgnore dir]
313− startingContents <- checkDir dir
314− void $ errExit False $ runOb ["thunk", "update", toTextIgnore dir, "--branch", "dumble-palooza"]
315− checkDir dir >>= liftIO . assertEqual "" startingContents
316−
317− describe "ob hoogle" $ {- NOT parallel -} do
318− it "starts a hoogle server on the given port" $ inTmpObInit $ \_ -> do
319− [p0] <- liftIO $ getFreePorts 1
320− maskExitSuccess $ runHandle "ob" ["hoogle", "--port", T.pack (show p0)] $ \stdout -> fix $ \loop -> do
321− ln <- liftIO $ T.hGetLine stdout
322− echo ln
323− let search = "Server starting on port " <> T.pack (show p0)
324− case search `T.isInfixOf` ln of
325− False -> loop -- keep waiting
326− True -> do
327− let req uri = liftIO $ HTTP.parseRequest uri >>= flip HTTP.httpLbs httpManager
328− req ("http://127.0.0.1:" <> show p0) >>= \r -> case HTTP.responseStatus r == HTTP.ok200 of
329− False -> errorExit $ "Request to hoogle server failed: " <> T.pack (show r)
330− True -> exit 0
331
350
332maskExitSuccess :: Sh () -> Sh ()
351maskExitSuccess :: Sh () -> Sh ()
333maskExitSuccess = handle_sh (\case ExitSuccess -> pure (); e -> throw e)
352maskExitSuccess = handle_sh (\case ExitSuccess -> pure (); e -> throw e)