don't cache `internalTags`

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 : _) ->