module Hakyllbars.Field.Git
( gitFields,
gitSha1Compiler,
gitMessageCompiler,
gitLogField,
gitFileField,
gitFileCompiler,
gitBranchCompiler,
gitBranch,
)
where
import Data.Binary
import GHC.Generics (Generic)
import Hakyllbars.Common
import Hakyllbars.Context
import System.Exit
import System.Process
gitFields ::
String ->
String ->
Context a
gitFields :: forall a. [Char] -> [Char] -> Context a
gitFields [Char]
providerDirectory [Char]
gitWebUrl =
forall a. Monoid a => [a] -> a
mconcat
[ forall v a. IntoValue v a => [Char] -> v -> Context a
constField [Char]
"gitWebUrl" [Char]
gitWebUrl,
forall v a.
IntoValue v a =>
[Char] -> (Item a -> TemplateRunner a v) -> Context a
field [Char]
"gitSha1" (forall a. [Char] -> Item a -> TemplateRunner a [Char]
gitSha1Compiler [Char]
providerDirectory),
forall v a.
IntoValue v a =>
[Char] -> (Item a -> TemplateRunner a v) -> Context a
field [Char]
"gitMessage" (forall a. [Char] -> Item a -> TemplateRunner a [Char]
gitMessageCompiler [Char]
providerDirectory),
forall v a.
IntoValue v a =>
[Char] -> (Item a -> TemplateRunner a v) -> Context a
field [Char]
"gitBranch" forall a. Item a -> TemplateRunner a [Char]
gitBranchCompiler,
forall v a.
IntoValue v a =>
[Char] -> [Char] -> (GitFile -> v) -> Context a
gitFileField [Char]
providerDirectory [Char]
"gitFilePath" GitFile -> [Char]
gitFilePath,
forall v a.
IntoValue v a =>
[Char] -> [Char] -> (GitFile -> v) -> Context a
gitFileField [Char]
providerDirectory [Char]
"gitFileName" ([Char] -> [Char]
takeFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitFile -> [Char]
gitFilePath),
forall v a.
IntoValue v a =>
[Char] -> [Char] -> (GitFile -> v) -> Context a
gitFileField [Char]
providerDirectory [Char]
"isFromSource" GitFile -> Bool
gitFileIsFromSource,
forall v a.
IntoValue v a =>
[Char] -> [Char] -> (GitFile -> v) -> Context a
gitFileField [Char]
providerDirectory [Char]
"isChanged" GitFile -> Bool
gitFileIsChanged
]
gitSha1Compiler :: String -> Item a -> TemplateRunner a String
gitSha1Compiler :: forall a. [Char] -> Item a -> TemplateRunner a [Char]
gitSha1Compiler = forall a. [Char] -> [Char] -> Item a -> TemplateRunner a [Char]
gitLogField [Char]
"%h"
gitMessageCompiler :: String -> Item a -> TemplateRunner a String
gitMessageCompiler :: forall a. [Char] -> Item a -> TemplateRunner a [Char]
gitMessageCompiler = forall a. [Char] -> [Char] -> Item a -> TemplateRunner a [Char]
gitLogField [Char]
"%s"
type LogFormat = String
gitLogField :: LogFormat -> String -> Item a -> TemplateRunner a String
gitLogField :: forall a. [Char] -> [Char] -> Item a -> TemplateRunner a [Char]
gitLogField [Char]
format [Char]
providerDirectory Item a
item =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. IO a -> Compiler a
unsafeCompiler do
Maybe [Char]
maybeResult <- [Char] -> Maybe [Char] -> IO (Maybe [Char])
gitLog [Char]
format (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
providerDirectory [Char] -> [Char] -> [Char]
</> Identifier -> [Char]
toFilePath (forall a. Item a -> Identifier
itemIdentifier Item a
item))
case Maybe [Char]
maybeResult of
Just [Char]
result -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result
Maybe [Char]
Nothing -> forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe [Char] -> IO (Maybe [Char])
gitLog [Char]
format forall a. Maybe a
Nothing
data GitFile = GitFile
{ GitFile -> [Char]
gitFilePath :: String,
GitFile -> Bool
gitFileIsFromSource :: Bool,
GitFile -> Bool
gitFileIsChanged :: Bool
}
deriving (forall x. Rep GitFile x -> GitFile
forall x. GitFile -> Rep GitFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GitFile x -> GitFile
$cfrom :: forall x. GitFile -> Rep GitFile x
Generic)
instance Binary GitFile where
get :: Get GitFile
get = [Char] -> Bool -> Bool -> GitFile
GitFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
get
put :: GitFile -> Put
put (GitFile [Char]
x Bool
y Bool
z) = forall t. Binary t => t -> Put
put [Char]
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Bool
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Bool
z
gitFileField ::
(IntoValue v a) =>
String ->
String ->
(GitFile -> v) ->
Context a
gitFileField :: forall v a.
IntoValue v a =>
[Char] -> [Char] -> (GitFile -> v) -> Context a
gitFileField [Char]
providerDirectory [Char]
key GitFile -> v
f = forall v a.
IntoValue v a =>
[Char] -> (Item a -> TemplateRunner a v) -> Context a
field [Char]
key forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GitFile -> v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> Item a -> TemplateRunner a GitFile
gitFileCompiler [Char]
providerDirectory
gitFileCompiler ::
String ->
Item a ->
TemplateRunner a GitFile
gitFileCompiler :: forall a. [Char] -> Item a -> TemplateRunner a GitFile
gitFileCompiler [Char]
providerDirectory Item a
item =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
[Char] -> Bool -> Bool -> GitFile
GitFile [Char]
gitFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> Compiler a
unsafeCompiler ([Char] -> IO Bool
doesFileExist [Char]
gitFilePath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IO a -> Compiler a
unsafeCompiler ([Char] -> IO Bool
isChanged [Char]
gitFilePath)
where
gitFilePath :: [Char]
gitFilePath = [Char]
providerDirectory [Char] -> [Char] -> [Char]
</> Identifier -> [Char]
toFilePath (forall a. Item a -> Identifier
itemIdentifier Item a
item)
isChanged :: [Char] -> IO Bool
isChanged [Char]
filePath = do
let args :: [[Char]]
args = [[Char]
"diff", [Char]
"HEAD", [Char]
filePath]
(ExitCode
exitCode, [Char]
stdout, [Char]
_stderr) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
"git" [[Char]]
args [Char]
""
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (ExitCode
exitCode forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
stdout)
gitLog :: LogFormat -> Maybe FilePath -> IO (Maybe String)
gitLog :: [Char] -> Maybe [Char] -> IO (Maybe [Char])
gitLog [Char]
format Maybe [Char]
filePath = do
let fpArgs :: [[Char]]
fpArgs = forall a. a -> a -> Bool -> a
bool [] [forall a. HasCallStack => Maybe a -> a
fromJust Maybe [Char]
filePath] (forall a. Maybe a -> Bool
isJust Maybe [Char]
filePath)
let args :: [[Char]]
args = [[Char]
"log", [Char]
"-1", [Char]
"HEAD", [Char]
"--pretty=format:" forall a. [a] -> [a] -> [a]
++ [Char]
format] forall a. [a] -> [a] -> [a]
++ [[Char]]
fpArgs
(ExitCode
_exitCode, [Char]
stdout, [Char]
_stderr) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
"git" [[Char]]
args [Char]
""
forall (m :: * -> *) a. Monad m => a -> m a
return if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
stdout then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just [Char]
stdout
gitBranchCompiler :: Item a -> TemplateRunner a String
gitBranchCompiler :: forall a. Item a -> TemplateRunner a [Char]
gitBranchCompiler Item a
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. IO a -> Compiler a
unsafeCompiler IO [Char]
gitBranch
gitBranch :: IO String
gitBranch :: IO [Char]
gitBranch = do
let args :: [[Char]]
args = [[Char]
"branch", [Char]
"--show-current"]
(ExitCode
exitCode, [Char]
stdout, [Char]
stderr) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
"git" [[Char]]
args [Char]
""
if ExitCode
exitCode forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
stdout
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to get current branch: " forall a. [a] -> [a] -> [a]
++ [Char]
stderr