git.iko.soy/obelisk
on master help sign in
Merge pull request #227 from obsidiansystems/ts-overwriting-init

Require extra flag before overwriting on ob init

commit5fc7a3336e571e8aa0c8594b777abddd40887c48 authorLuigy Leon <luichi.19@gmail.com> dateMon 15 Oct 2018, 15:28 (8 years ago) parenteb931dd996a8c8
3 files changed+19−6
compare with master
unifiedsplit
lib/command/src/Obelisk/Command.hs+6−3 lib/command/src/Obelisk/Command/Project.hs+6−2 lib/selftest/src/Obelisk/SelfTest.hs+7−1
lib/command/src/Obelisk/Command.hs+6−3
@@ -86,8 +86,11 @@ initSource = foldl1 (<|>)
8686 , InitSource_Symlink <$> strOption (long "symlink" <> action "directory" <> metavar "PATH")
8787 ]
8888
89+initForce :: Parser Bool
90+initForce = switch (long "force" <> help "Allow ob init to overwrite files")
91+
8992data ObCommand
90− = ObCommand_Init InitSource
93+ = ObCommand_Init InitSource Bool
9194 | ObCommand_Deploy DeployCommand
9295 | ObCommand_Run
9396 | ObCommand_Thunk ThunkCommand
@@ -127,7 +130,7 @@ inNixShell' p = withProjectRoot "." $ \root -> do
127130obCommand :: ArgsConfig -> Parser ObCommand
128131obCommand cfg = hsubparser
129132 (mconcat
130− [ command "init" $ info (ObCommand_Init <$> initSource) $ progDesc "Initialize an Obelisk project"
133+ [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"
131134 , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
132135 , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
133136 , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
@@ -369,7 +372,7 @@ parseHandoff as' = case hasNoHandoff as' of
369372
370373ob :: MonadObelisk m => ObCommand -> m ()
371374ob = \case
372− ObCommand_Init source -> initProject source
375+ ObCommand_Init source force -> initProject source force
373376 ObCommand_Deploy dc -> case dc of
374377 DeployCommand_Init deployOpts -> withProjectRoot "." $ \root -> do
375378 let deployDir = _deployInitOpts_outputDir deployOpts
lib/command/src/Obelisk/Command/Project.hs+6−2
@@ -66,10 +66,14 @@ toImplDir :: FilePath -> FilePath
6666toImplDir p = toObeliskDir p </> "impl"
6767
6868-- | Create a new project rooted in the current directory
69−initProject :: MonadObelisk m => InitSource -> m ()
70−initProject source = withSystemTempDirectory "ob-init" $ \tmpDir -> do
69+initProject :: MonadObelisk m => InitSource -> Bool -> m ()
70+initProject source force = withSystemTempDirectory "ob-init" $ \tmpDir -> do
7171 let implDir = toImplDir tmpDir
7272 obDir = toObeliskDir tmpDir
73+ liftIO (listDirectory ".") >>= \case
74+ [] -> pure ()
75+ _ | force -> putLog Warning "Initializing in non-empty directory"
76+ | otherwise -> failWith "ob init requires an empty directory. Use the flag --force to init anyway, potentially overwriting files."
7377 skeleton <- withSpinner "Setting up obelisk" $ do
7478 liftIO $ createDirectory obDir
7579 case source of
lib/selftest/src/Obelisk/SelfTest.hs+7−1
@@ -26,7 +26,7 @@ import System.Exit (ExitCode (..))
2626import System.Info
2727import System.IO (Handle, hClose)
2828import System.IO.Temp
29−import System.Process (readProcessWithExitCode)
29+import System.Process (readProcessWithExitCode, CreateProcess(cwd), readCreateProcessWithExitCode, proc)
3030import System.Timeout
3131import Test.Hspec
3232import Test.HUnit.Base
@@ -119,6 +119,12 @@ main = do
119119 it "works with default impl" $ inTmp $ \_ -> run "ob" ["init"]
120120 it "works with master branch impl" $ inTmp $ \_ -> run "ob" ["init", "--branch", "master"]
121121 it "works with symlink" $ inTmp $ \_ -> run "ob" ["init", "--symlink", obeliskImpl]
122+ it "doesn't silently overwrite existing files" $ withSystemTempDirectory "ob-init" $ \dir -> do
123+ let p force = (proc "ob" $ "--no-handoff" : "init" : if force then ["--force"] else []) { cwd = Just dir }
124+ (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p False) ""
125+ (ExitFailure _, _, _) <- readCreateProcessWithExitCode (p False) ""
126+ (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p True) ""
127+ pure ()
122128
123129 it "doesn't create anything when given an invalid impl" $ inTmp $ \tmp -> do
124130 void $ errExit False $ run "ob" ["init", "--symlink", "/dev/null"]