From f83b424bf70b7b14b0268aeeafe1b3483fced49f Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 21 Mar 2024 05:35:00 +0100 Subject: chore: Git -> Backend --- app/Git.hs | 162 ------------------------------------------------------------- 1 file changed, 162 deletions(-) delete mode 100644 app/Git.hs (limited to 'app/Git.hs') diff --git a/app/Git.hs b/app/Git.hs deleted file mode 100644 index 25c9149..0000000 --- a/app/Git.hs +++ /dev/null @@ -1,162 +0,0 @@ -module Git - ( module Git.CommitHash, - getCommitHashes, - getRootDir, - getFilesOf, - getChangedFilesOf, - Commit (..), - Author (..), - getCommitOf, - readTextFileOfText, - readTextFileOfBS, - resolveRef, - getCommitsBetween, - diffOf, - ) -where - -import Control.Exception (IOException, catch, throwIO) -import Data.Binary (Binary) -import Data.Binary.Instances () -import Data.ByteString.Lazy qualified as LB -import Data.Maybe (fromMaybe) -import Data.Text qualified as T -import Data.Text.Encoding qualified as T -import Data.Text.Lazy qualified as LT -import Data.Text.Lazy.Encoding qualified as LT -import Data.Text.Lazy.IO qualified as LT -import Data.Time.Clock (UTCTime, getCurrentTime) -import Exception qualified as E -import GHC.Generics (Generic) -import Git.CommitHash -import Patch qualified as A -import Process (proc, sh, sh_) -import Text.Printf (printf) - -getCommitHashes :: Maybe CommitHash -> Maybe CommitHash -> IO [CommitHash] -getCommitHashes maybeBottomCommit Nothing = - getCommitHashes maybeBottomCommit (Just WorkingTree) -getCommitHashes (Just WorkingTree) (Just WorkingTree) = - pure [WorkingTree] -getCommitHashes (Just WorkingTree) (Just (Commit _)) = - pure [] -getCommitHashes Nothing (Just WorkingTree) = - (WorkingTree :) . map Commit . T.lines - <$> sh (proc "git log --format=%%H HEAD") -getCommitHashes (Just (Commit bottomHash)) (Just WorkingTree) = - (WorkingTree :) . map Commit . T.lines - <$> sh (proc "git log --format=%%H %..HEAD" bottomHash) -getCommitHashes Nothing (Just (Commit topHash)) = - map Commit . T.lines - <$> sh (proc "git log --format=%%H %" topHash) -getCommitHashes (Just (Commit bottomHash)) (Just (Commit topHash)) = - map Commit . T.lines - <$> sh (proc "git log --format=%%H %..%" bottomHash topHash) - -getRootDir :: IO FilePath -getRootDir = - T.unpack . stripTrailingNL - <$> sh (proc "git rev-parse --show-toplevel") - where - stripTrailingNL s = fromMaybe s $ T.stripSuffix "\n" s - -getFilesOf :: CommitHash -> IO [FilePath] -getFilesOf WorkingTree = - map T.unpack . T.lines - <$> sh "git ls-files --cached --modified --others --exclude-standard --full-name" -getFilesOf (Commit hash) = - map T.unpack . T.lines - <$> sh (proc "git ls-tree -r --name-only --full-name --full-tree %" hash) - -getChangedFilesOf :: CommitHash -> IO [FilePath] -getChangedFilesOf WorkingTree = - map T.unpack . T.lines - <$> sh "git ls-files --modified --others --exclude-standard --full-name" -getChangedFilesOf (Commit hash) = do - map T.unpack . T.lines - <$> sh (proc "git diff-tree -r --name-only %" hash) - -data Commit = Commit' - { commitHash :: CommitHash, - date :: UTCTime, - author :: Author - } - deriving (Show, Generic, Binary, Eq) - -data Author = Author - { name :: T.Text, - email :: T.Text - } - deriving (Show, Generic, Binary, Eq) - -getCommitOf :: CommitHash -> IO Commit -getCommitOf commitHash@WorkingTree = do - date <- getCurrentTime - authorName <- sh "git config user.name" - authorEmail <- sh "git config user.email" - pure - Commit' - { author = Author authorName authorEmail, - .. - } -getCommitOf commitHash@(Commit hash) = do - ( T.splitOn "\NUL" . head . T.lines - <$> sh - ( proc - "git show --quiet --format=%%ai%%x00%%ae%%x00%%an %" - hash - ) - ) - >>= \case - rawDate : authorEmail : authorName : _ -> - let date = read (T.unpack rawDate) - in pure - Commit' - { author = Author authorName authorEmail, - .. - } - _ -> throwIO E.NoCommits - -readTextFileOfText :: CommitHash -> FilePath -> IO LT.Text -readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8 - -readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString -readTextFileOfBS = readTextFileOf LB.readFile id - -readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a -readTextFileOf readFile _ WorkingTree filePath = - catch - (readFile filePath) - (\(_ :: IOException) -> throwIO (E.CannotReadFile filePath)) -readTextFileOf _ decode (Commit hash) filePath = - catch - (decode <$> sh (proc "git show %:%" hash filePath)) - (\(_ :: E.ProcessException) -> throwIO (E.CannotReadFile (printf "%s:%s" hash filePath))) - -resolveRef :: T.Text -> IO CommitHash -resolveRef = - fmap (Commit . T.strip . T.decodeUtf8 . LB.toStrict) - . sh - . proc "git rev-parse %" - --- | `getCommitsBetween prevCommit commit` returns the commits from `prevCommit` to `commit`. The result excludes `prevCommit`, but includes `commit`. --- --- If `prevCommit` is not an ancestor of `commit`, this functions throws `NoAncestor commit prevCommit`. -getCommitsBetween :: CommitHash -> CommitHash -> IO [CommitHash] -getCommitsBetween WorkingTree commit@(Commit _) = - throwIO (E.NoAncestor WorkingTree commit) -getCommitsBetween WorkingTree WorkingTree = pure [WorkingTree] -getCommitsBetween prevCommit WorkingTree = - fmap (++ [WorkingTree]) . getCommitsBetween prevCommit - =<< resolveRef "HEAD" -getCommitsBetween prevCommit@(Commit prevHash) commit@(Commit hash) = do - catch - (sh_ (proc "git merge-base --is-ancestor % %" prevHash hash)) - (\(_ :: E.ProcessException) -> throwIO (E.NoAncestor commit prevCommit)) - map (Commit . T.strip) . T.lines . T.decodeUtf8 . LB.toStrict - <$> sh (proc "git log --format=%%H %..%" prevHash hash) - -diffOf :: CommitHash -> CommitHash -> IO A.Patch -diffOf prevHash hash = - A.parse . T.decodeUtf8 . LB.toStrict - <$> sh (proc "git diff % %" (toTextUnsafe prevHash) (toTextUnsafe hash)) -- cgit v1.2.3