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

-- | The Git fields configuration.
gitFields ::
  -- | The configured hakyll provider directory.
  String ->
  -- | The base url to the online git repository for browsing.
  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
    ]

-- | Gets the git-sha1 hash of the current item.
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"

-- | Gets the git commit message of the current item.
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

-- | Extracts a latest git log field from the current item.
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

-- | gets a given field from the git file.
gitFileField ::
  (IntoValue v a) =>
  -- | The hakyll provider directory.
  String ->
  -- | The field name.
  String ->
  -- | The getter for the git file field.
  (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

-- | Compiles the git file for the given item.
gitFileCompiler ::
  -- | The hakyll provider directory.
  String ->
  -- | The item to compile.
  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