bda2bab · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Use the new logging process in thunk commands

bda2babSridhar Ratnakumar8 years ago

lib/command/src/Obelisk/CLI/Process.hs+3−2

compare with master

unifiedsplit

@@ -28,7 +28,8 @@ import System.IO (Handle)

28import System.IO.Streams (InputStream, handleToInputStream)

29import qualified System.IO.Streams as Streams

30import System.IO.Streams.Concurrent (concurrentMerge)

31−import System.Process

31+import System.Process (CreateProcess, StdStream (CreatePipe), cmdspec, createProcess, std_err, std_out,

32+ waitForProcess)

33import Obelisk.CLI.Logging (Output, Severity (..), failWith, putLogRaw)

34import Obelisk.CLI.Logging (Output, Severity (..), failWith, putLogRaw)

@@ -67,7 +68,7 @@ withProcess process action = do

67 ExitSuccess -> return ()

68 ExitSuccess -> return ()

68 ExitFailure code -> do

69 ExitFailure code -> do

69 -- Log an error. We also fail immediately; however we should probably let the caller control that.

70 -- Log an error. We also fail immediately; however we should probably let the caller control that.

70− failWith $ T.pack $ "Process " <> show process <> " failed with exit code: " <> show code

71+ failWith $ T.pack $ show (cmdspec process) <> " failed with exit code: " <> show code

71 return (out, err) -- Return the handles

72 return (out, err) -- Return the handles

73-- | Read from an input stream and log its contents

74-- | Read from an input stream and log its contents

lib/command/src/Obelisk/Command.hs+1−1

@@ -241,7 +241,7 @@ ob = \case

241 let deployDir = _deployInitOpts_ouputDir deployOpts

242 sshKeyPath = _deployInitOpts_sshKey deployOpts

243 hostname = _deployInitOpts_hostname deployOpts

244− liftIO $ deployInit thunkPtr (root </> "config") deployDir sshKeyPath hostname

244+ deployInit thunkPtr (root </> "config") deployDir sshKeyPath hostname

245 DeployCommand_Push -> deployPush "."

246 DeployCommand_Update -> deployUpdate "."

247 ObCommand_Run -> inNixShell' $ static run

lib/command/src/Obelisk/Command/Deploy.hs+20−17

@@ -18,29 +18,32 @@ import System.Posix.Files

18import System.Process

20import Obelisk.App (MonadObelisk)

21−import Obelisk.CLI (failWith)

21+import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith)

22import Obelisk.Command.Nix

23import Obelisk.Command.Thunk

24import Obelisk.Command.Utils

26−deployInit :: ThunkPtr -> FilePath -> FilePath -> FilePath -> [String] -> IO ()

26+deployInit :: MonadObelisk m => ThunkPtr -> FilePath -> FilePath -> FilePath -> [String] -> m ()

27deployInit thunkPtr configDir deployDir sshKeyPath hostnames = do

28+ hasConfigDir <- liftIO $ do

28− createDirectoryIfMissing True deployDir

29+ createDirectoryIfMissing True deployDir

29− hasConfigDir <- doesDirectoryExist configDir

30+ doesDirectoryExist configDir

30 when hasConfigDir $ do

31 when hasConfigDir $ do

32+ callProcessAndLogOutput Notice $

31− cp

33+ cp

32− [ "-r"

34+ [ "-r"

33− , "-T"

35+ , "-T"

34− , configDir

36+ , configDir

35− , deployDir </> "config"

37+ , deployDir </> "config"

36− ]

38+ ]

39+ liftIO $ do

37− keyExists <- doesFileExist sshKeyPath

40+ keyExists <- doesFileExist sshKeyPath

38− when keyExists $ do

41+ when keyExists $ do

39− target <- makeAbsolute sshKeyPath

42+ target <- makeAbsolute sshKeyPath

40− createSymbolicLink target (deployDir </> "ssh_key")

43+ createSymbolicLink target (deployDir </> "ssh_key")

41− createThunk (deployDir </> "src") thunkPtr

44+ createThunk (deployDir </> "src") thunkPtr

42− writeFile (deployDir </> "backend_hosts") $ unlines hostnames

45+ writeFile (deployDir </> "backend_hosts") $ unlines hostnames

43− initGit deployDir

46+ initGit deployDir

45deployPush :: MonadObelisk m => FilePath -> m ()

48deployPush :: MonadObelisk m => FilePath -> m ()

46deployPush deployPath = do

49deployPush deployPath = do

lib/command/src/Obelisk/Command/Project.hs+9−8

@@ -29,7 +29,7 @@ import GitHub.Data.GitData (Branch)

29import GitHub.Data.Name (Name)

31import Obelisk.App (MonadObelisk)

32−import Obelisk.CLI (Severity (..), failWith, putLog, withSpinner)

32+import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, putLog, withSpinner)

33import Obelisk.Command.Thunk

34import Obelisk.Command.Utils (cp)

35--TODO: Make this module resilient to random exceptions

@@ -71,13 +71,14 @@ initProject source = do

71 --TODO: We should probably handoff to the impl here

72 skeleton <- nixBuildAttrWithCache implDir "skeleton" --TODO: I don't think there's actually any reason to cache this

73 withSpinner "Copying project skeleton" $ do

74+ callProcessAndLogOutput Notice $

74− liftIO $ cp --TODO: Make this package depend on nix-prefetch-url properly

75+ cp --TODO: Make this package depend on nix-prefetch-url properly

75− [ "-r"

76+ [ "-r"

76− , "--no-preserve=mode"

77+ , "--no-preserve=mode"

77− , "-T"

78+ , "-T"

78− , skeleton </> "."

79+ , skeleton </> "."

79− , "."

80+ , "."

80− ]

81+ ]

82--TODO: Handle errors

83--TODO: Handle errors

83--TODO: Allow the user to ignore our security concerns

84--TODO: Allow the user to ignore our security concerns

lib/command/src/Obelisk/Command/Thunk.hs+24−25

@@ -71,7 +71,7 @@ import System.Process (StdStream (CreatePipe), callProcess, createProcess, proc,

71import Development.Placeholders

72import Obelisk.App (MonadObelisk)

73import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, putLog, withSpinner)

74−import Obelisk.Command.Utils (callProcessNixShell, checkGitCleanStatus, cp)

74+import Obelisk.Command.Utils (checkGitCleanStatus, cp, procWithPackages)

76--TODO: Support symlinked thunk data

77data ThunkData

@@ -472,36 +472,35 @@ unpackThunk thunkDir = readThunk thunkDir >>= \case

472 Nothing -> fail "Cannot determine clone URI for thunk source"

473 Just c -> return $ T.unpack $ getUrl c

474 withSpinner ("Retrieving thunk " <> T.pack thunkName <> " from GitHub") $ do

475− callProcessAndLogOutput Notice (proc "hub" ["clone", "-n", githubURI, tmpRepo])

475+ callProcessAndLogOutput Notice $

476+ proc "hub" ["clone", "-n", githubURI, tmpRepo]

476− let obGitDir = tmpRepo </> ".git" </> "obelisk"

477+ let obGitDir = tmpRepo </> ".git" </> "obelisk"

477− --If this directory already exists then something is weird and we should fail

478+ --If this directory already exists then something is weird and we should fail

478− liftIO $ createDirectory obGitDir

479+ liftIO $ createDirectory obGitDir

479− withSpinner ("Copying thunk " <> T.pack thunkName <> " to " <> T.pack thunkDir) $ do

480+ callProcessAndLogOutput Notice $

480− liftIO $ cp

481− [ "-r"

482− , "-T"

483− , thunkDir </> "."

484− , obGitDir </> "orig-thunk"

481+ cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]

485− ]

482+ withSpinner ("Preparing thunk in " <> T.pack thunkDir) $ do

486− let checkoutOptions = concat

483+ -- Checkout

484+ putLog Notice $ "Checking out " <> T.pack (show $ maybe "" untagName $ _gitHubSource_branch s)

485+ callProcessAndLogOutput Debug $

486+ proc "hub" $ concat

487 [ ["-C", tmpRepo]

488 , pure "checkout"

489 , maybe [] (\n -> ["-B", T.unpack (untagName n)]) (_gitHubSource_branch s)

490 , pure $ Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr

491 ]

492− liftIO $ do

492+ -- Set upstream branch

493− callProcess "hub" checkoutOptions

494 forM_ (_gitHubSource_branch s) $ \branch ->

493 forM_ (_gitHubSource_branch s) $ \branch ->

494+ callProcessAndLogOutput Debug $

495− callProcess "hub" ["-C", tmpRepo, "branch", "-u", "origin/" <> T.unpack (untagName branch)]

495+ proc "hub" ["-C", tmpRepo, "branch", "-u", "origin/" <> T.unpack (untagName branch)]

496− callProcess "rm"

496+ callProcessAndLogOutput Notice $

497− [ "-r"

498− , thunkDir

497+ proc "rm" ["-r", thunkDir]

499− ]

498+ callProcessAndLogOutput Notice $

500− callProcessNixShell ["coreutils"] "mv"

499+ procWithPackages ["coreutils"] "mv"

501− [ "-T"

500+ [ "-T"

502− , tmpRepo

501+ , tmpRepo

503− , thunkDir

502+ , thunkDir

504− ]

503+ ]

505 ThunkSource_Git _s -> do

504 ThunkSource_Git _s -> do

506 $notImplemented

505 $notImplemented

507

506

lib/command/src/Obelisk/Command/Utils.hs+8−7

@@ -2,10 +2,9 @@

2{-# LANGUAGE OverloadedStrings #-}

3module Obelisk.Command.Utils where

5−import qualified Data.List as L

6import Data.Semigroup ((<>))

5import Data.Semigroup ((<>))

7import qualified Data.Text as T

6import qualified Data.Text as T

8−import System.Process

7+import System.Process (CreateProcess, callProcess, proc, readProcess)

10-- Check whether the working directory is clean

9-- Check whether the working directory is clean

11checkGitCleanStatus :: FilePath -> IO Bool

10checkGitCleanStatus :: FilePath -> IO Bool

@@ -23,11 +22,13 @@ initGit dir = do

23 git ["add", "."]

22 git ["add", "."]

24 git ["commit", "-m", "Initial commit."]

23 git ["commit", "-m", "Initial commit."]

25+-- | Like `System.Process.proc` but with the specified Nix packages installed

26−callProcessNixShell :: [String] -> FilePath -> [String] -> IO ()

26+procWithPackages :: [String] -> FilePath -> [String] -> CreateProcess

27−callProcessNixShell pkgs cmd args = callProcess "nix-shell" $

27+procWithPackages pkgs cmd args = proc "nix-shell" $

28− "-p" : pkgs <> ["--run", L.intercalate " " $ cmd : map quoteAndEscape args]

28+ "-p" : pkgs <> ["--run", unwords $ cmd : map quoteAndEscape args]

29 where

30 quoteAndEscape x = T.unpack $ "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

32+-- | Portable `cp` command

32−cp :: [String] -> IO ()

33+cp :: [String] -> CreateProcess

33−cp = callProcessNixShell ["coreutils"] "cp"

34+cp = procWithPackages ["coreutils"] "cp"