core-program 0.6.6.0 → 0.6.7.1

raw patch · 3 files changed

+126/−16 lines, 3 filesdep +githashPVP ok

version bump matches the API change (PVP)

Dependencies added: githash

API changes (from Hackage documentation)

Files

• core-program.cabal +2/−1
• lib/Core/Program/Arguments.hs +10/−4
• lib/Core/Program/Metadata.hs +114/−11

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           core-program-version:        0.6.6.0+version:        0.6.7.1 synopsis:       Opinionated Haskell Interoperability description:    A library to help build command-line programs, both tools and                 longer-running daemons.@@ -63,6 +63,7 @@     , exceptions     , filepath     , fsnotify+    , githash     , hashable >=1.2     , hourglass     , mtl

@@ -1003,7 +1003,13 @@  buildVersion :: Version -> Doc ann buildVersion version =-    pretty (projectNameFrom version)-        <+> "v"-            <> pretty (versionNumberFrom version)-            <> hardline+    let+        project = projectNameFrom version+        number = versionNumberFrom version+        description = gitDescriptionFrom version+    in+        pretty project+            <+> pretty number+                <> if null description+                    then hardline+                    else "," <+> pretty description <> hardline

@@ -1,4 +1,6 @@ {-# LANGUAGE DeriveLift #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}@@ -13,6 +15,9 @@     , versionNumberFrom     , projectNameFrom     , projectSynopsisFrom+    , gitHashFrom+    , gitDescriptionFrom+    , gitBranchFrom        -- * Splice     , fromPackage@@ -21,14 +26,14 @@     , __LOCATION__     ) where -import Core.Data+import Core.Data.Structures import Core.System.Base (IOMode (..), withFile) import Core.System.Pretty import Core.Text-import qualified Data.List as List (find, isSuffixOf)-import Data.Maybe (fromMaybe)+import Data.List qualified as List (find, isSuffixOf) import Data.String import GHC.Stack (HasCallStack, SrcLoc (..), callStack, getCallStack)+import GitHash import Language.Haskell.TH (Q, runIO) import Language.Haskell.TH.Syntax (Exp (..), Lift) import System.Directory (listDirectory)@@ -54,16 +59,29 @@ For more complex usage you can populate a 'Version' object using the 'fromPackage' splice below. You can then call various accessors like 'versionNumberFrom' to access individual fields.++@since 0.6.7 -} data Version = Version     { projectNameFrom :: String     , projectSynopsisFrom :: String     , versionNumberFrom :: String+    , gitHashFrom :: String+    , gitDescriptionFrom :: String+    , gitBranchFrom :: String     }     deriving (Show, Lift)  emptyVersion :: Version-emptyVersion = Version "" "" "0"+emptyVersion =+    Version+        { projectNameFrom = ""+        , projectSynopsisFrom = ""+        , versionNumberFrom = "0"+        , gitHashFrom = ""+        , gitDescriptionFrom = ""+        , gitBranchFrom = ""+        }  instance IsString Version where     fromString x = emptyVersion {versionNumberFrom = x}@@ -88,30 +106,85 @@ @ \{\-\# LANGUAGE TemplateHaskell \#\-\} -version :: 'Version' version = $('fromPackage')+version :: 'Version'+version = $('fromPackage')  main :: 'IO' () main = do     context <- 'Core.Program.Execute.configure' version 'Core.Program.Execute.None' ('Core.Program.Arguments.simpleConfig' ...+    'Core.Program.Execute.executeWith' context program++program :: 'Core.Program.Execute.Program' 'Core.Program.Execute.None' ()+program = do+    ... @ -(Using Template Haskell slows down compilation of this file, but the upside of-this technique is that it avoids linking the Haskell build machinery into your-executable, saving you about 10 MB in the size of the resultant binary)+In addition to metadata from the Haskell package, we also extract information+from the Git repository the code was built within, if applicable. When the+program is built within a source code checkout (as is typical in continuous+integration & continuous deployment systems) then the repository is queried+for the SHA1 hash, branch name, and for whether the checkout is clean.++The resultant @--version@ output might look like the following:++@+\$ __ping --version__+ip-utils v2.0.1.9, f18ec7b+@++If, on the other hand, you had been developing locally you'll see this:++@+\$ __ping --version__+ip-utils v2.0.1.9, f18ec7b (dirty)+@++signifying that there are uncommitted files in your local tree.++If you are building the program from a relese tarball, this mechanism will+omit reporting any information about the state of a Git repository as it is+not to hand.++@since 0.6.7 -} fromPackage :: Q Exp fromPackage = do     pairs <- readCabalFile -    let name = fromMaybe "" . lookupKeyValue "name" $ pairs-    let synopsis = fromMaybe "" . lookupKeyValue "synopsis" $ pairs-    let version = fromMaybe "" . lookupKeyValue "version" $ pairs+    let name = case lookupKeyValue "name" pairs of+            Nothing -> ""+            Just value -> value+    let synopsis = case lookupKeyValue "synopsis" pairs of+            Nothing -> ""+            Just value -> value+    let version = case lookupKeyValue "version" pairs of+            Nothing -> ""+            Just value -> "v" <> value +    possibleInfo <- readGitRepository++    let full = case possibleInfo of+            Nothing -> ""+            Just info -> giHash info+    let short = case possibleInfo of+            Nothing -> ""+            Just info ->+                let short' = take 7 (giHash info)+                in  if giDirty info+                        then short' ++ " (dirty)"+                        else short'+    let branch = case possibleInfo of+            Nothing -> ""+            Just info -> giBranch info+     let result =             Version                 { projectNameFrom = fromRope name                 , projectSynopsisFrom = fromRope synopsis                 , versionNumberFrom = fromRope version+                , gitHashFrom = full+                , gitDescriptionFrom = short+                , gitBranchFrom = branch                 }      --  I would have preferred@@ -191,6 +264,8 @@ This isn't the full stack trace, just information about the current line. If you want more comprehensive stack trace you need to add 'HasCallStack' constraints everywhere, and then...++@since 0.4.3 -}  -- This works because the call stack has the most recent frame at the head of@@ -225,3 +300,31 @@         pretty (srcLocFile loc)             <> ":"             <> pretty (show (srcLocStartLine loc))++{- |+Information about the revision from which this piece of software was built.+The most useful field here is the \"short\", human-readable for via+'gitShortFrom', which can be used augment telemetry, for example.++@since 0.6.7+-}++{- |+This is a splice which extracts a 'Commit' object based on the repository in+which the build was run. Like the 'fromPackage' splice, this also uses the+evil @TemplateHaskell@ extension.++Note that if the application was compiled was done using a release tarball and+not built from source the values returned will be empty placeholders.++@since 0.6.7+-}+readGitRepository :: Q (Maybe GitInfo)+readGitRepository = do+    runIO $ do+        getGitRoot "." >>= \case+            Left _ -> pure Nothing+            Right path -> do+                getGitInfo path >>= \case+                    Left _ -> pure Nothing+                    Right value -> pure (Just value)