aboutsummaryrefslogtreecommitdiffstats
path: root/app/Issue.hs
diff options
context:
space:
mode:
Diffstat (limited to 'app/Issue.hs')
-rw-r--r--app/Issue.hs47
1 files changed, 38 insertions, 9 deletions
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 : _) ->