{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- Stability: experimental
-- Portability: portable
--
-- This module provides mechanisms for obtaining the git commit date.
-- The cloned repo will not be preserved.
module NvFetcher.GetGitCommitDate
  ( -- * Types
    DateFormat (..),
    GetGitCommitDate (..),

    -- * Rules
    getGitCommitDateRule,

    -- * Functions
    getGitCommitDate,
  )
where

import Control.Monad (void)
import Data.Coerce (coerce)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import NvFetcher.Types
import Prettyprinter (pretty, (<+>))

getGitCommitDateRule :: Rules ()
getGitCommitDateRule :: Rules ()
getGitCommitDateRule = Rules (GetGitCommitDate -> Action Text) -> Rules ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rules (GetGitCommitDate -> Action Text) -> Rules ())
-> Rules (GetGitCommitDate -> Action Text) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
  (GetGitCommitDate -> Action Text)
-> Rules (GetGitCommitDate -> Action Text)
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleCache ((GetGitCommitDate -> Action Text)
 -> Rules (GetGitCommitDate -> Action Text))
-> (GetGitCommitDate -> Action Text)
-> Rules (GetGitCommitDate -> Action Text)
forall a b. (a -> b) -> a -> b
$ \q :: GetGitCommitDate
q@(GetGitCommitDate (Text -> String
T.unpack -> String
url) (Text -> String
T.unpack -> String
rev) DateFormat
format) -> (String -> Action Text) -> Action Text
forall a. (String -> Action a) -> Action a
withTempDir ((String -> Action Text) -> Action Text)
-> (String -> Action Text) -> Action Text
forall a b. (a -> b) -> a -> b
$ \String
repo -> do
    String -> Action ()
putInfo (String -> Action ())
-> (Doc Any -> String) -> Doc Any -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> Action ()) -> Doc Any -> Action ()
forall a b. (a -> b) -> a -> b
$ Doc Any
"#" Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
<+> GetGitCommitDate -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. GetGitCommitDate -> Doc ann
pretty GetGitCommitDate
q
    (StdoutTrim String
out) <- Action (StdoutTrim String) -> Action (StdoutTrim String)
forall a. Action a -> Action a
quietly (Action (StdoutTrim String) -> Action (StdoutTrim String))
-> Action (StdoutTrim String) -> Action (StdoutTrim String)
forall a b. (a -> b) -> a -> b
$ do
      [CmdOption] -> String -> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ [String -> CmdOption
Cwd String
repo, Bool -> CmdOption
EchoStderr Bool
False, Bool -> CmdOption
EchoStdout Bool
False] (String
"git init" :: String)
      [CmdOption] -> String -> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ [String -> CmdOption
Cwd String
repo, Bool -> CmdOption
EchoStderr Bool
False] (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"git remote add origin " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
url
      [CmdOption] -> String -> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ [String -> CmdOption
Cwd String
repo, Bool -> CmdOption
EchoStderr Bool
False] (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"git fetch --depth 1 origin " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
rev
      [CmdOption] -> String -> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ [String -> CmdOption
Cwd String
repo, Bool -> CmdOption
EchoStderr Bool
False] (String
"git checkout FETCH_HEAD" :: String)
      [CmdOption] -> String -> Action (StdoutTrim String)
forall args r. (Partial, CmdArguments args) => args
cmd [String -> CmdOption
Cwd String
repo, CmdOption
Shell] (String -> Action (StdoutTrim String))
-> String -> Action (StdoutTrim String)
forall a b. (a -> b) -> a -> b
$ String
"git --no-pager log -1 --format=%cd --date=format:\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"%Y-%m-%d" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ DateFormat -> Maybe Text
forall a b. Coercible a b => a -> b
coerce DateFormat
format) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""
    Text -> Action Text
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Action Text) -> Text -> Action Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
out

getGitCommitDate :: Text -> Text -> DateFormat -> Action Text
getGitCommitDate :: Text -> Text -> DateFormat -> Action Text
getGitCommitDate Text
url Text
rev DateFormat
format = GetGitCommitDate -> Action Text
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (GetGitCommitDate -> Action Text)
-> GetGitCommitDate -> Action Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DateFormat -> GetGitCommitDate
GetGitCommitDate Text
url Text
rev DateFormat
format