diff options
| -rw-r--r-- | app/History.hs | 111 | ||||
| -rw-r--r-- | app/Main.hs | 13 |
2 files changed, 52 insertions, 72 deletions
diff --git a/app/History.hs b/app/History.hs index 72ca2d9..3ac8a8e 100644 --- a/app/History.hs +++ b/app/History.hs @@ -7,13 +7,14 @@ where import CMark qualified as D import Cache (cachedMaybe) import Comment qualified as G +import Control.Arrow (first) import Control.Exception (catch, handle, try) import Data.Binary (Binary) import Data.ByteString.Lazy qualified as LB import Data.Function (on, (&)) -import Data.List (deleteFirstsBy, find) import Data.List.NonEmpty qualified as N -import Data.Maybe (catMaybes, isJust) +import Data.Map qualified as M +import Data.Maybe (catMaybes) import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.IO qualified as T @@ -56,7 +57,7 @@ import Tuple () data History = History { commitHash :: CommitHash, - issues :: [I.Issue], + issues :: M.Map T.Text I.Issue, issueEvents :: [IssueEvent] } deriving (Show, Generic, Binary) @@ -90,13 +91,13 @@ getParentCommitHashOf commitHash = data Scramble = Scramble { commitHash :: CommitHash, filesChanged :: [FilePath], - issues :: [I.Issue] + issues :: M.Map T.Text I.Issue } deriving (Show, Binary, Generic) getScrambleOf :: CommitHash -> IO Scramble getScrambleOf commitHash = do - (issues, filesChanged) <- getIssuesAndFilesChanged commitHash + (issues, filesChanged) <- first (M.fromList . map (\i -> (i.id, i))) <$> getIssuesAndFilesChanged commitHash pure $ Scramble {..} getIssuesAndFilesChanged :: CommitHash -> IO ([I.Issue], [FilePath]) @@ -151,51 +152,57 @@ propagate commitHash oldHistory scramble = do issueEvents <- propagateIssueEvents oldHistory.issueEvents oldHistory.issues commitHash issues pure $ History {..} -propagateIssues :: [I.Issue] -> Scramble -> [I.Issue] -propagateIssues oldIssues partialCommitInfo = - mergeListsBy - eq - ( \old new -> - new - { I.provenance = - I.Provenance - { first = old.provenance.first, - last = - if ((/=) `on` (.rawText)) old new - then new.provenance.last - else old.provenance.last - }, - I.closed = False - } +propagateIssues :: M.Map T.Text I.Issue -> Scramble -> M.Map T.Text I.Issue +propagateIssues oldIssues scramble = + M.mergeWithKey + ( \_ old new -> + Just $ + new + { I.provenance = + I.Provenance + { first = old.provenance.first, + last = + if ((/=) `on` (.rawText)) old new + then new.provenance.last + else old.provenance.last + }, + I.closed = False + } ) - ( \old -> - if elemBy eq old partialCommitInfo.issues - || not (old.file `elem` partialCommitInfo.filesChanged) - then old - else old {I.closed = True} + ( M.map + ( \old -> + if M.member old.id scramble.issues + || not (old.file `elem` scramble.filesChanged) + then old + else old {I.closed = True} + ) ) id oldIssues - partialCommitInfo.issues + scramble.issues -propagateIssueEvents :: [IssueEvent] -> [I.Issue] -> CommitHash -> [I.Issue] -> IO [IssueEvent] +propagateIssueEvents :: [IssueEvent] -> M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> IO [IssueEvent] propagateIssueEvents oldIssueEvents oldIssues commitHash issues = fmap (oldIssueEvents ++) $ newIssueEvents oldIssues commitHash issues -newIssueEvents :: [I.Issue] -> CommitHash -> [I.Issue] -> IO [IssueEvent] +newIssueEvents :: M.Map T.Text I.Issue -> CommitHash -> M.Map T.Text I.Issue -> IO [IssueEvent] newIssueEvents oldIssues' commitHash issues' = sequence $ concat - [ [IssueCreated commitHash issue <$> patchCreated issue | issue <- deleteFirstsBy eq issues oldIssues], + [ [ IssueCreated commitHash issue <$> patchCreated issue + | issue <- M.elems (issues `M.difference` oldIssues) + ], [ IssueChanged commitHash oldIssue newIssue <$> patchChanged oldIssue newIssue - | (newIssue : oldIssue : _) <- intersectBy' eq issues oldIssues, - neq newIssue oldIssue + | (newIssue, oldIssue) <- M.elems (M.intersectionWith (,) issues oldIssues), + newIssue `neq` oldIssue ], - [IssueDeleted commitHash issue {I.closed = True} <$> patchDeleted issue | issue <- deleteFirstsBy eq oldIssues issues] + [ IssueDeleted commitHash issue {I.closed = True} <$> patchDeleted issue + | issue <- M.elems (oldIssues `M.difference` issues) + ] ] where - issues = filter (not . (.closed)) issues' - oldIssues = filter (not . (.closed)) oldIssues' + issues = M.filter (not . (.closed)) issues' + oldIssues = M.filter (not . (.closed)) oldIssues' patchCreated new = diff "" new.rawText patchChanged old new = diff old.rawText new.rawText @@ -207,38 +214,10 @@ newIssueEvents oldIssues' commitHash issues' = T.writeFile (tmp </> "new") new A.parse . LT.toStrict . LT.decodeUtf8 <$> sh ("git diff --no-index -- old new || :" & setWorkingDir cwd) + neq = (/=) `on` (.rawText) + unsafeAssume :: CommitHash -> Scramble -> IO History unsafeAssume commitHash scramble = do let issues = scramble.issues - issueEvents <- propagateIssueEvents [] [] commitHash issues + issueEvents <- propagateIssueEvents [] M.empty commitHash issues pure $ History {..} - -eq :: I.Issue -> I.Issue -> Bool -eq = (==) `on` (.id) - -neq :: I.Issue -> I.Issue -> Bool -neq = (/=) `on` (.rawText) - -mergeListsBy :: (a -> a -> Bool) -> (a -> a -> b) -> (a -> b) -> (a -> b) -> [a] -> [a] -> [b] -mergeListsBy eq onBoth onLeft onRight lefts rights = - concat - [ [ maybe (onLeft left) (onBoth left) right - | left <- lefts, - right <- - let rights' = filter (eq left) rights - in if null rights' then [Nothing] else (map Just rights') - ], - [ onRight right - | right <- rights, - not (elemBy eq right lefts) - ] - ] - --- | A variant of `Data.List.intersectBy` that retuns the witnesses of the --- intersection. -intersectBy' :: (a -> a -> Bool) -> [a] -> [a] -> [[a]] -intersectBy' eq xs ys = filter (not . null) (map (\x -> x : filter (eq x) ys) xs) - --- | A variant of `elem` that uses a custom comparison function. -elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool -elemBy eq x xs = isJust $ find (eq x) xs diff --git a/app/Main.hs b/app/Main.hs index 7c0e748..d757292 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -334,7 +334,8 @@ module Main where import Control.Applicative ((<|>)) import Data.Function ((&)) -import Data.List (find, intersperse) +import Data.List (intersperse) +import Data.Map qualified as M import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Text.Lazy qualified as LT @@ -517,7 +518,7 @@ idArg = ( O.metavar "ID" <> O.completer ( O.listIOCompleter $ - map (T.unpack . I.id) . (.issues) + map T.unpack . M.keys . (.issues) <$> getHistory ) ) @@ -552,7 +553,7 @@ main = do . I.applyFilters filters . I.applyPath files . I.applyClosed closed - . (.issues) + . (M.elems . (.issues)) <$> getHistory let groupedIssues = I.groupIssuesByTag group ungroupedIssues putDoc colorize noPager width (group, groupedIssues) @@ -562,7 +563,7 @@ main = do . I.applyFilters filters . I.applyPath files . I.applyClosed closed - . (.issues) + . (M.elems . (.issues)) <$> getHistory putDoc colorize noPager width . (P.vsep . intersperse "") $ map (if detailed then (P.render . P.Detailed) else (P.render . P.Summarized)) issues @@ -575,7 +576,7 @@ main = do Options {colorize, noPager, width, command = Show {id, edit}} -> do issues <- (.issues) <$> getHistory issue <- - case find ((==) id . T.unpack . I.id) issues of + case M.lookup (T.pack id) issues of Nothing -> die (printf "no issue with id `%s'\n" id) Just issue -> pure issue if edit @@ -586,7 +587,7 @@ main = do hClose h sh_ (proc "${EDITOR-vi} -- %" fp) I.replaceText issue =<< T.readFile fp - else putDoc colorize noPager width $ showIssue issues issue + else putDoc colorize noPager width $ showIssue (M.elems issues) issue Options {colorize, noPager, width, internalTags, command = Tags} -> do issues <- (.issues) <$> getHistory let tags = |