4dacf45 · obelisk · git.iko.soy

git.iko.soy/obelisk

Merge remote-tracking branch 'origin/develop' into eac@ghcide-compat

commit4dacf4569e102c10319c49d54775d3ed9c8b7626 authorElliot Cameron <eacameron@gmail.com> dateFri 10 Apr 2020, 15:31 (7 years ago) parentb63953f 14f6fe9

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

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

66{-# LANGUAGE TupleSections #-}

77module Obelisk.Command where

9−import Control.Monad

109import Control.Monad.IO.Class (MonadIO, liftIO)

1110import Data.Bool (bool)

1211import Data.Foldable (for_)

@@ -181,16 +180,6 @@ data DeployCommand

181180 | DeployCommand_Update

182181 deriving Show

183182

184−data DeployInitOpts = DeployInitOpts

185− { _deployInitOpts_outputDir :: FilePath

186− , _deployInitOpts_sshKey :: FilePath

187− , _deployInitOpts_hostname :: [String]

188− , _deployInitOpts_route :: String

189− , _deployInitOpts_adminEmail :: String

190− , _deployInitOpts_enableHttps :: Bool

191− }

192− deriving Show

193−

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

195184profileCommand = (,)

196185 <$> strOption

@@ -387,22 +376,7 @@ ob :: MonadObelisk m => ObCommand -> m ()

387376ob = \case

388377 ObCommand_Init source force -> initProject source force

389378 ObCommand_Deploy dc -> case dc of

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

391− let deployDir = _deployInitOpts_outputDir deployOpts

392− r <- liftIO $ canonicalizePath root

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

394− when rootEqualsTarget $

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

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

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

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

399− Right ThunkData_Checkout -> getThunkPtr False root Nothing

400− let sshKeyPath = _deployInitOpts_sshKey deployOpts

401− hostname = _deployInitOpts_hostname deployOpts

402− route = _deployInitOpts_route deployOpts

403− adminEmail = _deployInitOpts_adminEmail deployOpts

404− enableHttps = _deployInitOpts_enableHttps deployOpts

405− deployInit thunkPtr deployDir sshKeyPath hostname route adminEmail enableHttps

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

406380 DeployCommand_Push remoteBuilder -> do

407381 deployPath <- liftIO $ canonicalizePath "."

408382 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 True 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