-- |
-- Module      :  System.Hapistrano.Types
-- Copyright   :  © 2015-Present Stack Builders
-- License     :  MIT
--
-- Stability   :  experimental
-- Portability :  portable
--
-- Type definitions for the Hapistrano tool.
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

module System.Hapistrano.Types
  ( Hapistrano(..)
  , HapistranoException(..)
  , Failure(..)
  , Config(..)
  , Source(..)
  , Task(..)
  , ReleaseFormat(..)
  , SshOptions(..)
  , OutputDest(..)
  , Release
  , TargetSystem(..)
  , DeployState(..)
  , Shell(..)
  , Opts(..)
  , Command(..)
  , MaintenanceOptions(..)
  -- * Types helpers
  , mkRelease
  , releaseTime
  , renderRelease
  , parseRelease
  , fromMaybeReleaseFormat
  , fromMaybeKeepReleases
  , toMaybePath
  ) where

import           Control.Applicative
import           Control.Monad.Catch
import           Control.Monad.Except
import           Control.Monad.Reader
import           Data.Aeson
import           Data.Maybe
import           Data.Time
import           Numeric.Natural
import           Path

-- | Hapistrano monad.
newtype Hapistrano a =
  Hapistrano { forall a. Hapistrano a -> Config -> IO a
unHapistrano :: Config -> IO a }
    deriving
      ( forall a b. a -> Hapistrano b -> Hapistrano a
forall a b. (a -> b) -> Hapistrano a -> Hapistrano b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Hapistrano b -> Hapistrano a
$c<$ :: forall a b. a -> Hapistrano b -> Hapistrano a
fmap :: forall a b. (a -> b) -> Hapistrano a -> Hapistrano b
$cfmap :: forall a b. (a -> b) -> Hapistrano a -> Hapistrano b
Functor
      , Functor Hapistrano
forall a. a -> Hapistrano a
forall a b. Hapistrano a -> Hapistrano b -> Hapistrano a
forall a b. Hapistrano a -> Hapistrano b -> Hapistrano b
forall a b. Hapistrano (a -> b) -> Hapistrano a -> Hapistrano b
forall a b c.
(a -> b -> c) -> Hapistrano a -> Hapistrano b -> Hapistrano c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Hapistrano a -> Hapistrano b -> Hapistrano a
$c<* :: forall a b. Hapistrano a -> Hapistrano b -> Hapistrano a
*> :: forall a b. Hapistrano a -> Hapistrano b -> Hapistrano b
$c*> :: forall a b. Hapistrano a -> Hapistrano b -> Hapistrano b
liftA2 :: forall a b c.
(a -> b -> c) -> Hapistrano a -> Hapistrano b -> Hapistrano c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Hapistrano a -> Hapistrano b -> Hapistrano c
<*> :: forall a b. Hapistrano (a -> b) -> Hapistrano a -> Hapistrano b
$c<*> :: forall a b. Hapistrano (a -> b) -> Hapistrano a -> Hapistrano b
pure :: forall a. a -> Hapistrano a
$cpure :: forall a. a -> Hapistrano a
Applicative
      , Applicative Hapistrano
forall a. a -> Hapistrano a
forall a b. Hapistrano a -> Hapistrano b -> Hapistrano b
forall a b. Hapistrano a -> (a -> Hapistrano b) -> Hapistrano b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Hapistrano a
$creturn :: forall a. a -> Hapistrano a
>> :: forall a b. Hapistrano a -> Hapistrano b -> Hapistrano b
$c>> :: forall a b. Hapistrano a -> Hapistrano b -> Hapistrano b
>>= :: forall a b. Hapistrano a -> (a -> Hapistrano b) -> Hapistrano b
$c>>= :: forall a b. Hapistrano a -> (a -> Hapistrano b) -> Hapistrano b
Monad
      , Monad Hapistrano
forall a. IO a -> Hapistrano a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Hapistrano a
$cliftIO :: forall a. IO a -> Hapistrano a
MonadIO
      , Monad Hapistrano
forall e a. Exception e => e -> Hapistrano a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> Hapistrano a
$cthrowM :: forall e a. Exception e => e -> Hapistrano a
MonadThrow
      , MonadThrow Hapistrano
forall e a.
Exception e =>
Hapistrano a -> (e -> Hapistrano a) -> Hapistrano a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
Hapistrano a -> (e -> Hapistrano a) -> Hapistrano a
$ccatch :: forall e a.
Exception e =>
Hapistrano a -> (e -> Hapistrano a) -> Hapistrano a
MonadCatch
      , MonadReader Config
      ) via (ReaderT Config IO)

-- | Hapistrano exception
newtype HapistranoException = HapistranoException (Failure, Maybe Release)
  deriving (Int -> HapistranoException -> ShowS
[HapistranoException] -> ShowS
HapistranoException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HapistranoException] -> ShowS
$cshowList :: [HapistranoException] -> ShowS
show :: HapistranoException -> String
$cshow :: HapistranoException -> String
showsPrec :: Int -> HapistranoException -> ShowS
$cshowsPrec :: Int -> HapistranoException -> ShowS
Show)

instance Exception HapistranoException

-- | Failure with status code and a message.
data Failure =
  Failure Int (Maybe String)
  deriving Int -> Failure -> ShowS
[Failure] -> ShowS
Failure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Failure] -> ShowS
$cshowList :: [Failure] -> ShowS
show :: Failure -> String
$cshow :: Failure -> String
showsPrec :: Int -> Failure -> ShowS
$cshowsPrec :: Int -> Failure -> ShowS
Show

-- | Hapistrano configuration options.
data Config =
  Config
    { Config -> Maybe SshOptions
configSshOptions   :: !(Maybe SshOptions)
    -- ^ 'Nothing' if we are running locally, or SSH options to use.
    , Config -> Shell
configShellOptions :: !Shell
    -- ^ One of the supported 'Shell's
    , Config -> OutputDest -> String -> IO ()
configPrint        :: !(OutputDest -> String -> IO ())
    -- ^ How to print messages
    }

-- | The source of the repository. It can be from a version control provider
-- like GitHub or a local directory.
data Source
  = GitRepository
      { Source -> String
gitRepositoryURL      :: String
      -- ^ The URL of remote Git repository to deploy
      , Source -> String
gitRepositoryRevision :: String
      -- ^ The SHA1 or branch to release
      }
  | LocalDirectory
      { Source -> Path Abs Dir
localDirectoryPath :: Path Abs Dir
      -- ^ The local repository to deploy
      }
  deriving (Source -> Source -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, Eq Source
Source -> Source -> Bool
Source -> Source -> Ordering
Source -> Source -> Source
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Source -> Source -> Source
$cmin :: Source -> Source -> Source
max :: Source -> Source -> Source
$cmax :: Source -> Source -> Source
>= :: Source -> Source -> Bool
$c>= :: Source -> Source -> Bool
> :: Source -> Source -> Bool
$c> :: Source -> Source -> Bool
<= :: Source -> Source -> Bool
$c<= :: Source -> Source -> Bool
< :: Source -> Source -> Bool
$c< :: Source -> Source -> Bool
compare :: Source -> Source -> Ordering
$ccompare :: Source -> Source -> Ordering
Ord, Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show)

-- | The records describes deployment task.
data Task =
  Task
    { Task -> Path Abs Dir
taskDeployPath    :: Path Abs Dir
    -- ^ The root of the deploy target on the remote host
    , Task -> Source
taskSource        :: Source
    -- ^ The 'Source' to deploy
    , Task -> ReleaseFormat
taskReleaseFormat :: ReleaseFormat
    -- ^ The 'ReleaseFormat' to use
    }
  deriving (Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
Show, Task -> Task -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c== :: Task -> Task -> Bool
Eq, Eq Task
Task -> Task -> Bool
Task -> Task -> Ordering
Task -> Task -> Task
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Task -> Task -> Task
$cmin :: Task -> Task -> Task
max :: Task -> Task -> Task
$cmax :: Task -> Task -> Task
>= :: Task -> Task -> Bool
$c>= :: Task -> Task -> Bool
> :: Task -> Task -> Bool
$c> :: Task -> Task -> Bool
<= :: Task -> Task -> Bool
$c<= :: Task -> Task -> Bool
< :: Task -> Task -> Bool
$c< :: Task -> Task -> Bool
compare :: Task -> Task -> Ordering
$ccompare :: Task -> Task -> Ordering
Ord)

-- | Release format mode.
data ReleaseFormat
  = ReleaseShort -- ^ Standard release path following Capistrano's format
  | ReleaseLong -- ^ Long release path including picoseconds
  deriving (Int -> ReleaseFormat -> ShowS
[ReleaseFormat] -> ShowS
ReleaseFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseFormat] -> ShowS
$cshowList :: [ReleaseFormat] -> ShowS
show :: ReleaseFormat -> String
$cshow :: ReleaseFormat -> String
showsPrec :: Int -> ReleaseFormat -> ShowS
$cshowsPrec :: Int -> ReleaseFormat -> ShowS
Show, ReadPrec [ReleaseFormat]
ReadPrec ReleaseFormat
Int -> ReadS ReleaseFormat
ReadS [ReleaseFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReleaseFormat]
$creadListPrec :: ReadPrec [ReleaseFormat]
readPrec :: ReadPrec ReleaseFormat
$creadPrec :: ReadPrec ReleaseFormat
readList :: ReadS [ReleaseFormat]
$creadList :: ReadS [ReleaseFormat]
readsPrec :: Int -> ReadS ReleaseFormat
$creadsPrec :: Int -> ReadS ReleaseFormat
Read, ReleaseFormat -> ReleaseFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReleaseFormat -> ReleaseFormat -> Bool
$c/= :: ReleaseFormat -> ReleaseFormat -> Bool
== :: ReleaseFormat -> ReleaseFormat -> Bool
$c== :: ReleaseFormat -> ReleaseFormat -> Bool
Eq, Eq ReleaseFormat
ReleaseFormat -> ReleaseFormat -> Bool
ReleaseFormat -> ReleaseFormat -> Ordering
ReleaseFormat -> ReleaseFormat -> ReleaseFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReleaseFormat -> ReleaseFormat -> ReleaseFormat
$cmin :: ReleaseFormat -> ReleaseFormat -> ReleaseFormat
max :: ReleaseFormat -> ReleaseFormat -> ReleaseFormat
$cmax :: ReleaseFormat -> ReleaseFormat -> ReleaseFormat
>= :: ReleaseFormat -> ReleaseFormat -> Bool
$c>= :: ReleaseFormat -> ReleaseFormat -> Bool
> :: ReleaseFormat -> ReleaseFormat -> Bool
$c> :: ReleaseFormat -> ReleaseFormat -> Bool
<= :: ReleaseFormat -> ReleaseFormat -> Bool
$c<= :: ReleaseFormat -> ReleaseFormat -> Bool
< :: ReleaseFormat -> ReleaseFormat -> Bool
$c< :: ReleaseFormat -> ReleaseFormat -> Bool
compare :: ReleaseFormat -> ReleaseFormat -> Ordering
$ccompare :: ReleaseFormat -> ReleaseFormat -> Ordering
Ord, Int -> ReleaseFormat
ReleaseFormat -> Int
ReleaseFormat -> [ReleaseFormat]
ReleaseFormat -> ReleaseFormat
ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
ReleaseFormat -> ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReleaseFormat -> ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
$cenumFromThenTo :: ReleaseFormat -> ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
enumFromTo :: ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
$cenumFromTo :: ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
enumFromThen :: ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
$cenumFromThen :: ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
enumFrom :: ReleaseFormat -> [ReleaseFormat]
$cenumFrom :: ReleaseFormat -> [ReleaseFormat]
fromEnum :: ReleaseFormat -> Int
$cfromEnum :: ReleaseFormat -> Int
toEnum :: Int -> ReleaseFormat
$ctoEnum :: Int -> ReleaseFormat
pred :: ReleaseFormat -> ReleaseFormat
$cpred :: ReleaseFormat -> ReleaseFormat
succ :: ReleaseFormat -> ReleaseFormat
$csucc :: ReleaseFormat -> ReleaseFormat
Enum, ReleaseFormat
forall a. a -> a -> Bounded a
maxBound :: ReleaseFormat
$cmaxBound :: ReleaseFormat
minBound :: ReleaseFormat
$cminBound :: ReleaseFormat
Bounded)

instance FromJSON ReleaseFormat where
  parseJSON :: Value -> Parser ReleaseFormat
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"release format" forall a b. (a -> b) -> a -> b
$ \case
      Text
"short" -> forall (m :: * -> *) a. Monad m => a -> m a
return ReleaseFormat
ReleaseShort
      Text
"long" -> forall (m :: * -> *) a. Monad m => a -> m a
return ReleaseFormat
ReleaseLong
      Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected 'short' or 'long'"

-- | Current shells supported.
data Shell
  = Bash
  | Zsh
  deriving (Int -> Shell -> ShowS
[Shell] -> ShowS
Shell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Shell] -> ShowS
$cshowList :: [Shell] -> ShowS
show :: Shell -> String
$cshow :: Shell -> String
showsPrec :: Int -> Shell -> ShowS
$cshowsPrec :: Int -> Shell -> ShowS
Show, Shell -> Shell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shell -> Shell -> Bool
$c/= :: Shell -> Shell -> Bool
== :: Shell -> Shell -> Bool
$c== :: Shell -> Shell -> Bool
Eq, Eq Shell
Shell -> Shell -> Bool
Shell -> Shell -> Ordering
Shell -> Shell -> Shell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Shell -> Shell -> Shell
$cmin :: Shell -> Shell -> Shell
max :: Shell -> Shell -> Shell
$cmax :: Shell -> Shell -> Shell
>= :: Shell -> Shell -> Bool
$c>= :: Shell -> Shell -> Bool
> :: Shell -> Shell -> Bool
$c> :: Shell -> Shell -> Bool
<= :: Shell -> Shell -> Bool
$c<= :: Shell -> Shell -> Bool
< :: Shell -> Shell -> Bool
$c< :: Shell -> Shell -> Bool
compare :: Shell -> Shell -> Ordering
$ccompare :: Shell -> Shell -> Ordering
Ord)

instance FromJSON Shell where
  parseJSON :: Value -> Parser Shell
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"shell" forall a b. (a -> b) -> a -> b
$ \case
      Text
"bash" -> forall (m :: * -> *) a. Monad m => a -> m a
return Shell
Bash
      Text
"zsh" -> forall (m :: * -> *) a. Monad m => a -> m a
return Shell
Zsh
      Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"supported shells: 'bash' or 'zsh'"

-- | SSH options.
data SshOptions =
  SshOptions
    { SshOptions -> String
sshHost :: String -- ^ Host to use
    , SshOptions -> Word
sshPort :: Word -- ^ Port to use
    , SshOptions -> [String]
sshArgs :: [String] -- ^ Arguments for ssh
    }
  deriving (Int -> SshOptions -> ShowS
[SshOptions] -> ShowS
SshOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SshOptions] -> ShowS
$cshowList :: [SshOptions] -> ShowS
show :: SshOptions -> String
$cshow :: SshOptions -> String
showsPrec :: Int -> SshOptions -> ShowS
$cshowsPrec :: Int -> SshOptions -> ShowS
Show, ReadPrec [SshOptions]
ReadPrec SshOptions
Int -> ReadS SshOptions
ReadS [SshOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SshOptions]
$creadListPrec :: ReadPrec [SshOptions]
readPrec :: ReadPrec SshOptions
$creadPrec :: ReadPrec SshOptions
readList :: ReadS [SshOptions]
$creadList :: ReadS [SshOptions]
readsPrec :: Int -> ReadS SshOptions
$creadsPrec :: Int -> ReadS SshOptions
Read, SshOptions -> SshOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SshOptions -> SshOptions -> Bool
$c/= :: SshOptions -> SshOptions -> Bool
== :: SshOptions -> SshOptions -> Bool
$c== :: SshOptions -> SshOptions -> Bool
Eq, Eq SshOptions
SshOptions -> SshOptions -> Bool
SshOptions -> SshOptions -> Ordering
SshOptions -> SshOptions -> SshOptions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SshOptions -> SshOptions -> SshOptions
$cmin :: SshOptions -> SshOptions -> SshOptions
max :: SshOptions -> SshOptions -> SshOptions
$cmax :: SshOptions -> SshOptions -> SshOptions
>= :: SshOptions -> SshOptions -> Bool
$c>= :: SshOptions -> SshOptions -> Bool
> :: SshOptions -> SshOptions -> Bool
$c> :: SshOptions -> SshOptions -> Bool
<= :: SshOptions -> SshOptions -> Bool
$c<= :: SshOptions -> SshOptions -> Bool
< :: SshOptions -> SshOptions -> Bool
$c< :: SshOptions -> SshOptions -> Bool
compare :: SshOptions -> SshOptions -> Ordering
$ccompare :: SshOptions -> SshOptions -> Ordering
Ord)

-- | Output destination.
data OutputDest
  = StdoutDest
  | StderrDest
  deriving (OutputDest -> OutputDest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputDest -> OutputDest -> Bool
$c/= :: OutputDest -> OutputDest -> Bool
== :: OutputDest -> OutputDest -> Bool
$c== :: OutputDest -> OutputDest -> Bool
Eq, Int -> OutputDest -> ShowS
[OutputDest] -> ShowS
OutputDest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputDest] -> ShowS
$cshowList :: [OutputDest] -> ShowS
show :: OutputDest -> String
$cshow :: OutputDest -> String
showsPrec :: Int -> OutputDest -> ShowS
$cshowsPrec :: Int -> OutputDest -> ShowS
Show, ReadPrec [OutputDest]
ReadPrec OutputDest
Int -> ReadS OutputDest
ReadS [OutputDest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutputDest]
$creadListPrec :: ReadPrec [OutputDest]
readPrec :: ReadPrec OutputDest
$creadPrec :: ReadPrec OutputDest
readList :: ReadS [OutputDest]
$creadList :: ReadS [OutputDest]
readsPrec :: Int -> ReadS OutputDest
$creadsPrec :: Int -> ReadS OutputDest
Read, Eq OutputDest
OutputDest -> OutputDest -> Bool
OutputDest -> OutputDest -> Ordering
OutputDest -> OutputDest -> OutputDest
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputDest -> OutputDest -> OutputDest
$cmin :: OutputDest -> OutputDest -> OutputDest
max :: OutputDest -> OutputDest -> OutputDest
$cmax :: OutputDest -> OutputDest -> OutputDest
>= :: OutputDest -> OutputDest -> Bool
$c>= :: OutputDest -> OutputDest -> Bool
> :: OutputDest -> OutputDest -> Bool
$c> :: OutputDest -> OutputDest -> Bool
<= :: OutputDest -> OutputDest -> Bool
$c<= :: OutputDest -> OutputDest -> Bool
< :: OutputDest -> OutputDest -> Bool
$c< :: OutputDest -> OutputDest -> Bool
compare :: OutputDest -> OutputDest -> Ordering
$ccompare :: OutputDest -> OutputDest -> Ordering
Ord, OutputDest
forall a. a -> a -> Bounded a
maxBound :: OutputDest
$cmaxBound :: OutputDest
minBound :: OutputDest
$cminBound :: OutputDest
Bounded, Int -> OutputDest
OutputDest -> Int
OutputDest -> [OutputDest]
OutputDest -> OutputDest
OutputDest -> OutputDest -> [OutputDest]
OutputDest -> OutputDest -> OutputDest -> [OutputDest]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OutputDest -> OutputDest -> OutputDest -> [OutputDest]
$cenumFromThenTo :: OutputDest -> OutputDest -> OutputDest -> [OutputDest]
enumFromTo :: OutputDest -> OutputDest -> [OutputDest]
$cenumFromTo :: OutputDest -> OutputDest -> [OutputDest]
enumFromThen :: OutputDest -> OutputDest -> [OutputDest]
$cenumFromThen :: OutputDest -> OutputDest -> [OutputDest]
enumFrom :: OutputDest -> [OutputDest]
$cenumFrom :: OutputDest -> [OutputDest]
fromEnum :: OutputDest -> Int
$cfromEnum :: OutputDest -> Int
toEnum :: Int -> OutputDest
$ctoEnum :: Int -> OutputDest
pred :: OutputDest -> OutputDest
$cpred :: OutputDest -> OutputDest
succ :: OutputDest -> OutputDest
$csucc :: OutputDest -> OutputDest
Enum)

-- | Release indentifier.
data Release =
  Release ReleaseFormat UTCTime
  deriving (Release -> Release -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Release -> Release -> Bool
$c/= :: Release -> Release -> Bool
== :: Release -> Release -> Bool
$c== :: Release -> Release -> Bool
Eq, Int -> Release -> ShowS
[Release] -> ShowS
Release -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Release] -> ShowS
$cshowList :: [Release] -> ShowS
show :: Release -> String
$cshow :: Release -> String
showsPrec :: Int -> Release -> ShowS
$cshowsPrec :: Int -> Release -> ShowS
Show, Eq Release
Release -> Release -> Bool
Release -> Release -> Ordering
Release -> Release -> Release
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Release -> Release -> Release
$cmin :: Release -> Release -> Release
max :: Release -> Release -> Release
$cmax :: Release -> Release -> Release
>= :: Release -> Release -> Bool
$c>= :: Release -> Release -> Bool
> :: Release -> Release -> Bool
$c> :: Release -> Release -> Bool
<= :: Release -> Release -> Bool
$c<= :: Release -> Release -> Bool
< :: Release -> Release -> Bool
$c< :: Release -> Release -> Bool
compare :: Release -> Release -> Ordering
$ccompare :: Release -> Release -> Ordering
Ord)

-- | Target's system where application will be deployed.
data TargetSystem
  = GNULinux
  | BSD
  deriving (TargetSystem -> TargetSystem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetSystem -> TargetSystem -> Bool
$c/= :: TargetSystem -> TargetSystem -> Bool
== :: TargetSystem -> TargetSystem -> Bool
$c== :: TargetSystem -> TargetSystem -> Bool
Eq, Int -> TargetSystem -> ShowS
[TargetSystem] -> ShowS
TargetSystem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetSystem] -> ShowS
$cshowList :: [TargetSystem] -> ShowS
show :: TargetSystem -> String
$cshow :: TargetSystem -> String
showsPrec :: Int -> TargetSystem -> ShowS
$cshowsPrec :: Int -> TargetSystem -> ShowS
Show, ReadPrec [TargetSystem]
ReadPrec TargetSystem
Int -> ReadS TargetSystem
ReadS [TargetSystem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TargetSystem]
$creadListPrec :: ReadPrec [TargetSystem]
readPrec :: ReadPrec TargetSystem
$creadPrec :: ReadPrec TargetSystem
readList :: ReadS [TargetSystem]
$creadList :: ReadS [TargetSystem]
readsPrec :: Int -> ReadS TargetSystem
$creadsPrec :: Int -> ReadS TargetSystem
Read, Eq TargetSystem
TargetSystem -> TargetSystem -> Bool
TargetSystem -> TargetSystem -> Ordering
TargetSystem -> TargetSystem -> TargetSystem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TargetSystem -> TargetSystem -> TargetSystem
$cmin :: TargetSystem -> TargetSystem -> TargetSystem
max :: TargetSystem -> TargetSystem -> TargetSystem
$cmax :: TargetSystem -> TargetSystem -> TargetSystem
>= :: TargetSystem -> TargetSystem -> Bool
$c>= :: TargetSystem -> TargetSystem -> Bool
> :: TargetSystem -> TargetSystem -> Bool
$c> :: TargetSystem -> TargetSystem -> Bool
<= :: TargetSystem -> TargetSystem -> Bool
$c<= :: TargetSystem -> TargetSystem -> Bool
< :: TargetSystem -> TargetSystem -> Bool
$c< :: TargetSystem -> TargetSystem -> Bool
compare :: TargetSystem -> TargetSystem -> Ordering
$ccompare :: TargetSystem -> TargetSystem -> Ordering
Ord, TargetSystem
forall a. a -> a -> Bounded a
maxBound :: TargetSystem
$cmaxBound :: TargetSystem
minBound :: TargetSystem
$cminBound :: TargetSystem
Bounded, Int -> TargetSystem
TargetSystem -> Int
TargetSystem -> [TargetSystem]
TargetSystem -> TargetSystem
TargetSystem -> TargetSystem -> [TargetSystem]
TargetSystem -> TargetSystem -> TargetSystem -> [TargetSystem]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TargetSystem -> TargetSystem -> TargetSystem -> [TargetSystem]
$cenumFromThenTo :: TargetSystem -> TargetSystem -> TargetSystem -> [TargetSystem]
enumFromTo :: TargetSystem -> TargetSystem -> [TargetSystem]
$cenumFromTo :: TargetSystem -> TargetSystem -> [TargetSystem]
enumFromThen :: TargetSystem -> TargetSystem -> [TargetSystem]
$cenumFromThen :: TargetSystem -> TargetSystem -> [TargetSystem]
enumFrom :: TargetSystem -> [TargetSystem]
$cenumFrom :: TargetSystem -> [TargetSystem]
fromEnum :: TargetSystem -> Int
$cfromEnum :: TargetSystem -> Int
toEnum :: Int -> TargetSystem
$ctoEnum :: Int -> TargetSystem
pred :: TargetSystem -> TargetSystem
$cpred :: TargetSystem -> TargetSystem
succ :: TargetSystem -> TargetSystem
$csucc :: TargetSystem -> TargetSystem
Enum)

-- | State of the deployment after running @hap deploy@.
-- __note:__ the 'Unknown' value is not intended to be
-- written to the @.hapistrano_deploy_state@ file; instead,
-- it's intended to represent whenever Hapistrano couldn't
-- get the information on the deployment state (e.g. the file is not present).
data DeployState
  = Fail
  | Success
  | Unknown
  deriving (DeployState -> DeployState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeployState -> DeployState -> Bool
$c/= :: DeployState -> DeployState -> Bool
== :: DeployState -> DeployState -> Bool
$c== :: DeployState -> DeployState -> Bool
Eq, Int -> DeployState -> ShowS
[DeployState] -> ShowS
DeployState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeployState] -> ShowS
$cshowList :: [DeployState] -> ShowS
show :: DeployState -> String
$cshow :: DeployState -> String
showsPrec :: Int -> DeployState -> ShowS
$cshowsPrec :: Int -> DeployState -> ShowS
Show, ReadPrec [DeployState]
ReadPrec DeployState
Int -> ReadS DeployState
ReadS [DeployState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeployState]
$creadListPrec :: ReadPrec [DeployState]
readPrec :: ReadPrec DeployState
$creadPrec :: ReadPrec DeployState
readList :: ReadS [DeployState]
$creadList :: ReadS [DeployState]
readsPrec :: Int -> ReadS DeployState
$creadsPrec :: Int -> ReadS DeployState
Read, Eq DeployState
DeployState -> DeployState -> Bool
DeployState -> DeployState -> Ordering
DeployState -> DeployState -> DeployState
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeployState -> DeployState -> DeployState
$cmin :: DeployState -> DeployState -> DeployState
max :: DeployState -> DeployState -> DeployState
$cmax :: DeployState -> DeployState -> DeployState
>= :: DeployState -> DeployState -> Bool
$c>= :: DeployState -> DeployState -> Bool
> :: DeployState -> DeployState -> Bool
$c> :: DeployState -> DeployState -> Bool
<= :: DeployState -> DeployState -> Bool
$c<= :: DeployState -> DeployState -> Bool
< :: DeployState -> DeployState -> Bool
$c< :: DeployState -> DeployState -> Bool
compare :: DeployState -> DeployState -> Ordering
$ccompare :: DeployState -> DeployState -> Ordering
Ord, DeployState
forall a. a -> a -> Bounded a
maxBound :: DeployState
$cmaxBound :: DeployState
minBound :: DeployState
$cminBound :: DeployState
Bounded, Int -> DeployState
DeployState -> Int
DeployState -> [DeployState]
DeployState -> DeployState
DeployState -> DeployState -> [DeployState]
DeployState -> DeployState -> DeployState -> [DeployState]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DeployState -> DeployState -> DeployState -> [DeployState]
$cenumFromThenTo :: DeployState -> DeployState -> DeployState -> [DeployState]
enumFromTo :: DeployState -> DeployState -> [DeployState]
$cenumFromTo :: DeployState -> DeployState -> [DeployState]
enumFromThen :: DeployState -> DeployState -> [DeployState]
$cenumFromThen :: DeployState -> DeployState -> [DeployState]
enumFrom :: DeployState -> [DeployState]
$cenumFrom :: DeployState -> [DeployState]
fromEnum :: DeployState -> Int
$cfromEnum :: DeployState -> Int
toEnum :: Int -> DeployState
$ctoEnum :: Int -> DeployState
pred :: DeployState -> DeployState
$cpred :: DeployState -> DeployState
succ :: DeployState -> DeployState
$csucc :: DeployState -> DeployState
Enum)

-- | Maintenance options

data MaintenanceOptions = Enable | Disable

-- | Command line options.

data Opts = Opts
  { Opts -> Command
optsCommand    :: Command
  , Opts -> String
optsConfigFile :: FilePath
  }

-- | Command to execute and command-specific options.

data Command
  = Deploy (Maybe ReleaseFormat) (Maybe Natural) Bool -- ^ Deploy a new release (with timestamp
    -- format, how many releases to keep, and whether the failed releases except the latest one
    -- get deleted or not)
  | Rollback Natural -- ^ Rollback to Nth previous release
  | Maintenance MaintenanceOptions

-- | Create a 'Release' indentifier.
mkRelease :: ReleaseFormat -> UTCTime -> Release
mkRelease :: ReleaseFormat -> UTCTime -> Release
mkRelease = ReleaseFormat -> UTCTime -> Release
Release

-- | Extract deployment time from 'Release'.
releaseTime :: Release -> UTCTime
releaseTime :: Release -> UTCTime
releaseTime (Release ReleaseFormat
_ UTCTime
time) = UTCTime
time

-- | Render 'Release' indentifier as a 'String'.
renderRelease :: Release -> String
renderRelease :: Release -> String
renderRelease (Release ReleaseFormat
rfmt UTCTime
time) = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt UTCTime
time
  where
    fmt :: String
fmt =
      case ReleaseFormat
rfmt of
        ReleaseFormat
ReleaseShort -> String
releaseFormatShort
        ReleaseFormat
ReleaseLong  -> String
releaseFormatLong

----------------------------------------------------------------------------
-- Types helpers

-- | Parse 'Release' identifier from a 'String'.
parseRelease :: String -> Maybe Release
parseRelease :: String -> Maybe Release
parseRelease String
s =
  (ReleaseFormat -> UTCTime -> Release
Release ReleaseFormat
ReleaseLong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe UTCTime
p String
releaseFormatLong String
s) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (ReleaseFormat -> UTCTime -> Release
Release ReleaseFormat
ReleaseShort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe UTCTime
p String
releaseFormatShort String
s)
  where
    p :: String -> String -> Maybe UTCTime
p = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale

releaseFormatShort, releaseFormatLong :: String
releaseFormatShort :: String
releaseFormatShort = String
"%Y%m%d%H%M%S"

releaseFormatLong :: String
releaseFormatLong = String
"%Y%m%d%H%M%S%q"

-- | Get release format based on the CLI and file configuration values.
fromMaybeReleaseFormat ::
     Maybe ReleaseFormat -> Maybe ReleaseFormat -> ReleaseFormat
fromMaybeReleaseFormat :: Maybe ReleaseFormat -> Maybe ReleaseFormat -> ReleaseFormat
fromMaybeReleaseFormat Maybe ReleaseFormat
cliRF Maybe ReleaseFormat
configRF =
  forall a. a -> Maybe a -> a
fromMaybe ReleaseFormat
ReleaseShort (Maybe ReleaseFormat
cliRF forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ReleaseFormat
configRF)

-- | Get keep releases based on the CLI and file configuration values.
fromMaybeKeepReleases :: Maybe Natural -> Maybe Natural -> Natural
fromMaybeKeepReleases :: Maybe Natural -> Maybe Natural -> Natural
fromMaybeKeepReleases Maybe Natural
cliKR Maybe Natural
configKR =
  forall a. a -> Maybe a -> a
fromMaybe Natural
defaultKeepReleases (Maybe Natural
cliKR forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Natural
configKR)

defaultKeepReleases :: Natural
defaultKeepReleases :: Natural
defaultKeepReleases = Natural
5

-- | Get the local path to copy from the 'Source' configuration value.
toMaybePath :: Source -> Maybe (Path Abs Dir)
toMaybePath :: Source -> Maybe (Path Abs Dir)
toMaybePath (LocalDirectory Path Abs Dir
path) = forall a. a -> Maybe a
Just Path Abs Dir
path
toMaybePath Source
_                     = forall a. Maybe a
Nothing