4e0f0fd · obelisk · git.iko.soy

git.iko.soy/obelisk

command: Fix ob deploy for new thunks

commit4e0f0fdef18e4b0f41cdc7fdb64d3837e0aa5208 authorElliot Cameron <eacameron@gmail.com> dateThu 9 Apr 2020, 15:39 (7 years ago) parenta9bd464

2 files changed+27−36

compare with master

unifiedsplit

lib/command/src/Obelisk/Command.hs+1−27 lib/command/src/Obelisk/Command/Deploy.hs+26−9

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

@@ -5,7 +5,6 @@

55{-# LANGUAGE ScopedTypeVariables #-}

66module Obelisk.Command where

8−import Control.Monad

98import Control.Monad.IO.Class (liftIO)

109import Data.Bool (bool)

1110import Data.Foldable (for_)

@@ -171,16 +170,6 @@ data DeployCommand

171170 | DeployCommand_Update

172171 deriving Show

173172

174−data DeployInitOpts = DeployInitOpts

175− { _deployInitOpts_outputDir :: FilePath

176− , _deployInitOpts_sshKey :: FilePath

177− , _deployInitOpts_hostname :: [String]

178− , _deployInitOpts_route :: String

179− , _deployInitOpts_adminEmail :: String

180− , _deployInitOpts_enableHttps :: Bool

181− }

182− deriving Show

183−

184173profileCommand :: Parser (String, [String])

185174profileCommand = (,)

186175 <$> strOption

@@ -355,22 +344,7 @@ ob :: MonadObelisk m => ObCommand -> m ()

355344ob = \case

356345 ObCommand_Init source force -> initProject source force

357346 ObCommand_Deploy dc -> case dc of

358− DeployCommand_Init deployOpts -> withProjectRoot "." $ \root -> do

359− let deployDir = _deployInitOpts_outputDir deployOpts

360− r <- liftIO $ canonicalizePath root

361− rootEqualsTarget <- liftIO $ equalFilePath r <$> canonicalizePath deployDir

362− when rootEqualsTarget $

363− failWith $ "Deploy directory " <> T.pack deployDir <> " should not be the same as project root."

364− thunkPtr <- readThunk root >>= \case

365− Left err -> failWith $ "Can't read thunk at: " <> T.pack root <> ": " <> T.pack (show err)

366− Right (ThunkData_Packed _ ptr) -> return ptr

367− Right ThunkData_Checkout -> getThunkPtr False root Nothing

368− let sshKeyPath = _deployInitOpts_sshKey deployOpts

369− hostname = _deployInitOpts_hostname deployOpts

370− route = _deployInitOpts_route deployOpts

371− adminEmail = _deployInitOpts_adminEmail deployOpts

372− enableHttps = _deployInitOpts_enableHttps deployOpts

373− deployInit thunkPtr deployDir sshKeyPath hostname route adminEmail enableHttps

347+ DeployCommand_Init deployOpts -> withProjectRoot "." $ \root -> deployInit deployOpts root

374348 DeployCommand_Push remoteBuilder -> do

375349 deployPath <- liftIO $ canonicalizePath "."

376350 deployPush deployPath $ case remoteBuilder of

lib/command/src/Obelisk/Command/Deploy.hs+26−9

@@ -1,11 +1,13 @@

1+{-# LANGUAGE DeriveGeneric #-}

12{-# LANGUAGE FlexibleContexts #-}

23{-# LANGUAGE LambdaCase #-}

34{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE QuasiQuotes #-}

46{-# LANGUAGE ScopedTypeVariables #-}

57{-# LANGUAGE ViewPatterns #-}

6−{-# LANGUAGE DeriveGeneric #-}

78module Obelisk.Command.Deploy where

10+import Control.Applicative (liftA2)

911import Control.Lens

1012import Control.Monad

1113import Control.Monad.Catch (Exception (displayException), MonadThrow, bracket, throwM, try)

@@ -16,6 +18,7 @@ import qualified Data.ByteString.Lazy as BSL

1618import Data.Default

1719import qualified Data.Map as Map

1820import qualified Data.Set as Set

21+import Data.String.Here.Interpolated (i)

1922import qualified Data.Text as T

2023import qualified Data.Text.IO as T

2124import GHC.Generics

@@ -36,18 +39,32 @@ import Obelisk.Command.Project

3639import Obelisk.Command.Thunk

3740import Obelisk.Command.Utils

3841

42+data DeployInitOpts = DeployInitOpts

43+ { _deployInitOpts_outputDir :: FilePath

44+ , _deployInitOpts_sshKey :: FilePath

45+ , _deployInitOpts_hostname :: [String]

46+ , _deployInitOpts_route :: String

47+ , _deployInitOpts_adminEmail :: String

48+ , _deployInitOpts_enableHttps :: Bool

49+ } deriving Show

50+

51+deployInit :: MonadObelisk m => DeployInitOpts -> FilePath -> m ()

52+deployInit deployOpts root = do

53+ let deployDir = _deployInitOpts_outputDir deployOpts

54+ rootEqualsTarget <- liftIO $ liftA2 equalFilePath (canonicalizePath root) (canonicalizePath deployDir)

55+ when rootEqualsTarget $

56+ failWith [i|Deploy directory ${deployDir} should not be the same as project root.|]

57+ thunkPtr <- readThunk root >>= \case

58+ Right (ThunkData_Packed _ ptr) -> return ptr

59+ _ -> getThunkPtr False root Nothing

60+ deployInit' thunkPtr deployOpts

3961

40−deployInit

62+deployInit'

4163 :: MonadObelisk m

4264 => ThunkPtr

43− -> FilePath

44− -> FilePath

45− -> [String] -- ^ hostnames

46− -> String -- ^ route

47− -> String -- ^ admin email

48− -> Bool -- ^ enable https

65+ -> DeployInitOpts

4966 -> m ()

50−deployInit thunkPtr deployDir sshKeyPath hostnames route adminEmail enableHttps = do

67+deployInit' thunkPtr (DeployInitOpts deployDir sshKeyPath hostnames route adminEmail enableHttps) = do

5168 liftIO $ createDirectoryIfMissing True deployDir

5269 localKey <- withSpinner ("Preparing " <> T.pack deployDir) $ do

5370 localKey <- liftIO (doesFileExist sshKeyPath) >>= \case