{-# LANGUAGE OverloadedStrings #-}
module System.Hapistrano.Types
( Hapistrano
, Failure (..)
, Config (..)
, Task (..)
, ReleaseFormat(..)
, SshOptions (..)
, OutputDest (..)
, Release
, TargetSystem(..)
, mkRelease
, releaseTime
, renderRelease
, parseRelease
, fromMaybeReleaseFormat
, fromMaybeKeepReleases )
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
type Hapistrano a = ExceptT Failure (ReaderT Config IO) a
data Failure = Failure Int (Maybe String)
data Config = Config
{ configSshOptions :: !(Maybe SshOptions)
, configPrint :: !(OutputDest -> String -> IO ())
}
data Task = Task
{ taskDeployPath :: Path Abs Dir
, taskRepository :: String
, taskRevision :: String
, taskReleaseFormat :: ReleaseFormat
} deriving (Show, Eq, Ord)
data ReleaseFormat
= ReleaseShort
| ReleaseLong
deriving (Show, Read, Eq, Ord, Enum, Bounded)
instance FromJSON ReleaseFormat where
parseJSON = withText "release format" $ \t ->
case t of
"short" -> return ReleaseShort
"long" -> return ReleaseLong
_ -> fail "expected 'short' or 'long'"
data SshOptions = SshOptions
{ sshHost :: String
, sshPort :: Word
} deriving (Show, Read, Eq, Ord)
data OutputDest
= StdoutDest
| StderrDest
deriving (Eq, Show, Read, Ord, Bounded, Enum)
data Release = Release ReleaseFormat UTCTime
deriving (Eq, Show, Ord)
data TargetSystem
= GNULinux
| BSD
deriving (Eq, Show, Read, Ord, Bounded, Enum)
mkRelease :: ReleaseFormat -> UTCTime -> Release
mkRelease = Release
releaseTime :: Release -> UTCTime
releaseTime (Release _ time) = time
renderRelease :: Release -> String
renderRelease (Release rfmt time) = formatTime defaultTimeLocale fmt time
where
fmt = case rfmt of
ReleaseShort -> releaseFormatShort
ReleaseLong -> releaseFormatLong
parseRelease :: String -> Maybe Release
parseRelease s = (Release ReleaseLong <$> p releaseFormatLong s)
<|> (Release ReleaseShort <$> p releaseFormatShort s)
where
p = parseTimeM False defaultTimeLocale
releaseFormatShort, releaseFormatLong :: String
releaseFormatShort = "%Y%m%d%H%M%S"
releaseFormatLong = "%Y%m%d%H%M%S%q"
fromMaybeReleaseFormat :: Maybe ReleaseFormat -> Maybe ReleaseFormat -> ReleaseFormat
fromMaybeReleaseFormat cliRF configRF = fromMaybe ReleaseShort (cliRF <|> configRF)
fromMaybeKeepReleases :: Maybe Natural -> Maybe Natural -> Natural
fromMaybeKeepReleases cliKR configKR = fromMaybe defaultKeepReleases (cliKR <|> configKR)
defaultKeepReleases :: Natural
defaultKeepReleases = 5