mirror of
https://github.com/serokell/xrefcheck.git
synced 2024-09-11 13:37:36 +03:00
Addressing requested changes
This commit is contained in:
parent
420aee0f6d
commit
72a1b23433
@ -16,6 +16,7 @@ steps:
|
|||||||
list_padding: 2
|
list_padding: 2
|
||||||
separate_lists: true
|
separate_lists: true
|
||||||
space_surround: false
|
space_surround: false
|
||||||
|
post_qualify: true
|
||||||
- trailing_whitespace: {}
|
- trailing_whitespace: {}
|
||||||
columns: 100
|
columns: 100
|
||||||
newline: native
|
newline: native
|
||||||
@ -38,6 +39,7 @@ language_extensions:
|
|||||||
- FunctionalDependencies
|
- FunctionalDependencies
|
||||||
- GADTs
|
- GADTs
|
||||||
- GeneralizedNewtypeDeriving
|
- GeneralizedNewtypeDeriving
|
||||||
|
- ImportQualifiedPost
|
||||||
- LambdaCase
|
- LambdaCase
|
||||||
- MultiParamTypeClasses
|
- MultiParamTypeClasses
|
||||||
- MultiWayIf
|
- MultiWayIf
|
||||||
|
@ -27,7 +27,7 @@ import Text.Numeral.Roman (toRoman)
|
|||||||
import Xrefcheck.Progress
|
import Xrefcheck.Progress
|
||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
import Data.DList (DList)
|
import Data.DList (DList)
|
||||||
import qualified Data.DList as DList
|
import Data.DList qualified as DList
|
||||||
|
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
-- Types
|
-- Types
|
||||||
@ -103,7 +103,8 @@ data FileInfoDiff = FileInfoDiff
|
|||||||
makeLenses ''FileInfoDiff
|
makeLenses ''FileInfoDiff
|
||||||
|
|
||||||
diffToFileInfo :: FileInfoDiff -> FileInfo
|
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
|
instance Semigroup FileInfoDiff where
|
||||||
FileInfoDiff a b <> FileInfoDiff c d = FileInfoDiff (a <> c) (b <> d)
|
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)
|
newtype RepoInfo = RepoInfo (Map FilePath FileInfo)
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
finaliseFileInfo :: FileInfo -> FileInfo
|
|
||||||
finaliseFileInfo = execState $ do
|
|
||||||
fiReferences %= reverse
|
|
||||||
fiAnchors %= reverse
|
|
||||||
|
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
-- Instances
|
-- Instances
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
@ -296,9 +292,7 @@ stripAnchorDupNo t = do
|
|||||||
-- | Strip './' prefix from local references.
|
-- | Strip './' prefix from local references.
|
||||||
canonizeLocalRef :: Text -> Text
|
canonizeLocalRef :: Text -> Text
|
||||||
canonizeLocalRef ref =
|
canonizeLocalRef ref =
|
||||||
case T.stripPrefix localPrefix ref of
|
maybe ref canonizeLocalRef (T.stripPrefix localPrefix ref)
|
||||||
Nothing -> ref
|
|
||||||
Just r -> canonizeLocalRef r
|
|
||||||
where
|
where
|
||||||
localPrefix = toText ['.', pathSeparator]
|
localPrefix = toText ['.', pathSeparator]
|
||||||
|
|
||||||
|
@ -21,6 +21,8 @@ import CMarkGFM (Node (..), NodeType (..), PosInfo (..), commonmarkToNode)
|
|||||||
import Control.Monad.Except (MonadError, throwError)
|
import Control.Monad.Except (MonadError, throwError)
|
||||||
import Data.Aeson.TH (deriveFromJSON)
|
import Data.Aeson.TH (deriveFromJSON)
|
||||||
import Data.ByteString.Lazy qualified as BSL
|
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 qualified as T
|
||||||
import Data.Text.Lazy qualified as LT
|
import Data.Text.Lazy qualified as LT
|
||||||
import Fmt (Buildable (..), blockListF, nameF, (+|), (|+))
|
import Fmt (Buildable (..), blockListF, nameF, (+|), (|+))
|
||||||
@ -28,7 +30,6 @@ import Fmt (Buildable (..), blockListF, nameF, (+|), (|+))
|
|||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
import Xrefcheck.Util
|
import Xrefcheck.Util
|
||||||
import Data.Default (def)
|
|
||||||
|
|
||||||
data MarkdownConfig = MarkdownConfig
|
data MarkdownConfig = MarkdownConfig
|
||||||
{ mcFlavor :: Flavor
|
{ mcFlavor :: Flavor
|
||||||
@ -55,8 +56,7 @@ toPosition = Position . \case
|
|||||||
startLine |+ ":" +| startColumn |+ " - " +|
|
startLine |+ ":" +| startColumn |+ " - " +|
|
||||||
endLine |+ ":" +| endColumn |+ ""
|
endLine |+ ":" +| endColumn |+ ""
|
||||||
|
|
||||||
{- | Extract text from the topmost node.
|
-- | Extract text from the topmost node.
|
||||||
-}
|
|
||||||
nodeExtractText :: Node -> Text
|
nodeExtractText :: Node -> Text
|
||||||
nodeExtractText = T.strip . mconcat . map extractText . nodeFlatten
|
nodeExtractText = T.strip . mconcat . map extractText . nodeFlatten
|
||||||
where
|
where
|
||||||
@ -75,14 +75,12 @@ data IgnoreMode
|
|||||||
| None
|
| None
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
{- | A fold over a `Node`.
|
-- | A fold over a `Node`.
|
||||||
-}
|
|
||||||
cataNode :: (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
|
cataNode :: (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
|
||||||
cataNode f (Node pos ty subs) = f pos ty (cataNode f <$> subs)
|
cataNode f (Node pos ty subs) = f pos ty (cataNode f <$> subs)
|
||||||
|
|
||||||
{- | Remove nodes with accordance with global `MarkdownConfig` and local
|
-- | Remove nodes with accordance with global `MarkdownConfig` and local
|
||||||
overrides.
|
-- overrides.
|
||||||
-}
|
|
||||||
removeIgnored :: Node -> Either Text Node
|
removeIgnored :: Node -> Either Text Node
|
||||||
removeIgnored = runIdentity . runExceptT . flip evalStateT None . cataNode remove
|
removeIgnored = runIdentity . runExceptT . flip evalStateT None . cataNode remove
|
||||||
where
|
where
|
||||||
@ -110,18 +108,17 @@ removeIgnored = runIdentity . runExceptT . flip evalStateT None . cataNode remov
|
|||||||
let mType = safeHead $ words $ show ty
|
let mType = safeHead $ words $ show ty
|
||||||
in fromMaybe "" mType
|
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 :: (Monoid a, Monad m) => (Node -> m a) -> Node -> m a
|
||||||
foldNode action node@(Node _ _ subs) = do
|
foldNode action node@(Node _ _ subs) = do
|
||||||
a <- action node
|
a <- action node
|
||||||
b <- concatForM subs (foldNode action)
|
b <- concatForM subs (foldNode action)
|
||||||
return (a <> b)
|
return (a <> b)
|
||||||
|
|
||||||
{- | Extract information from source tree.
|
-- | Extract information from source tree.
|
||||||
-}
|
|
||||||
nodeExtractInfo
|
nodeExtractInfo
|
||||||
:: ( MonadError Text m
|
:: forall m
|
||||||
|
. ( MonadError Text m
|
||||||
, MonadState IgnoreMode m
|
, MonadState IgnoreMode m
|
||||||
, MonadReader MarkdownConfig m
|
, MonadReader MarkdownConfig m
|
||||||
)
|
)
|
||||||
@ -136,6 +133,7 @@ nodeExtractInfo input@(Node _ _ nSubs) = do
|
|||||||
diffToFileInfo <$> foldNode extractor relevant
|
diffToFileInfo <$> foldNode extractor relevant
|
||||||
|
|
||||||
where
|
where
|
||||||
|
extractor :: Node -> m FileInfoDiff
|
||||||
extractor node@(Node pos ty _) =
|
extractor node@(Node pos ty _) =
|
||||||
case ty of
|
case ty of
|
||||||
HTML_BLOCK _ -> do
|
HTML_BLOCK _ -> do
|
||||||
@ -146,7 +144,7 @@ nodeExtractInfo input@(Node _ _ nSubs) = do
|
|||||||
let aType = HeaderAnchor lvl
|
let aType = HeaderAnchor lvl
|
||||||
let aName = headerToAnchor flavor $ nodeExtractText node
|
let aName = headerToAnchor flavor $ nodeExtractText node
|
||||||
let aPos = toPosition pos
|
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
|
HTML_INLINE text -> do
|
||||||
let mName = T.stripSuffix "\">" =<< T.stripPrefix "<a name=\"" text
|
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)
|
t : ts -> (t, Just $ T.intercalate "#" ts)
|
||||||
[] -> error "impossible"
|
[] -> error "impossible"
|
||||||
return $ FileInfoDiff
|
return $ FileInfoDiff
|
||||||
(pure $ Reference {rName, rPos, rLink, rAnchor})
|
(DList.singleton $ Reference {rName, rPos, rLink, rAnchor})
|
||||||
mempty
|
DList.empty
|
||||||
|
|
||||||
_ -> return mempty
|
_ -> return mempty
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user