chore: uncache large issue fields

8 files changed, 102 insertions, 43 deletions

diff --git a/anissue.cabal b/anissue.cabal
index 5ebda20..74c1478 100644
--- a/anissue.cabal
+++ b/anissue.cabal
@@ -119,6 +119,7 @@ executable anissue
                       prettyprinter,
                       prettyprinter-ansi-terminal,
                       regex,
+                      SHA,
                       temporary,
                       terminal-size,
                       text,
diff --git a/app/Comment.hs b/app/Comment.hs
index 5d1c1ef..c834509 100644
--- a/app/Comment.hs
+++ b/app/Comment.hs
@@ -15,13 +15,13 @@ import Control.Exception (catch)
 import Control.Monad
 import Data.Binary (Binary)
 import Data.ByteString qualified as B
+import Data.ByteString.Lazy qualified as LB
 import Data.List (find, sortBy)
 import Data.List.NonEmpty qualified as N
 import Data.Maybe (fromMaybe)
 import Data.Ord (comparing)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
-import Data.Text.Lazy qualified as LT
 import Exception qualified as E
 import Foreign.C.String
 import Foreign.Marshal.Alloc (malloc)
@@ -29,6 +29,7 @@ import Foreign.Marshal.Array (mallocArray, peekArray)
 import Foreign.Ptr (nullPtr)
 import Foreign.Storable
 import GHC.Generics (Generic)
+import GHC.Int (Int64)
 import Git qualified
 import System.FilePath (takeExtension)
 import TreeSitter.Node qualified as S
@@ -38,8 +39,8 @@ import TreeSitter.Tree qualified as S
 data Comment = Comment
   { text :: T.Text,
     language :: Language,
-    start :: Int,
-    end :: Int,
+    startByte :: Int64,
+    endByte :: Int64,
     startPoint :: Point,
     endPoint :: Point,
     filePath :: FilePath
@@ -55,10 +56,9 @@ data Point = Point
 getComments :: Git.CommitHash -> FilePath -> IO [Comment]
 getComments commitHash filePath =
   fmap mergeLineComments
-    . extractComments filePath language
-    . (T.encodeUtf8 . LT.toStrict)
+    . (extractComments filePath language . LB.toStrict)
     =<< catch
-      (Git.readTextFileOf commitHash filePath)
+      (Git.readTextFileOfBS commitHash filePath)
       (\(_ :: E.CannotReadFile) -> pure "")
   where
     language = fromExtension (takeExtension filePath)
@@ -67,14 +67,14 @@ getComments commitHash filePath =
     mergeLineComments =
       map mergeGroup
         . chainsBy (\a b -> a.endPoint.row + 1 == b.startPoint.row)
-        . sortBy (comparing (liftA2 (,) (.start) (.end)))
+        . sortBy (comparing (liftA2 (,) (.startByte) (.endByte)))
 
     mergeGroup :: N.NonEmpty Comment -> Comment
     mergeGroup css@(c N.:| cs) =
       c
         { text = T.unlines (map (.text) (c : cs)),
-          start = first.start,
-          end = last.end,
+          startByte = first.startByte,
+          endByte = last.endByte,
           startPoint = first.startPoint,
           endPoint = last.endPoint
         }
@@ -100,9 +100,13 @@ extractComments filePath language str' = do
       S.withRootNode tree $ \node -> do
         map
           ( \n' ->
-              let start = fromIntegral $ S.nodeStartByte n'
-                  end = fromIntegral $ S.nodeEndByte n'
-                  text = T.decodeUtf8 . B.take (end - start) . B.drop start $ str'
+              let startByte = fromIntegral $ S.nodeStartByte n'
+                  endByte = fromIntegral $ S.nodeEndByte n'
+                  text =
+                    T.decodeUtf8
+                      . B.take (fromIntegral endByte - fromIntegral startByte)
+                      . B.drop (fromIntegral startByte)
+                      $ str'
                   startPoint = fromTSPoint (S.nodeStartPoint n')
                   endPoint = fromTSPoint (S.nodeEndPoint n')
 
diff --git a/app/Git.hs b/app/Git.hs
index be95f61..6431259 100644
--- a/app/Git.hs
+++ b/app/Git.hs
@@ -6,7 +6,8 @@ module Git
     Commit (..),
     Author (..),
     getCommitOf,
-    readTextFileOf,
+    readTextFileOfText,
+    readTextFileOfBS,
   )
 where
 
@@ -28,7 +29,6 @@ import GHC.Generics (Generic)
 import Git.CommitHash
 import Process (proc, sh)
 import Text.Printf (printf)
-import Prelude hiding (lines)
 
 getCommitHashes :: IO (NonEmpty T.Text)
 getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB.toStrict <$> sh "git log --format=%H"
@@ -87,12 +87,18 @@ getCommitOf commitHash@(Commit hash) = do
                 }
       _ -> throwIO E.NoCommits
 
-readTextFileOf :: CommitHash -> FilePath -> IO LT.Text
-readTextFileOf WorkingTree filePath =
+readTextFileOfText :: CommitHash -> FilePath -> IO LT.Text
+readTextFileOfText = readTextFileOf LT.readFile LT.decodeUtf8
+
+readTextFileOfBS :: CommitHash -> FilePath -> IO LB.ByteString
+readTextFileOfBS = readTextFileOf LB.readFile (\x->x)
+
+readTextFileOf :: (FilePath -> IO a) -> (LB.ByteString -> a) -> CommitHash -> FilePath -> IO a
+readTextFileOf readFile _ WorkingTree filePath =
   catch
-    (LT.readFile filePath)
+    (readFile filePath)
     (\(_ :: IOException) -> throwIO (E.CannotReadFile filePath))
-readTextFileOf (Commit hash) filePath =
+readTextFileOf _ decode (Commit hash) filePath =
   catch
-    (LT.decodeUtf8 <$> sh (proc "git show %:%" hash filePath))
+    (decode <$> sh (proc "git show %:%" hash filePath))
     (\(_ :: E.ProcessException) -> throwIO (E.CannotReadFile (printf "%s:%s" hash filePath)))
diff --git a/app/History.hs b/app/History.hs
index 31651bd..0e498b7 100644
--- a/app/History.hs
+++ b/app/History.hs
@@ -12,12 +12,14 @@ import Control.Arrow (first)
 import Control.Exception (catch, handle, try)
 import Data.Binary (Binary)
 import Data.ByteString.Lazy qualified as LB
+import Data.Digest.Pure.SHA qualified as S
 import Data.Function (on)
-import Data.List.NonEmpty qualified as N
 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.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
 import Die (die)
 import Exception qualified as E
 import GHC.Generics (Generic)
@@ -123,17 +125,19 @@ fromComment commitHash comment = do
         let (markers, title) =
               I.stripIssueMarkers (T.pack (show (P.render parseResult.heading)))
          in I.Issue
-              { title = title,
-                description = N.nonEmpty parseResult.paragraphs,
+              { commitHash = commitHash,
+                language = comment.language,
+                rawTextHash = S.sha1 (LT.encodeUtf8 (LT.fromStrict rawText)),
+                title = title,
                 file = comment.filePath,
                 provenance = provenance,
+                startByte = comment.startByte,
+                endByte = comment.endByte,
                 startPoint = comment.startPoint,
                 endPoint = comment.endPoint,
                 tags = I.extractTags parseResult.tags,
                 markers = markers,
-                rawText = rawText,
                 commentStyle = commentStyle,
-                comments = N.nonEmpty parseResult.comments,
                 closed = False
               }
     )
@@ -159,7 +163,7 @@ propagateIssues oldIssues scramble =
                 I.Provenance
                   { first = old.provenance.first,
                     last =
-                      if ((/=) `on` (.rawText)) old new
+                      if ((/=) `on` (.rawTextHash)) old new
                         then new.provenance.last
                         else old.provenance.last
                   },
@@ -190,7 +194,7 @@ newIssueEvents oldIssues' commitHash issues' =
       ],
       [ IssueChanged commitHash oldIssue newIssue
         | (newIssue, oldIssue) <- M.elems (M.intersectionWith (,) issues oldIssues),
-          newIssue `neq` oldIssue
+          ((/=) `on` (.rawTextHash)) newIssue oldIssue
       ],
       [ IssueDeleted commitHash issue {I.closed = True}
         | issue <- M.elems (oldIssues `M.difference` issues)
@@ -200,8 +204,6 @@ newIssueEvents oldIssues' commitHash issues' =
     issues = M.filter (not . (.closed)) issues'
     oldIssues = M.filter (not . (.closed)) oldIssues'
 
-    neq = (/=) `on` (.rawText)
-
 unsafeAssume :: CommitHash -> Scramble -> History
 unsafeAssume commitHash scramble =
   History
diff --git a/app/Issue.hs b/app/Issue.hs
index 124b0d7..27f6801 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -12,34 +12,67 @@ where
 import CMark qualified as D
 import CMark.Extra ()
 import Comment qualified as G
+import Comment.Language qualified as G
 import Data.Binary (Binary (..))
+import Data.ByteString.Lazy qualified as LB
+import Data.Digest.Pure.SHA qualified as S
 import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as N
 import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
 import Data.Text.IO qualified as T
 import Data.Time.Clock (UTCTime (utctDay))
 import GHC.Generics (Generic)
+import GHC.Int (Int64)
 import GHC.Records (HasField (..))
 import Git (Author (..), Commit (..))
+import Git qualified as Git
+import Issue.Parser qualified as I
 import Issue.Provenance (Provenance (..))
 import Issue.Tag (Tag (..))
+import Issue.Text qualified as I
 import Prelude hiding (id)
 
 data Issue = Issue
-  { title :: T.Text,
-    description :: Maybe (NonEmpty D.Node),
-    file :: String,
+  { commitHash :: Git.CommitHash,
+    language :: G.Language,
+    rawTextHash :: S.Digest S.SHA1State,
+    title :: T.Text,
+    file :: FilePath,
     provenance :: Provenance,
+    startByte :: Int64,
+    endByte :: Int64,
     startPoint :: G.Point,
     endPoint :: G.Point,
     tags :: [Tag],
     markers :: [T.Text],
-    rawText :: T.Text,
     commentStyle :: G.CommentStyle,
-    comments :: Maybe (NonEmpty [D.Node]),
     closed :: Bool
   }
   deriving (Show, Binary, Generic, Eq)
 
+instance HasField "description" Issue (IO (Maybe (NonEmpty D.Node))) where
+  getField issue = do
+    rawText <- issue.rawText
+    let node = D.commonmarkToNode [] rawText
+    case I.parse I.issueMarkers node of
+      Just parseResult -> pure (N.nonEmpty parseResult.paragraphs)
+      Nothing -> pure Nothing
+
+instance HasField "rawText" Issue (IO T.Text) where
+  getField issue = do
+    text <- getText issue
+    let (_, rawText) = G.uncomment issue.language text
+    pure rawText
+
+instance HasField "comments" Issue (IO (Maybe (NonEmpty [D.Node]))) where
+  getField issue = do
+    rawText <- issue.rawText
+    let node = D.commonmarkToNode [] rawText
+    case I.parse I.issueMarkers node of
+      Just parseResult -> pure (N.nonEmpty parseResult.comments)
+      Nothing -> pure Nothing
+
 id :: Issue -> T.Text
 id issue = toSpinalCase issue.title
   where
@@ -51,7 +84,9 @@ internalTags issue@(Issue {..}) =
   concat
     [ [ Tag "id" $ Just issue.id,
         Tag "title" $ Just title,
-        Tag "rawText" $ Just rawText,
+        -- TODO Remove @rawText internal tag
+        --
+        -- Tag "rawText" $ Just rawText,
         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,
@@ -67,8 +102,14 @@ instance HasField "internalTags" Issue [Tag] where
 instance HasField "id" Issue T.Text where
   getField issue = id issue
 
+getText :: Issue -> IO T.Text
+getText (Issue {..}) =
+  T.decodeUtf8 . LB.toStrict . LB.take (endByte - startByte) . LB.drop startByte
+    <$> Git.readTextFileOfBS commitHash file
+
 replaceText :: Issue -> T.Text -> IO ()
-replaceText issue s' = T.writeFile issue.file . replace (indent (comment s')) =<< T.readFile issue.file
+replaceText issue s' =
+  T.writeFile issue.file . replace (indent (comment s')) =<< T.readFile issue.file
   where
     comment = T.intercalate "\n" . map T.strip . T.lines . G.comment issue.commentStyle
     indent = T.intercalate "\n" . mapButFirst (T.replicate (issue.startPoint.column - 1) " " <>) . T.lines
diff --git a/app/Issue/Render.hs b/app/Issue/Render.hs
index c8a913b..aca8134 100644
--- a/app/Issue/Render.hs
+++ b/app/Issue/Render.hs
@@ -42,8 +42,10 @@ newtype IssueDescription = IssueDescription {unIssueDescription :: Issue}
 
 instance P.Render IssueDescription where
   render (IssueDescription issue) =
-    maybe P.emptyDoc (P.render . N.toList) $
-      issue.description
+    P.render
+      ( maybe P.emptyDoc (P.render . N.toList)
+          <$> issue.description
+      )
 
 instance P.Render (P.Linked Issue) where
   render (P.Linked issue)
@@ -71,8 +73,10 @@ newtype IssueComments = IssueComments {unIssueComments :: Issue}
 
 instance P.Render IssueComments where
   render (IssueComments issue) =
-    maybe P.emptyDoc (P.vsep . map P.render . N.toList) $
-      issue.comments
+    P.render
+      ( maybe P.emptyDoc (P.vsep . map P.render . N.toList)
+          <$> issue.comments
+      )
 
 newtype IssueOpenedBy = IssueOpenedBy {unIssueOpenedBy :: Issue}
 
diff --git a/app/IssueEvent.hs b/app/IssueEvent.hs
index c82dba5..0c641ad 100644
--- a/app/IssueEvent.hs
+++ b/app/IssueEvent.hs
@@ -5,6 +5,7 @@ module IssueEvent
   )
 where
 
+import Control.Monad (join)
 import Data.Binary (Binary (..))
 import Data.Function ((&))
 import Data.Text qualified as T
@@ -42,9 +43,9 @@ data IssueEvent
   deriving (Show, Generic, Binary)
 
 instance HasField "patch" IssueEvent (IO Patch) where
-  getField (IssueCreated {..}) = diff "" issue.rawText
-  getField (IssueChanged {..}) = diff oldIssue.rawText issue.rawText
-  getField (IssueDeleted {..}) = diff issue.rawText ""
+  getField (IssueCreated {..}) = join $ (diff "" <$> issue.rawText)
+  getField (IssueChanged {..}) = join $ (diff <$> oldIssue.rawText <*> issue.rawText)
+  getField (IssueDeleted {..}) = join $ (flip diff "" <$> issue.rawText)
 
 diff :: T.Text -> T.Text -> IO A.Patch
 diff old new = withSystemTempDirectory "diff" $ \tmp -> do
diff --git a/app/Main.hs b/app/Main.hs
index 6ccc29a..603ab2a 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -626,7 +626,7 @@ editIssues issues = withSystemTempDirectory "anissue-edit" (go issues)
   where
     go :: [Issue] -> FilePath -> IO ()
     go issues cwd = do
-      mapM_ (\issue -> T.writeFile (fp issue) issue.rawText) issues
+      mapM_ (\issue -> T.writeFile (fp issue) =<< issue.rawText) issues
       sh_ (proc "${EDITOR-vi} -- %" (map fp issues))
       replaceTexts issues
       where