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 --- anissue.cabal | 4 +- app/Backend.hs | 162 +++++++++++++++++++++++++++++++++++++++++++++ app/Backend/CommitHash.hs | 42 ++++++++++++ app/Cache.hs | 4 +- app/Comment.hs | 6 +- app/Exception.hs | 4 +- app/Git.hs | 162 --------------------------------------------- app/Git/CommitHash.hs | 42 ------------ app/History.hs | 8 +-- app/History/IssueEvents.hs | 20 +++--- app/History/Issues.hs | 10 +-- app/History/Scramble.hs | 10 +-- app/Issue.hs | 8 +-- app/Issue/Provenance.hs | 6 +- app/Issue/Render.hs | 2 +- app/IssueEvent.hs | 2 +- app/Main.hs | 4 +- app/Review.hs | 32 ++++----- app/Settings.hs | 4 +- 19 files changed, 266 insertions(+), 266 deletions(-) create mode 100644 app/Backend.hs create mode 100644 app/Backend/CommitHash.hs delete mode 100644 app/Git.hs delete mode 100644 app/Git/CommitHash.hs diff --git a/anissue.cabal b/anissue.cabal index 35c64ee..6e71d1f 100644 --- a/anissue.cabal +++ b/anissue.cabal @@ -24,8 +24,8 @@ executable anissue Debug Die Exception - Git - Git.CommitHash + Backend + Backend.CommitHash History History.Plan History.IssueEvents diff --git a/app/Backend.hs b/app/Backend.hs new file mode 100644 index 0000000..b07eca6 --- /dev/null +++ b/app/Backend.hs @@ -0,0 +1,162 @@ +module Backend + ( module Backend.CommitHash, + getCommitHashes, + getRootDir, + getFilesOf, + getChangedFilesOf, + Commit (..), + Author (..), + getCommitOf, + readTextFileOfText, + readTextFileOfBS, + resolveRef, + getCommitsBetween, + diffOf, + ) +where + +import Backend.CommitHash +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 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)) diff --git a/app/Backend/CommitHash.hs b/app/Backend/CommitHash.hs new file mode 100644 index 0000000..7ec1d54 --- /dev/null +++ b/app/Backend/CommitHash.hs @@ -0,0 +1,42 @@ +module Backend.CommitHash + ( CommitHash (..), + toShortText, + toText, + toTextUnsafe, + ) +where + +import Data.Binary (Binary) +import Data.Maybe (fromMaybe) +import Data.Text qualified as T +import GHC.Generics (Generic) +import Render qualified as P + +data CommitHash + = WorkingTree + | Commit T.Text + deriving (Eq, Ord, Show, Binary, Generic) + +toShortText :: CommitHash -> Maybe T.Text +toShortText = fmap (T.take 7) . toText + +toText :: CommitHash -> Maybe T.Text +toText WorkingTree = Nothing +toText (Commit hash) = Just hash + +toTextUnsafe :: CommitHash -> T.Text +toTextUnsafe (Commit hash) = hash +toTextUnsafe _ = error "toTextUnsafe: WorkingDir" + +instance P.Render CommitHash where + render = P.render . P.Detailed + +instance P.Render (P.Detailed CommitHash) where + render (P.Detailed commitHash) = + P.styled [P.color P.Yellow] $ + P.render (fromMaybe "" (toText commitHash)) + +instance P.Render (P.Summarized CommitHash) where + render (P.Summarized commitHash) = + P.styled [P.color P.Yellow] $ + P.render (fromMaybe "" (toShortText commitHash)) diff --git a/app/Cache.hs b/app/Cache.hs index 4540fa4..f500526 100644 --- a/app/Cache.hs +++ b/app/Cache.hs @@ -20,15 +20,15 @@ where -- @topic caching -- @backlog +import Backend qualified import Data.Binary (Binary, decodeFileOrFail, encodeFile) import Data.Text qualified as T -import Git qualified import System.Directory (createDirectoryIfMissing, doesFileExist) import System.FilePath (()) cached :: Binary a => T.Text -> IO a -> IO a cached key func = do - root <- Git.getRootDir + root <- Backend.getRootDir createDirectoryIfMissing True (root ".anissue") let file = (root ".anissue" T.unpack key) doesFileExist file >>= \case diff --git a/app/Comment.hs b/app/Comment.hs index febd47e..7c76561 100644 --- a/app/Comment.hs +++ b/app/Comment.hs @@ -9,6 +9,7 @@ module Comment ) where +import Backend qualified import Comment.Language qualified as L import Control.Applicative (liftA2) import Control.Exception (catch) @@ -26,7 +27,6 @@ import Foreign.Marshal.Alloc (alloca, free) import Foreign.Marshal.Array (peekArray) import Foreign.Storable import GHC.Generics (Generic) -import Git qualified import System.FilePath (takeExtension) import TreeSitter qualified as S @@ -47,13 +47,13 @@ data Point = Point } deriving (Eq, Show, Generic, Binary) -getComments :: Git.CommitHash -> FilePath -> IO [Comment] +getComments :: Backend.CommitHash -> FilePath -> IO [Comment] getComments commitHash filePath = fmap mergeLineComments . extractComments filePath language . LB.toStrict =<< catch - (Git.readTextFileOfBS commitHash filePath) + (Backend.readTextFileOfBS commitHash filePath) (\(_ :: E.CannotReadFile) -> pure "") where language = L.fromPath (takeExtension filePath) diff --git a/app/Exception.hs b/app/Exception.hs index 6ac243b..f99e7ff 100644 --- a/app/Exception.hs +++ b/app/Exception.hs @@ -12,12 +12,12 @@ module Exception ) where +import Backend.CommitHash qualified as Backend import CMark qualified as D import Control.Exception import Data.ByteString.Lazy.Char8 as LB import Data.Text qualified as T import Data.Void (Void) -import Git.CommitHash qualified as Git import System.Exit (ExitCode) import Text.Megaparsec qualified as P @@ -78,7 +78,7 @@ data UnsupportedLanguage = UnsupportedLanguage T.Text instance Exception UnsupportedLanguage -data NoAncestor = NoAncestor Git.CommitHash Git.CommitHash +data NoAncestor = NoAncestor Backend.CommitHash Backend.CommitHash deriving (Show) instance Exception NoAncestor 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)) diff --git a/app/Git/CommitHash.hs b/app/Git/CommitHash.hs deleted file mode 100644 index f791af8..0000000 --- a/app/Git/CommitHash.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Git.CommitHash - ( CommitHash (..), - toShortText, - toText, - toTextUnsafe, - ) -where - -import Data.Binary (Binary) -import Data.Maybe (fromMaybe) -import Data.Text qualified as T -import GHC.Generics (Generic) -import Render qualified as P - -data CommitHash - = WorkingTree - | Commit T.Text - deriving (Eq, Ord, Show, Binary, Generic) - -toShortText :: CommitHash -> Maybe T.Text -toShortText = fmap (T.take 7) . toText - -toText :: CommitHash -> Maybe T.Text -toText WorkingTree = Nothing -toText (Commit hash) = Just hash - -toTextUnsafe :: CommitHash -> T.Text -toTextUnsafe (Commit hash) = hash -toTextUnsafe _ = error "toTextUnsafe: WorkingDir" - -instance P.Render CommitHash where - render = P.render . P.Detailed - -instance P.Render (P.Detailed CommitHash) where - render (P.Detailed commitHash) = - P.styled [P.color P.Yellow] $ - P.render (fromMaybe "" (toText commitHash)) - -instance P.Render (P.Summarized CommitHash) where - render (P.Summarized commitHash) = - P.styled [P.color P.Yellow] $ - P.render (fromMaybe "" (toShortText commitHash)) diff --git a/app/History.hs b/app/History.hs index d423907..c808400 100644 --- a/app/History.hs +++ b/app/History.hs @@ -7,13 +7,13 @@ module History ) where +import Backend qualified import Comment qualified as G import Control.Exception (Handler (..), catches) import Data.List.NonEmpty qualified as NE import Data.Maybe (catMaybes) import Data.Proxy (Proxy (Proxy)) import Exception qualified as E -import Git qualified import History.IssueEvents (IssueEvents (..)) import History.Issues (Issues (..)) import History.Plan (formulate, realise) @@ -24,15 +24,15 @@ import Parallel (parMapM) getIssues :: IO Issues getIssues = realise . (formulate Proxy) . NE.fromList - =<< Git.getCommitHashes Nothing (Just Git.WorkingTree) + =<< Backend.getCommitHashes Nothing (Just Backend.WorkingTree) getIssueEvents :: IO IssueEvents getIssueEvents = realise . (formulate Proxy) . NE.fromList - =<< Git.getCommitHashes Nothing (Just Git.WorkingTree) + =<< Backend.getCommitHashes Nothing (Just Backend.WorkingTree) -- | Get all issues in the given directory and file. -getIssuesOfFile :: Git.CommitHash -> FilePath -> IO [I.Issue] +getIssuesOfFile :: Backend.CommitHash -> FilePath -> IO [I.Issue] getIssuesOfFile commitHash filename = ( fmap catMaybes . parMapM (fromComment commitHash) =<< G.getComments commitHash filename diff --git a/app/History/IssueEvents.hs b/app/History/IssueEvents.hs index 176d660..fc7bdcf 100644 --- a/app/History/IssueEvents.hs +++ b/app/History/IssueEvents.hs @@ -3,6 +3,7 @@ module History.IssueEvents ) where +import Backend qualified import Data.Binary (Binary) import Data.Function (on) import Data.List @@ -12,7 +13,6 @@ import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Proxy (Proxy) import GHC.Generics (Generic) -import Git qualified import History.Plan (Id, Planable, Proto, assume, propagate, protoOf) import History.Scramble (Scramble (..), getIssuesOfFile) import Issue (Issue (..)) @@ -20,17 +20,17 @@ import IssueEvent (IssueEvent (..)) import IssueEvent qualified as E data IssueEvents = IssueEvents - { commitHash :: Git.CommitHash, + { commitHash :: Backend.CommitHash, issueEvents :: [E.IssueEvent] } deriving (Show, Generic, Binary) instance Planable IssueEvents where - type Id IssueEvents = Git.CommitHash + type Id IssueEvents = Backend.CommitHash type Proto IssueEvents = Scramble - protoOf :: Proxy IssueEvents -> Git.CommitHash -> IO Scramble - protoOf _ commitHash@Git.WorkingTree = do - filesChanged <- Git.getFilesOf commitHash + protoOf :: Proxy IssueEvents -> Backend.CommitHash -> IO Scramble + protoOf _ commitHash@Backend.WorkingTree = do + filesChanged <- Backend.getFilesOf commitHash issues <- concat <$> mapM (getIssuesOfFile commitHash) filesChanged pure $ Scramble @@ -40,8 +40,8 @@ instance Planable IssueEvents where ], .. } - protoOf _ commitHash@(Git.Commit _) = do - filesChanged <- Git.getChangedFilesOf commitHash + protoOf _ commitHash@(Backend.Commit _) = do + filesChanged <- Backend.getChangedFilesOf commitHash issues <- concat <$> mapM (getIssuesOfFile commitHash) filesChanged pure $ Scramble @@ -63,7 +63,7 @@ instance Planable IssueEvents where } propagate :: - [Git.CommitHash] -> + [Backend.CommitHash] -> IssueEvents -> Scramble -> IssueEvents @@ -96,7 +96,7 @@ instance Planable IssueEvents where -- So, in the case `issue-1` has been re-opened, we cannot track its deletion at `commit-b`, because whether it was re-opened or originally created at `commit-b` depends on whether `issue-1` is present in the bottom `commit-a`, that we process only later. Thus, the scramble of commit `commit-b` cannot safely advance the issue's original commit, and we use this information to track re-opening of commits at later commits. -- -- Note that in the whole process, issue change events and issue deletion events can never be bottom-most/latest events, as they would depend on information not yet known, ie. the first commit can neither change nor delete an issue. -propagateIssueEvents :: [Git.CommitHash] -> IssueEvents -> Scramble -> IssueEvents +propagateIssueEvents :: [Backend.CommitHash] -> IssueEvents -> Scramble -> IssueEvents propagateIssueEvents log topIssueEvents bottomScramble = IssueEvents { commitHash = bottomScramble.commitHash, diff --git a/app/History/Issues.hs b/app/History/Issues.hs index 08ad772..63f1735 100644 --- a/app/History/Issues.hs +++ b/app/History/Issues.hs @@ -3,29 +3,29 @@ module History.Issues ) where +import Backend qualified import Data.Binary (Binary) import Data.Function (on) import Data.Map qualified as M import Data.Proxy (Proxy) import Data.Text qualified as T import GHC.Generics (Generic) -import Git qualified import History.Plan (Id, Planable, Proto, assume, propagate, protoOf) import History.Scramble (Scramble (..), getIssuesOfFile) import Issue qualified as I data Issues = Issues - { commitHash :: Git.CommitHash, + { commitHash :: Backend.CommitHash, issues :: M.Map T.Text I.Issue } deriving (Show, Generic, Binary) instance Planable Issues where - type Id Issues = Git.CommitHash + type Id Issues = Backend.CommitHash type Proto Issues = Scramble - protoOf :: Proxy Issues -> Git.CommitHash -> IO Scramble + protoOf :: Proxy Issues -> Backend.CommitHash -> IO Scramble protoOf _ commitHash = do - filesChanged <- Git.getChangedFilesOf commitHash + filesChanged <- Backend.getChangedFilesOf commitHash issues <- concat <$> mapM (getIssuesOfFile commitHash) filesChanged pure $ Scramble diff --git a/app/History/Scramble.hs b/app/History/Scramble.hs index 9004dbf..39a1ac7 100644 --- a/app/History/Scramble.hs +++ b/app/History/Scramble.hs @@ -5,6 +5,7 @@ module History.Scramble ) where +import Backend qualified import CMark qualified as D import Comment qualified as G import Control.Exception (Handler (..), catches) @@ -17,7 +18,6 @@ import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Encoding qualified as LT import Exception qualified as E import GHC.Generics (Generic) -import Git qualified import Issue qualified as I import Issue.Parser qualified as I import Issue.Tag qualified as I @@ -28,14 +28,14 @@ import Render qualified as P -- | `Scramble` records the complete issues ONLY in files that have -- been changed in the commit. data Scramble = Scramble - { commitHash :: Git.CommitHash, + { commitHash :: Backend.CommitHash, filesChanged :: [FilePath], issues :: M.Map T.Text I.Issue } deriving (Show, Binary, Generic) -- | Get all issues in the given directory and file. -getIssuesOfFile :: Git.CommitHash -> FilePath -> IO [I.Issue] +getIssuesOfFile :: Backend.CommitHash -> FilePath -> IO [I.Issue] getIssuesOfFile commitHash filename = ( fmap catMaybes . parMapM (fromComment commitHash) =<< G.getComments commitHash filename @@ -45,9 +45,9 @@ getIssuesOfFile commitHash filename = ] -- | Note that `provenance` is trivial and needs to be fixed up later. -fromComment :: Git.CommitHash -> G.Comment -> IO (Maybe I.Issue) +fromComment :: Backend.CommitHash -> G.Comment -> IO (Maybe I.Issue) fromComment commitHash comment = do - commit <- Git.getCommitOf commitHash + commit <- Backend.getCommitOf commitHash let provenance = I.Provenance commit commit pure $ diff --git a/app/Issue.hs b/app/Issue.hs index b6ddad6..f6a516c 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -9,6 +9,8 @@ module Issue ) where +import Backend (Author (..), Commit (..)) +import Backend qualified as Backend import CMark qualified as D import CMark.Extra () import Comment qualified as G @@ -24,8 +26,6 @@ import Data.Text.IO qualified as T import Data.Time.Clock (UTCTime (utctDay)) import GHC.Generics (Generic) import GHC.Records (HasField (..)) -import Git (Author (..), Commit (..)) -import Git qualified import Issue.Parser qualified as I import Issue.Provenance (Provenance (..)) import Issue.Tag (Tag (..)) @@ -33,7 +33,7 @@ import Issue.Text qualified as I import Prelude hiding (id) data Issue = Issue - { commitHash :: Git.CommitHash, + { commitHash :: Backend.CommitHash, language :: G.Language, rawTextHash :: S.Digest S.SHA1State, title :: T.Text, @@ -100,7 +100,7 @@ instance HasField "id" Issue T.Text where getText :: Issue -> IO T.Text getText (Issue {..}) = T.decodeUtf8 . LB.toStrict . LB.take (fromIntegral (endByte - startByte)) . LB.drop (fromIntegral startByte) - <$> Git.readTextFileOfBS commitHash file + <$> Backend.readTextFileOfBS commitHash file replaceText :: Issue -> T.Text -> IO () replaceText issue s' = diff --git a/app/Issue/Provenance.hs b/app/Issue/Provenance.hs index 321f6a2..90c96ea 100644 --- a/app/Issue/Provenance.hs +++ b/app/Issue/Provenance.hs @@ -3,12 +3,12 @@ module Issue.Provenance ) where +import Backend qualified import Data.Binary (Binary) import GHC.Generics (Generic) -import Git qualified data Provenance = Provenance - { first :: Git.Commit, - last :: Git.Commit + { first :: Backend.Commit, + last :: Backend.Commit } deriving (Eq, Show, Generic, Binary) diff --git a/app/Issue/Render.hs b/app/Issue/Render.hs index aca8134..9a5b030 100644 --- a/app/Issue/Render.hs +++ b/app/Issue/Render.hs @@ -10,12 +10,12 @@ module Issue.Render ) where +import Backend (Author (..), Commit (..)) import Data.List (intersperse) import Data.List.NonEmpty qualified as N import Data.Map qualified as M import Data.Text qualified as T import Data.Time.Clock (UTCTime (utctDay)) -import Git (Author (..), Commit (..)) import Issue (Issue (..)) import Issue.Provenance (Provenance (..)) import Render ((<<<), (===)) diff --git a/app/IssueEvent.hs b/app/IssueEvent.hs index 28bbae1..952e5a2 100644 --- a/app/IssueEvent.hs +++ b/app/IssueEvent.hs @@ -5,6 +5,7 @@ module IssueEvent ) where +import Backend.CommitHash (CommitHash) import Control.Monad (join) import Data.Binary (Binary (..)) import Data.Function ((&)) @@ -12,7 +13,6 @@ import Data.Text qualified as T import Data.Text.IO qualified as T import GHC.Generics (Generic) import GHC.Records (HasField (..)) -import Git.CommitHash (CommitHash) import Issue (Issue (..)) import Issue.Render qualified as I import Patch (Patch) diff --git a/app/Main.hs b/app/Main.hs index 1a1bf6b..4b129d9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -353,6 +353,7 @@ module Main where +import Backend qualified import Comment qualified as G import Control.Applicative ((<|>)) import Control.Exception (catch) @@ -366,7 +367,6 @@ import Data.Text.IO qualified as T import Data.Text.Lazy qualified as LT import Data.Text.Lazy.IO qualified as LT import Exception qualified as E -import Git qualified import History qualified as H import Issue (Issue (..)) import Issue qualified as I @@ -716,7 +716,7 @@ editIssues issues = withSystemTempDirectory "anissue-edit" (go issues) I.replaceText issue =<< T.readFile (fp issue) replaceTexts (issue : issues) = do I.replaceText issue =<< T.readFile (fp issue) - issues' <- H.getIssuesOfFile Git.WorkingTree issue.file + issues' <- H.getIssuesOfFile Backend.WorkingTree issue.file replaceTexts [fromMaybe issue (find ((==) issue.id . (.id)) issues') | issue <- issues] putDoc :: P.Render a => Color -> Bool -> Maybe Int -> a -> IO () diff --git a/app/Review.hs b/app/Review.hs index 721d8e3..52af23b 100644 --- a/app/Review.hs +++ b/app/Review.hs @@ -7,6 +7,7 @@ module Review ) where +import Backend qualified import Comment.Language qualified as L import Control.Monad (ap, forM, forM_, when) import Data.Binary qualified as B @@ -17,7 +18,6 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.IO qualified as T import GHC.Generics (Generic) -import Git qualified import Patch qualified as A import Process (proc, sh, sh_) import Render (renderAsText) @@ -31,7 +31,7 @@ import Text.Diff.Parse.Types qualified as D data Plan = Plan { baseBranch :: BranchName, featureBranch :: BranchName, - commit :: Git.CommitHash, + commit :: Backend.CommitHash, perCommit :: Bool, steps :: NE.NonEmpty PlanStep } @@ -40,22 +40,22 @@ data Plan = Plan type BranchName = T.Text data PlanStep = PlanStep - { commit :: Git.CommitHash, - earlierCommit :: Git.CommitHash, + { commit :: Backend.CommitHash, + earlierCommit :: Backend.CommitHash, changes :: D.FileDeltas } deriving (Show, Generic, B.Binary) formulatePlan :: Bool -> T.Text -> T.Text -> IO Plan formulatePlan perCommit baseBranch featureBranch = do - baseCommit <- Git.resolveRef baseBranch - featureCommit <- Git.resolveRef featureBranch + baseCommit <- Backend.resolveRef baseBranch + featureCommit <- Backend.resolveRef featureBranch commits <- if perCommit then do commits <- - reverse <$> Git.getCommitsBetween baseCommit featureCommit + reverse <$> Backend.getCommitsBetween baseCommit featureCommit pure $ zipWith (,) commits (baseCommit : commits) else pure [(featureCommit, baseCommit)] @@ -63,7 +63,7 @@ formulatePlan perCommit baseBranch featureBranch = do fmap concat . forM commits $ \(commit, earlierCommit) -> map ((commit, earlierCommit),) . (: []) . (.fileDeltas) - <$> Git.diffOf earlierCommit commit + <$> Backend.diffOf earlierCommit commit pure Plan @@ -86,8 +86,8 @@ reviewStep step = do <$> sh ( proc "git log %..%" - (Git.toTextUnsafe step.earlierCommit) - (Git.toTextUnsafe step.commit) + (Backend.toTextUnsafe step.earlierCommit) + (Backend.toTextUnsafe step.commit) ) separateReview step.earlierCommit step.changes =<< reviewPatch commitMessages step.changes @@ -136,7 +136,7 @@ addComments = mapLines f x = x {D.hunkLines = map f x.hunkLines} separateReview :: - Git.CommitHash -> + Backend.CommitHash -> D.FileDeltas -> D.FileDeltas -> IO D.FileDeltas @@ -163,7 +163,7 @@ separateReview commit fileDeltas fileDeltas' = patchFile = "a.patch" patchFile' = "b.patch" -withTempSourceFiles :: Git.CommitHash -> D.FileDeltas -> (FilePath -> IO a) -> IO a +withTempSourceFiles :: Backend.CommitHash -> D.FileDeltas -> (FilePath -> IO a) -> IO a withTempSourceFiles commit fileDeltas action = do withSystemTempDirectory "anissue" $ \tmp -> do createDirectoryIfMissing False (tmp "a") @@ -173,8 +173,8 @@ withTempSourceFiles commit fileDeltas action = do fileContents <- if sourceFile /= "/dev/null" then case commit of - Git.Commit hash -> sh (proc "git show %:%" hash sourceFile) - Git.WorkingTree -> sh (proc "cat" sourceFile) + Backend.Commit hash -> sh (proc "git show %:%" hash sourceFile) + Backend.WorkingTree -> sh (proc "cat" sourceFile) else pure "" createDirectoryIfMissing True (tmp "a" sourceDir) LB.writeFile (tmp "a" sourceFile) fileContents @@ -209,11 +209,11 @@ commit_editmsg plan = do "#", "# review: approve " <> plan.featureBranch, "#", - "# Reviewed branch " <> plan.featureBranch <> " at commit " <> Git.toTextUnsafe plan.commit <> ".", + "# Reviewed branch " <> plan.featureBranch <> " at commit " <> Backend.toTextUnsafe plan.commit <> ".", "#", "# To requst changes, format your commit message like this:", "#", "# review: request-changes " <> plan.featureBranch, "#", - "# Reviewed branch " <> plan.featureBranch <> " at commit " <> Git.toTextUnsafe plan.commit <> "." + "# Reviewed branch " <> plan.featureBranch <> " at commit " <> Backend.toTextUnsafe plan.commit <> "." ] diff --git a/app/Settings.hs b/app/Settings.hs index c439b65..2d3c204 100644 --- a/app/Settings.hs +++ b/app/Settings.hs @@ -4,10 +4,10 @@ module Settings ) where +import Backend qualified import Data.Aeson qualified as A import Data.Yaml (decodeFileThrow) import GHC.Generics (Generic) -import Git qualified import System.Directory (doesFileExist) import System.Environment.XDG.BaseDir (getSystemConfigFiles, getUserConfigFile) import System.FilePath (()) @@ -40,5 +40,5 @@ readSettings = <$> sequence [ getSystemConfigFiles "anissue" "settings.yaml", ((: []) <$> getUserConfigFile "anissue" "settings.yaml"), - ((: []) . ( "anissue.yaml")) <$> Git.getRootDir + ((: []) . ( "anissue.yaml")) <$> Backend.getRootDir ] -- cgit v1.2.3