aboutsummaryrefslogtreecommitdiffstats
path: root/app
diff options
context:
space:
mode:
Diffstat (limited to 'app')
-rw-r--r--app/History/CommitInfo.hs34
-rw-r--r--app/Issue.hs25
-rw-r--r--app/Main.hs49
3 files changed, 33 insertions, 75 deletions
diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs
index 94e2f96..3c371d1 100644
--- a/app/History/CommitInfo.hs
+++ b/app/History/CommitInfo.hs
@@ -46,18 +46,13 @@ fromPartialCommitInfos (partialCommitInfo : partialCommitInfos) =
Just
new
{ provenance =
- ( \oldProvenance newProvenance ->
- ( I.Provenance
- { first = oldProvenance.first,
- last =
- if clear old /= clear new
- then newProvenance.last
- else oldProvenance.last
- }
- )
- )
- <$> old.provenance
- <*> new.provenance
+ I.Provenance
+ { first = old.provenance.first,
+ last =
+ if ((/=) `on` (.rawText)) old new
+ then new.provenance.last
+ else old.provenance.last
+ }
}
)
( \old ->
@@ -85,7 +80,7 @@ diffCommitInfos oldInfo newInfo =
[ [IssueCreated newHash issue | issue <- deleteFirstsBy eq newIssues oldIssues],
[ IssueChanged newHash (last issues)
| issues <- intersectBy' eq newIssues oldIssues,
- not (null [(x, y) | x <- issues, y <- issues, clear x /= clear y])
+ not (null [(x, y) | x <- issues, y <- issues, ((/=) `on` (.rawText)) x y])
],
[IssueDeleted newHash issue | issue <- deleteFirstsBy eq oldIssues newIssues]
]
@@ -96,19 +91,6 @@ diffCommitInfos oldInfo newInfo =
eq = (==) `on` id
--- TODO Fix issue comparison
---
--- Because issues carry `provenance` issues compare unequally when we want
--- them to be equal.
-clear :: Issue -> Issue
-clear i =
- i
- { provenance = Nothing,
- start = Position 0 0,
- end = Position 0 0,
- file = ""
- }
-
mergeListsBy :: (a -> a -> Bool) -> (a -> a -> b) -> (a -> b) -> (a -> b) -> [a] -> [a] -> [b]
mergeListsBy eq onBoth onLeft onRight lefts rights =
concat
diff --git a/app/Issue.hs b/app/Issue.hs
index b8deb6e..6d8746d 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -31,12 +31,7 @@ data Issue = Issue
{ title :: T.Text,
description :: Maybe T.Text,
file :: String,
- -- TODO Make provenance obligatory
- --
- -- I cannot think of instances where an issue exists without a provenance..
- --
- -- @difficulty easy
- provenance :: Maybe Provenance,
+ provenance :: Provenance,
start :: G.Position,
end :: G.Position,
tags :: [Tag],
@@ -54,18 +49,12 @@ internalTags :: Issue -> [Tag]
internalTags (Issue {..}) =
concat
[ [ Tag "id" $ Just $ toSpinalCase title,
- Tag "title" $ Just $ title
+ Tag "title" $ Just $ title,
+ Tag "createdAt" $ Just $ T.pack $ show $ utctDay provenance.first.date,
+ Tag "modifiedAt" $ Just $ T.pack $ show $ utctDay provenance.last.date,
+ Tag "author" $ Just $ provenance.first.author.name,
+ Tag "editor" $ Just $ provenance.last.author.name
],
- maybe
- []
- ( \provenance' ->
- [ Tag "createdAt" $ Just $ T.pack $ show $ utctDay provenance'.first.date,
- Tag "modifiedAt" $ Just $ T.pack $ show $ utctDay provenance'.last.date,
- Tag "author" $ Just $ provenance'.first.author.name,
- Tag "editor" $ Just $ provenance'.last.author.name
- ]
- )
- provenance,
map (Tag "type" . Just) markers
]
@@ -95,7 +84,7 @@ fromComment cwd comment = do
{ title = title,
description = description,
file = comment.file,
- provenance = Just provenance,
+ provenance = provenance,
start = comment.start,
end = comment.end,
tags = maybe [] I.extractTags description,
diff --git a/app/Main.hs b/app/Main.hs
index 4d3902d..1de7360 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -626,20 +626,16 @@ main = do
( \issue ->
let title = map (P.annotate P.bold . P.pretty) (T.words issue.title)
tags = prettyTags (issue.tags ++ if internalTags then issue.internalTags else [])
- openedBy =
- fromProvenance $
- P.annotate (P.color P.Black) . ("by" <+>) . P.pretty . (.first.author.name)
- openedOn =
- fromProvenance $
- P.annotate (P.color P.Black) . ("on" <+>) . P.pretty . show . utctDay . (.first.date)
- fromProvenance = flip fmap issue.provenance
+ openedBy = P.annotate (P.color P.Black) ("by" <+> P.pretty issue.provenance.first.author.name)
+ openedOn = P.annotate (P.color P.Black) ("on" <+> P.pretty (show (utctDay issue.provenance.first.date)))
in P.nest 4 $
P.fillSep
( concat $
[ title,
tags,
- maybeToList openedOn,
- maybeToList openedBy
+ [ openedOn,
+ openedBy
+ ]
]
)
)
@@ -655,20 +651,16 @@ main = do
( \issue ->
let title = map (P.annotate P.bold . P.pretty) (T.words issue.title)
tags = prettyTags (issue.tags ++ if internalTags then issue.internalTags else [])
- openedBy =
- fromProvenance $
- P.annotate (P.color P.Black) . ("by" <+>) . P.pretty . (.first.author.name)
- openedOn =
- fromProvenance $
- P.annotate (P.color P.Black) . ("on" <+>) . P.pretty . show . utctDay . (.first.date)
- fromProvenance = flip fmap issue.provenance
+ openedBy = P.annotate (P.color P.Black) ("by" <+> (P.pretty (issue.provenance.first.author.name)))
+ openedOn = P.annotate (P.color P.Black) ("on" <+> (P.pretty (show (utctDay ((issue.provenance.first.date))))))
in P.nest 4 $
P.fillSep
( concat $
[ title,
tags,
- maybeToList openedOn,
- maybeToList openedBy
+ [ openedOn,
+ openedBy
+ ]
]
)
)
@@ -722,19 +714,14 @@ main = do
issue.file
++ ":"
++ show issue.start.row
- ++ ( case issue.provenance of
- Nothing ->
- "HEAD"
- Just provenance ->
- "\nvia "
- ++ T.unpack provenance.first.hash
- ++ "\nby "
- ++ T.unpack provenance.first.author.name
- ++ " <"
- ++ T.unpack provenance.first.author.email
- ++ ">\nat "
- ++ show provenance.first.date
- )
+ ++ "\nvia "
+ ++ T.unpack issue.provenance.first.hash
+ ++ "\nby "
+ ++ T.unpack issue.provenance.first.author.name
+ ++ " <"
+ ++ T.unpack issue.provenance.first.author.email
+ ++ ">\nat "
+ ++ show issue.provenance.first.date
++ "\n\n"
sh_
( ( case width of
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 15:24:59 +0000