[#64] Copy paste detection in lists

package.yaml

@@ -25,6 +25,7 @@ default-extensions:
   - ConstraintKinds
   - DataKinds
   - DefaultSignatures
+  - DeriveAnyClass
   - DeriveDataTypeable
   - DeriveGeneric
   - DerivingStrategies

src/Xrefcheck/Core.hs

@@ -15,6 +15,8 @@ import Control.Lens (makeLenses)
 import Data.Aeson (FromJSON (..), withText)
 import Data.Char (isAlphaNum)
 import Data.Char qualified as C
+import Data.DList (DList)
+import Data.DList qualified as DList
 import Data.Default (Default (..))
 import Data.List qualified as L
 import Data.Map qualified as M
@@ -26,8 +28,6 @@ import Text.Numeral.Roman (toRoman)
 
 import Xrefcheck.Progress
 import Xrefcheck.Util
-import Data.DList (DList)
-import Data.DList qualified as DList
 
 -----------------------------------------------------------
 -- Types
@@ -62,6 +62,7 @@ instance FromJSON Flavor where
 -- representation of this thing, and it actually appears in reports only.
 newtype Position = Position (Maybe Text)
   deriving stock (Show, Eq, Generic)
+  deriving anyclass NFData
 
 instance Buildable Position where
   build (Position pos) = case pos of
@@ -77,7 +78,9 @@ data Reference = Reference
   , rAnchor :: Maybe Text
     -- ^ Section or custom anchor tag.
   , rPos    :: Position
-  } deriving stock (Show, Generic)
+  }
+  deriving stock (Show, Generic)
+  deriving anyclass NFData
 
 -- | Context of anchor.
 data AnchorType
@@ -88,35 +91,50 @@ data AnchorType
   | BiblioAnchor
     -- ^ Id of entry in bibliography
   deriving stock (Show, Eq, Generic)
+  deriving anyclass NFData
 
 -- | A referable anchor.
 data Anchor = Anchor
   { aType :: AnchorType
   , aName :: Text
   , aPos  :: Position
-  } deriving stock (Show, Eq, Generic)
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass NFData
+
+data CopyPaste = CopyPaste
+  { cpAnchorText :: Text
+  , cpPlainText  :: Text
+  , cpPosition   :: Position
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass NFData
 
 data FileInfoDiff = FileInfoDiff
   { _fidReferences :: DList Reference
   , _fidAnchors    :: DList Anchor
+  , _fidCopyPastes :: DList CopyPaste
   }
 makeLenses ''FileInfoDiff
 
 diffToFileInfo :: FileInfoDiff -> FileInfo
-diffToFileInfo (FileInfoDiff refs anchors) =
-    FileInfo (DList.toList refs) (DList.toList anchors)
+diffToFileInfo (FileInfoDiff refs anchors pastas) =
+    FileInfo (DList.toList refs) (DList.toList anchors) (DList.toList pastas)
 
 instance Semigroup FileInfoDiff where
-  FileInfoDiff a b <> FileInfoDiff c d = FileInfoDiff (a <> c) (b <> d)
+  FileInfoDiff a b e <> FileInfoDiff c d f = FileInfoDiff (a <> c) (b <> d) (e <> f)
 
 instance Monoid FileInfoDiff where
-  mempty = FileInfoDiff mempty mempty
+  mempty = FileInfoDiff mempty mempty mempty
 
 -- | All information regarding a single file we care about.
 data FileInfo = FileInfo
   { _fiReferences :: [Reference]
   , _fiAnchors    :: [Anchor]
-  } deriving stock (Show, Generic)
+  , _fiCopyPastes :: [CopyPaste]
+  }
+  deriving stock (Show, Generic)
+  deriving anyclass NFData
 makeLenses ''FileInfo
 
 instance Default FileInfo where
@@ -129,12 +147,6 @@ newtype RepoInfo = RepoInfo (Map FilePath FileInfo)
 -- Instances
 -----------------------------------------------------------
 
-instance NFData Position
-instance NFData Reference
-instance NFData AnchorType
-instance NFData Anchor
-instance NFData FileInfo
-
 instance Buildable Reference where
   build Reference{..} =
     nameF ("reference " +| paren (build loc) |+ " " +| rPos |+ "") $

src/Xrefcheck/Scanners/Markdown.hs

@@ -144,17 +144,19 @@ nodeExtractInfo input@(Node _ _ nSubs) = do
           let aType = HeaderAnchor lvl
           let aName = headerToAnchor flavor $ nodeExtractText node
           let aPos  = toPosition pos
-          return $ FileInfoDiff DList.empty $ DList.singleton $ Anchor {aType, aName, aPos}
+          return mempty
+            { _fidAnchors = DList.singleton $ Anchor {aType, aName, aPos}
+            }
 
         HTML_INLINE text -> do
           let mName = T.stripSuffix "\">" =<< T.stripPrefix "<a name=\"" text
           case mName of
             Just aName -> do
               let aType = HandAnchor
                   aPos  = toPosition pos
-              return $ FileInfoDiff
-                mempty
-                (pure $ Anchor {aType, aName, aPos})
+              return mempty
+                { _fidAnchors = DList.singleton $ Anchor {aType, aName, aPos}
+                }
 
             Nothing -> do
               return mempty
@@ -167,9 +169,9 @@ nodeExtractInfo input@(Node _ _ nSubs) = do
                   [t]    -> (t, Nothing)
                   t : ts -> (t, Just $ T.intercalate "#" ts)
                   []     -> error "impossible"
-          return $ FileInfoDiff
-            (DList.singleton $ Reference {rName, rPos, rLink, rAnchor})
-            DList.empty
+          return mempty
+            { _fidReferences = DList.singleton $ Reference {rName, rPos, rLink, rAnchor}
+            }
 
         _ -> return mempty