-- |
-- Module      :  System.Hapistrano.Types
-- Copyright   :  © 2015-Present Stack Builders
-- License     :  MIT
--
-- Maintainer  :  Juan Paucar <jpaucar@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Type definitions for the Hapistrano tool.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

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

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

-- | Hapistrano monad.
type Hapistrano a = ExceptT Failure (ReaderT Config IO) a

-- | Failure with status code and a message.
data Failure =
  Failure Int (Maybe String)

-- | 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
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
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
Eq Source
-> (Source -> Source -> Ordering)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Source)
-> (Source -> Source -> Source)
-> Ord 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
$cp1Ord :: Eq Source
Ord, Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
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
(Int -> Task -> ShowS)
-> (Task -> String) -> ([Task] -> ShowS) -> Show Task
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
(Task -> Task -> Bool) -> (Task -> Task -> Bool) -> Eq Task
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
Eq Task
-> (Task -> Task -> Ordering)
-> (Task -> Task -> Bool)
-> (Task -> Task -> Bool)
-> (Task -> Task -> Bool)
-> (Task -> Task -> Bool)
-> (Task -> Task -> Task)
-> (Task -> Task -> Task)
-> Ord 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
$cp1Ord :: Eq Task
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
(Int -> ReleaseFormat -> ShowS)
-> (ReleaseFormat -> String)
-> ([ReleaseFormat] -> ShowS)
-> Show ReleaseFormat
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]
(Int -> ReadS ReleaseFormat)
-> ReadS [ReleaseFormat]
-> ReadPrec ReleaseFormat
-> ReadPrec [ReleaseFormat]
-> Read 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
(ReleaseFormat -> ReleaseFormat -> Bool)
-> (ReleaseFormat -> ReleaseFormat -> Bool) -> Eq ReleaseFormat
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
Eq ReleaseFormat
-> (ReleaseFormat -> ReleaseFormat -> Ordering)
-> (ReleaseFormat -> ReleaseFormat -> Bool)
-> (ReleaseFormat -> ReleaseFormat -> Bool)
-> (ReleaseFormat -> ReleaseFormat -> Bool)
-> (ReleaseFormat -> ReleaseFormat -> Bool)
-> (ReleaseFormat -> ReleaseFormat -> ReleaseFormat)
-> (ReleaseFormat -> ReleaseFormat -> ReleaseFormat)
-> Ord 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
$cp1Ord :: Eq ReleaseFormat
Ord, Int -> ReleaseFormat
ReleaseFormat -> Int
ReleaseFormat -> [ReleaseFormat]
ReleaseFormat -> ReleaseFormat
ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
ReleaseFormat -> ReleaseFormat -> ReleaseFormat -> [ReleaseFormat]
(ReleaseFormat -> ReleaseFormat)
-> (ReleaseFormat -> ReleaseFormat)
-> (Int -> ReleaseFormat)
-> (ReleaseFormat -> Int)
-> (ReleaseFormat -> [ReleaseFormat])
-> (ReleaseFormat -> ReleaseFormat -> [ReleaseFormat])
-> (ReleaseFormat -> ReleaseFormat -> [ReleaseFormat])
-> (ReleaseFormat
    -> ReleaseFormat -> ReleaseFormat -> [ReleaseFormat])
-> Enum 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
ReleaseFormat -> ReleaseFormat -> Bounded 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 =
    String
-> (Text -> Parser ReleaseFormat) -> Value -> Parser ReleaseFormat
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"release format" ((Text -> Parser ReleaseFormat) -> Value -> Parser ReleaseFormat)
-> (Text -> Parser ReleaseFormat) -> Value -> Parser ReleaseFormat
forall a b. (a -> b) -> a -> b
$ \case
      Text
"short" -> ReleaseFormat -> Parser ReleaseFormat
forall (m :: * -> *) a. Monad m => a -> m a
return ReleaseFormat
ReleaseShort
      Text
"long" -> ReleaseFormat -> Parser ReleaseFormat
forall (m :: * -> *) a. Monad m => a -> m a
return ReleaseFormat
ReleaseLong
      Text
_ -> String -> Parser ReleaseFormat
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
(Int -> Shell -> ShowS)
-> (Shell -> String) -> ([Shell] -> ShowS) -> Show Shell
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
(Shell -> Shell -> Bool) -> (Shell -> Shell -> Bool) -> Eq Shell
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
Eq Shell
-> (Shell -> Shell -> Ordering)
-> (Shell -> Shell -> Bool)
-> (Shell -> Shell -> Bool)
-> (Shell -> Shell -> Bool)
-> (Shell -> Shell -> Bool)
-> (Shell -> Shell -> Shell)
-> (Shell -> Shell -> Shell)
-> Ord 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
$cp1Ord :: Eq Shell
Ord)

instance FromJSON Shell where
  parseJSON :: Value -> Parser Shell
parseJSON =
    String -> (Text -> Parser Shell) -> Value -> Parser Shell
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"shell" ((Text -> Parser Shell) -> Value -> Parser Shell)
-> (Text -> Parser Shell) -> Value -> Parser Shell
forall a b. (a -> b) -> a -> b
$ \case
      Text
"bash" -> Shell -> Parser Shell
forall (m :: * -> *) a. Monad m => a -> m a
return Shell
Bash
      Text
"zsh" -> Shell -> Parser Shell
forall (m :: * -> *) a. Monad m => a -> m a
return Shell
Zsh
      Text
_ -> String -> Parser Shell
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
(Int -> SshOptions -> ShowS)
-> (SshOptions -> String)
-> ([SshOptions] -> ShowS)
-> Show SshOptions
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]
(Int -> ReadS SshOptions)
-> ReadS [SshOptions]
-> ReadPrec SshOptions
-> ReadPrec [SshOptions]
-> Read 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
(SshOptions -> SshOptions -> Bool)
-> (SshOptions -> SshOptions -> Bool) -> Eq SshOptions
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
Eq SshOptions
-> (SshOptions -> SshOptions -> Ordering)
-> (SshOptions -> SshOptions -> Bool)
-> (SshOptions -> SshOptions -> Bool)
-> (SshOptions -> SshOptions -> Bool)
-> (SshOptions -> SshOptions -> Bool)
-> (SshOptions -> SshOptions -> SshOptions)
-> (SshOptions -> SshOptions -> SshOptions)
-> Ord 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
$cp1Ord :: Eq SshOptions
Ord)

-- | Output destination.
data OutputDest
  = StdoutDest
  | StderrDest
  deriving (OutputDest -> OutputDest -> Bool
(OutputDest -> OutputDest -> Bool)
-> (OutputDest -> OutputDest -> Bool) -> Eq OutputDest
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
(Int -> OutputDest -> ShowS)
-> (OutputDest -> String)
-> ([OutputDest] -> ShowS)
-> Show OutputDest
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]
(Int -> ReadS OutputDest)
-> ReadS [OutputDest]
-> ReadPrec OutputDest
-> ReadPrec [OutputDest]
-> Read 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
Eq OutputDest
-> (OutputDest -> OutputDest -> Ordering)
-> (OutputDest -> OutputDest -> Bool)
-> (OutputDest -> OutputDest -> Bool)
-> (OutputDest -> OutputDest -> Bool)
-> (OutputDest -> OutputDest -> Bool)
-> (OutputDest -> OutputDest -> OutputDest)
-> (OutputDest -> OutputDest -> OutputDest)
-> Ord 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
$cp1Ord :: Eq OutputDest
Ord, OutputDest
OutputDest -> OutputDest -> Bounded 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]
(OutputDest -> OutputDest)
-> (OutputDest -> OutputDest)
-> (Int -> OutputDest)
-> (OutputDest -> Int)
-> (OutputDest -> [OutputDest])
-> (OutputDest -> OutputDest -> [OutputDest])
-> (OutputDest -> OutputDest -> [OutputDest])
-> (OutputDest -> OutputDest -> OutputDest -> [OutputDest])
-> Enum 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
(Release -> Release -> Bool)
-> (Release -> Release -> Bool) -> Eq Release
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
(Int -> Release -> ShowS)
-> (Release -> String) -> ([Release] -> ShowS) -> Show Release
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
Eq Release
-> (Release -> Release -> Ordering)
-> (Release -> Release -> Bool)
-> (Release -> Release -> Bool)
-> (Release -> Release -> Bool)
-> (Release -> Release -> Bool)
-> (Release -> Release -> Release)
-> (Release -> Release -> Release)
-> Ord 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
$cp1Ord :: Eq Release
Ord)

-- | Target's system where application will be deployed
data TargetSystem
  = GNULinux
  | BSD
  deriving (TargetSystem -> TargetSystem -> Bool
(TargetSystem -> TargetSystem -> Bool)
-> (TargetSystem -> TargetSystem -> Bool) -> Eq TargetSystem
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
(Int -> TargetSystem -> ShowS)
-> (TargetSystem -> String)
-> ([TargetSystem] -> ShowS)
-> Show TargetSystem
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]
(Int -> ReadS TargetSystem)
-> ReadS [TargetSystem]
-> ReadPrec TargetSystem
-> ReadPrec [TargetSystem]
-> Read 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
Eq TargetSystem
-> (TargetSystem -> TargetSystem -> Ordering)
-> (TargetSystem -> TargetSystem -> Bool)
-> (TargetSystem -> TargetSystem -> Bool)
-> (TargetSystem -> TargetSystem -> Bool)
-> (TargetSystem -> TargetSystem -> Bool)
-> (TargetSystem -> TargetSystem -> TargetSystem)
-> (TargetSystem -> TargetSystem -> TargetSystem)
-> Ord 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
$cp1Ord :: Eq TargetSystem
Ord, TargetSystem
TargetSystem -> TargetSystem -> Bounded 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]
(TargetSystem -> TargetSystem)
-> (TargetSystem -> TargetSystem)
-> (Int -> TargetSystem)
-> (TargetSystem -> Int)
-> (TargetSystem -> [TargetSystem])
-> (TargetSystem -> TargetSystem -> [TargetSystem])
-> (TargetSystem -> TargetSystem -> [TargetSystem])
-> (TargetSystem -> TargetSystem -> TargetSystem -> [TargetSystem])
-> Enum 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)

-- | 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) = TimeLocale -> String -> UTCTime -> String
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 (UTCTime -> Release) -> Maybe UTCTime -> Maybe Release
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe UTCTime
p String
releaseFormatLong String
s) Maybe Release -> Maybe Release -> Maybe Release
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (ReleaseFormat -> UTCTime -> Release
Release ReleaseFormat
ReleaseShort (UTCTime -> Release) -> Maybe UTCTime -> Maybe Release
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 = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
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 =
  ReleaseFormat -> Maybe ReleaseFormat -> ReleaseFormat
forall a. a -> Maybe a -> a
fromMaybe ReleaseFormat
ReleaseShort (Maybe ReleaseFormat
cliRF Maybe ReleaseFormat -> Maybe ReleaseFormat -> Maybe ReleaseFormat
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 =
  Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
defaultKeepReleases (Maybe Natural
cliKR Maybe Natural -> Maybe Natural -> Maybe Natural
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) = Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
path
toMaybePath Source
_                     = Maybe (Path Abs Dir)
forall a. Maybe a
Nothing