{- SPDX-FileCopyrightText: 2018-2019 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Scanner for gathering references to verify from Markdown documents.
module Xrefcheck.Scanners.Markdown
  ( MarkdownConfig (..)

  , defGithubMdConfig
  , markdownScanner
  , markdownSupport
  , parseFileInfo
  , makeError
  ) where

import Universum hiding (use)

import CMarkGFM
  (Node (..), NodeType (..), PosInfo (..), commonmarkToNode, extAutolink, optFootnotes)
import Control.Lens (_Just, makeLenses, makeLensesFor, use, (.=))
import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell)
import Data.Aeson (FromJSON (..), genericParseJSON)
import Data.ByteString.Lazy qualified as BSL
import Data.DList qualified as DList
import Data.Reflection (Given)
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

import Xrefcheck.Core
import Xrefcheck.Scan
import Xrefcheck.System
import Xrefcheck.Util

data MarkdownConfig = MarkdownConfig
  { MarkdownConfig -> Flavor
mcFlavor :: Flavor
  } deriving stock ((forall x. MarkdownConfig -> Rep MarkdownConfig x)
-> (forall x. Rep MarkdownConfig x -> MarkdownConfig)
-> Generic MarkdownConfig
forall x. Rep MarkdownConfig x -> MarkdownConfig
forall x. MarkdownConfig -> Rep MarkdownConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MarkdownConfig -> Rep MarkdownConfig x
from :: forall x. MarkdownConfig -> Rep MarkdownConfig x
$cto :: forall x. Rep MarkdownConfig x -> MarkdownConfig
to :: forall x. Rep MarkdownConfig x -> MarkdownConfig
Generic)

instance FromJSON (MarkdownConfig) where
  parseJSON :: Value -> Parser MarkdownConfig
parseJSON = Options -> Value -> Parser MarkdownConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonConfigOption

defGithubMdConfig :: MarkdownConfig
defGithubMdConfig :: MarkdownConfig
defGithubMdConfig = MarkdownConfig
  { mcFlavor :: Flavor
mcFlavor = Flavor
GitHub
  }

instance Buildable Node where
  build :: Node -> Builder
build (Node Maybe PosInfo
_mpos NodeType
ty [Node]
mSubs) = Builder -> Builder -> Builder
nameF (NodeType -> Builder
forall b a. (Show a, IsString b) => a -> b
show NodeType
ty) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
    Builder
-> (NonEmpty Node -> Builder) -> Maybe (NonEmpty Node) -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"[]" NonEmpty Node -> Builder
forall a. (HasCallStack, Buildable a) => NonEmpty a -> Builder
interpolateBlockListF ([Node] -> Maybe (NonEmpty Node)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Node]
mSubs)

toPosition :: FilePath -> Maybe PosInfo -> Position
toPosition :: FilePath -> Maybe PosInfo -> Position
toPosition FilePath
filepath = Text -> Position
Position (Text -> Position)
-> (Maybe PosInfo -> Text) -> Maybe PosInfo -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  Maybe PosInfo
Nothing -> [int|s|#{filepath}|]
  Just PosInfo{Int
startLine :: Int
startColumn :: Int
endLine :: Int
endColumn :: Int
startLine :: PosInfo -> Int
startColumn :: PosInfo -> Int
endLine :: PosInfo -> Int
endColumn :: PosInfo -> Int
..}
    | Int
startLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endLine ->
        [int|s|
        #{filepath}:#{startLine}:#{startColumn}-#{endColumn}
        |]
    | Bool
otherwise ->
        [int|s|
        #{filepath}:#{startLine}:#{startColumn}-#{endLine}:#{endColumn}
        |]

-- | Extract text from the topmost node.
nodeExtractText :: Node -> Text
nodeExtractText :: Node -> Text
nodeExtractText = Text -> Text
T.strip (Text -> Text) -> (Node -> Text) -> Node -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Node -> [Text]) -> Node -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeType -> Text) -> [NodeType] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map NodeType -> Text
extractText ([NodeType] -> [Text]) -> (Node -> [NodeType]) -> Node -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [NodeType]
nodeFlatten
  where
    extractText :: NodeType -> Text
extractText = \case
      TEXT Text
t -> Text
t
      CODE Text
t -> Text
t
      NodeType
_ -> Text
""

    nodeFlatten :: Node -> [NodeType]
    nodeFlatten :: Node -> [NodeType]
nodeFlatten (Node Maybe PosInfo
_pos NodeType
ty [Node]
subs) = NodeType
ty NodeType -> [NodeType] -> [NodeType]
forall a. a -> [a] -> [a]
: (Element [Node] -> [NodeType]) -> [Node] -> [NodeType]
forall c b. Container c => (Element c -> [b]) -> c -> [b]
concatMap Node -> [NodeType]
Element [Node] -> [NodeType]
nodeFlatten [Node]
subs


data IgnoreMode
  = IMLink
  | IMParagraph
  | IMAll
  deriving stock (IgnoreMode -> IgnoreMode -> Bool
(IgnoreMode -> IgnoreMode -> Bool)
-> (IgnoreMode -> IgnoreMode -> Bool) -> Eq IgnoreMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IgnoreMode -> IgnoreMode -> Bool
== :: IgnoreMode -> IgnoreMode -> Bool
$c/= :: IgnoreMode -> IgnoreMode -> Bool
/= :: IgnoreMode -> IgnoreMode -> Bool
Eq)

-- | "ignore link" pragmas in different places behave slightly different,
-- so @IgnoreMode@ @Link@ is parametrized
data IgnoreLinkState
  = ExpectingLinkInParagraph
  -- ^ When ignore annotation is inside @PARAGRAPH@ node,
  -- we expect a link to ignore later in this paragraph.
  -- We raise scan error if we see this status after
  -- traversing subnodes of a @PARAGRAPH@ node.
  | ExpectingLinkInSubnodes
  -- ^ If ignore annotation is not inside @PARAGRAPH@, then we expect a link
  -- in subtree of next node. We raise scan error if we see this status
  -- after traversing childs of any node that is not an ignore annotation.
  | ParentExpectsLink
  -- ^ When we have `ExpectingLinkInSubnodes`, we traverse subtree of some node,
  -- and we should change `IgnoreLinkState`, because it's not a problem if
  -- our node's first child doesn't contain a link. So this status means that
  -- we won't throw errors if we don't find a link for now
  deriving stock (IgnoreLinkState -> IgnoreLinkState -> Bool
(IgnoreLinkState -> IgnoreLinkState -> Bool)
-> (IgnoreLinkState -> IgnoreLinkState -> Bool)
-> Eq IgnoreLinkState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IgnoreLinkState -> IgnoreLinkState -> Bool
== :: IgnoreLinkState -> IgnoreLinkState -> Bool
$c/= :: IgnoreLinkState -> IgnoreLinkState -> Bool
/= :: IgnoreLinkState -> IgnoreLinkState -> Bool
Eq)

data IgnoreModeState
  = IMSLink IgnoreLinkState
  | IMSParagraph
  | IMSAll
  deriving stock (IgnoreModeState -> IgnoreModeState -> Bool
(IgnoreModeState -> IgnoreModeState -> Bool)
-> (IgnoreModeState -> IgnoreModeState -> Bool)
-> Eq IgnoreModeState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IgnoreModeState -> IgnoreModeState -> Bool
== :: IgnoreModeState -> IgnoreModeState -> Bool
$c/= :: IgnoreModeState -> IgnoreModeState -> Bool
/= :: IgnoreModeState -> IgnoreModeState -> Bool
Eq)

-- | Bind `IgnoreMode` to its `PosInfo` so that we can tell where the
-- corresponding annotation was declared.
data Ignore = Ignore
  { Ignore -> IgnoreModeState
_ignoreMode :: IgnoreModeState
  , Ignore -> Maybe PosInfo
_ignorePos :: Maybe PosInfo
  }
makeLensesFor [("_ignoreMode", "ignoreMode")] 'Ignore

data GetIgnoreMode
  = NotAnAnnotation
  | ValidMode IgnoreMode
  | InvalidMode Text
  deriving stock (GetIgnoreMode -> GetIgnoreMode -> Bool
(GetIgnoreMode -> GetIgnoreMode -> Bool)
-> (GetIgnoreMode -> GetIgnoreMode -> Bool) -> Eq GetIgnoreMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetIgnoreMode -> GetIgnoreMode -> Bool
== :: GetIgnoreMode -> GetIgnoreMode -> Bool
$c/= :: GetIgnoreMode -> GetIgnoreMode -> Bool
/= :: GetIgnoreMode -> GetIgnoreMode -> Bool
Eq)

data ScannerState = ScannerState
  { ScannerState -> Maybe Ignore
_ssIgnore :: Maybe Ignore
  , ScannerState -> Maybe NodeType
_ssParentNodeType :: Maybe NodeType
  -- ^ @cataNodeWithParentNodeInfo@ allows to get a @NodeType@ of parent node from this field
  }
makeLenses ''ScannerState

initialScannerState :: ScannerState
initialScannerState :: ScannerState
initialScannerState = ScannerState
  { _ssIgnore :: Maybe Ignore
_ssIgnore = Maybe Ignore
forall a. Maybe a
Nothing
  , _ssParentNodeType :: Maybe NodeType
_ssParentNodeType = Maybe NodeType
forall a. Maybe a
Nothing
  }

type ScannerM a = StateT ScannerState (Writer [ScanError 'Parse]) a

-- | A fold over a `Node`.
cataNode :: (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
cataNode :: forall c. (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
cataNode Maybe PosInfo -> NodeType -> [c] -> c
f (Node Maybe PosInfo
pos NodeType
ty [Node]
subs) = Maybe PosInfo -> NodeType -> [c] -> c
f Maybe PosInfo
pos NodeType
ty ((Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
forall c. (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
cataNode Maybe PosInfo -> NodeType -> [c] -> c
f (Node -> c) -> [Node] -> [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
subs)

-- | Sets correct @_ssParentNodeType@ before running scanner on each node
cataNodeWithParentNodeInfo
  :: (Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a)
  -> Node
  -> ScannerM a
cataNodeWithParentNodeInfo :: forall a.
(Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a)
-> Node -> ScannerM a
cataNodeWithParentNodeInfo Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a
f Node
node = (Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a)
-> Node -> ScannerM a
forall c. (Maybe PosInfo -> NodeType -> [c] -> c) -> Node -> c
cataNode Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a
f' Node
node
  where
    f' :: Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a
f' Maybe PosInfo
pos NodeType
ty [ScannerM a]
childScanners = Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a
f Maybe PosInfo
pos NodeType
ty ([ScannerM a] -> ScannerM a) -> [ScannerM a] -> ScannerM a
forall a b. (a -> b) -> a -> b
$
      (ScannerM a -> ScannerM a) -> [ScannerM a] -> [ScannerM a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Maybe NodeType -> Identity (Maybe NodeType))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe NodeType)
ssParentNodeType ((Maybe NodeType -> Identity (Maybe NodeType))
 -> ScannerState -> Identity ScannerState)
-> Maybe NodeType
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NodeType -> Maybe NodeType
forall a. a -> Maybe a
Just NodeType
ty StateT ScannerState (Writer [ScanError 'Parse]) ()
-> ScannerM a -> ScannerM a
forall a b.
StateT ScannerState (Writer [ScanError 'Parse]) a
-> StateT ScannerState (Writer [ScanError 'Parse]) b
-> StateT ScannerState (Writer [ScanError 'Parse]) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) [ScannerM a]
childScanners

-- | Find ignore annotations (ignore paragraph and ignore link)
-- and remove nodes that should be ignored.
removeIgnored :: Node -> ExtractorM Node
removeIgnored :: Node -> ExtractorM Node
removeIgnored Node
rootNode = do
  FilePath
filepath <- (ExtractorCtx -> FilePath)
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ExtractorCtx -> FilePath
ecFilePath
  let
    remove
      :: Maybe PosInfo
      -> NodeType
      -> [ScannerM Node]
      -> ScannerM Node
    remove :: Maybe PosInfo -> NodeType -> [ScannerM Node] -> ScannerM Node
remove Maybe PosInfo
pos NodeType
ty [ScannerM Node]
subs = do
      let node :: Node
node = Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
pos NodeType
ty []
      Node
scan <- Getting (Maybe Ignore) ScannerState (Maybe Ignore)
-> StateT ScannerState (Writer [ScanError 'Parse]) (Maybe Ignore)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Ignore) ScannerState (Maybe Ignore)
Lens' ScannerState (Maybe Ignore)
ssIgnore StateT ScannerState (Writer [ScanError 'Parse]) (Maybe Ignore)
-> (Maybe Ignore -> ScannerM Node) -> ScannerM Node
forall a b.
StateT ScannerState (Writer [ScanError 'Parse]) a
-> (a -> StateT ScannerState (Writer [ScanError 'Parse]) b)
-> StateT ScannerState (Writer [ScanError 'Parse]) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        -- When no `Ignore` state is set check next node for annotation,
        -- if found then set it as new `IgnoreMode` otherwise skip node.
        Maybe Ignore
Nothing -> Maybe PosInfo
-> NodeType -> [ScannerM Node] -> GetIgnoreMode -> ScannerM Node
handleIgnoreMode Maybe PosInfo
pos NodeType
ty [ScannerM Node]
subs (GetIgnoreMode -> ScannerM Node) -> GetIgnoreMode -> ScannerM Node
forall a b. (a -> b) -> a -> b
$ Node -> GetIgnoreMode
getIgnoreMode Node
node
        Just (Ignore IgnoreModeState
mode Maybe PosInfo
modePos) ->
          case (IgnoreModeState
mode, NodeType
ty) of
            -- We expect to find a paragraph immediately after the
            -- `ignore paragraph` annotanion. If the paragraph is not
            -- found we should report an error.
            (IgnoreModeState
IMSParagraph, NodeType
PARAGRAPH)    -> ((Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Ignore
forall a. Maybe a
Nothing) StateT ScannerState (Writer [ScanError 'Parse]) ()
-> Node -> ScannerM Node
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Node
defNode
            (IgnoreModeState
IMSParagraph, NodeType
x)            -> do
              Writer [ScanError 'Parse] ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT ScannerState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> [ScanError 'Parse]
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse]
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> [ScanError 'Parse]
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
modePos (Text -> ScanErrorDescription
ParagraphErr (NodeType -> Text
prettyType NodeType
x))
              (Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Ignore
forall a. Maybe a
Nothing
              Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
pos NodeType
ty ([Node] -> Node)
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
-> ScannerM Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScannerM Node]
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ScannerM Node]
subs

            -- We don't expect to find an `ignore all` annotation here,
            -- since that annotation should be at the top of the file and
            -- the file should already be ignored when `checkIgnoreFile` is called.
            -- We should report an error if we find it anyway.
            (IgnoreModeState
IMSAll, NodeType
_)                 -> do
              Writer [ScanError 'Parse] ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT ScannerState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> [ScanError 'Parse]
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse]
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> [ScanError 'Parse]
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
modePos ScanErrorDescription
FileErr
              (Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Ignore
forall a. Maybe a
Nothing
              Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
pos NodeType
ty ([Node] -> Node)
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
-> ScannerM Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScannerM Node]
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ScannerM Node]
subs

            (IMSLink IgnoreLinkState
_, LINK {})         -> do
              (Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Ignore
forall a. Maybe a
Nothing
              Node -> ScannerM Node
forall a. a -> StateT ScannerState (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
defNode
            (IMSLink IgnoreLinkState
_, IMAGE {})        -> do
              (Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Ignore
forall a. Maybe a
Nothing
              Node -> ScannerM Node
forall a. a -> StateT ScannerState (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
defNode
            (IMSLink IgnoreLinkState
ignoreLinkState, NodeType
_) -> do
              Bool
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IgnoreLinkState
ignoreLinkState IgnoreLinkState -> IgnoreLinkState -> Bool
forall a. Eq a => a -> a -> Bool
== IgnoreLinkState
ExpectingLinkInSubnodes) (StateT ScannerState (Writer [ScanError 'Parse]) ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$
                (Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> ((IgnoreModeState -> Identity IgnoreModeState)
    -> Maybe Ignore -> Identity (Maybe Ignore))
-> (IgnoreModeState -> Identity IgnoreModeState)
-> ScannerState
-> Identity ScannerState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ignore -> Identity Ignore)
-> Maybe Ignore -> Identity (Maybe Ignore)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Ignore -> Identity Ignore)
 -> Maybe Ignore -> Identity (Maybe Ignore))
-> ((IgnoreModeState -> Identity IgnoreModeState)
    -> Ignore -> Identity Ignore)
-> (IgnoreModeState -> Identity IgnoreModeState)
-> Maybe Ignore
-> Identity (Maybe Ignore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IgnoreModeState -> Identity IgnoreModeState)
-> Ignore -> Identity Ignore
Lens' Ignore IgnoreModeState
ignoreMode ((IgnoreModeState -> Identity IgnoreModeState)
 -> ScannerState -> Identity ScannerState)
-> IgnoreModeState
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=  IgnoreLinkState -> IgnoreModeState
IMSLink IgnoreLinkState
ParentExpectsLink
              Node
node' <- Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
pos NodeType
ty ([Node] -> Node)
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
-> ScannerM Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScannerM Node]
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ScannerM Node]
subs
              Bool
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IgnoreLinkState
ignoreLinkState IgnoreLinkState -> IgnoreLinkState -> Bool
forall a. Eq a => a -> a -> Bool
== IgnoreLinkState
ExpectingLinkInSubnodes) (StateT ScannerState (Writer [ScanError 'Parse]) ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ do
                Maybe Ignore
currentIgnore <- Getting (Maybe Ignore) ScannerState (Maybe Ignore)
-> StateT ScannerState (Writer [ScanError 'Parse]) (Maybe Ignore)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Ignore) ScannerState (Maybe Ignore)
Lens' ScannerState (Maybe Ignore)
ssIgnore
                case Maybe Ignore
currentIgnore of
                  Just (Ignore {_ignoreMode :: Ignore -> IgnoreModeState
_ignoreMode = IMSLink IgnoreLinkState
ParentExpectsLink}) -> do
                    Writer [ScanError 'Parse] ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT ScannerState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> Writer [ScanError 'Parse] ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
modePos ScanErrorDescription
LinkErr
                    (Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Ignore
forall a. Maybe a
Nothing
                  Maybe Ignore
_ -> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (f :: * -> *). Applicative f => f ()
pass
              Node -> ScannerM Node
forall a. a -> StateT ScannerState (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
node'

      Bool
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NodeType
ty NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
PARAGRAPH) (StateT ScannerState (Writer [ScanError 'Parse]) ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Ignore) ScannerState (Maybe Ignore)
-> StateT ScannerState (Writer [ScanError 'Parse]) (Maybe Ignore)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Ignore) ScannerState (Maybe Ignore)
Lens' ScannerState (Maybe Ignore)
ssIgnore StateT ScannerState (Writer [ScanError 'Parse]) (Maybe Ignore)
-> (Maybe Ignore
    -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b.
StateT ScannerState (Writer [ScanError 'Parse]) a
-> (a -> StateT ScannerState (Writer [ScanError 'Parse]) b)
-> StateT ScannerState (Writer [ScanError 'Parse]) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (Ignore (IMSLink IgnoreLinkState
ExpectingLinkInParagraph) Maybe PosInfo
pragmaPos) ->
          Writer [ScanError 'Parse] ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT ScannerState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> Writer [ScanError 'Parse] ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
pragmaPos ScanErrorDescription
LinkErr
        Maybe Ignore
_ -> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (f :: * -> *). Applicative f => f ()
pass

      Node -> ScannerM Node
forall a. a -> StateT ScannerState (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
scan

    handleIgnoreMode
      :: Maybe PosInfo
      -> NodeType
      -> [ScannerM Node]
      -> GetIgnoreMode
      -> ScannerM Node
    handleIgnoreMode :: Maybe PosInfo
-> NodeType -> [ScannerM Node] -> GetIgnoreMode -> ScannerM Node
handleIgnoreMode Maybe PosInfo
pos NodeType
nodeType [ScannerM Node]
subs = \case
      ValidMode IgnoreMode
mode  -> do
        IgnoreModeState
ignoreModeState <- case IgnoreMode
mode of
          IgnoreMode
IMLink -> Getting (Maybe NodeType) ScannerState (Maybe NodeType)
-> StateT ScannerState (Writer [ScanError 'Parse]) (Maybe NodeType)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe NodeType) ScannerState (Maybe NodeType)
Lens' ScannerState (Maybe NodeType)
ssParentNodeType StateT ScannerState (Writer [ScanError 'Parse]) (Maybe NodeType)
-> (Maybe NodeType -> IgnoreModeState)
-> StateT ScannerState (Writer [ScanError 'Parse]) IgnoreModeState
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> IgnoreLinkState -> IgnoreModeState
IMSLink (IgnoreLinkState -> IgnoreModeState)
-> (Maybe NodeType -> IgnoreLinkState)
-> Maybe NodeType
-> IgnoreModeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
             Just NodeType
PARAGRAPH -> IgnoreLinkState
ExpectingLinkInParagraph
             Maybe NodeType
_ -> IgnoreLinkState
ExpectingLinkInSubnodes

          IgnoreMode
IMParagraph -> IgnoreModeState
-> StateT ScannerState (Writer [ScanError 'Parse]) IgnoreModeState
forall a. a -> StateT ScannerState (Writer [ScanError 'Parse]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IgnoreModeState
IMSParagraph

          IgnoreMode
IMAll -> IgnoreModeState
-> StateT ScannerState (Writer [ScanError 'Parse]) IgnoreModeState
forall a. a -> StateT ScannerState (Writer [ScanError 'Parse]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IgnoreModeState
IMSAll

        ((Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Ignore -> Maybe Ignore
forall a. a -> Maybe a
Just (IgnoreModeState -> Maybe PosInfo -> Ignore
Ignore IgnoreModeState
ignoreModeState Maybe PosInfo
correctPos)) StateT ScannerState (Writer [ScanError 'Parse]) ()
-> Node -> ScannerM Node
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Node
defNode
      InvalidMode Text
msg -> do
        Writer [ScanError 'Parse] ()
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> StateT ScannerState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> [ScanError 'Parse]
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse]
 -> StateT ScannerState (Writer [ScanError 'Parse]) ())
-> [ScanError 'Parse]
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
correctPos (ScanErrorDescription -> [ScanError 'Parse])
-> ScanErrorDescription -> [ScanError 'Parse]
forall a b. (a -> b) -> a -> b
$ Text -> ScanErrorDescription
UnrecognisedErr Text
msg
        ((Maybe Ignore -> Identity (Maybe Ignore))
-> ScannerState -> Identity ScannerState
Lens' ScannerState (Maybe Ignore)
ssIgnore ((Maybe Ignore -> Identity (Maybe Ignore))
 -> ScannerState -> Identity ScannerState)
-> Maybe Ignore
-> StateT ScannerState (Writer [ScanError 'Parse]) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Ignore
forall a. Maybe a
Nothing) StateT ScannerState (Writer [ScanError 'Parse]) ()
-> Node -> ScannerM Node
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Node
defNode
      GetIgnoreMode
NotAnAnnotation -> Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
pos NodeType
nodeType ([Node] -> Node)
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
-> ScannerM Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScannerM Node]
-> StateT ScannerState (Writer [ScanError 'Parse]) [Node]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ScannerM Node]
subs
      where
        correctPos :: Maybe PosInfo
correctPos = Node -> Maybe PosInfo
getPosition (Node -> Maybe PosInfo) -> Node -> Maybe PosInfo
forall a b. (a -> b) -> a -> b
$ Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
pos NodeType
nodeType []

    prettyType :: NodeType -> Text
    prettyType :: NodeType -> Text
prettyType NodeType
ty =
      let mType :: Maybe (Element [Text])
mType = [Text] -> Maybe (Element [Text])
forall t. Container t => t -> Maybe (Element t)
safeHead ([Text] -> Maybe (Element [Text]))
-> [Text] -> Maybe (Element [Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ NodeType -> Text
forall b a. (Show a, IsString b) => a -> b
show NodeType
ty
      in Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
Maybe (Element [Text])
mType

    action :: ScannerM Node
    action :: ScannerM Node
action = (Maybe PosInfo -> NodeType -> [ScannerM Node] -> ScannerM Node)
-> Node -> ScannerM Node
forall a.
(Maybe PosInfo -> NodeType -> [ScannerM a] -> ScannerM a)
-> Node -> ScannerM a
cataNodeWithParentNodeInfo Maybe PosInfo -> NodeType -> [ScannerM Node] -> ScannerM Node
remove Node
rootNode

  (Node
node, ScannerState
s) <- Writer [ScanError 'Parse] (Node, ScannerState)
-> ReaderT
     ExtractorCtx (Writer [ScanError 'Parse]) (Node, ScannerState)
forall (m :: * -> *) a. Monad m => m a -> ReaderT ExtractorCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] (Node, ScannerState)
 -> ReaderT
      ExtractorCtx (Writer [ScanError 'Parse]) (Node, ScannerState))
-> Writer [ScanError 'Parse] (Node, ScannerState)
-> ReaderT
     ExtractorCtx (Writer [ScanError 'Parse]) (Node, ScannerState)
forall a b. (a -> b) -> a -> b
$ ScannerM Node
-> ScannerState -> Writer [ScanError 'Parse] (Node, ScannerState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ScannerM Node
action ScannerState
initialScannerState
  case ScannerState
s of
    -- We expect `Ignore` state to be `Nothing` when we reach EOF,
    -- otherwise that means there was an annotation that didn't match
    -- any node, so we have to report that.
    ScannerState {_ssIgnore :: ScannerState -> Maybe Ignore
_ssIgnore = Just (Ignore IgnoreModeState
mode Maybe PosInfo
pos)} -> do
      case IgnoreModeState
mode of
        IgnoreModeState
IMSParagraph -> do
            Writer [ScanError 'Parse] ()
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT ExtractorCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ())
-> Writer [ScanError 'Parse] ()
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> (ScanErrorDescription -> [ScanError 'Parse])
-> ScanErrorDescription
-> Writer [ScanError 'Parse] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
pos (ScanErrorDescription -> Writer [ScanError 'Parse] ())
-> ScanErrorDescription -> Writer [ScanError 'Parse] ()
forall a b. (a -> b) -> a -> b
$ Text -> ScanErrorDescription
ParagraphErr Text
"EOF"
            Node -> ExtractorM Node
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
node
        IMSLink IgnoreLinkState
_ -> do
            Writer [ScanError 'Parse] ()
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT ExtractorCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ())
-> Writer [ScanError 'Parse] ()
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
pos ScanErrorDescription
LinkErr
            Node -> ExtractorM Node
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
node
        IgnoreModeState
IMSAll -> do
            Writer [ScanError 'Parse] ()
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT ExtractorCtx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer [ScanError 'Parse] ()
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ())
-> Writer [ScanError 'Parse] ()
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) ()
forall a b. (a -> b) -> a -> b
$ [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell ([ScanError 'Parse] -> Writer [ScanError 'Parse] ())
-> [ScanError 'Parse] -> Writer [ScanError 'Parse] ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
pos ScanErrorDescription
FileErr
            Node -> ExtractorM Node
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
node
    ScannerState
_ -> Node -> ExtractorM Node
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
node

-- | Custom `foldMap` for source tree.
foldNode :: (Monoid a, Monad m) => (Node -> m a) -> Node -> m a
foldNode :: forall a (m :: * -> *).
(Monoid a, Monad m) =>
(Node -> m a) -> Node -> m a
foldNode Node -> m a
action node :: Node
node@(Node Maybe PosInfo
_ NodeType
_ [Node]
subs) = do
  a
a <- Node -> m a
action Node
node
  a
b <- [Node] -> (Node -> m a) -> m a
forall (f :: * -> *) m (l :: * -> *) a.
(Applicative f, Monoid m, Container (l m), Element (l m) ~ m,
 Traversable l) =>
l a -> (a -> f m) -> f m
concatForM [Node]
subs ((Node -> m a) -> Node -> m a
forall a (m :: * -> *).
(Monoid a, Monad m) =>
(Node -> m a) -> Node -> m a
foldNode Node -> m a
action)
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)

data ExtractorCtx = ExtractorCtx
  { ExtractorCtx -> MarkdownConfig
ecConfig :: MarkdownConfig
  , ExtractorCtx -> FilePath
ecFilePath :: String  -- for printing
  }

type ExtractorM a = ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a

-- | Extract information from source tree.
nodeExtractInfo :: Node -> ExtractorM FileInfo
nodeExtractInfo :: Node -> ExtractorM FileInfo
nodeExtractInfo input :: Node
input@(Node Maybe PosInfo
_ NodeType
_ [Node]
nSubs) = do
  if [Node] -> Bool
checkIgnoreAllFile [Node]
nSubs
  then FileInfo -> ExtractorM FileInfo
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfoDiff -> FileInfo
diffToFileInfo FileInfoDiff
forall a. Monoid a => a
mempty)
  else FileInfoDiff -> FileInfo
diffToFileInfo (FileInfoDiff -> FileInfo)
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
-> ExtractorM FileInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Node
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff)
-> Node
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a (m :: * -> *).
(Monoid a, Monad m) =>
(Node -> m a) -> Node -> m a
foldNode Node
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
extractor (Node
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff)
-> ExtractorM Node
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> ExtractorM Node
removeIgnored Node
input)

  where
    extractor :: Node -> ExtractorM FileInfoDiff
    extractor :: Node
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
extractor node :: Node
node@(Node Maybe PosInfo
pos NodeType
ty [Node]
_) = do
      FilePath
filepath <- (ExtractorCtx -> FilePath)
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ExtractorCtx -> FilePath
ecFilePath
      case NodeType
ty of
        HTML_BLOCK Text
_ -> do
          FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfoDiff
forall a. Monoid a => a
mempty

        HEADING Int
lvl -> do
          Flavor
flavor <- (ExtractorCtx -> Flavor)
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) Flavor
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (MarkdownConfig -> Flavor
mcFlavor (MarkdownConfig -> Flavor)
-> (ExtractorCtx -> MarkdownConfig) -> ExtractorCtx -> Flavor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtractorCtx -> MarkdownConfig
ecConfig)
          let aType :: AnchorType
aType = Int -> AnchorType
HeaderAnchor Int
lvl
          let aName :: Text
aName = Flavor -> Text -> Text
headerToAnchor Flavor
flavor (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Node -> Text
nodeExtractText Node
node
          let aPos :: Position
aPos  = FilePath -> Maybe PosInfo -> Position
toPosition FilePath
filepath Maybe PosInfo
pos
          FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfoDiff
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff)
-> FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a b. (a -> b) -> a -> b
$ DList Reference -> DList Anchor -> FileInfoDiff
FileInfoDiff DList Reference
forall a. DList a
DList.empty (DList Anchor -> FileInfoDiff) -> DList Anchor -> FileInfoDiff
forall a b. (a -> b) -> a -> b
$ Anchor -> DList Anchor
forall a. a -> DList a
DList.singleton (Anchor -> DList Anchor) -> Anchor -> DList Anchor
forall a b. (a -> b) -> a -> b
$ Anchor {AnchorType
aType :: AnchorType
aType :: AnchorType
aType, Text
aName :: Text
aName :: Text
aName, Position
aPos :: Position
aPos :: Position
aPos}

        HTML_INLINE Text
text -> do
          let
            mName :: Maybe Text
mName = do
              Tag Text
tag <- [Tag Text] -> Maybe (Element [Tag Text])
forall t. Container t => t -> Maybe (Element t)
safeHead ([Tag Text] -> Maybe (Element [Tag Text]))
-> [Tag Text] -> Maybe (Element [Tag Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
text
              [Attribute Text]
attributes <- case Tag Text
tag of
                TagOpen Text
a [Attribute Text]
attrs
                  | Text -> Text
T.toLower Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"a" -> [Attribute Text] -> Maybe [Attribute Text]
forall a. a -> Maybe a
Just [Attribute Text]
attrs
                Tag Text
_ -> Maybe [Attribute Text]
forall a. Maybe a
Nothing
              (Text
_, Text
name) <- (Element [Attribute Text] -> Bool)
-> [Attribute Text] -> Maybe (Element [Attribute Text])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\(Text
field, Text
_) -> Text -> Text
T.toLower Text
field Element [Text] -> [Text] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [Text
"name", Text
"id"]) [Attribute Text]
attributes
              Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name

          case Maybe Text
mName of
            Just Text
aName -> do
              let aType :: AnchorType
aType = AnchorType
HandAnchor
                  aPos :: Position
aPos  = FilePath -> Maybe PosInfo -> Position
toPosition FilePath
filepath Maybe PosInfo
pos
              FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfoDiff
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff)
-> FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a b. (a -> b) -> a -> b
$ DList Reference -> DList Anchor -> FileInfoDiff
FileInfoDiff
                DList Reference
forall a. Monoid a => a
mempty
                (Anchor -> DList Anchor
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Anchor -> DList Anchor) -> Anchor -> DList Anchor
forall a b. (a -> b) -> a -> b
$ Anchor {AnchorType
aType :: AnchorType
aType :: AnchorType
aType, Text
aName :: Text
aName :: Text
aName, Position
aPos :: Position
aPos :: Position
aPos})

            Maybe Text
Nothing -> do
              FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfoDiff
forall a. Monoid a => a
mempty

        LINK Text
url Text
_ -> Text
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
extractLink Text
url

        IMAGE Text
url Text
_ -> Text
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
extractLink Text
url

        NodeType
_ -> FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfoDiff
forall a. Monoid a => a
mempty

      where
        extractLink :: Text
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
extractLink Text
url = do
          FilePath
filepath <- (ExtractorCtx -> FilePath)
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ExtractorCtx -> FilePath
ecFilePath
          let rName :: Text
rName = Node -> Text
nodeExtractText Node
node
              rPos :: Position
rPos = FilePath -> Maybe PosInfo -> Position
toPosition FilePath
filepath Maybe PosInfo
pos
              rInfo :: ReferenceInfo
rInfo = Text -> ReferenceInfo
referenceInfo (Text -> ReferenceInfo) -> Text -> ReferenceInfo
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
forall t. Container t => t -> Bool
null Text
url then Text
rName else Text
url

          FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a. a -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfoDiff
 -> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff)
-> FileInfoDiff
-> ReaderT ExtractorCtx (Writer [ScanError 'Parse]) FileInfoDiff
forall a b. (a -> b) -> a -> b
$ DList Reference -> DList Anchor -> FileInfoDiff
FileInfoDiff
            (Reference -> DList Reference
forall a. a -> DList a
DList.singleton (Reference -> DList Reference) -> Reference -> DList Reference
forall a b. (a -> b) -> a -> b
$ Reference {Text
rName :: Text
rName :: Text
rName, Position
rPos :: Position
rPos :: Position
rPos, ReferenceInfo
rInfo :: ReferenceInfo
rInfo :: ReferenceInfo
rInfo})
            DList Anchor
forall a. DList a
DList.empty

-- | Check if there is `ignore all` at the beginning of the file,
-- ignoring preceding comments if there are any.
checkIgnoreAllFile :: [Node] -> Bool
checkIgnoreAllFile :: [Node] -> Bool
checkIgnoreAllFile [Node]
nodes =
  let isSimpleComment :: Node -> Bool
      isSimpleComment :: Node -> Bool
isSimpleComment Node
node = Node -> Bool
isComment Node
node Bool -> Bool -> Bool
&& Bool -> Bool
not (Node -> Bool
isIgnoreFile Node
node)

      mIgnoreFile :: Maybe (Element [Node])
mIgnoreFile = [Node] -> Maybe (Element [Node])
forall t. Container t => t -> Maybe (Element t)
safeHead ([Node] -> Maybe (Element [Node]))
-> [Node] -> Maybe (Element [Node])
forall a b. (a -> b) -> a -> b
$ (Node -> Bool) -> [Node] -> [Node]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Node -> Bool
isSimpleComment [Node]
nodes
  in Bool -> (Node -> Bool) -> Maybe Node -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Node -> Bool
isIgnoreFile Maybe Node
Maybe (Element [Node])
mIgnoreFile
  where
    isComment :: Node -> Bool
    isComment :: Node -> Bool
isComment = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool) -> (Node -> Maybe Text) -> Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Maybe Text
getCommentContent

    isIgnoreFile :: Node -> Bool
    isIgnoreFile :: Node -> Bool
isIgnoreFile = (IgnoreMode -> GetIgnoreMode
ValidMode IgnoreMode
IMAll GetIgnoreMode -> GetIgnoreMode -> Bool
forall a. Eq a => a -> a -> Bool
==) (GetIgnoreMode -> Bool) -> (Node -> GetIgnoreMode) -> Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> GetIgnoreMode
getIgnoreMode

defNode :: Node
defNode :: Node
defNode = Maybe PosInfo -> NodeType -> [Node] -> Node
Node Maybe PosInfo
forall a. Maybe a
Nothing NodeType
DOCUMENT [] -- hard-coded default Node

makeError
  :: FilePath
  -> Maybe PosInfo
  -> ScanErrorDescription
  -> [ScanError 'Parse]
makeError :: FilePath
-> Maybe PosInfo -> ScanErrorDescription -> [ScanError 'Parse]
makeError FilePath
filepath Maybe PosInfo
pos ScanErrorDescription
errDescription =
  OneItem [ScanError 'Parse] -> [ScanError 'Parse]
forall x. One x => OneItem x -> x
one (OneItem [ScanError 'Parse] -> [ScanError 'Parse])
-> OneItem [ScanError 'Parse] -> [ScanError 'Parse]
forall a b. (a -> b) -> a -> b
$ Position -> ScanErrorDescription -> ScanError 'Parse
mkParseScanError (FilePath -> Maybe PosInfo -> Position
toPosition FilePath
filepath Maybe PosInfo
pos) ScanErrorDescription
errDescription

getCommentContent :: Node -> Maybe Text
getCommentContent :: Node -> Maybe Text
getCommentContent Node
node = do
  Text
txt <- Node -> Maybe Text
getHTMLText Node
node
  Text -> Text -> Maybe Text
T.stripSuffix Text
"-->" (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
T.stripPrefix Text
"<!--" (Text -> Text
T.strip Text
txt)

getHTMLText :: Node -> Maybe Text
getHTMLText :: Node -> Maybe Text
getHTMLText (Node Maybe PosInfo
_ (HTML_BLOCK Text
txt) [Node]
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
getHTMLText (Node Maybe PosInfo
_ (HTML_INLINE Text
txt) [Node]
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
getHTMLText Node
_ = Maybe Text
forall a. Maybe a
Nothing

getXrefcheckContent :: Node -> Maybe Text
getXrefcheckContent :: Node -> Maybe Text
getXrefcheckContent Node
node =
  let notStripped :: Maybe Text
notStripped = Text -> Text -> Maybe Text
T.stripPrefix Text
"xrefcheck:" (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        Node -> Maybe Text
getCommentContent Node
node
  in Text -> Text
T.strip (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
notStripped

-- | Get the correct position of an annotation node. There is a bug in
-- `commonmarkToNode` from the `cmark-gfm` package that affects one line
-- `HTML_BLOCK` nodes, those node have wrong end line and end column positions.
-- As our annotations are always oneliners, we can fix this by simply setting
-- end line equals to start line and calculating end column from start column
-- and annotation length.
getPosition :: Node -> Maybe PosInfo
getPosition :: Node -> Maybe PosInfo
getPosition node :: Node
node@(Node Maybe PosInfo
pos NodeType
_ [Node]
_) = do
  Int
annLength <- Text -> Int
forall t. Container t => t -> Int
length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Int) -> Maybe Text -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node -> Maybe Text
getHTMLText Node
node
  PosInfo Int
sl Int
sc Int
_ Int
_ <- Maybe PosInfo
pos
  PosInfo -> Maybe PosInfo
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PosInfo -> Maybe PosInfo) -> PosInfo -> Maybe PosInfo
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> PosInfo
PosInfo Int
sl Int
sc Int
sl (Int
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
annLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Extract `IgnoreMode` if current node is xrefcheck annotation.
getIgnoreMode :: Node -> GetIgnoreMode
getIgnoreMode :: Node -> GetIgnoreMode
getIgnoreMode Node
node = GetIgnoreMode
-> (Text -> GetIgnoreMode) -> Maybe Text -> GetIgnoreMode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GetIgnoreMode
NotAnAnnotation ([Text] -> GetIgnoreMode
textToMode ([Text] -> GetIgnoreMode)
-> (Text -> [Text]) -> Text -> GetIgnoreMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
words) (Node -> Maybe Text
getXrefcheckContent Node
node)

textToMode :: [Text] -> GetIgnoreMode
textToMode :: [Text] -> GetIgnoreMode
textToMode (Text
"ignore" : [Text
x])
  | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"link"      = IgnoreMode -> GetIgnoreMode
ValidMode IgnoreMode
IMLink
  | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"paragraph" = IgnoreMode -> GetIgnoreMode
ValidMode IgnoreMode
IMParagraph
  | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"all"      = IgnoreMode -> GetIgnoreMode
ValidMode IgnoreMode
IMAll
  | Bool
otherwise        = Text -> GetIgnoreMode
InvalidMode Text
x
textToMode [Text]
_         = GetIgnoreMode
NotAnAnnotation

parseFileInfo :: MarkdownConfig -> String -> LT.Text -> (FileInfo, [ScanError 'Parse])
parseFileInfo :: MarkdownConfig
-> FilePath -> Text -> (FileInfo, [ScanError 'Parse])
parseFileInfo MarkdownConfig
config FilePath
pathForPrinting Text
input
  = Writer [ScanError 'Parse] FileInfo
-> (FileInfo, [ScanError 'Parse])
forall w a. Monoid w => Writer w a -> (a, w)
runWriter
  (Writer [ScanError 'Parse] FileInfo
 -> (FileInfo, [ScanError 'Parse]))
-> Writer [ScanError 'Parse] FileInfo
-> (FileInfo, [ScanError 'Parse])
forall a b. (a -> b) -> a -> b
$ (ExtractorM FileInfo
 -> ExtractorCtx -> Writer [ScanError 'Parse] FileInfo)
-> ExtractorCtx
-> ExtractorM FileInfo
-> Writer [ScanError 'Parse] FileInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip ExtractorM FileInfo
-> ExtractorCtx -> Writer [ScanError 'Parse] FileInfo
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (MarkdownConfig -> FilePath -> ExtractorCtx
ExtractorCtx MarkdownConfig
config FilePath
pathForPrinting)
  (ExtractorM FileInfo -> Writer [ScanError 'Parse] FileInfo)
-> ExtractorM FileInfo -> Writer [ScanError 'Parse] FileInfo
forall a b. (a -> b) -> a -> b
$ Node -> ExtractorM FileInfo
nodeExtractInfo
  (Node -> ExtractorM FileInfo) -> Node -> ExtractorM FileInfo
forall a b. (a -> b) -> a -> b
$ [CMarkOption] -> [CMarkExtension] -> Text -> Node
commonmarkToNode [CMarkOption
optFootnotes] [CMarkExtension
extAutolink]
  (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict Text
input

markdownScanner :: Given PrintUnixPaths => MarkdownConfig -> ScanAction
markdownScanner :: Given PrintUnixPaths => MarkdownConfig -> ScanAction
markdownScanner MarkdownConfig
config FilePath
root RelPosixLink
relativePath =
  MarkdownConfig
-> FilePath -> Text -> (FileInfo, [ScanError 'Parse])
parseFileInfo MarkdownConfig
config FilePath
pathForPrinting (Text -> (FileInfo, [ScanError 'Parse]))
-> (ByteString -> Text)
-> ByteString
-> (FileInfo, [ScanError 'Parse])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
    (ByteString -> (FileInfo, [ScanError 'Parse]))
-> IO ByteString -> IO (FileInfo, [ScanError 'Parse])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BSL.readFile FilePath
rootedPath
  where
    rootedPath :: FilePath
rootedPath = FilePath -> RelPosixLink -> FilePath
filePathFromRoot FilePath
root RelPosixLink
relativePath
    pathForPrinting :: FilePath
pathForPrinting = FilePath -> FilePath
Given PrintUnixPaths => FilePath -> FilePath
mkPathForPrinting FilePath
rootedPath

markdownSupport :: Given PrintUnixPaths => MarkdownConfig -> FileSupport
markdownSupport :: Given PrintUnixPaths => MarkdownConfig -> FileSupport
markdownSupport MarkdownConfig
config Bool
isSymlink FilePath
extension = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ FilePath
extension FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".md"
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
isSymlink
  ScanAction -> Maybe ScanAction
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScanAction -> Maybe ScanAction) -> ScanAction -> Maybe ScanAction
forall a b. (a -> b) -> a -> b
$ Given PrintUnixPaths => MarkdownConfig -> ScanAction
MarkdownConfig -> ScanAction
markdownScanner MarkdownConfig
config