{-| Provides utilities to parse Dhall comments
-}

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE KindSignatures    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

module Dhall.Docs.Comment
    ( parseComments
    , CommentParseError(..)
    , DhallDocsText
    , parseSingleDhallDocsComment
    , unDhallDocsText
    ) where

import Control.Applicative (many, some, (<|>))
import Data.Functor        (void)
import Data.List.NonEmpty  (NonEmpty (..), (<|))
import Data.Text           (Text)
import Dhall.Docs.Util
import Dhall.Parser        (Parser (..))
import Text.Megaparsec     (SourcePos, (<?>))

import qualified Data.Either
import qualified Data.Foldable
import qualified Data.List.NonEmpty  as NonEmpty
import qualified Data.Maybe          as Maybe
import qualified Data.Text
import qualified Dhall.Parser.Token  as Token
import qualified Text.Megaparsec
import qualified Text.Megaparsec.Pos as Megaparsec.Pos

-- | For explanation of this data-type see 'DhallComment'
data CommentType = DhallDocsComment | MarkedComment | RawComment

type ListOfSingleLineComments = NonEmpty (SourcePos, Text)

{-| Internal representation of Dhall comments. Text is always stripped from
    whitespace from both the start and begin of the string

    * If @a = 'DhallDocsComment'@ then comment is valid to extract its contents
    and be rendered on documentation
    * If @a = 'MarkedComment'@ then comment has the @|@ marker that
    @dhall-docs@ will be aware of, but this comment may not be a @dhall-docs@
    comment
    * If @a = `RawComment`@ then the comment is a raw comment
-}
data DhallComment (a :: CommentType)
    -- | A single block comment: starting from @{-@ and ending in @-}@
    = BlockComment Text
    {-| A group of subsequent single line comment, each one starting from @--@
        and ending in the last character to the end of the line. Each one keeps
        its 'SourcePos' to validate indentation.

        A property of 'SingleLineComments' is that the 'sourceLine's in the
        'NonEmpty (SourcePos, Text)' are in strictly-increasing order /and/
        the difference between the 'sourceLine' of any adyacent pair is @1@.

        Note that several @dhall-docs@ comments maybe inside a single 'SingleLineComments'
    -}
    | SingleLineComments ListOfSingleLineComments
    deriving Int -> DhallComment a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall (a :: CommentType). Int -> DhallComment a -> ShowS
forall (a :: CommentType). [DhallComment a] -> ShowS
forall (a :: CommentType). DhallComment a -> [Char]
showList :: [DhallComment a] -> ShowS
$cshowList :: forall (a :: CommentType). [DhallComment a] -> ShowS
show :: DhallComment a -> [Char]
$cshow :: forall (a :: CommentType). DhallComment a -> [Char]
showsPrec :: Int -> DhallComment a -> ShowS
$cshowsPrec :: forall (a :: CommentType). Int -> DhallComment a -> ShowS
Show

-- | Extracted text from a valid @dhall-docs@ comment
newtype DhallDocsText = DhallDocsText Text
    deriving Int -> DhallDocsText -> ShowS
[DhallDocsText] -> ShowS
DhallDocsText -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DhallDocsText] -> ShowS
$cshowList :: [DhallDocsText] -> ShowS
show :: DhallDocsText -> [Char]
$cshow :: DhallDocsText -> [Char]
showsPrec :: Int -> DhallDocsText -> ShowS
$cshowsPrec :: Int -> DhallDocsText -> ShowS
Show

unDhallDocsText :: DhallDocsText -> Text
unDhallDocsText :: DhallDocsText -> Text
unDhallDocsText (DhallDocsText Text
t) = Text
t

-- | A mirror of "Dhall.Parser.Token".'Dhall.Parser.Token.lineComment' but
--   returning a 'DhallComment'
lineCommentParser :: Parser (NonEmpty (DhallComment 'RawComment))
lineCommentParser :: Parser (NonEmpty (DhallComment 'RawComment))
lineCommentParser = do
    ((SourcePos, Text)
l : [(SourcePos, Text)]
ls) <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (SourcePos, Text)
singleLine
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map forall (a :: CommentType).
ListOfSingleLineComments -> DhallComment a
SingleLineComments forall a b. (a -> b) -> a -> b
$ ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
groupComments ((SourcePos, Text)
l forall a. a -> [a] -> NonEmpty a
:| [(SourcePos, Text)]
ls)
  where
    groupComments :: ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
    groupComments :: ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
groupComments ListOfSingleLineComments
ls = case forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [(SourcePos, Text)]
remaining of
        Maybe ListOfSingleLineComments
Nothing -> ListOfSingleLineComments
g forall a. a -> [a] -> NonEmpty a
:| []
        Just ListOfSingleLineComments
l -> ListOfSingleLineComments
g forall a. a -> NonEmpty a -> NonEmpty a
<| ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
groupComments ListOfSingleLineComments
l
      where
        lineNumber :: SourcePos -> Int
lineNumber = Pos -> Int
Megaparsec.Pos.unPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
Megaparsec.Pos.sourceLine

        (ListOfSingleLineComments
g, [(SourcePos, Text)]
remaining) = ListOfSingleLineComments
-> (ListOfSingleLineComments, [(SourcePos, Text)])
removeSubseq ListOfSingleLineComments
ls
        removeSubseq :: ListOfSingleLineComments -> (ListOfSingleLineComments, [(SourcePos, Text)])
        removeSubseq :: ListOfSingleLineComments
-> (ListOfSingleLineComments, [(SourcePos, Text)])
removeSubseq ((SourcePos, Text)
x :| []) = ((SourcePos, Text)
x forall a. a -> [a] -> NonEmpty a
:| [], [])
        removeSubseq (x :: (SourcePos, Text)
x@(SourcePos
xPos, Text
_) :| ys :: [(SourcePos, Text)]
ys@(y :: (SourcePos, Text)
y@(SourcePos
yPos, Text
_) : [(SourcePos, Text)]
rest))
            | SourcePos -> Int
lineNumber SourcePos
yPos forall a. Num a => a -> a -> a
- SourcePos -> Int
lineNumber SourcePos
xPos forall a. Eq a => a -> a -> Bool
== Int
1
                = let (ListOfSingleLineComments
subSeq, [(SourcePos, Text)]
r) = ListOfSingleLineComments
-> (ListOfSingleLineComments, [(SourcePos, Text)])
removeSubseq ((SourcePos, Text)
y forall a. a -> [a] -> NonEmpty a
:| [(SourcePos, Text)]
rest) in ((SourcePos, Text)
x forall a. a -> NonEmpty a -> NonEmpty a
<| ListOfSingleLineComments
subSeq, [(SourcePos, Text)]
r)
            | Bool
otherwise = ((SourcePos, Text)
x forall a. a -> [a] -> NonEmpty a
:| [], [(SourcePos, Text)]
ys)

    singleLine :: Parser (SourcePos, Text)
singleLine = do
      SourcePos
sourcePos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
      Text
commentLine <- Parser Text
Token.lineComment
      Parser ()
whitespace
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourcePos
sourcePos, Text
commentLine)

-- | Consume whitespace lines or lines that only have whitespaces *before* a comment
whitespace :: Parser ()
whitespace :: Parser ()
whitespace = forall (m :: * -> *) a. MonadPlus m => m a -> m ()
Text.Megaparsec.skipMany (forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Text.Megaparsec.choice
    [ forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P forall a. Maybe a
Nothing Char -> Bool
predicate)
    , forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
Token.text Text
"\r\n")
    ] forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"whitespace")
  where
    predicate :: Char -> Bool
predicate Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n'

blockCommentParser :: Parser (DhallComment 'RawComment)
blockCommentParser :: Parser (DhallComment 'RawComment)
blockCommentParser = do
    Text
c <- Parser Text
Token.blockComment
    Parser ()
whitespace
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: CommentType). Text -> DhallComment a
BlockComment Text
c

-- | Parse all comments in a text fragment
parseComments :: String -> Text -> [DhallComment 'RawComment]
parseComments :: [Char] -> Text -> [DhallComment 'RawComment]
parseComments [Char]
delta Text
text = case Either (ParseErrorBundle Text Void) [DhallComment 'RawComment]
result of
    Left ParseErrorBundle Text Void
err -> forall a. HasCallStack => [Char] -> a
error ([Char]
"An error has occurred while parsing comments:\n "
      forall a. Semigroup a => a -> a -> a
<> forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
Text.Megaparsec.errorBundlePretty ParseErrorBundle Text Void
err)
    Right [DhallComment 'RawComment]
comments -> [DhallComment 'RawComment]
comments
  where
    parser :: Parser [DhallComment 'RawComment]
parser = do
        [NonEmpty (DhallComment 'RawComment)]
comments <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ do
            Parser ()
whitespace
            Parser (NonEmpty (DhallComment 'RawComment))
lineCommentParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((forall a. a -> [a] -> NonEmpty a
:| []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (DhallComment 'RawComment)
blockCommentParser)
        forall e s (m :: * -> *). MonadParsec e s m => m ()
Text.Megaparsec.eof
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. NonEmpty a -> [a]
NonEmpty.toList [NonEmpty (DhallComment 'RawComment)]
comments

    result :: Either (ParseErrorBundle Text Void) [DhallComment 'RawComment]
result = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
Text.Megaparsec.parse (forall a. Parser a -> Parsec Void Text a
unParser Parser [DhallComment 'RawComment]
parser) [Char]
delta Text
text

data CommentParseError
    = MissingNewlineOnBlockComment
    | BadSingleLineCommentsAlignment
    | BadPrefixesOnSingleLineComments
    | SeveralSubseqDhallDocsComments
    deriving Int -> CommentParseError -> ShowS
[CommentParseError] -> ShowS
CommentParseError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CommentParseError] -> ShowS
$cshowList :: [CommentParseError] -> ShowS
show :: CommentParseError -> [Char]
$cshow :: CommentParseError -> [Char]
showsPrec :: Int -> CommentParseError -> ShowS
$cshowsPrec :: Int -> CommentParseError -> ShowS
Show

-- | Checks if a 'RawComment' has the @dhall-docs@ marker
parseMarkedComment :: DhallComment 'RawComment -> Maybe (DhallComment 'MarkedComment)
parseMarkedComment :: DhallComment 'RawComment -> Maybe (DhallComment 'MarkedComment)
parseMarkedComment (BlockComment Text
comment)
    | Text
"{-|" Text -> Text -> Bool
`Data.Text.isPrefixOf` Text
comment = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (a :: CommentType). Text -> DhallComment a
BlockComment Text
comment
    | Bool
otherwise = forall a. Maybe a
Nothing

parseMarkedComment (SingleLineComments ListOfSingleLineComments
ls)
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
"--|" Text -> Text -> Bool
`Data.Text.isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) ListOfSingleLineComments
ls = forall a. a -> Maybe a
Just (forall (a :: CommentType).
ListOfSingleLineComments -> DhallComment a
SingleLineComments ListOfSingleLineComments
ls)
    | Bool
otherwise = forall a. Maybe a
Nothing

-- | Knowing that there is a @dhall-docs@ marker inside the comment, this
--   checks if a 'MarkedComment' is a 'DhallDocsComment'. For 'SingleLineComments'
--   this also removes the prefix lines before the first marked comment
parseDhallDocsComment :: DhallComment 'MarkedComment -> Either CommentParseError (DhallComment 'DhallDocsComment)
parseDhallDocsComment :: DhallComment 'MarkedComment
-> Either CommentParseError (DhallComment 'DhallDocsComment)
parseDhallDocsComment (BlockComment Text
comment) =
    if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Data.Text.isPrefixOf` Text
comment) [Text
"{-|\n", Text
"{-|\r\n"] then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (a :: CommentType). Text -> DhallComment a
BlockComment Text
comment
    else forall a b. a -> Either a b
Left CommentParseError
MissingNewlineOnBlockComment

parseDhallDocsComment (SingleLineComments ListOfSingleLineComments
lineComments) =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: CommentType).
ListOfSingleLineComments -> DhallComment a
SingleLineComments forall a b. (a -> b) -> a -> b
$ ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkAlignment ListOfSingleLineComments
lineComments forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkAmountOfMarkers forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkPrefixes
  where
    sourceCol :: SourcePos -> Int
sourceCol = Pos -> Int
Text.Megaparsec.unPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
Text.Megaparsec.sourceColumn

    checkAmountOfMarkers :: ListOfSingleLineComments -> Either CommentParseError ListOfSingleLineComments
    checkAmountOfMarkers :: ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkAmountOfMarkers ListOfSingleLineComments
ls =
        if Int
numberOfMarkers forall a. Ord a => a -> a -> Bool
> Int
1 then forall a b. a -> Either a b
Left CommentParseError
SeveralSubseqDhallDocsComments
        else case [(SourcePos, Text)]
newLines of
            [] -> forall a. Text -> a
fileAnIssue Text
"checkAmountOfMarkers failed with newLines = []"
            (SourcePos, Text)
l : [(SourcePos, Text)]
remainder -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (SourcePos, Text)
l forall a. a -> [a] -> NonEmpty a
:| [(SourcePos, Text)]
remainder
      where
        commentLines :: [(SourcePos, Text)]
commentLines = forall a. NonEmpty a -> [a]
NonEmpty.toList ListOfSingleLineComments
ls
        numberOfMarkers :: Int
numberOfMarkers = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
Data.Text.isPrefixOf Text
"--|" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(SourcePos, Text)]
commentLines
        ([(SourcePos, Text)]
_, [(SourcePos, Text)]
newLines) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text -> Text -> Bool
Data.Text.isPrefixOf Text
"--|" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(SourcePos, Text)]
commentLines

    checkAlignment :: ListOfSingleLineComments -> Either CommentParseError ListOfSingleLineComments
    checkAlignment :: ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkAlignment ls :: ListOfSingleLineComments
ls@((SourcePos
first, Text
_) :| [(SourcePos, Text)]
rest)
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
sourceCol SourcePos
first) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Int
sourceCol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(SourcePos, Text)]
rest = forall a b. b -> Either a b
Right ListOfSingleLineComments
ls
        | Bool
otherwise = forall a b. a -> Either a b
Left CommentParseError
BadSingleLineCommentsAlignment

    checkPrefixes :: ListOfSingleLineComments -> Either CommentParseError ListOfSingleLineComments
    checkPrefixes :: ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkPrefixes ls :: ListOfSingleLineComments
ls@((SourcePos
_, Text
first) :| [(SourcePos, Text)]
rest)
        | Text
"--| " Text -> Text -> Bool
`Data.Text.isPrefixOf` Text
first Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(SourcePos, Text)]
rest
            = forall a b. b -> Either a b
Right ListOfSingleLineComments
ls
        | Bool
otherwise = forall a b. a -> Either a b
Left CommentParseError
BadPrefixesOnSingleLineComments
      where
        p :: Text -> Bool
p Text
t = Text -> Text -> Bool
Data.Text.isPrefixOf Text
"--  " Text
t Bool -> Bool -> Bool
|| (Text -> Int -> Ordering
Data.Text.compareLength Text
t Int
2 forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
&& Text
"--" forall a. Eq a => a -> a -> Bool
== Text
t)

parseDhallDocsText :: DhallComment 'DhallDocsComment -> DhallDocsText
parseDhallDocsText :: DhallComment 'DhallDocsComment -> DhallDocsText
parseDhallDocsText (BlockComment Text
blockComment) =
    case Text -> Text -> Maybe Text
Data.Text.stripSuffix Text
"-}" Text
joinedText of
        Maybe Text
Nothing -> forall a. Text -> a
fileAnIssue (Text
"Obtained 'Nothing' on extractText.stripSuffix with text: \"" forall a. Semigroup a => a -> a -> a
<> Text
joinedText forall a. Semigroup a => a -> a -> a
<> Text
"\"")
        Just Text
e -> Text -> DhallDocsText
DhallDocsText Text
e
  where
    joinedText :: Text
joinedText = Text -> Text
Data.Text.strip forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Data.Text.unlines [Text]
reIndentedLines
    commentLines :: [Text]
commentLines = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Data.Text.lines Text
blockComment

    leadingSpaces :: Text -> Text
leadingSpaces = (Char -> Bool) -> Text -> Text
Data.Text.takeWhile Char -> Bool
isSpace
        where
        isSpace :: Char -> Bool
isSpace Char
t = Char
t forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
t forall a. Eq a => a -> a -> Bool
== Char
'\t'

    nonEmptyCommentLines :: [Text]
nonEmptyCommentLines = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Data.Text.null) [Text]
commentLines

    commonIndentation :: Int
commonIndentation = Text -> Int
Data.Text.length forall a b. (a -> b) -> a -> b
$
        case forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
leadingSpaces [Text]
nonEmptyCommentLines of
            Text
l : [Text]
ls -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.Foldable.foldl' Text -> Text -> Text
sharedPrefix Text
l [Text]
ls
            []     -> Text
""
        where
        sharedPrefix :: Text -> Text -> Text
sharedPrefix Text
ab Text
ac =
            case Text -> Text -> Maybe (Text, Text, Text)
Data.Text.commonPrefixes Text
ab Text
ac of
                Just (Text
a, Text
_, Text
_) -> Text
a
                Maybe (Text, Text, Text)
Nothing          -> Text
""

    reIndentedLines :: [Text]
reIndentedLines = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Data.Text.drop Int
commonIndentation) [Text]
commentLines

parseDhallDocsText (SingleLineComments (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd -> (Text
first :| [Text]
rest))) =
    Text -> DhallDocsText
DhallDocsText forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Data.Text.unlines forall a b. (a -> b) -> a -> b
$ Text
firstLine forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
cleanRest [Text]
rest
  where
    debugLines :: Text
debugLines = [Text] -> Text
Data.Text.unlines (Text
first forall a. a -> [a] -> [a]
: [Text]
rest)
    firstLine :: Text
firstLine = case Text -> Text -> Maybe Text
Data.Text.stripPrefix Text
"--| " Text
first of
        Maybe Text
Nothing -> forall a. Text -> a
fileAnIssue forall a b. (a -> b) -> a -> b
$
            Text
"Error strippping \"--| \" prefix on parseDhallDocsText. " forall a. Semigroup a => a -> a -> a
<>
            Text
"All comment lines are here:\n" forall a. Semigroup a => a -> a -> a
<> Text
debugLines

        Just Text
s -> Text
s

    cleanRest :: Text -> Text
cleanRest Text
l = case Text -> Text -> Maybe Text
Data.Text.stripPrefix Text
"--  " Text
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe Text
Data.Text.stripPrefix Text
"--" Text
l of
        Maybe Text
Nothing -> forall a. Text -> a
fileAnIssue forall a b. (a -> b) -> a -> b
$
            Text
"Error strippping \"--  \" prefix on parseDhallDocsText. " forall a. Semigroup a => a -> a -> a
<>
            Text
"All comment lines are here:\n" forall a. Semigroup a => a -> a -> a
<> Text
debugLines

        Just Text
s -> Text
s

-- | Returns 'Nothing' when 'DhallDocsComment' was parsed or no error was detected
parseSingleDhallDocsComment :: String -> Text -> Maybe (Either [CommentParseError] DhallDocsText)
parseSingleDhallDocsComment :: [Char] -> Text -> Maybe (Either [CommentParseError] DhallDocsText)
parseSingleDhallDocsComment [Char]
delta Text
text = do
    let rawComments :: [DhallComment 'RawComment]
rawComments = [Char] -> Text -> [DhallComment 'RawComment]
parseComments [Char]
delta Text
text
    let markedComments :: [DhallComment 'MarkedComment]
markedComments = forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe DhallComment 'RawComment -> Maybe (DhallComment 'MarkedComment)
parseMarkedComment [DhallComment 'RawComment]
rawComments
    let ([CommentParseError]
errors_, [DhallComment 'DhallDocsComment]
dhallDocsComments) = forall a b. [Either a b] -> ([a], [b])
Data.Either.partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map DhallComment 'MarkedComment
-> Either CommentParseError (DhallComment 'DhallDocsComment)
parseDhallDocsComment [DhallComment 'MarkedComment]
markedComments

    let errors :: [CommentParseError]
errors =
                if forall (t :: * -> *) a. Foldable t => t a -> Int
length [DhallComment 'DhallDocsComment]
dhallDocsComments forall a. Ord a => a -> a -> Bool
>= Int
2 then
                    CommentParseError
SeveralSubseqDhallDocsComments forall a. a -> [a] -> [a]
: [CommentParseError]
errors_
                else
                    [CommentParseError]
errors_

    case ([CommentParseError]
errors, [DhallComment 'DhallDocsComment]
dhallDocsComments) of
        ([] ,  []) -> forall a. Maybe a
Nothing
        (CommentParseError
_:[CommentParseError]
_,   [DhallComment 'DhallDocsComment]
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [CommentParseError]
errors
        ([CommentParseError]
_  , [DhallComment 'DhallDocsComment
a]) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ DhallComment 'DhallDocsComment -> DhallDocsText
parseDhallDocsText DhallComment 'DhallDocsComment
a
        ([CommentParseError]
_  ,   [DhallComment 'DhallDocsComment]
_) -> forall a. Text -> a
fileAnIssue Text
"Returned more than one comment at parseSingleDhallDocsComment"