{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module System.Hapistrano
( runHapistrano
, pushRelease
, pushReleaseWithoutVc
, activateRelease
, linkToShared
, createHapistranoDeployState
, rollback
, dropOldReleases
, playScript
, playScriptLocally
, releasePath
, sharedPath
, currentSymlinkPath
, tempSymlinkPath
, deployState )
where
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader (local, runReaderT)
import Data.List (dropWhileEnd, genericDrop, sortOn)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (Down (..))
import Data.Time
import Numeric.Natural
import Path
import System.Hapistrano.Commands
import System.Hapistrano.Config (deployStateFilename)
import System.Hapistrano.Core
import System.Hapistrano.Types
import Text.Read (readMaybe)
runHapistrano ::
MonadIO m
=> Maybe SshOptions
-> Shell
-> (OutputDest -> String -> IO ())
-> Hapistrano a
-> m (Either Int a)
runHapistrano :: Maybe SshOptions
-> Shell
-> (OutputDest -> String -> IO ())
-> Hapistrano a
-> m (Either Int a)
runHapistrano Maybe SshOptions
sshOptions Shell
shell' OutputDest -> String -> IO ()
printFnc Hapistrano a
m =
IO (Either Int a) -> m (Either Int a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Int a) -> m (Either Int a))
-> IO (Either Int a) -> m (Either Int a)
forall a b. (a -> b) -> a -> b
$ do
let config :: Config
config =
Config :: Maybe SshOptions
-> Shell -> (OutputDest -> String -> IO ()) -> Config
Config
{ configSshOptions :: Maybe SshOptions
configSshOptions = Maybe SshOptions
sshOptions
, configShellOptions :: Shell
configShellOptions = Shell
shell'
, configPrint :: OutputDest -> String -> IO ()
configPrint = OutputDest -> String -> IO ()
printFnc
}
Either (Failure, Maybe Release) a
r <- ReaderT Config IO (Either (Failure, Maybe Release) a)
-> Config -> IO (Either (Failure, Maybe Release) a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Hapistrano a
-> ReaderT Config IO (Either (Failure, Maybe Release) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT Hapistrano a
m) Config
config
case Either (Failure, Maybe Release) a
r of
Left (Failure Int
n Maybe String
msg, Maybe Release
_) -> do
Maybe String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
msg (OutputDest -> String -> IO ()
printFnc OutputDest
StderrDest)
Either Int a -> IO (Either Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either Int a
forall a b. a -> Either a b
Left Int
n)
Right a
x -> Either Int a -> IO (Either Int a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either Int a
forall a b. b -> Either a b
Right a
x)
pushRelease :: Task -> Hapistrano Release
pushRelease :: Task -> Hapistrano Release
pushRelease Task {Path Abs Dir
ReleaseFormat
Source
taskReleaseFormat :: Task -> ReleaseFormat
taskSource :: Task -> Source
taskDeployPath :: Task -> Path Abs Dir
taskReleaseFormat :: ReleaseFormat
taskSource :: Source
taskDeployPath :: Path Abs Dir
..} = do
Path Abs Dir -> Hapistrano ()
setupDirs Path Abs Dir
taskDeployPath
Source -> Hapistrano Release
pushReleaseForRepository Source
taskSource
where
pushReleaseForRepository :: Source -> Hapistrano Release
pushReleaseForRepository GitRepository {String
gitRepositoryRevision :: Source -> String
gitRepositoryURL :: Source -> String
gitRepositoryRevision :: String
gitRepositoryURL :: String
..} = do
String -> Path Abs Dir -> Maybe Release -> Hapistrano ()
ensureCacheInPlace String
gitRepositoryURL Path Abs Dir
taskDeployPath Maybe Release
forall a. Maybe a
Nothing
Release
release <- ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
taskReleaseFormat
Path Abs Dir -> Release -> Hapistrano ()
cloneToRelease Path Abs Dir
taskDeployPath Release
release
Path Abs Dir -> Release -> String -> Hapistrano ()
setReleaseRevision Path Abs Dir
taskDeployPath Release
release String
gitRepositoryRevision
Release -> Hapistrano Release
forall (m :: * -> *) a. Monad m => a -> m a
return Release
release
pushReleaseForRepository LocalDirectory {} =
ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
taskReleaseFormat
pushReleaseWithoutVc :: Task -> Hapistrano Release
pushReleaseWithoutVc :: Task -> Hapistrano Release
pushReleaseWithoutVc Task {Path Abs Dir
ReleaseFormat
Source
taskReleaseFormat :: ReleaseFormat
taskSource :: Source
taskDeployPath :: Path Abs Dir
taskReleaseFormat :: Task -> ReleaseFormat
taskSource :: Task -> Source
taskDeployPath :: Task -> Path Abs Dir
..} = do
Path Abs Dir -> Hapistrano ()
setupDirs Path Abs Dir
taskDeployPath
ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
taskReleaseFormat
activateRelease
:: TargetSystem
-> Path Abs Dir
-> Release
-> Hapistrano ()
activateRelease :: TargetSystem -> Path Abs Dir -> Release -> Hapistrano ()
activateRelease TargetSystem
ts Path Abs Dir
deployPath Release
release = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
forall a. Maybe a
Nothing
let tpath :: Path Abs File
tpath = Path Abs Dir -> Path Abs File
tempSymlinkPath Path Abs Dir
deployPath
cpath :: Path Abs File
cpath = Path Abs Dir -> Path Abs File
currentSymlinkPath Path Abs Dir
deployPath
Ln -> Maybe Release -> Hapistrano (Result Ln)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (TargetSystem -> Path Abs Dir -> Path Abs File -> Ln
forall t. TargetSystem -> Path Abs t -> Path Abs File -> Ln
Ln TargetSystem
ts Path Abs Dir
rpath Path Abs File
tpath) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
Mv File -> Maybe Release -> Hapistrano (Result (Mv File))
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (TargetSystem -> Path Abs File -> Path Abs File -> Mv File
forall t. TargetSystem -> Path Abs t -> Path Abs t -> Mv t
Mv TargetSystem
ts Path Abs File
tpath Path Abs File
cpath) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
createHapistranoDeployState
:: Path Abs Dir
-> Release
-> DeployState
-> Hapistrano ()
createHapistranoDeployState :: Path Abs Dir -> Release -> DeployState -> Hapistrano ()
createHapistranoDeployState Path Abs Dir
deployPath Release
release DeployState
state = do
Path Rel File
parseStatePath <- String
-> ExceptT
(Failure, Maybe Release) (ReaderT Config IO) (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
deployStateFilename
Path Abs Dir
actualReleasePath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
forall a. Maybe a
Nothing
let stateFilePath :: Path Abs File
stateFilePath = Path Abs Dir
actualReleasePath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
parseStatePath
Touch -> Maybe Release -> Hapistrano (Result Touch)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> Touch
Touch Path Abs File
stateFilePath) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
BasicWrite -> Maybe Release -> Hapistrano (Result BasicWrite)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> String -> BasicWrite
BasicWrite Path Abs File
stateFilePath (String -> BasicWrite) -> String -> BasicWrite
forall a b. (a -> b) -> a -> b
$ DeployState -> String
forall a. Show a => a -> String
show DeployState
state) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
rollback
:: TargetSystem
-> Path Abs Dir
-> Natural
-> Hapistrano ()
rollback :: TargetSystem -> Path Abs Dir -> Natural -> Hapistrano ()
rollback TargetSystem
ts Path Abs Dir
deployPath Natural
n = do
[Release]
releases <- DeployState -> Path Abs Dir -> Hapistrano [Release]
releasesWithState DeployState
Success Path Abs Dir
deployPath
case Natural -> [Release] -> [Release]
forall i a. Integral i => i -> [a] -> [a]
genericDrop Natural
n [Release]
releases of
[] -> Int -> Maybe String -> Maybe Release -> Hapistrano ()
forall a. Int -> Maybe String -> Maybe Release -> Hapistrano a
failWith Int
1 (String -> Maybe String
forall a. a -> Maybe a
Just String
"Could not find the requested release to rollback to.") Maybe Release
forall a. Maybe a
Nothing
(Release
x:[Release]
_) -> TargetSystem -> Path Abs Dir -> Release -> Hapistrano ()
activateRelease TargetSystem
ts Path Abs Dir
deployPath Release
x
dropOldReleases
:: Path Abs Dir
-> Natural
-> Bool
-> Hapistrano ()
dropOldReleases :: Path Abs Dir -> Natural -> Bool -> Hapistrano ()
dropOldReleases Path Abs Dir
deployPath Natural
n Bool
keepOneFailed = do
[Release]
failedReleases <- DeployState -> Path Abs Dir -> Hapistrano [Release]
releasesWithState DeployState
Fail Path Abs Dir
deployPath
Bool -> Hapistrano () -> Hapistrano ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
keepOneFailed Bool -> Bool -> Bool
&& [Release] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Release]
failedReleases Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Hapistrano () -> Hapistrano ()) -> Hapistrano () -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$
[Release] -> (Release -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Release] -> [Release]
forall a. [a] -> [a]
tail [Release]
failedReleases) ((Release -> Hapistrano ()) -> Hapistrano ())
-> (Release -> Hapistrano ()) -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$ \Release
release -> do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
forall a. Maybe a
Nothing
Rm -> Maybe Release -> Hapistrano (Result Rm)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs Dir -> Rm
forall t. Path Abs t -> Rm
Rm Path Abs Dir
rpath) Maybe Release
forall a. Maybe a
Nothing
[Release]
dreleases <- Path Abs Dir -> Hapistrano [Release]
deployedReleases Path Abs Dir
deployPath
[Release] -> (Release -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Natural -> [Release] -> [Release]
forall i a. Integral i => i -> [a] -> [a]
genericDrop Natural
n [Release]
dreleases) ((Release -> Hapistrano ()) -> Hapistrano ())
-> (Release -> Hapistrano ()) -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$ \Release
release -> do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
forall a. Maybe a
Nothing
Rm -> Maybe Release -> Hapistrano (Result Rm)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs Dir -> Rm
forall t. Path Abs t -> Rm
Rm Path Abs Dir
rpath) Maybe Release
forall a. Maybe a
Nothing
playScript
:: Path Abs Dir
-> Release
-> Maybe (Path Rel Dir)
-> [GenericCommand]
-> Hapistrano ()
playScript :: Path Abs Dir
-> Release
-> Maybe (Path Rel Dir)
-> [GenericCommand]
-> Hapistrano ()
playScript Path Abs Dir
deployDir Release
release Maybe (Path Rel Dir)
mWorkingDir [GenericCommand]
cmds = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployDir Release
release Maybe (Path Rel Dir)
mWorkingDir
[GenericCommand]
-> (GenericCommand -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenericCommand]
cmds ((Cd GenericCommand -> Maybe Release -> Hapistrano ())
-> Maybe Release -> Cd GenericCommand -> Hapistrano ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cd GenericCommand -> Maybe Release -> Hapistrano ()
forall a. Command a => a -> Maybe Release -> Hapistrano ()
execWithInheritStdout (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release) (Cd GenericCommand -> Hapistrano ())
-> (GenericCommand -> Cd GenericCommand)
-> GenericCommand
-> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> GenericCommand -> Cd GenericCommand
forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
rpath)
playScriptLocally :: [GenericCommand] -> Hapistrano ()
playScriptLocally :: [GenericCommand] -> Hapistrano ()
playScriptLocally [GenericCommand]
cmds =
(Config -> Config) -> Hapistrano () -> Hapistrano ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
(\Config
c ->
Config
c
{ configSshOptions :: Maybe SshOptions
configSshOptions = Maybe SshOptions
forall a. Maybe a
Nothing
}) (Hapistrano () -> Hapistrano ()) -> Hapistrano () -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$
[GenericCommand]
-> (GenericCommand -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenericCommand]
cmds ((GenericCommand -> Hapistrano ()) -> Hapistrano ())
-> (GenericCommand -> Hapistrano ()) -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$ (GenericCommand -> Maybe Release -> Hapistrano ())
-> Maybe Release -> GenericCommand -> Hapistrano ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip GenericCommand -> Maybe Release -> Hapistrano ()
forall a. Command a => a -> Maybe Release -> Hapistrano ()
execWithInheritStdout Maybe Release
forall a. Maybe a
Nothing
setupDirs
:: Path Abs Dir
-> Hapistrano ()
setupDirs :: Path Abs Dir -> Hapistrano ()
setupDirs Path Abs Dir
deployPath = do
((MkDir -> Maybe Release -> Hapistrano ())
-> Maybe Release -> MkDir -> Hapistrano ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MkDir -> Maybe Release -> Hapistrano ()
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec Maybe Release
forall a. Maybe a
Nothing (MkDir -> Hapistrano ())
-> (Path Abs Dir -> MkDir) -> Path Abs Dir -> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir (Path Abs Dir -> MkDir)
-> (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> MkDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
releasesPath) Path Abs Dir
deployPath
((MkDir -> Maybe Release -> Hapistrano ())
-> Maybe Release -> MkDir -> Hapistrano ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MkDir -> Maybe Release -> Hapistrano ()
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec Maybe Release
forall a. Maybe a
Nothing (MkDir -> Hapistrano ())
-> (Path Abs Dir -> MkDir) -> Path Abs Dir -> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir (Path Abs Dir -> MkDir)
-> (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> MkDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
cacheRepoPath) Path Abs Dir
deployPath
((MkDir -> Maybe Release -> Hapistrano ())
-> Maybe Release -> MkDir -> Hapistrano ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MkDir -> Maybe Release -> Hapistrano ()
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec Maybe Release
forall a. Maybe a
Nothing (MkDir -> Hapistrano ())
-> (Path Abs Dir -> MkDir) -> Path Abs Dir -> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir (Path Abs Dir -> MkDir)
-> (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> MkDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
sharedPath) Path Abs Dir
deployPath
ensureCacheInPlace
:: String
-> Path Abs Dir
-> Maybe Release
-> Hapistrano ()
ensureCacheInPlace :: String -> Path Abs Dir -> Maybe Release -> Hapistrano ()
ensureCacheInPlace String
repo Path Abs Dir
deployPath Maybe Release
maybeRelease = do
let cpath :: Path Abs Dir
cpath = Path Abs Dir -> Path Abs Dir
cacheRepoPath Path Abs Dir
deployPath
refs :: Path Abs Dir
refs = Path Abs Dir
cpath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "refs")
Bool
exists <- (Ls -> Maybe Release -> Hapistrano (Result Ls)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs Dir -> Ls
Ls Path Abs Dir
refs) Maybe Release
forall a. Maybe a
Nothing Hapistrano ()
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
-> ((Failure, Maybe Release)
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool)
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
-> (Failure, Maybe Release)
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
forall a b. a -> b -> a
const (Bool -> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
Bool -> Hapistrano () -> Hapistrano ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (Hapistrano () -> Hapistrano ()) -> Hapistrano () -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$
GitClone -> Maybe Release -> Hapistrano (Result GitClone)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Bool -> Either String (Path Abs Dir) -> Path Abs Dir -> GitClone
GitClone Bool
True (String -> Either String (Path Abs Dir)
forall a b. a -> Either a b
Left String
repo) Path Abs Dir
cpath) Maybe Release
maybeRelease
Cd GitFetch -> Maybe Release -> Hapistrano (Result (Cd GitFetch))
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs Dir -> GitFetch -> Cd GitFetch
forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
cpath (String -> GitFetch
GitFetch String
"origin")) Maybe Release
maybeRelease
newRelease :: ReleaseFormat -> Hapistrano Release
newRelease :: ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
releaseFormat =
ReleaseFormat -> UTCTime -> Release
mkRelease ReleaseFormat
releaseFormat (UTCTime -> Release)
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) UTCTime
-> Hapistrano Release
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
cloneToRelease
:: Path Abs Dir
-> Release
-> Hapistrano ()
cloneToRelease :: Path Abs Dir -> Release -> Hapistrano ()
cloneToRelease Path Abs Dir
deployPath Release
release = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
forall a. Maybe a
Nothing
let cpath :: Path Abs Dir
cpath = Path Abs Dir -> Path Abs Dir
cacheRepoPath Path Abs Dir
deployPath
GitClone -> Maybe Release -> Hapistrano (Result GitClone)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Bool -> Either String (Path Abs Dir) -> Path Abs Dir -> GitClone
GitClone Bool
False (Path Abs Dir -> Either String (Path Abs Dir)
forall a b. b -> Either a b
Right Path Abs Dir
cpath) Path Abs Dir
rpath) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
setReleaseRevision
:: Path Abs Dir
-> Release
-> String
-> Hapistrano ()
setReleaseRevision :: Path Abs Dir -> Release -> String -> Hapistrano ()
setReleaseRevision Path Abs Dir
deployPath Release
release String
revision = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
forall a. Maybe a
Nothing
Cd GitCheckout
-> Maybe Release -> Hapistrano (Result (Cd GitCheckout))
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs Dir -> GitCheckout -> Cd GitCheckout
forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
rpath (String -> GitCheckout
GitCheckout String
revision)) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
deployedReleases
:: Path Abs Dir
-> Hapistrano [Release]
deployedReleases :: Path Abs Dir -> Hapistrano [Release]
deployedReleases Path Abs Dir
deployPath = do
let rpath :: Path Abs Dir
rpath = Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath
[Path Abs Dir]
xs <- Find Dir -> Maybe Release -> Hapistrano (Result (Find Dir))
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Natural -> Path Abs Dir -> Find Dir
forall t. Natural -> Path Abs Dir -> Find t
Find Natural
1 Path Abs Dir
rpath :: Find Dir) Maybe Release
forall a. Maybe a
Nothing
[Path Rel Dir]
ps <- Path Abs Dir -> [Path Abs Dir] -> Hapistrano [Path Rel Dir]
forall t. Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs Path Abs Dir
rpath ((Path Abs Dir -> Bool) -> [Path Abs Dir] -> [Path Abs Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
/= Path Abs Dir
rpath) [Path Abs Dir]
xs)
([Release] -> Hapistrano [Release]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Release] -> Hapistrano [Release])
-> ([String] -> [Release]) -> [String] -> Hapistrano [Release]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Release -> Down Release) -> [Release] -> [Release]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Release -> Down Release
forall a. a -> Down a
Down ([Release] -> [Release])
-> ([String] -> [Release]) -> [String] -> [Release]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe Release) -> [String] -> [Release]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Release
parseRelease)
((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> String)
-> (Path Rel Dir -> String) -> Path Rel Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> String
fromRelDir (Path Rel Dir -> String) -> [Path Rel Dir] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Rel Dir]
ps)
releasesWithState
:: DeployState
-> Path Abs Dir
-> Hapistrano [Release]
releasesWithState :: DeployState -> Path Abs Dir -> Hapistrano [Release]
releasesWithState DeployState
selectedState Path Abs Dir
deployPath = do
[Release]
releases <- Path Abs Dir -> Hapistrano [Release]
deployedReleases Path Abs Dir
deployPath
(Release
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool)
-> [Release] -> Hapistrano [Release]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (
(DeployState -> Bool)
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) DeployState
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\Bool
bool -> if DeployState
selectedState DeployState -> DeployState -> Bool
forall a. Eq a => a -> a -> Bool
== DeployState
Success then Bool
bool else Bool -> Bool
not Bool
bool) (Bool -> Bool) -> (DeployState -> Bool) -> DeployState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeployState -> Bool
stateToBool)
(ExceptT (Failure, Maybe Release) (ReaderT Config IO) DeployState
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool)
-> (Release
-> ExceptT
(Failure, Maybe Release) (ReaderT Config IO) DeployState)
-> Release
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir
-> Maybe (Path Rel Dir)
-> Release
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) DeployState
deployState Path Abs Dir
deployPath Maybe (Path Rel Dir)
forall a. Maybe a
Nothing
) [Release]
releases
where
stateToBool :: DeployState -> Bool
stateToBool :: DeployState -> Bool
stateToBool DeployState
Fail = Bool
False
stateToBool DeployState
_ = Bool
True
releasesPath
:: Path Abs Dir
-> Path Abs Dir
releasesPath :: Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath = Path Abs Dir
deployPath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "releases")
sharedPath
:: Path Abs Dir
-> Path Abs Dir
sharedPath :: Path Abs Dir -> Path Abs Dir
sharedPath Path Abs Dir
deployPath = Path Abs Dir
deployPath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "shared")
linkToShared
:: TargetSystem
-> Path Abs Dir
-> Path Abs Dir
-> FilePath
-> Maybe Release
-> Hapistrano ()
linkToShared :: TargetSystem
-> Path Abs Dir
-> Path Abs Dir
-> String
-> Maybe Release
-> Hapistrano ()
linkToShared TargetSystem
configTargetSystem Path Abs Dir
rpath Path Abs Dir
configDeployPath String
thingToLink Maybe Release
maybeRelease = do
Path Rel File
destPath <- String
-> ExceptT
(Failure, Maybe Release) (ReaderT Config IO) (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
thingToLink
let dpath :: Path Abs File
dpath = Path Abs Dir
rpath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
destPath
sharedPath' :: Path Abs File
sharedPath' = Path Abs Dir -> Path Abs Dir
sharedPath Path Abs Dir
configDeployPath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
destPath
Ln -> Maybe Release -> Hapistrano (Result Ln)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (TargetSystem -> Path Abs File -> Path Abs File -> Ln
forall t. TargetSystem -> Path Abs t -> Path Abs File -> Ln
Ln TargetSystem
configTargetSystem Path Abs File
sharedPath' Path Abs File
dpath) Maybe Release
maybeRelease
releasePath
:: Path Abs Dir
-> Release
-> Maybe (Path Rel Dir)
-> Hapistrano (Path Abs Dir)
releasePath :: Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
mWorkingDir =
let rendered :: String
rendered = Release -> String
renderRelease Release
release
in case String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
rendered of
Maybe (Path Rel Dir)
Nothing -> Int -> Maybe String -> Maybe Release -> Hapistrano (Path Abs Dir)
forall a. Int -> Maybe String -> Maybe Release -> Hapistrano a
failWith Int
1 (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Could not append path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rendered) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
Just Path Rel Dir
rpath ->
Path Abs Dir -> Hapistrano (Path Abs Dir)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs Dir -> Hapistrano (Path Abs Dir))
-> Path Abs Dir -> Hapistrano (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ case Maybe (Path Rel Dir)
mWorkingDir of
Maybe (Path Rel Dir)
Nothing -> Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rpath
Just Path Rel Dir
workingDir -> Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rpath Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
workingDir
cacheRepoPath
:: Path Abs Dir
-> Path Abs Dir
cacheRepoPath :: Path Abs Dir -> Path Abs Dir
cacheRepoPath Path Abs Dir
deployPath = Path Abs Dir
deployPath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "repo")
currentSymlinkPath
:: Path Abs Dir
-> Path Abs File
currentSymlinkPath :: Path Abs Dir -> Path Abs File
currentSymlinkPath Path Abs Dir
deployPath = Path Abs Dir
deployPath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelFile "current")
tempSymlinkPath
:: Path Abs Dir
-> Path Abs File
tempSymlinkPath :: Path Abs Dir -> Path Abs File
tempSymlinkPath Path Abs Dir
deployPath = Path Abs Dir
deployPath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelFile "current_tmp")
deployState
:: Path Abs Dir
-> Maybe (Path Rel Dir)
-> Release
-> Hapistrano DeployState
deployState :: Path Abs Dir
-> Maybe (Path Rel Dir)
-> Release
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) DeployState
deployState Path Abs Dir
deployPath Maybe (Path Rel Dir)
mWorkingDir Release
release = do
Path Rel File
parseStatePath <- String
-> ExceptT
(Failure, Maybe Release) (ReaderT Config IO) (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
deployStateFilename
Path Abs Dir
actualReleasePath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
mWorkingDir
let stateFilePath :: Path Abs File
stateFilePath = Path Abs Dir
actualReleasePath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
parseStatePath
Bool
doesExist <- CheckExists -> Maybe Release -> Hapistrano (Result CheckExists)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> CheckExists
CheckExists Path Abs File
stateFilePath) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
if Bool
doesExist then do
String
deployStateContents <- Cat -> Maybe Release -> Hapistrano (Result Cat)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> Cat
Cat Path Abs File
stateFilePath) (Release -> Maybe Release
forall a. a -> Maybe a
Just Release
release)
DeployState
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) DeployState
forall (m :: * -> *) a. Monad m => a -> m a
return (DeployState
-> ExceptT
(Failure, Maybe Release) (ReaderT Config IO) DeployState)
-> DeployState
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) DeployState
forall a b. (a -> b) -> a -> b
$ (DeployState -> Maybe DeployState -> DeployState
forall a. a -> Maybe a -> a
fromMaybe DeployState
Unknown (Maybe DeployState -> DeployState)
-> (String -> Maybe DeployState) -> String -> DeployState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe DeployState
forall a. Read a => String -> Maybe a
readMaybe) String
deployStateContents
else DeployState
-> ExceptT (Failure, Maybe Release) (ReaderT Config IO) DeployState
forall (m :: * -> *) a. Monad m => a -> m a
return DeployState
Unknown
stripDirs :: Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs :: Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs Path Abs Dir
path =
#if MIN_VERSION_path(0,6,0)
(Path Abs t
-> ExceptT
(Failure, Maybe Release) (ReaderT Config IO) (Path Rel t))
-> [Path Abs t] -> Hapistrano [Path Rel t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Path Abs Dir
-> Path Abs t
-> ExceptT
(Failure, Maybe Release) (ReaderT Config IO) (Path Rel t)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
path)
#else
mapM (stripDir path)
#endif