Merge pull request #87 from stackbuilders/version_details

When showing version information also show git branch and commit

CHANGELOG.md

@@ -1,3 +1,7 @@
+## 0.3.5.1
+* Standarize style
+* When showing version information also show git branch and commit
+
 ## 0.3.5.0
 * Add support for deploying to other Unix systems, besides GNU/Linux which
   didn't supported all the flags that Hapistrano was using. See issue #63

app/Config.hs

@@ -9,41 +9,41 @@ module Config
   , CopyThing (..) )
 where
 
-import Data.Aeson
-import Data.Function (on)
-import Data.List (nubBy)
-import Data.Maybe (maybeToList)
-import Data.Yaml
-import Path
-import System.Hapistrano.Commands
-import System.Hapistrano.Types (TargetSystem(..))
+import           Data.Aeson
+import           Data.Function              (on)
+import           Data.List                  (nubBy)
+import           Data.Maybe                 (maybeToList)
+import           Data.Yaml
+import           Path
+import           System.Hapistrano.Commands
+import           System.Hapistrano.Types    (TargetSystem (..))
 
 -- | Hapistrano configuration typically loaded from @hap.yaml@ file.
 
 data Config = Config
-  { configDeployPath :: !(Path Abs Dir)
+  { configDeployPath     :: !(Path Abs Dir)
     -- ^ Top-level deploy directory on target machine
-  , configHosts :: ![(String, Word)]
+  , configHosts          :: ![(String, Word)]
     -- ^ Hosts\/ports to deploy to. If empty, localhost will be assumed.
-  , configRepo :: !String
+  , configRepo           :: !String
     -- ^ Location of repository that contains the source code to deploy
-  , configRevision :: !String
+  , configRevision       :: !String
     -- ^ Revision to use
   , configRestartCommand :: !(Maybe GenericCommand)
     -- ^ The command to execute when switching to a different release
     -- (usually after a deploy or rollback).
-  , configBuildScript :: !(Maybe [GenericCommand])
+  , configBuildScript    :: !(Maybe [GenericCommand])
     -- ^ Build script to execute to build the project
-  , configCopyFiles :: ![CopyThing]
+  , configCopyFiles      :: ![CopyThing]
     -- ^ Collection of files to copy over to target machine before building
-  , configCopyDirs :: ![CopyThing]
+  , configCopyDirs       :: ![CopyThing]
     -- ^ Collection of directories to copy over to target machine before building
-  , configVcAction :: !Bool
+  , configVcAction       :: !Bool
   -- ^ Perform version control related actions. By default, it's assumed to be True.
-  , configRunLocally :: !(Maybe [GenericCommand])
+  , configRunLocally     :: !(Maybe [GenericCommand])
   -- ^ Perform a series of commands on the local machine before communication
   -- with target server starts
-  , configTargetSystem :: !TargetSystem
+  , configTargetSystem   :: !TargetSystem
   -- ^ Optional parameter to specify the target system. It's GNU/Linux by
   -- default
   } deriving (Eq, Ord, Show)
@@ -93,5 +93,5 @@ instance FromJSON TargetSystem where
 mkCmd :: String -> Parser GenericCommand
 mkCmd raw =
   case mkGenericCommand raw of
-    Nothing -> fail "invalid restart command"
+    Nothing  -> fail "invalid restart command"
     Just cmd -> return cmd

app/Main.hs

@@ -1,30 +1,29 @@
-{-# LANGUAGE CPP             #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module Main (main) where
 
-import Control.Concurrent.Async
-import Control.Concurrent.STM
-import Control.Monad
-import Data.Monoid ((<>))
-import Data.Version (showVersion)
-import Numeric.Natural
-import Options.Applicative hiding (str)
-import Path
-import Path.IO
-import Paths_hapistrano (version)
-import System.Exit
-import System.Hapistrano.Types
-import System.IO
 import qualified Config                     as C
+import           Control.Concurrent.Async
+import           Control.Concurrent.STM
+import           Control.Monad
+import           Data.Monoid                ((<>))
+import           Data.Version               (showVersion)
 import qualified Data.Yaml                  as Yaml
+import           Development.GitRev
+import           Formatting
+import           Numeric.Natural
+import           Options.Applicative        hiding (str)
+import           Path
+import           Path.IO
+import           Paths_hapistrano           (version)
+import           System.Exit
 import qualified System.Hapistrano          as Hap
 import qualified System.Hapistrano.Commands as Hap
 import qualified System.Hapistrano.Core     as Hap
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
+import           System.Hapistrano.Types
+import           System.IO
 
 ----------------------------------------------------------------------------
 -- Command line options
@@ -32,7 +31,7 @@ import Control.Applicative
 -- | Command line options.
 
 data Opts = Opts
-  { optsCommand :: Command
+  { optsCommand    :: Command
   , optsConfigFile :: FilePath
   }
 
@@ -51,10 +50,15 @@ parserInfo =
      header "Hapistrano - A deployment library for Haskell applications")
   where
     versionOption :: Parser (a -> a)
-    versionOption =
-      infoOption
+    versionOption = infoOption
+      (formatToString
+        ("Hapistrano: "% string
+          % "\nbranch: " % string
+          % "\nrevision: " % string)
         (showVersion version)
-        (long "version" <> short 'v' <> help "Show version of the program")
+        $(gitBranch)
+        $(gitHash))
+      (long "version" <> short 'v' <> help "Show version information")
 
 optionParser :: Parser Opts
 optionParser = Opts
@@ -176,8 +180,8 @@ main = do
               xs ->
                 let f (host, port) = SshOptions host port
                 in hap . Just . f <$> xs
-      results <- (runConcurrently . sequenceA . fmap Concurrently)
+      results <- (runConcurrently . traverse Concurrently)
         ((Right () <$ printer (length haps)) : haps)
       case sequence_ results of
-        Left n -> exitWith (ExitFailure n)
+        Left n   -> exitWith (ExitFailure n)
         Right () -> putStrLn "Success."

hapistrano.cabal

@@ -1,5 +1,5 @@
 name:                hapistrano
-version:             0.3.5.0
+version:             0.3.5.1
 synopsis:            A deployment library for Haskell applications
 description:
   .
@@ -45,6 +45,8 @@ library
                      , System.Hapistrano.Types
   build-depends:       base               >= 4.8 && < 5.0
                      , filepath           >= 1.2 && < 1.5
+                     , formatting         >= 6.2 && < 7.0
+                     , gitrev             >= 1.2 && < 1.4
                      , mtl                >= 2.0 && < 3.0
                      , path               >= 0.5 && < 0.7
                      , process            >= 1.4 && < 1.7
@@ -64,6 +66,8 @@ executable hap
   build-depends:       aeson              >= 0.11 && < 1.3
                      , async              >= 2.0.1.6 && < 2.2
                      , base               >= 4.8 && < 5.0
+                     , formatting         >= 6.2 && < 7.0
+                     , gitrev             >= 1.2 && < 1.4
                      , hapistrano
                      , optparse-applicative >= 0.11 && < 0.15
                      , path               >= 0.5 && < 0.7

spec/System/HapistranoSpec.hs

@@ -4,19 +4,19 @@ module System.HapistranoSpec
   ( spec )
 where
 
-import Control.Monad
-import Control.Monad.Reader
-import Path
-import Path.IO
-import Data.Maybe (catMaybes)
-import System.Hapistrano.Types
-import System.Info (os)
-import System.IO
-import Test.Hspec hiding (shouldBe, shouldReturn)
-import qualified System.Hapistrano as Hap
+import           Control.Monad
+import           Control.Monad.Reader
+import           Data.Maybe                 (catMaybes)
+import           Path
+import           Path.IO
+import qualified System.Hapistrano          as Hap
 import qualified System.Hapistrano.Commands as Hap
-import qualified System.Hapistrano.Core as Hap
-import qualified Test.Hspec as Hspec
+import qualified System.Hapistrano.Core     as Hap
+import           System.Hapistrano.Types
+import           System.Info                (os)
+import           System.IO
+import           Test.Hspec                 hiding (shouldBe, shouldReturn)
+import qualified Test.Hspec                 as Hspec
 
 testBranchName :: String
 testBranchName = "another_branch"

src/System/Hapistrano.hs

@@ -30,18 +30,18 @@ module System.Hapistrano
   , ctokenPath )
 where
 
-import Control.Monad
-import Control.Monad.Except
-import Data.List (genericDrop, dropWhileEnd, sortBy)
-import Data.Maybe (mapMaybe)
-import Data.Ord (comparing, Down (..))
-import Data.Time
-import Numeric.Natural
-import Path
-import System.Hapistrano.Commands
-import System.Hapistrano.Core
-import System.Hapistrano.Types
-import Control.Monad.Reader (local)
+import           Control.Monad
+import           Control.Monad.Except
+import           Control.Monad.Reader       (local)
+import           Data.List                  (dropWhileEnd, genericDrop, sortBy)
+import           Data.Maybe                 (mapMaybe)
+import           Data.Ord                   (Down (..), comparing)
+import           Data.Time
+import           Numeric.Natural
+import           Path
+import           System.Hapistrano.Commands
+import           System.Hapistrano.Core
+import           System.Hapistrano.Types
 
 ----------------------------------------------------------------------------
 -- High-level functionality
@@ -251,7 +251,7 @@ releasePath
 releasePath deployPath release = do
   let rendered = renderRelease release
   case parseRelDir rendered of
-    Nothing -> failWith 1 (Just $ "Could not append path: " ++ rendered)
+    Nothing    -> failWith 1 (Just $ "Could not append path: " ++ rendered)
     Just rpath -> return (releasesPath deployPath </> rpath)
 
 -- | Return the full path to the git repo used for cache purposes on the
@@ -292,7 +292,7 @@ ctokenPath
 ctokenPath deployPath release = do
   let rendered = renderRelease release
   case parseRelFile rendered of
-    Nothing -> failWith 1 (Just $ "Could not append path: " ++ rendered)
+    Nothing    -> failWith 1 (Just $ "Could not append path: " ++ rendered)
     Just rpath -> return (ctokensPath deployPath </> rpath)
 
 stripDirs :: Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]

src/System/Hapistrano/Commands.hs

@@ -37,15 +37,15 @@ module System.Hapistrano.Commands
   , readScript )
 where
 
-import Control.Monad.IO.Class
-import Data.Char (isSpace)
-import Data.List (dropWhileEnd)
-import Data.Maybe (catMaybes, mapMaybe, fromJust)
-import Data.Proxy
-import Numeric.Natural
-import Path
+import           Control.Monad.IO.Class
+import           Data.Char               (isSpace)
+import           Data.List               (dropWhileEnd)
+import           Data.Maybe              (catMaybes, fromJust, mapMaybe)
+import           Data.Proxy
+import           Numeric.Natural
+import           Path
 
-import System.Hapistrano.Types (TargetSystem(..))
+import           System.Hapistrano.Types (TargetSystem (..))
 
 ----------------------------------------------------------------------------
 -- Commands
@@ -231,7 +231,7 @@ instance Command GitClone where
     [ Just "clone"
     , if bare then Just "--bare" else Nothing
     , Just (case src of
-       Left repoUrl -> repoUrl
+       Left repoUrl  -> repoUrl
        Right srcPath -> fromAbsDir srcPath)
     , Just (fromAbsDir dest) ]
   parseResult Proxy _ = ()

src/System/Hapistrano/Core.hs

@@ -22,15 +22,15 @@ module System.Hapistrano.Core
   , scpDir )
 where
 
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.Reader
-import Data.Proxy
-import Path
-import System.Exit
-import System.Hapistrano.Commands
-import System.Hapistrano.Types
-import System.Process
+import           Control.Monad
+import           Control.Monad.Except
+import           Control.Monad.Reader
+import           Data.Proxy
+import           Path
+import           System.Exit
+import           System.Hapistrano.Commands
+import           System.Hapistrano.Types
+import           System.Process
 
 -- | Run the 'Hapistrano' monad. The monad hosts 'exec' actions.
 
@@ -106,7 +106,7 @@ scp' src dest extraArgs = do
       hostPrefix =
         case sshHost <$> configSshOptions of
           Nothing -> ""
-          Just x -> x ++ ":"
+          Just x  -> x ++ ":"
       args = extraArgs ++ portArg ++ [src, hostPrefix ++ dest]
   void (exec' prog args (prog ++ " " ++ unwords args))
 

src/System/Hapistrano/Types.hs

@@ -25,11 +25,11 @@ module System.Hapistrano.Types
   , parseRelease )
 where
 
-import Control.Applicative
-import Control.Monad.Except
-import Control.Monad.Reader
-import Data.Time
-import Path
+import           Control.Applicative
+import           Control.Monad.Except
+import           Control.Monad.Reader
+import           Data.Time
+import           Path
 
 -- | Hapistrano monad.
 
@@ -44,18 +44,18 @@ data Failure = Failure Int (Maybe String)
 data Config = Config
   { configSshOptions :: !(Maybe SshOptions)
     -- ^ 'Nothing' if we are running locally, or SSH options to use.
-  , configPrint :: !(OutputDest -> String -> IO ())
+  , configPrint      :: !(OutputDest -> String -> IO ())
     -- ^ How to print messages
   }
 
 -- | The records describes deployment task.
 
 data Task = Task
-  { taskDeployPath :: Path Abs Dir
+  { taskDeployPath    :: Path Abs Dir
     -- ^ The root of the deploy target on the remote host
-  , taskRepository :: String
+  , taskRepository    :: String
     -- ^ The URL of remote Git repo to deploy
-  , taskRevision :: String
+  , taskRevision      :: String
     -- ^ A SHA1 or branch to release
   , taskReleaseFormat :: ReleaseFormat
     -- ^ The 'ReleaseFormat' to use

stack.yaml

@@ -1,3 +1,3 @@
-resolver: lts-9.0
+resolver: lts-9.20
 packages:
 - '.'