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

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

-- | Markdown documents markdownScanner.

module Xrefcheck.Scanners.Markdown
    ( markdownScanner
    , markdownSupport
    , parseFileInfo
    ) where

import CMarkGFM (Node (..), NodeType (..), PosInfo (..), commonmarkToNode)
import Control.Lens ((%=))
import Control.Monad.Trans.Except (Except, runExcept, throwE)
import qualified Data.ByteString.Lazy as BSL
import Data.Char (isSpace)
import Data.Default (Default (..))
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Fmt (Buildable (..), blockListF, nameF, (+|), (|+))

import Xrefcheck.Core
import Xrefcheck.Scan

instance Buildable Node where
    build :: Node -> Builder
build (Node Maybe PosInfo
_mpos NodeType
ty [Node]
subs) = 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
$ [Node] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF [Node]
subs

toPosition :: Maybe PosInfo -> Position
toPosition :: Maybe PosInfo -> Position
toPosition = Maybe Text -> Position
Position (Maybe Text -> Position)
-> (Maybe PosInfo -> Maybe Text) -> Maybe PosInfo -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Maybe PosInfo
Nothing -> Maybe Text
forall a. Maybe a
Nothing
    Just PosInfo{Int
startLine :: PosInfo -> Int
startColumn :: PosInfo -> Int
endLine :: PosInfo -> Int
endColumn :: PosInfo -> Int
endColumn :: Int
endLine :: Int
startColumn :: Int
startLine :: Int
..}
        | Int
startLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endLine -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
            Int
startLine Int -> Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
":" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
startColumn Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"-" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
endColumn Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
        | Bool
otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
            Builder
" " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+|
            Int
startLine Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
":" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
startColumn Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" - " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|
            Int
endLine Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
":" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
endColumn Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

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]
: (Node -> [NodeType]) -> [Node] -> [NodeType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Node -> [NodeType]
nodeFlatten [Node]
subs

nodeExtractText :: Node -> Text
nodeExtractText :: Node -> Text
nodeExtractText = [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
""

data IgnoreMode
    = Link
    | Paragraph
    | File
    deriving IgnoreMode -> IgnoreMode -> Bool
(IgnoreMode -> IgnoreMode -> Bool)
-> (IgnoreMode -> IgnoreMode -> Bool) -> Eq IgnoreMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IgnoreMode -> IgnoreMode -> Bool
$c/= :: IgnoreMode -> IgnoreMode -> Bool
== :: IgnoreMode -> IgnoreMode -> Bool
$c== :: IgnoreMode -> IgnoreMode -> Bool
Eq

nodeExtractInfo :: Node -> Except Text FileInfo
nodeExtractInfo :: Node -> Except Text FileInfo
nodeExtractInfo (Node Maybe PosInfo
_ NodeType
_ [Node]
docNodes) =
    if [Node] -> Bool
checkIgnoreFile [Node]
docNodes
    then FileInfo -> Except Text FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
forall a. Default a => a
def
    else FileInfo -> FileInfo
finaliseFileInfo (FileInfo -> FileInfo)
-> Except Text FileInfo -> Except Text FileInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Except Text FileInfo
extractionResult
    where
        extractionResult :: Except Text FileInfo
        extractionResult :: Except Text FileInfo
extractionResult =
            StateT FileInfo (Except Text) ()
-> FileInfo -> Except Text FileInfo
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ([Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [Node]
docNodes Maybe IgnoreMode
forall a. Maybe a
Nothing) FileInfo
forall a. Default a => a
def

        loop :: [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
        loop :: [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [] Maybe IgnoreMode
_ = StateT FileInfo (Except Text) ()
forall (f :: * -> *). Applicative f => f ()
pass
        loop (node :: Node
node@(Node Maybe PosInfo
pos NodeType
ty [Node]
subs) : [Node]
nodes) Maybe IgnoreMode
toIgnore
            | Maybe IgnoreMode
toIgnore Maybe IgnoreMode -> Maybe IgnoreMode -> Bool
forall a. Eq a => a -> a -> Bool
== IgnoreMode -> Maybe IgnoreMode
forall a. a -> Maybe a
Just IgnoreMode
File = Maybe IgnoreMode
-> Text -> Maybe PosInfo -> StateT FileInfo (Except Text) ()
returnError Maybe IgnoreMode
toIgnore Text
"" Maybe PosInfo
pos
            | Maybe IgnoreMode
toIgnore Maybe IgnoreMode -> Maybe IgnoreMode -> Bool
forall a. Eq a => a -> a -> Bool
== IgnoreMode -> Maybe IgnoreMode
forall a. a -> Maybe a
Just IgnoreMode
Link = do
                let (Node Maybe PosInfo
startPos NodeType
_ [Node]
_) = Node -> (Node -> Node) -> Maybe Node -> Node
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Node
defNode Node -> Node
forall a. a -> a
id (Maybe Node -> Node) -> Maybe Node -> Node
forall a b. (a -> b) -> a -> b
$ [Node] -> Maybe (Element [Node])
forall t. Container t => t -> Maybe (Element t)
safeHead [Node]
subs
                let mNext :: Maybe [Node]
mNext = case NodeType
ty of
                        NodeType
PARAGRAPH -> [Node] -> Maybe [Node]
afterIgnoredLink [Node]
subs Maybe [Node] -> Maybe [Node] -> Maybe [Node]
forall a. Semigroup a => a -> a -> a
<> [Node] -> Maybe [Node]
forall a. a -> Maybe a
Just [Node]
nodes
                        TEXT Text
txt | [Char] -> Bool
forall t. Container t => t -> Bool
null ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
txt) -> [Node] -> Maybe [Node]
afterIgnoredLink [Node]
nodes
                        NodeType
SOFTBREAK -> [Node] -> Maybe [Node]
afterIgnoredLink [Node]
nodes
                        NodeType
_ -> [Node] -> Maybe [Node]
afterIgnoredLink (Node
node Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node]
nodes)
                case Maybe [Node]
mNext of
                    Just [Node]
next -> [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [Node]
next Maybe IgnoreMode
forall a. Maybe a
Nothing
                    Maybe [Node]
Nothing   -> Maybe IgnoreMode
-> Text -> Maybe PosInfo -> StateT FileInfo (Except Text) ()
returnError Maybe IgnoreMode
toIgnore Text
"" Maybe PosInfo
startPos
            | Maybe IgnoreMode
toIgnore Maybe IgnoreMode -> Maybe IgnoreMode -> Bool
forall a. Eq a => a -> a -> Bool
== IgnoreMode -> Maybe IgnoreMode
forall a. a -> Maybe a
Just IgnoreMode
Paragraph =
                case NodeType
ty of
                    NodeType
PARAGRAPH -> [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [Node]
nodes Maybe IgnoreMode
forall a. Maybe a
Nothing
                    NodeType
_         -> Maybe IgnoreMode
-> Text -> Maybe PosInfo -> StateT FileInfo (Except Text) ()
returnError Maybe IgnoreMode
toIgnore (NodeType -> Text
prettyType NodeType
ty) Maybe PosInfo
pos
            | Bool
otherwise =
                case NodeType
ty of
                    HTML_BLOCK Text
_ -> Node
-> Maybe PosInfo
-> [Node]
-> Maybe IgnoreMode
-> StateT FileInfo (Except Text) ()
processHtmlNode Node
node Maybe PosInfo
pos [Node]
nodes Maybe IgnoreMode
toIgnore
                    HEADING Int
lvl -> do
                        let aType :: AnchorType
aType = Int -> AnchorType
HeaderAnchor Int
lvl
                        let aName :: Text
aName = Text -> Text
headerToAnchor (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Node -> Text
nodeExtractText Node
node
                        let aPos :: Position
aPos = Maybe PosInfo -> Position
toPosition Maybe PosInfo
pos
                        ([Anchor] -> Identity [Anchor]) -> FileInfo -> Identity FileInfo
Lens' FileInfo [Anchor]
fiAnchors (([Anchor] -> Identity [Anchor]) -> FileInfo -> Identity FileInfo)
-> ([Anchor] -> [Anchor]) -> StateT FileInfo (Except Text) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Anchor :: AnchorType -> Text -> Position -> Anchor
Anchor{Text
AnchorType
Position
aPos :: Position
aName :: Text
aType :: AnchorType
aPos :: Position
aName :: Text
aType :: AnchorType
..} Anchor -> [Anchor] -> [Anchor]
forall a. a -> [a] -> [a]
:)
                        [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [Node]
nodes Maybe IgnoreMode
toIgnore
                    HTML_INLINE Text
htmlText -> do
                        let mName :: Maybe Text
mName = 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
"<a name=\"" Text
htmlText
                        Maybe Text
-> (Text -> StateT FileInfo (Except Text) ())
-> StateT FileInfo (Except Text) ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe Text
mName ((Text -> StateT FileInfo (Except Text) ())
 -> StateT FileInfo (Except Text) ())
-> (Text -> StateT FileInfo (Except Text) ())
-> StateT FileInfo (Except Text) ()
forall a b. (a -> b) -> a -> b
$ \Text
aName -> do
                            let aType :: AnchorType
aType = AnchorType
HandAnchor
                                aPos :: Position
aPos = Maybe PosInfo -> Position
toPosition Maybe PosInfo
pos
                            ([Anchor] -> Identity [Anchor]) -> FileInfo -> Identity FileInfo
Lens' FileInfo [Anchor]
fiAnchors (([Anchor] -> Identity [Anchor]) -> FileInfo -> Identity FileInfo)
-> ([Anchor] -> [Anchor]) -> StateT FileInfo (Except Text) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Anchor :: AnchorType -> Text -> Position -> Anchor
Anchor{Text
AnchorType
Position
aPos :: Position
aType :: AnchorType
aName :: Text
aPos :: Position
aName :: Text
aType :: AnchorType
..} Anchor -> [Anchor] -> [Anchor]
forall a. a -> [a] -> [a]
:)
                        Node
-> Maybe PosInfo
-> [Node]
-> Maybe IgnoreMode
-> StateT FileInfo (Except Text) ()
processHtmlNode Node
node Maybe PosInfo
pos [Node]
nodes Maybe IgnoreMode
toIgnore
                    LINK Text
url Text
_ -> do
                        let rName :: Text
rName = Node -> Text
nodeExtractText Node
node
                            rPos :: Position
rPos = Maybe PosInfo -> Position
toPosition Maybe PosInfo
pos
                            link :: Text
link = if Text -> Bool
forall t. Container t => t -> Bool
null Text
url then Text
rName else Text
url
                        let (Text
rLink, Maybe Text
rAnchor) = case Text -> Text -> [Text]
T.splitOn Text
"#" Text
link of
                                [Text
t]    -> (Text
t, Maybe Text
forall a. Maybe a
Nothing)
                                Text
t : [Text]
ts -> (Text
t, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"#" [Text]
ts)
                                []     -> Text -> (Text, Maybe Text)
forall a. HasCallStack => Text -> a
error Text
"impossible"
                        ([Reference] -> Identity [Reference])
-> FileInfo -> Identity FileInfo
Lens' FileInfo [Reference]
fiReferences (([Reference] -> Identity [Reference])
 -> FileInfo -> Identity FileInfo)
-> ([Reference] -> [Reference]) -> StateT FileInfo (Except Text) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Reference :: Text -> Text -> Maybe Text -> Position -> Reference
Reference{Maybe Text
Text
Position
rPos :: Position
rAnchor :: Maybe Text
rLink :: Text
rName :: Text
rAnchor :: Maybe Text
rLink :: Text
rPos :: Position
rName :: Text
..} Reference -> [Reference] -> [Reference]
forall a. a -> [a] -> [a]
:)
                        [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [Node]
nodes Maybe IgnoreMode
toIgnore
                    NodeType
_ -> [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop ([Node]
subs [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node]
nodes) Maybe IgnoreMode
toIgnore

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

        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)
            where
                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

        getIgnoreMode :: Node -> Maybe IgnoreMode
        getIgnoreMode :: Node -> Maybe IgnoreMode
getIgnoreMode Node
node =
            let mContent :: Maybe Text
mContent = Node -> Maybe Text
getXrefcheckContent Node
node

                textToMode :: [Text] -> Maybe IgnoreMode
                textToMode :: [Text] -> Maybe IgnoreMode
textToMode (Text
"ignore" : [Text
x])
                    | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"link"      = IgnoreMode -> Maybe IgnoreMode
forall (m :: * -> *) a. Monad m => a -> m a
return IgnoreMode
Link
                    | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"paragraph" = IgnoreMode -> Maybe IgnoreMode
forall (m :: * -> *) a. Monad m => a -> m a
return IgnoreMode
Paragraph
                    | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"file"      = IgnoreMode -> Maybe IgnoreMode
forall (m :: * -> *) a. Monad m => a -> m a
return IgnoreMode
File
                    | Bool
otherwise        = Maybe IgnoreMode
forall a. Maybe a
Nothing
                textToMode [Text]
_           = Maybe IgnoreMode
forall a. Maybe a
Nothing
            in [Text] -> Maybe IgnoreMode
textToMode ([Text] -> Maybe IgnoreMode)
-> (Text -> [Text]) -> Text -> Maybe IgnoreMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
words (Text -> Maybe IgnoreMode) -> Maybe Text -> Maybe IgnoreMode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mContent

        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 -> Maybe IgnoreMode
forall a. a -> Maybe a
Just IgnoreMode
File Maybe IgnoreMode -> Maybe IgnoreMode -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe IgnoreMode -> Bool)
-> (Node -> Maybe IgnoreMode) -> Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Maybe IgnoreMode
getIgnoreMode

        checkIgnoreFile :: [Node] -> Bool
        checkIgnoreFile :: [Node] -> Bool
checkIgnoreFile [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

        isLink :: Node -> Bool
        isLink :: Node -> Bool
isLink (Node Maybe PosInfo
_ (LINK Text
_ Text
_) [Node]
_) = Bool
True
        isLink Node
_ = Bool
False

        isText :: Node -> Bool
        isText :: Node -> Bool
isText (Node Maybe PosInfo
_ (TEXT Text
_) [Node]
_) = Bool
True
        isText Node
_ = Bool
False

        afterIgnoredLink :: [Node] -> Maybe [Node]
        afterIgnoredLink :: [Node] -> Maybe [Node]
afterIgnoredLink (Node
fNode : [Node]
nodes)
            | Node -> Bool
isLink Node
fNode = [Node] -> Maybe [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
nodes
            | Node
sNode : [Node]
nodes' <- [Node]
nodes =
                if Node -> Bool
isText Node
fNode Bool -> Bool -> Bool
&& Node -> Bool
isLink Node
sNode
                then [Node] -> Maybe [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
nodes'
                else Maybe [Node]
forall a. Maybe a
Nothing
            | Bool
otherwise = Maybe [Node]
forall a. Maybe a
Nothing
        afterIgnoredLink [Node]
_ = Maybe [Node]
forall a. Maybe a
Nothing

        prettyPos :: Maybe PosInfo -> Text
        prettyPos :: Maybe PosInfo -> Text
prettyPos Maybe PosInfo
pos =
            let posToText :: Position -> Text
                posToText :: Position -> Text
posToText (Position Maybe Text
mPos) = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mPos
            in Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Position -> Text
posToText (Position -> Text) -> Position -> Text
forall a b. (a -> b) -> a -> b
$ Maybe PosInfo -> Position
toPosition Maybe PosInfo
pos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

        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 -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
forall a. a -> a
id Maybe Text
Maybe (Element [Text])
mType

        fileMsg :: Text
        fileMsg :: Text
fileMsg =
            Text
"\"ignore file\" must be at the top of \
            \markdown or right after comments at the top"

        linkMsg :: Text
        linkMsg :: Text
linkMsg = Text
"expected a LINK after \"ignore link\" "

        paragraphMsg :: Text -> Text
        paragraphMsg :: Text -> Text
paragraphMsg Text
txt = [Text] -> Text
unwords
            [ Text
"expected a PARAGRAPH after \
               \\"ignore paragraph\", but found"
            , Text
txt
            , Text
""
            ]

        unrecognisedMsg :: Text -> Text
        unrecognisedMsg :: Text -> Text
unrecognisedMsg Text
txt = [Text] -> Text
unwords
            [ Text
"unrecognised option"
            , Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
            , Text
"perhaps you meant \
               \<\"ignore link\"|\"ignore paragraph\"|\"ignore file\"> "
            ]

        returnError :: Maybe IgnoreMode -> Text -> Maybe PosInfo -> StateT FileInfo (Except Text) ()
        returnError :: Maybe IgnoreMode
-> Text -> Maybe PosInfo -> StateT FileInfo (Except Text) ()
returnError Maybe IgnoreMode
mode Text
txt Maybe PosInfo
pos =
            let errMsg :: Text
errMsg = case Maybe IgnoreMode
mode of
                    Just IgnoreMode
Link      -> Text
linkMsg
                    Just IgnoreMode
Paragraph -> Text -> Text
paragraphMsg Text
txt
                    Just IgnoreMode
File      -> Text
fileMsg
                    Maybe IgnoreMode
Nothing        -> Text -> Text
unrecognisedMsg Text
txt
                posInfo :: Text
posInfo = Maybe PosInfo -> Text
prettyPos Maybe PosInfo
pos
            in ExceptT Text Identity () -> StateT FileInfo (Except Text) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT Text Identity () -> StateT FileInfo (Except Text) ())
-> ExceptT Text Identity () -> StateT FileInfo (Except Text) ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT Text Identity ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> ExceptT Text Identity ())
-> Text -> ExceptT Text Identity ()
forall a b. (a -> b) -> a -> b
$ Text
errMsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
posInfo

        processHtmlNode :: Node -> Maybe PosInfo -> [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
        processHtmlNode :: Node
-> Maybe PosInfo
-> [Node]
-> Maybe IgnoreMode
-> StateT FileInfo (Except Text) ()
processHtmlNode Node
node Maybe PosInfo
pos [Node]
nodes Maybe IgnoreMode
toIgnore = do
            let xrefcheckContent :: Maybe Text
xrefcheckContent = Node -> Maybe Text
getXrefcheckContent Node
node
            case Maybe Text
xrefcheckContent of
                Just Text
content -> StateT FileInfo (Except Text) ()
-> (IgnoreMode -> StateT FileInfo (Except Text) ())
-> Maybe IgnoreMode
-> StateT FileInfo (Except Text) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe IgnoreMode
-> Text -> Maybe PosInfo -> StateT FileInfo (Except Text) ()
returnError Maybe IgnoreMode
forall a. Maybe a
Nothing Text
content Maybe PosInfo
pos)
                    ([Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [Node]
nodes (Maybe IgnoreMode -> StateT FileInfo (Except Text) ())
-> (IgnoreMode -> Maybe IgnoreMode)
-> IgnoreMode
-> StateT FileInfo (Except Text) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IgnoreMode -> Maybe IgnoreMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Maybe IgnoreMode -> StateT FileInfo (Except Text) ())
-> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe IgnoreMode
getIgnoreMode Node
node
                Maybe Text
Nothing -> [Node] -> Maybe IgnoreMode -> StateT FileInfo (Except Text) ()
loop [Node]
nodes Maybe IgnoreMode
toIgnore

parseFileInfo :: LT.Text -> Either Text FileInfo
parseFileInfo :: Text -> Either Text FileInfo
parseFileInfo Text
input = Except Text FileInfo -> Either Text FileInfo
forall e a. Except e a -> Either e a
runExcept (Except Text FileInfo -> Either Text FileInfo)
-> Except Text FileInfo -> Either Text FileInfo
forall a b. (a -> b) -> a -> b
$ Node -> Except Text FileInfo
nodeExtractInfo (Node -> Except Text FileInfo) -> Node -> Except Text FileInfo
forall a b. (a -> b) -> a -> b
$
    [CMarkOption] -> [CMarkExtension] -> Text -> Node
commonmarkToNode [] [] (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict Text
input

markdownScanner :: ScanAction
markdownScanner :: ScanAction
markdownScanner [Char]
path = do
    Either Text FileInfo
errOrInfo <- Text -> Either Text FileInfo
parseFileInfo (Text -> Either Text FileInfo)
-> (ByteString -> Text) -> ByteString -> Either Text FileInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Either Text FileInfo)
-> IO ByteString -> IO (Either Text FileInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
BSL.readFile [Char]
path
    case Either Text FileInfo
errOrInfo of
        Left Text
errTxt -> do
            ScanAction
forall (m :: * -> *) a. MonadIO m => [Char] -> m a
die ScanAction -> ScanAction
forall a b. (a -> b) -> a -> b
$ [Char]
"Error when scanning " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
errTxt
        Right FileInfo
fileInfo -> FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
fileInfo

markdownSupport :: ([Extension], ScanAction)
markdownSupport :: ([[Char]], ScanAction)
markdownSupport = ([[Char]
".md"], ScanAction
markdownScanner)