Addressing requested changes

This commit is contained in:
Андреев Кирилл 2021-11-04 18:14:51 +04:00
parent 420aee0f6d
commit 72a1b23433
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
3 changed files with 20 additions and 26 deletions

View File

@ -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

View File

@ -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]

View File

@ -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 "<a name=\"" text
@ -170,8 +168,8 @@ nodeExtractInfo input@(Node _ _ nSubs) = do
t : ts -> (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