diff --git a/package.yaml b/package.yaml index 60f30533..3c106611 100644 --- a/package.yaml +++ b/package.yaml @@ -111,6 +111,7 @@ library: - reflection - nyan-interpolation - safe-exceptions + - parallel executables: xrefcheck: diff --git a/src/Xrefcheck/Scan.hs b/src/Xrefcheck/Scan.hs index da312a0e..b41dc740 100644 --- a/src/Xrefcheck/Scan.hs +++ b/src/Xrefcheck/Scan.hs @@ -2,7 +2,7 @@ - - SPDX-License-Identifier: MPL-2.0 -} - +{-# LANGUAGE DeriveAnyClass #-} {-# OPTIONS_GHC -Wno-orphans #-} -- | Generalised repo scanner and analyser. @@ -93,7 +93,8 @@ data ScanError = ScanError { sePosition :: Position , seFile :: FilePath , seDescription :: ScanErrorDescription - } deriving stock (Show, Eq) + } deriving stock (Show, Eq, Generic) + deriving anyclass NFData instance Given ColorMode => Buildable ScanError where build ScanError{..} = [int|| @@ -118,7 +119,8 @@ data ScanErrorDescription | FileErr | ParagraphErr Text | UnrecognisedErr Text - deriving stock (Show, Eq) + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData) instance Buildable ScanErrorDescription where build = \case diff --git a/src/Xrefcheck/Scanners/Markdown.hs b/src/Xrefcheck/Scanners/Markdown.hs index 14f68275..8ea0435b 100644 --- a/src/Xrefcheck/Scanners/Markdown.hs +++ b/src/Xrefcheck/Scanners/Markdown.hs @@ -12,6 +12,7 @@ module Xrefcheck.Scanners.Markdown , defGithubMdConfig , markdownScanner + , markdownParallelScanner , markdownSupport , parseFileInfo , makeError @@ -24,11 +25,10 @@ import CMarkGFM import Control.Lens (_Just, makeLenses, makeLensesFor, (.=)) import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell) import Data.Aeson (FromJSON (..), genericParseJSON) -import Data.ByteString.Lazy qualified as BSL +import Data.ByteString qualified as BS import Data.DList qualified as DList import Data.Default (def) import Data.Text qualified as T -import Data.Text.Lazy qualified as LT import Fmt (Buildable (..), nameF) import Text.HTML.TagSoup import Text.Interpolation.Nyan @@ -36,6 +36,7 @@ import Text.Interpolation.Nyan import Xrefcheck.Core import Xrefcheck.Scan import Xrefcheck.Util +import Control.Parallel.Strategies data MarkdownConfig = MarkdownConfig { mcFlavor :: Flavor @@ -406,16 +407,20 @@ textToMode ("ignore" : [x]) | otherwise = InvalidMode x textToMode _ = NotAnAnnotation -parseFileInfo :: MarkdownConfig -> FilePath -> LT.Text -> (FileInfo, [ScanError]) +parseFileInfo :: MarkdownConfig -> FilePath -> T.Text -> (FileInfo, [ScanError]) parseFileInfo config fp input = runWriter $ flip runReaderT config $ nodeExtractInfo fp - $ commonmarkToNode [optFootnotes] [extAutolink] - $ toStrict input + $ commonmarkToNode [optFootnotes] [extAutolink] input markdownScanner :: MarkdownConfig -> ScanAction -markdownScanner config path = parseFileInfo config path . decodeUtf8 <$> BSL.readFile path +markdownScanner config path = parseFileInfo config path . decodeUtf8 <$> BS.readFile path + +markdownParallelScanner :: MarkdownConfig -> ScanAction +markdownParallelScanner config path = do + resThunk <- parseFileInfo config path . decodeUtf8 <$> BS.readFile path + resThunk `usingIO` rparWith rdeepseq markdownSupport :: MarkdownConfig -> ([Extension], ScanAction) -markdownSupport config = ([".md"], markdownScanner config) +markdownSupport config = ([".md"], markdownParallelScanner config)