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