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