From 72a1b23433652442357855994dd6422d61a6e499 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=D0=90=D0=BD=D0=B4=D1=80=D0=B5=D0=B5=D0=B2=20=D0=9A=D0=B8?= =?UTF-8?q?=D1=80=D0=B8=D0=BB=D0=BB?= Date: Thu, 4 Nov 2021 18:14:51 +0400 Subject: [PATCH] Addressing requested changes --- .stylish-haskell.yaml | 2 ++ src/Xrefcheck/Core.hs | 14 ++++---------- src/Xrefcheck/Scanners/Markdown.hs | 30 ++++++++++++++---------------- 3 files changed, 20 insertions(+), 26 deletions(-) diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index a553a49..f32324b 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -16,6 +16,7 @@ steps: list_padding: 2 separate_lists: true space_surround: false + post_qualify: true - trailing_whitespace: {} columns: 100 newline: native @@ -38,6 +39,7 @@ language_extensions: - FunctionalDependencies - GADTs - GeneralizedNewtypeDeriving + - ImportQualifiedPost - LambdaCase - MultiParamTypeClasses - MultiWayIf diff --git a/src/Xrefcheck/Core.hs b/src/Xrefcheck/Core.hs index 19cbabc..7caa80a 100644 --- a/src/Xrefcheck/Core.hs +++ b/src/Xrefcheck/Core.hs @@ -27,7 +27,7 @@ import Text.Numeral.Roman (toRoman) import Xrefcheck.Progress import Xrefcheck.Util import Data.DList (DList) -import qualified Data.DList as DList +import Data.DList qualified as DList ----------------------------------------------------------- -- Types @@ -103,7 +103,8 @@ data FileInfoDiff = FileInfoDiff makeLenses ''FileInfoDiff diffToFileInfo :: FileInfoDiff -> FileInfo -diffToFileInfo (FileInfoDiff refs anchors) = FileInfo (DList.toList refs) (DList.toList anchors) +diffToFileInfo (FileInfoDiff refs anchors) = + FileInfo (DList.toList refs) (DList.toList anchors) instance Semigroup FileInfoDiff where FileInfoDiff a b <> FileInfoDiff c d = FileInfoDiff (a <> c) (b <> d) @@ -124,11 +125,6 @@ instance Default FileInfo where newtype RepoInfo = RepoInfo (Map FilePath FileInfo) deriving (Show) -finaliseFileInfo :: FileInfo -> FileInfo -finaliseFileInfo = execState $ do - fiReferences %= reverse - fiAnchors %= reverse - ----------------------------------------------------------- -- Instances ----------------------------------------------------------- @@ -296,9 +292,7 @@ stripAnchorDupNo t = do -- | Strip './' prefix from local references. canonizeLocalRef :: Text -> Text canonizeLocalRef ref = - case T.stripPrefix localPrefix ref of - Nothing -> ref - Just r -> canonizeLocalRef r + maybe ref canonizeLocalRef (T.stripPrefix localPrefix ref) where localPrefix = toText ['.', pathSeparator] diff --git a/src/Xrefcheck/Scanners/Markdown.hs b/src/Xrefcheck/Scanners/Markdown.hs index 5249412..6822250 100644 --- a/src/Xrefcheck/Scanners/Markdown.hs +++ b/src/Xrefcheck/Scanners/Markdown.hs @@ -21,6 +21,8 @@ import CMarkGFM (Node (..), NodeType (..), PosInfo (..), commonmarkToNode) import Control.Monad.Except (MonadError, throwError) import Data.Aeson.TH (deriveFromJSON) import Data.ByteString.Lazy qualified as BSL +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 (..), blockListF, nameF, (+|), (|+)) @@ -28,7 +30,6 @@ import Fmt (Buildable (..), blockListF, nameF, (+|), (|+)) import Xrefcheck.Core import Xrefcheck.Scan import Xrefcheck.Util -import Data.Default (def) data MarkdownConfig = MarkdownConfig { mcFlavor :: Flavor @@ -55,8 +56,7 @@ toPosition = Position . \case startLine |+ ":" +| startColumn |+ " - " +| endLine |+ ":" +| endColumn |+ "" -{- | Extract text from the topmost node. --} +-- | Extract text from the topmost node. nodeExtractText :: Node -> Text nodeExtractText = T.strip . mconcat . map extractText . nodeFlatten where @@ -75,14 +75,12 @@ data IgnoreMode | None deriving Eq -{- | A fold over a `Node`. --} +-- | A fold over a `Node`. cataNode :: (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c cataNode f (Node pos ty subs) = f pos ty (cataNode f <$> subs) -{- | Remove nodes with accordance with global `MarkdownConfig` and local - overrides. --} +-- | Remove nodes with accordance with global `MarkdownConfig` and local +-- overrides. removeIgnored :: Node -> Either Text Node removeIgnored = runIdentity . runExceptT . flip evalStateT None . cataNode remove where @@ -110,18 +108,17 @@ removeIgnored = runIdentity . runExceptT . flip evalStateT None . cataNode remov let mType = safeHead $ words $ show ty in fromMaybe "" mType -{- | Custom `foldMap` for source tree. --} +-- | Custom `foldMap` for source tree. foldNode :: (Monoid a, Monad m) => (Node -> m a) -> Node -> m a foldNode action node@(Node _ _ subs) = do a <- action node b <- concatForM subs (foldNode action) return (a <> b) -{- | Extract information from source tree. --} +-- | Extract information from source tree. nodeExtractInfo - :: ( MonadError Text m + :: forall m + . ( MonadError Text m , MonadState IgnoreMode m , MonadReader MarkdownConfig m ) @@ -136,6 +133,7 @@ nodeExtractInfo input@(Node _ _ nSubs) = do diffToFileInfo <$> foldNode extractor relevant where + extractor :: Node -> m FileInfoDiff extractor node@(Node pos ty _) = case ty of HTML_BLOCK _ -> do @@ -146,7 +144,7 @@ nodeExtractInfo input@(Node _ _ nSubs) = do let aType = HeaderAnchor lvl let aName = headerToAnchor flavor $ nodeExtractText node let aPos = toPosition pos - return $ FileInfoDiff mempty $ pure $ Anchor {aType, aName, aPos} + return $ FileInfoDiff DList.empty $ DList.singleton $ Anchor {aType, aName, aPos} HTML_INLINE text -> do let mName = T.stripSuffix "\">" =<< T.stripPrefix " (t, Just $ T.intercalate "#" ts) [] -> error "impossible" return $ FileInfoDiff - (pure $ Reference {rName, rPos, rLink, rAnchor}) - mempty + (DList.singleton $ Reference {rName, rPos, rLink, rAnchor}) + DList.empty _ -> return mempty