| 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::Qa ->CodeQaprojectError::Q(Eithere a) ->QagitHashQ::Q(EitherGitErrorOsString)
>>>:{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(Eithere a)) ->Q(Either(Errorse) a) -- unifying errorsembedGitError::Q(EitherGitErrora) ->Q(EitherGitRevErrora)embedEnvError::Q(EitherEnvErrora) ->Q(EitherGitRevErrora) -- look up environment variableenvValQ::OsString->Q(EitherEnvErrorOsString)
>>>:{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(EitherGitErrora) ->Q(EitherGitRevErrora)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
gitHashQfails, 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
selfinterface. 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(Eithere a) ->QFirste aunQFirst::QFirste a ->Q(Either(Errorse) 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(Eithere a)) ->Q(Either(Errorse) 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 ee :: Either EnvError (Either Text ())
>>>let joined = joinFirst GitRevErrorEnv GitRevErrorText e>>>joinedLeft (GitRevErrorText "an error")
>>>:type joinedjoined :: Either GitRevError ()
Since: 0.1