Copyright | (c) 2025 Thomas Bidne |
---|---|
License | BSD3 |
Maintainer | tbidne@protonmail.com |
Safe Haskell | None |
Language | Haskell2010 |
Development.GitRev.Typed.OsString
Description
Development.GitRev.Typed for OsString
.
Since: 0.1
Synopsis
- gitBranch :: Code Q OsString
- gitCommitCount :: Code Q OsString
- gitCommitDate :: Code Q OsString
- gitDescribe :: Code Q OsString
- gitDiff :: Code Q OsString
- gitDirty :: Code Q Bool
- gitDirtyTracked :: Code Q Bool
- gitHash :: Code Q OsString
- gitShortHash :: Code Q OsString
- gitTree :: Code Q OsString
- gitBranchQ :: Q (Either GitError OsString)
- gitCommitCountQ :: Q (Either GitError OsString)
- gitCommitDateQ :: Q (Either GitError OsString)
- gitDescribeQ :: Q (Either GitError OsString)
- gitDiffQ :: Q (Either GitError OsString)
- gitDirtyQ :: Q (Either GitError Bool)
- gitDirtyTrackedQ :: Q (Either GitError Bool)
- gitHashQ :: Q (Either GitError OsString)
- gitShortHashQ :: Q (Either GitError OsString)
- gitTreeQ :: Q (Either GitError OsString)
- runGitQ :: [OsString] -> IndexUsed -> Q (Either GitError OsString)
- runGitPostProcessQ :: (OsString -> OsString) -> [OsString] -> IndexUsed -> Q (Either GitError OsString)
- data IndexUsed
- envValQ :: OsString -> Q (Either EnvError OsString)
- runInEnvDirQ :: OsString -> Q a -> Q (Either EnvError a)
- runGitInEnvDirQ :: OsString -> Q (Either GitError a) -> Q (Either GitRevError a)
- withEnvValQ :: OsString -> (OsString -> Q a) -> Q (Either EnvError a)
- qToCode :: Lift a => Q a -> Code Q a
- data QFirst e a
- mkQFirst :: Q (Either e a) -> QFirst e a
- unQFirst :: QFirst e a -> Q (Either (Errors e) a)
- firstSuccessQ :: NonEmpty (Q (Either e a)) -> Q (Either (Errors e) a)
- data Errors e
- mkErrors :: NonEmpty e -> Errors e
- unErrors :: Errors e -> NonEmpty e
- projectStringUnknown :: Functor f => f (Either e OsString) -> f OsString
- projectConst :: forall f e a. Functor f => a -> f (Either e a) -> f a
- projectFalse :: Functor f => f (Either e Bool) -> f Bool
- projectError :: forall f e a. (Exception e, Functor f) => f (Either e a) -> f a
- projectErrorMap :: Functor f => (e -> String) -> f (Either e a) -> f a
- projectLeft :: Functor f => (e -> a) -> f (Either e a) -> f a
- data GitRevError
- newtype GitError = MkGitError {}
- data EnvError = MkEnvError {}
- embedGitError :: forall f p a. (Bifunctor p, Functor f) => f (p GitError a) -> f (p GitRevError a)
- embedEnvError :: forall f p a. (Bifunctor p, Functor f) => f (p EnvError a) -> f (p GitRevError a)
- embedTextError :: forall f p a. (Bifunctor p, Functor f) => f (p Text a) -> f (p GitRevError a)
- joinFirst :: forall p a1 a2 b c. (Bifunctor p, forall a. Monad (p a)) => (a1 -> b) -> (a2 -> b) -> p a1 (p a2 c) -> p b c
Basic functions
These functions are simple, merely a typed version of Development.GitRev's API.
NOTE: These functions do not error if git fails to run, opting
instead to return some default value (e.g. string UNKNOWN
, boolean False
).
gitBranch :: Code Q OsString Source #
Return the branch (or tag) name of the current git commit, or UNKNOWN
if not in a git repository. For detached heads, this will just be
HEAD.
Examples
λ. $$gitBranch "main"
Since: 0.1
gitCommitCount :: Code Q OsString Source #
Return the number of commits in the current head.
Examples
λ. $$gitCommitCount "47"
Since: 0.1
gitCommitDate :: Code Q OsString Source #
Return the commit date of the current head.
Examples
λ. $$gitCommitDate "Mon Apr 14 22:14:44 2025 +1200"
Since: 0.1
gitDescribe :: Code Q OsString Source #
Return the long git description for the current git commit, or
UNKNOWN
if not in a git repository.
Examples
λ. $$gitDescribe "1.2.0-14-g40b5d7b"
Since: 0.1
gitDiff :: Code Q OsString Source #
Return the diff of the working copy with HEAD.
Examples
λ. $$gitDiff "diff ..."
Since: 0.1
gitDirty :: Code Q Bool Source #
Return True
if there are non-committed files present in the
repository.
Examples
λ. $$gitDirty False
Since: 0.1
gitDirtyTracked :: Code Q Bool Source #
Return True
if there are non-commited changes to tracked files
present in the repository.
Examples
λ. $$gitDirtyTracked False
Since: 0.1
gitHash :: Code Q OsString Source #
Return the hash of the current git commit, or UNKNOWN
if not in
a git repository.
Examples
λ. $$gitHash "e67e943dd03744d3f93c21f84e127744e6a04543"
Since: 0.1
gitShortHash :: Code Q OsString Source #
Return the short hash of the current git commit, or UNKNOWN
if not in
a git repository.
Examples
λ. $$gitShortHash "e67e943"
Since: 0.1
gitTree :: Code Q OsString Source #
Return the hash of the current tree.
Examples
λ. $$gitTree "b718a493773568bbf920a4710b5b83bd1762dbb9"
Since: 0.1
Custom behavior
These functions allow defining custom behavior. For instance, using
the primitive gitHashQ
and combinator
projectError
, we can define a variant
of gitHash
that instead fails to compile if there are any problems with
git:
-- simplified type signaturesqToCode
::Q
a ->Code
Q
aprojectError
::Q
(Either
e a) ->Q
agitHashQ
::Q
(Either
GitError
OsString
)
>>>
:{
let gitHashOrDie :: Code Q OsString gitHashOrDie = qToCode $ projectError gitHashQ :}
We can also define a function that falls back to an environment variable,
in case the git command fails.
firstSuccessQ
takes the first action
that returns Right
.
firstSuccessQ
::NonEmpty
(Q
(Either
e a)) ->Q
(Either
(Errors
e) a) -- unifying errorsembedGitError
::Q
(Either
GitError
a) ->Q
(Either
GitRevError
a)embedEnvError
::Q
(Either
EnvError
a) ->Q
(Either
GitRevError
a) -- look up environment variableenvValQ
::OsString
->Q
(Either
EnvError
OsString
)
>>>
:{
let gitHashEnv :: OsString -> Code Q (Either (Errors GitRevError) OsString) gitHashEnv var = qToCode $ firstSuccessQ -- using -XOverloadedLists to make this a little nicer -- syntactically. [ embedGitError gitHashQ, embedEnvError $ envValQ var ] :}
Naturally, these can be combined:
>>>
:{
let gitHashEnvOrDie :: OsString -> Code Q OsString gitHashEnvOrDie var = qToCode . projectError $ firstSuccessQ [ embedGitError gitHashQ, embedEnvError $ envValQ var ] :}
"Out-of-tree" builds
Custom definitions are particularly useful for "out-of-tree" builds, where the build takes place outside of the normal git tree.
These builds present a problem, as we normally rely on building in the
project directory where the .git
directory is easy to locate. For
example, while gitHash
will work for 'cabal build'
, it will not work
for 'nix build'
or 'cabal install'
. Fortunately, there are
workarounds, both relying on passing the right data via environment
variables.
Passing the git directory.
For situations where we can pass the current directory during installation e.g.
$ export EXAMPLE_HOME=$(pwd); cabal install example
We can use
runGitInEnvDirQ
::OsString
->Q
(Either
GitError
a) ->Q
(Either
GitRevError
a)to define
>>>
:{
let gitHashSrcDir :: Code Q OsString gitHashSrcDir = qToCode . projectStringUnknown $ firstSuccessQ [ -- 1. We first try normal gitHashQ. embedGitError gitHashQ, -- 2. If that fails, we try again in the directory pointed -- to by "EXAMPLE_HOME". runGitInEnvDirQ [osstr|EXAMPLE_HOME|] gitHashQ ] :}If the initial call to
gitHashQ
fails, then we will try again, running the command from the directory pointed to byEXAMPLE_HOME
.Passing the value itself.
This approach can work well with nix, as nix flakes provides a variety of revisions via its
self
interface. For example:# Injecting the git hash via EXAMPLE_HASH where drv is the normal # derivation. drv.overrideAttrs (oldAttrs: { # Also: self.shortRev, self.dirtyShortRev EXAMPLE_HASH = "${self.rev or self.dirtyRev}"; });
Then we can define
>>>
:{
let gitHashVal :: Code Q OsString gitHashVal = qToCode . projectStringUnknown $ firstSuccessQ [ -- 1. We first try normal gitHashQ. embedGitError gitHashQ, -- 2. If that fails, get the value directly from -- "EXAMPLE_HASH". embedEnvError $ envValQ [osstr|EXAMPLE_HASH|] ] :}Once again, if the first attempt fails, we will run the second action, looking for the value of
EXAMPLE_HASH
.
Finally, we can compose these together to make a function that works for all three cases:
>>>
:{
let gitHashValSrc :: Code Q OsString gitHashValSrc = qToCode . projectStringUnknown $ firstSuccessQ [ embedGitError gitHashQ, runGitInEnvDirQ [osstr|EXAMPLE_HOME|] gitHashQ, embedEnvError $ envValQ [osstr|EXAMPLE_HASH|] ] :}
Multiple queries
Using the typed interfaced, it is easy to combine multiple queries in a safe way.
>>>
:{
import Control.Applicative (liftA3) -- | Returns (date, hash, short hash) gitComplexData :: Code Q (OsString, OsString, OsString) gitComplexData = toCode qs where toCode = qToCode . projectError qs = firstSuccessQ [ embedGitError gitComplexDataFromGitQ, runGitInEnvDirQ [osstr|EXAMPLE_HOME|] gitComplexDataFromGitQ ] gitComplexDataFromGitQ :: Q (Either GitError (OsString, OsString, OsString)) gitComplexDataFromGitQ = do -- custom command for commit YYYY-MM-DD d <- runGitQ [[osstr|log|], [osstr|HEAD|], [osstr|-1|], [osstr|--format=%cs|]] IdxNotUsed h <- gitHashQ sh <- gitShortHashQ pure $ liftA3 (,,) d h sh :}
Git Primitives
gitBranchQ :: Q (Either GitError OsString) Source #
Returns the current git branch.
Examples
>>>
$$(qToCode gitBranchQ)
Right ...
Since: 0.1
gitCommitCountQ :: Q (Either GitError OsString) Source #
Returns the git commit count.
Examples
>>>
$$(qToCode gitCommitCountQ)
Right ...
Since: 0.1
gitCommitDateQ :: Q (Either GitError OsString) Source #
Returns the latest git commit date.
Examples
>>>
$$(qToCode gitCommitDateQ)
Right ...
Since: 0.1
gitDescribeQ :: Q (Either GitError OsString) Source #
Returns the git description.
Examples
>>>
$$(qToCode gitDescribeQ)
Right ...
Since: 0.1
gitDiffQ :: Q (Either GitError OsString) Source #
Return the diff of the working copy with HEAD.
Examples
>>>
$$(qToCode gitDiffQ)
Right ...
Since: 0.1
gitDirtyQ :: Q (Either GitError Bool) Source #
Returns the git dirty status.
Examples
>>>
$$(qToCode gitDirtyQ)
Right ...
Since: 0.1
gitDirtyTrackedQ :: Q (Either GitError Bool) Source #
Returns the git dirty status, ignoring untracked files.
Examples
>>>
$$(qToCode gitDirtyTrackedQ)
Right ...
Since: 0.1
gitHashQ :: Q (Either GitError OsString) Source #
Returns the latest git hash.
Examples
>>>
$$(qToCode gitHashQ)
Right ...
Since: 0.1
gitShortHashQ :: Q (Either GitError OsString) Source #
Returns the latest git short hash.
Examples
>>>
$$(qToCode gitShortHashQ)
Right ...
Since: 0.1
gitTreeQ :: Q (Either GitError OsString) Source #
Returns the hash of the current tree.
Examples
>>>
$$(qToCode gitTreeQ)
Right ...
Since: 0.1
Running your own git actions
Arguments
:: [OsString] | Arguments to git. |
-> IndexUsed | Whether the index is used. |
-> Q (Either GitError OsString) |
Runs git with the arguments. If IdxUsed
is passed, it is tracked for
recompliation purposes.
Examples
>>>
:{
-- Returns 'YYYY-MM-DD' rather than e.g. gitCommitDateQ's -- 'Fri May 2 13:29:59 2025 +1200'. gitCommitDateShortQ :: Q (Either GitError OsString) gitCommitDateShortQ = runGitQ [[osstr|log|], [osstr|HEAD|], [osstr|-1|], [osstr|--format=%cs|]] IdxNotUsed :}
Since: 0.1
Type to flag if the git index is used or not in a call to runGitQ
.
Since: 0.1
Constructors
IdxUsed | The git index is used. Since: 0.1 |
IdxNotUsed | The git index is not used. Since: 0.1 |
Environment lookup
This section allows looking up data via environment variables.
Warning: caching
Suppose we install an executable example-exe
, that depends on
example-lib
, where the latter contains a TH splice for env var FOO
.
We first install via:
export FOO=A; cabal install example-exe --installdir=build --overwrite-policy=always
This will build example-lib
with A
in the splice.
Now suppose we run cabal clean
(or delete the build directory e.g.
dist-newstyle
) and run:
export FOO=B; cabal install example-exe --installdir=build --overwrite-policy=always
What will the result of the splice be? Probably still A
! The problem is
that cabal does not know that the environment has changed, hence it detects
no changes, and example-lib
is not re-installed.
The solution is to manually delete the library example-lib
, which
probably exists in the state directory e.g.
~/.local/state/cabal/store/ghc-9.8.4-inplace
.
Arguments
:: OsString | The environment variable |
-> Q (Either EnvError OsString) | The result |
Performs an environment variable lookup in Q
.
Examples
>>>
setEnv "SOME_VAR" "val"
>>>
$$(qToCode $ envValQ [osstr|SOME_VAR|])
Right "val"
Since: 0.1
Arguments
:: OsString | The environment variable |
-> Q a | The |
-> Q (Either EnvError a) | The result of running |
Runs the given Q
-action under the directory d
pointed to by the
given environment variable.
Examples
>>>
import System.Directory.OsPath (listDirectory)
>>>
setEnv "SOME_DIR" "./src"
>>>
$$(qToCode $ runInEnvDirQ [osstr|SOME_DIR|] $ runIO (listDirectory [osp|./|]))
Right ["Development"]
Since: 0.1
Arguments
:: OsString | Environment variable pointing to a directory path, in which we run the git process. |
-> Q (Either GitError a) | Git process to run. |
-> Q (Either GitRevError a) | The result. |
Runs the git action under the directory d
pointed to by the
given environment variable.
Examples
>>>
setEnv "SOME_DIR" "./"
>>>
$$(qToCode $ runGitInEnvDirQ [osstr|SOME_DIR|] gitHashQ)
Right ...
Since: 0.1
Arguments
:: OsString | The environment variable |
-> (OsString -> Q a) | Function to run on |
-> Q (Either EnvError a) |
Runs a Q
-action on the result of an environment variable, if it exists.
Examples
>>>
import System.Directory.OsPath (listDirectory)
>>>
setEnv "SOME_DIR" "./src"
>>>
$$(qToCode $ withEnvValQ [osstr|SOME_DIR|] (runIO . listDirectory))
Right ["Development"]
Since: 0.1
Q to Code
Q Combinators
Laziness
As alluded to above, Q
's default semigroup instance is not lazy enough:
>>>
:{
$$( qToCode $ (runIO (putStrLn "in q1") $> (Right "q1") :: Q (Either () String)) <> (runIO (putStrLn "in q2") $> Left ()) ) :} in q1 in q2 Right "q1"
For this reason, we introduce QFirst
:
mkQFirst
::Q
(Either
e a) ->QFirst
e aunQFirst
::QFirst
e a ->Q
(Either
(Errors
e) a)
>>>
:{
$$( qToCode $ unQFirst $ (mkQFirst $ runIO (putStrLn "in q1") $> (Right "q1") :: QFirst () String) <> (mkQFirst $ runIO (putStrLn "in q2") $> Left ()) ) :} in q1 Right "q1"
The function
firstSuccessQ
::NonEmpty
(Q
(Either
e a)) ->Q
(Either
(Errors
e) a)
utilizes QFirst
for sequencing a series of Q
actions, stopping after the
first success.
Wrapper for Q
over Either
with a lazier Semigroup
. With this, we
can run:
mkQFirst q1 <> mkQFirst q2
This will only execute q2
if q1
returns Left
, unlike Q
's normal
Semigroup
instance.
If both actions fail, then both errors will be returned via Errors
.
Warning: exceptions
In order for QFirst
to work as expected, the underlying Q
action
should not throw exceptions. Uncaught exceptions will not be caught
by QFirst
, hence the intended "try multiple Q
-actions until we have a
success" pattern will not work.
Since: 0.1
Instances
Bifunctor QFirst Source # | Since: 0.1 |
HasField "unQFirst" (QFirst e a) (Q (Either (Errors e) a)) Source # | Since: 0.1 |
e ~ SomeException => MonadIO (QFirst e) Source # | Catches synchronous exceptions. Since: 0.1 |
Defined in Development.GitRev.Internal.QFirst | |
Applicative (QFirst e) Source # | Since: 0.1 |
Functor (QFirst e) Source # | Since: 0.1 |
Monad (QFirst e) Source # | Since: 0.1 |
Semigroup (QFirst e a) Source # | Since: 0.1 |
Collects multiple errors. Intended for displaying multiple
exceptions via displayException
.
Since: 0.1
Instances
Eliminating Either
projectStringUnknown :: Functor f => f (Either e OsString) -> f OsString Source #
Projects Left
to the string UNKNOWN
.
Examples
>>>
$$(qToCode $ projectStringUnknown (pure $ Left ()))
"UNKNOWN"
Since: 0.1
projectConst :: forall f e a. Functor f => a -> f (Either e a) -> f a Source #
Projects Left
to the given value.
Examples
>>>
$$(qToCode $ projectConst "FAILURE" (pure $ Left ()))
"FAILURE"
Since: 0.1
projectError :: forall f e a. (Exception e, Functor f) => f (Either e a) -> f a Source #
Projects Left
via error
, rendering via displayException
. Hence
an error will cause a compilation failure in Q
.
Examples
>>>
:{
let gitHashOrDieQ :: Q Bool gitHashOrDieQ = projectError gitDirtyQ :}
Since: 0.1
projectLeft :: Functor f => (e -> a) -> f (Either e a) -> f a Source #
Projects Left
via the given function.
Since: 0.1
Errors
data GitRevError Source #
General error type for anything that can go wrong when running
gitrev-typed
splices.
Since: 0.1
Constructors
GitRevErrorGit GitError | Git error. Since: 0.1 |
GitRevErrorEnv EnvError | Environment variable lookup error. Since: 0.1 |
GitRevErrorText Text | Catch-all for anything else that can go wrong. Since: 0.1 |
Instances
Exception GitRevError Source # | Since: 0.1 |
Defined in Development.GitRev.Internal.Utils.OsString Methods toException :: GitRevError -> SomeException # fromException :: SomeException -> Maybe GitRevError # displayException :: GitRevError -> String # backtraceDesired :: GitRevError -> Bool # | |
Show GitRevError Source # | Since: 0.1 |
Defined in Development.GitRev.Internal.Utils.OsString Methods showsPrec :: Int -> GitRevError -> ShowS # show :: GitRevError -> String # showList :: [GitRevError] -> ShowS # | |
Eq GitRevError Source # | Since: 0.1 |
Defined in Development.GitRev.Internal.Utils.OsString | |
Lift GitRevError Source # | Since: 0.1 |
Defined in Development.GitRev.Internal.Utils.OsString Methods lift :: Quote m => GitRevError -> m Exp # liftTyped :: forall (m :: Type -> Type). Quote m => GitRevError -> Code m GitRevError # |
Errors that can be encountered with git.
Since: 0.1
Constructors
MkGitError | |
Instances
Exception GitError Source # | Since: 0.1 |
Defined in Development.GitRev.Internal.Git.OsString Methods toException :: GitError -> SomeException # fromException :: SomeException -> Maybe GitError # displayException :: GitError -> String # backtraceDesired :: GitError -> Bool # | |
Show GitError Source # | Since: 0.1 |
Eq GitError Source # | Since: 0.1 |
Lift GitError Source # | Since: 0.1 |
Environment variable lookup failure.
Since: 0.1
Constructors
MkEnvError | |
Instances
Exception EnvError Source # | Since: 0.1 |
Defined in Development.GitRev.Internal.Environment.OsString Methods toException :: EnvError -> SomeException # fromException :: SomeException -> Maybe EnvError # displayException :: EnvError -> String # backtraceDesired :: EnvError -> Bool # | |
Show EnvError Source # | Since: 0.1 |
Eq EnvError Source # | Since: 0.1 |
Lift EnvError Source # | Since: 0.1 |
Utilities
Arguments
:: forall f p a. (Bifunctor p, Functor f) | |
=> f (p GitError a) | . |
-> f (p GitRevError a) |
Embeds a GitError
in the larger GitRevError
.
Examples
>>>
:{
let q :: Q (Either GitError ()) q = pure (Left $ MkGitError [osstr|not found|]) in runQ $ embedGitError q :} Left (GitRevErrorGit (MkGitError {reason = "not found"}))
Since: 0.1
Arguments
:: forall f p a. (Bifunctor p, Functor f) | |
=> f (p EnvError a) | . |
-> f (p GitRevError a) |
Embeds an EnvError
in the larger GitRevError
.
Examples
>>>
:{
let q :: Q (Either EnvError ()) q = pure (Left $ MkEnvError [osstr|VAR|] Nothing [osstr|VAR does not exist|]) in runQ $ embedEnvError q :} Left (GitRevErrorEnv (MkEnvError {var = "VAR", value = Nothing, reason = "VAR does not exist"}))
Since: 0.1
Arguments
:: forall f p a. (Bifunctor p, Functor f) | |
=> f (p Text a) | . |
-> f (p GitRevError a) |
Embeds a Text
in the larger GitRevError
.
Examples
>>>
:{
let q :: Q (Either Text ()) q = pure (Left "Something went wrong") in runQ $ embedTextError q :} Left (GitRevErrorText "Something went wrong")
Since: 0.1
Arguments
:: forall p a1 a2 b c. (Bifunctor p, forall a. Monad (p a)) | |
=> (a1 -> b) | Map outer. |
-> (a2 -> b) | Map inner. |
-> p a1 (p a2 c) | Nested bifunctor. |
-> p b c | Flattened bifunctor. |
Join the first
component in a bifunctor, useful for unifying
nested errors with GitRevError
.
Examples
>>>
e = Right @EnvError (Left @Text @() "an error")
>>>
:type e
e :: Either EnvError (Either Text ())
>>>
let joined = joinFirst GitRevErrorEnv GitRevErrorText e
>>>
joined
Left (GitRevErrorText "an error")
>>>
:type joined
joined :: Either GitRevError ()
Since: 0.1