module Changelogged.Git where
import qualified Control.Foldl as Fold
import Control.Monad.Catch (catch)
import Data.Char (isDigit)
import Data.Either.Combinators (fromRight)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import Turtle
data GitInfo = GitInfo
{ gitHistory :: [Turtle.Line]
, gitRemoteUrl :: Text
, gitLatestVersion :: Maybe Text
} deriving (Show)
loadGitLatestTag :: Maybe Text -> IO (Maybe Text)
loadGitLatestTag mbranch = do
let branch = fromMaybe "HEAD^" mbranch
ver <- fold ((fromRight "" <$> inprocWithErr "git" ["describe", "--tags", "--abbrev=0", branch] empty) `catch` \ (_ :: ExitCode) -> empty) Fold.head
return $ fmap lineToText ver
loadGitRemoteUrl :: IO Text
loadGitRemoteUrl = remoteUrlToHttps
<$> strict (inproc "git" ["remote", "get-url", "origin"] empty)
remoteUrlToHttps :: Text -> Text
remoteUrlToHttps
= whenPossible (Text.stripSuffix ".git")
. Text.replace "git@github.com:" "https://github.com/"
. Text.strip
where
whenPossible fn y = fromMaybe y (fn y)
loadGitHistory
:: Maybe Text
-> IO [Turtle.Line]
loadGitHistory from = do
fold (grep
(invert (has (text "Merge branch")))
(inproc "git" (["log", "--oneline", "--first-parent"] <> range) empty))
Fold.list
where
range = case from of
Nothing -> []
Just commit -> [commit <> "..HEAD"]
loadGitInfo
:: Bool
-> Maybe Text
-> IO GitInfo
loadGitInfo entireHistory branch = do
latestTag <- loadGitLatestTag branch
gitHistory <- loadGitHistory (if entireHistory then Nothing else latestTag)
gitRemoteUrl <- loadGitRemoteUrl
let gitLatestVersion = extractVersion latestTag
return GitInfo {..}
where
extractVersion tag = case Text.dropWhile (not . isDigit) <$> tag of
Just ver | not (Text.null ver) -> Just ver
_ -> Nothing
ppGitInfo :: GitInfo -> Text
ppGitInfo GitInfo{..} = Text.unlines
[ "Git remote URL: " <> gitRemoteUrl
, "Latest release: " <> fromMaybe "<none>" gitLatestVersion
, "Changes since last release: " <> Text.pack (show (length gitHistory))
]