diff options
| -rw-r--r-- | app/History/CommitInfo.hs | 13 | ||||
| -rw-r--r-- | app/Issue.hs | 47 | ||||
| -rw-r--r-- | app/Issue/Tag.hs | 29 |
3 files changed, 42 insertions, 47 deletions
diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs index 865fcc4..94e2f96 100644 --- a/app/History/CommitInfo.hs +++ b/app/History/CommitInfo.hs @@ -16,7 +16,6 @@ import History.IssueEvent (IssueEvent (..)) import History.PartialCommitInfo (PartialCommitInfo (..)) import Issue (Issue (..), id) import Issue.Provenance qualified as I -import Issue.Tag qualified as I import TreeGrepper.Match (Position (..)) import Prelude hiding (id) @@ -58,12 +57,7 @@ fromPartialCommitInfos (partialCommitInfo : partialCommitInfos) = ) ) <$> old.provenance - <*> new.provenance, - internalTags = - I.internalTags - new.title - old.provenance - (I.tagValuesOf "type" new.internalTags) + <*> new.provenance } ) ( \old -> @@ -104,13 +98,12 @@ diffCommitInfos oldInfo newInfo = -- TODO Fix issue comparison -- --- Because issues carry `provenance` and `internalTags`, issues compare --- unequally when we want them to be equal. +-- Because issues carry `provenance` issues compare unequally when we want +-- them to be equal. clear :: Issue -> Issue clear i = i { provenance = Nothing, - internalTags = [], start = Position 0 0, end = Position 0 0, file = "" diff --git a/app/Issue.hs b/app/Issue.hs index e6568ad..8d8e250 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -3,6 +3,7 @@ module Issue Provenance (..), fromComment, id, + internalTags, getIssues, ) where @@ -12,11 +13,12 @@ import Control.Exception (handle) import Data.Binary (Binary) import Data.List (find) import Data.Maybe (catMaybes) -import Data.Text (Text) import Data.Text qualified as T +import Data.Time.Clock (UTCTime (utctDay)) import Exception qualified as E import GHC.Generics (Generic) -import Issue.Provenance (Provenance (..), commitFromHEAD) +import GHC.Records (HasField (..)) +import Issue.Provenance (Author (..), Commit (..), Provenance (..), commitFromHEAD) import Issue.Tag (Tag (..)) import Issue.Tag qualified as I import Issue.Text qualified as I @@ -26,8 +28,8 @@ import TreeGrepper.Match qualified as G import Prelude hiding (id) data Issue = Issue - { title :: Text, - description :: Maybe Text, + { title :: T.Text, + description :: Maybe T.Text, file :: String, -- TODO Make provenance obligatory -- @@ -38,7 +40,7 @@ data Issue = Issue start :: G.Position, end :: G.Position, tags :: [Tag], - internalTags :: [Tag] + markers :: [T.Text] } deriving (Show, Binary, Generic, Eq) @@ -47,11 +49,38 @@ id issue = (\(Tag _ v) -> T.unpack <$> v) =<< find (\(Tag k _) -> k == "id") (issue.tags ++ issue.internalTags) +internalTags :: Issue -> [Tag] +internalTags (Issue {..}) = + concat + [ [ Tag "id" $ Just $ toSpinalCase title, + Tag "title" $ Just $ title + ], + 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 + ] + +instance HasField "internalTags" Issue [Tag] where + getField issue = internalTags issue + +toSpinalCase :: T.Text -> T.Text +toSpinalCase = T.replace " " "-" . T.filter keep . T.toLower + where + keep = (`elem` (concat [[' ', '-'], ['a' .. 'z'], ['0' .. '9']])) + -- TODO Refactor non-issues -- -- This does not return an issue, as provenance is not computed over its -- history. Maybe this should return a different type, or be internal to --- `History`? Also, `internalTags` suffer. +-- `History`? fromComment :: FilePath -> Comment -> IO (Maybe Issue) fromComment cwd comment = do commit <- commitFromHEAD cwd @@ -69,7 +98,7 @@ fromComment cwd comment = do start = comment.start, end = comment.end, tags = maybe [] I.extractTags description, - internalTags = I.internalTags title (Just provenance) markers + markers = markers } else Nothing ) @@ -77,14 +106,14 @@ fromComment cwd comment = do (title', description) = I.extractText comment.file_type comment.text (markers, title) = stripIssueMarkers title' -issueMarkers :: [Text] +issueMarkers :: [T.Text] issueMarkers = [ "TODO", "FIXME", "QUESTION" ] -stripIssueMarkers :: Text -> ([Text], Text) +stripIssueMarkers :: T.Text -> ([T.Text], T.Text) stripIssueMarkers text = case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of (marker : _) -> diff --git a/app/Issue/Tag.hs b/app/Issue/Tag.hs index 29c69d9..ca550aa 100644 --- a/app/Issue/Tag.hs +++ b/app/Issue/Tag.hs @@ -1,7 +1,6 @@ module Issue.Tag ( Tag (..), extractTags, - internalTags, tagKey, tagValue, tagValuesOf, @@ -11,11 +10,9 @@ where import CMark qualified as D import Data.Binary (Binary) import Data.Maybe (catMaybes, mapMaybe) -import Data.Text (Text, pack) +import Data.Text (Text) import Data.Text qualified as T -import Data.Time.Clock (UTCTime (utctDay)) import GHC.Generics (Generic) -import Issue.Provenance (Author (..), Commit (..), Provenance (..)) data Tag = Tag Text (Maybe Text) deriving (Show, Generic, Binary, Eq) @@ -56,27 +53,3 @@ extractTags = collect . D.commonmarkToNode [] . T.words ) . T.lines - -internalTags :: Text -> Maybe Provenance -> [T.Text] -> [Tag] -internalTags title provenance' markers = - concat - [ [ Tag "id" $ Just $ toSpinalCase title, - Tag "title" $ Just $ title - ], - maybe - [] - ( \provenance -> - [ Tag "createdAt" $ Just $ pack $ show $ utctDay provenance.first.date, - Tag "modifiedAt" $ Just $ 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 - ] - -toSpinalCase :: Text -> Text -toSpinalCase = T.replace " " "-" . T.filter keep . T.toLower - where - keep = (`elem` (concat [[' ', '-'], ['a' .. 'z'], ['0' .. '9']])) |