{-| 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
[DhallComment a] -> ShowS
DhallComment a -> String
(Int -> DhallComment a -> ShowS)
-> (DhallComment a -> String)
-> ([DhallComment a] -> ShowS)
-> Show (DhallComment a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: CommentType). Int -> DhallComment a -> ShowS
forall (a :: CommentType). [DhallComment a] -> ShowS
forall (a :: CommentType). DhallComment a -> String
showList :: [DhallComment a] -> ShowS
$cshowList :: forall (a :: CommentType). [DhallComment a] -> ShowS
show :: DhallComment a -> String
$cshow :: forall (a :: CommentType). DhallComment a -> String
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 -> String
(Int -> DhallDocsText -> ShowS)
-> (DhallDocsText -> String)
-> ([DhallDocsText] -> ShowS)
-> Show DhallDocsText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DhallDocsText] -> ShowS
$cshowList :: [DhallDocsText] -> ShowS
show :: DhallDocsText -> String
$cshow :: DhallDocsText -> String
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) <- Parser (SourcePos, Text) -> Parser [(SourcePos, Text)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser (SourcePos, Text)
singleLine
    NonEmpty (DhallComment 'RawComment)
-> Parser (NonEmpty (DhallComment 'RawComment))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (DhallComment 'RawComment)
 -> Parser (NonEmpty (DhallComment 'RawComment)))
-> NonEmpty (DhallComment 'RawComment)
-> Parser (NonEmpty (DhallComment 'RawComment))
forall a b. (a -> b) -> a -> b
$ (ListOfSingleLineComments -> DhallComment 'RawComment)
-> NonEmpty ListOfSingleLineComments
-> NonEmpty (DhallComment 'RawComment)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ListOfSingleLineComments -> DhallComment 'RawComment
forall (a :: CommentType).
ListOfSingleLineComments -> DhallComment a
SingleLineComments (NonEmpty ListOfSingleLineComments
 -> NonEmpty (DhallComment 'RawComment))
-> NonEmpty ListOfSingleLineComments
-> NonEmpty (DhallComment 'RawComment)
forall a b. (a -> b) -> a -> b
$ ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
groupComments ((SourcePos, Text)
l (SourcePos, Text)
-> [(SourcePos, Text)] -> ListOfSingleLineComments
forall a. a -> [a] -> NonEmpty a
:| [(SourcePos, Text)]
ls)
  where
    groupComments :: ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
    groupComments :: ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
groupComments ListOfSingleLineComments
ls = case [(SourcePos, Text)] -> Maybe ListOfSingleLineComments
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [(SourcePos, Text)]
remaining of
        Maybe ListOfSingleLineComments
Nothing -> ListOfSingleLineComments
g ListOfSingleLineComments
-> [ListOfSingleLineComments] -> NonEmpty ListOfSingleLineComments
forall a. a -> [a] -> NonEmpty a
:| []
        Just ListOfSingleLineComments
l -> ListOfSingleLineComments
g ListOfSingleLineComments
-> NonEmpty ListOfSingleLineComments
-> NonEmpty ListOfSingleLineComments
forall a. a -> NonEmpty a -> NonEmpty a
<| ListOfSingleLineComments -> NonEmpty ListOfSingleLineComments
groupComments ListOfSingleLineComments
l
      where
        lineNumber :: SourcePos -> Int
lineNumber = Pos -> Int
Megaparsec.Pos.unPos (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
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 (SourcePos, Text)
-> [(SourcePos, Text)] -> ListOfSingleLineComments
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- SourcePos -> Int
lineNumber SourcePos
xPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                = let (ListOfSingleLineComments
subSeq, [(SourcePos, Text)]
r) = ListOfSingleLineComments
-> (ListOfSingleLineComments, [(SourcePos, Text)])
removeSubseq ((SourcePos, Text)
y (SourcePos, Text)
-> [(SourcePos, Text)] -> ListOfSingleLineComments
forall a. a -> [a] -> NonEmpty a
:| [(SourcePos, Text)]
rest) in ((SourcePos, Text)
x (SourcePos, Text)
-> ListOfSingleLineComments -> ListOfSingleLineComments
forall a. a -> NonEmpty a -> NonEmpty a
<| ListOfSingleLineComments
subSeq, [(SourcePos, Text)]
r)
            | Bool
otherwise = ((SourcePos, Text)
x (SourcePos, Text)
-> [(SourcePos, Text)] -> ListOfSingleLineComments
forall a. a -> [a] -> NonEmpty a
:| [], [(SourcePos, Text)]
ys)

    singleLine :: Parser (SourcePos, Text)
singleLine = do
      SourcePos
sourcePos <- Parser SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
Text.Megaparsec.getSourcePos
      Text
commentLine <- Parser Text
Token.lineComment
      Parser ()
whitespace
      (SourcePos, Text) -> Parser (SourcePos, Text)
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 = Parser () -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
Text.Megaparsec.skipMany ([Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
Text.Megaparsec.choice
    [ Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe String -> (Token Text -> Bool) -> Parser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
predicate)
    , Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Parser Text
Token.text Text
"\r\n")
    ] Parser () -> String -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"whitespace")
  where
    predicate :: Char -> Bool
predicate Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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
    DhallComment 'RawComment -> Parser (DhallComment 'RawComment)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DhallComment 'RawComment -> Parser (DhallComment 'RawComment))
-> DhallComment 'RawComment -> Parser (DhallComment 'RawComment)
forall a b. (a -> b) -> a -> b
$ Text -> DhallComment 'RawComment
forall (a :: CommentType). Text -> DhallComment a
BlockComment Text
c

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

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

data CommentParseError
    = MissingNewlineOnBlockComment
    | BadSingleLineCommentsAlignment
    | BadPrefixesOnSingleLineComments
    | SeveralSubseqDhallDocsComments
    deriving Int -> CommentParseError -> ShowS
[CommentParseError] -> ShowS
CommentParseError -> String
(Int -> CommentParseError -> ShowS)
-> (CommentParseError -> String)
-> ([CommentParseError] -> ShowS)
-> Show CommentParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentParseError] -> ShowS
$cshowList :: [CommentParseError] -> ShowS
show :: CommentParseError -> String
$cshow :: CommentParseError -> String
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 = DhallComment 'MarkedComment -> Maybe (DhallComment 'MarkedComment)
forall a. a -> Maybe a
Just (DhallComment 'MarkedComment
 -> Maybe (DhallComment 'MarkedComment))
-> DhallComment 'MarkedComment
-> Maybe (DhallComment 'MarkedComment)
forall a b. (a -> b) -> a -> b
$ Text -> DhallComment 'MarkedComment
forall (a :: CommentType). Text -> DhallComment a
BlockComment Text
comment
    | Bool
otherwise = Maybe (DhallComment 'MarkedComment)
forall a. Maybe a
Nothing

parseMarkedComment (SingleLineComments ListOfSingleLineComments
ls)
    | ((SourcePos, Text) -> Bool) -> ListOfSingleLineComments -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
"--|" Text -> Text -> Bool
`Data.Text.isPrefixOf`) (Text -> Bool)
-> ((SourcePos, Text) -> Text) -> (SourcePos, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, Text) -> Text
forall a b. (a, b) -> b
snd) ListOfSingleLineComments
ls = DhallComment 'MarkedComment -> Maybe (DhallComment 'MarkedComment)
forall a. a -> Maybe a
Just (ListOfSingleLineComments -> DhallComment 'MarkedComment
forall (a :: CommentType).
ListOfSingleLineComments -> DhallComment a
SingleLineComments ListOfSingleLineComments
ls)
    | Bool
otherwise = Maybe (DhallComment 'MarkedComment)
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 (Text -> Bool) -> [Text] -> Bool
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 DhallComment 'DhallDocsComment
-> Either CommentParseError (DhallComment 'DhallDocsComment)
forall a b. b -> Either a b
Right (DhallComment 'DhallDocsComment
 -> Either CommentParseError (DhallComment 'DhallDocsComment))
-> DhallComment 'DhallDocsComment
-> Either CommentParseError (DhallComment 'DhallDocsComment)
forall a b. (a -> b) -> a -> b
$ Text -> DhallComment 'DhallDocsComment
forall (a :: CommentType). Text -> DhallComment a
BlockComment Text
comment
    else CommentParseError
-> Either CommentParseError (DhallComment 'DhallDocsComment)
forall a b. a -> Either a b
Left CommentParseError
MissingNewlineOnBlockComment

parseDhallDocsComment (SingleLineComments ListOfSingleLineComments
lineComments) =
    (ListOfSingleLineComments -> DhallComment 'DhallDocsComment)
-> Either CommentParseError ListOfSingleLineComments
-> Either CommentParseError (DhallComment 'DhallDocsComment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListOfSingleLineComments -> DhallComment 'DhallDocsComment
forall (a :: CommentType).
ListOfSingleLineComments -> DhallComment a
SingleLineComments (Either CommentParseError ListOfSingleLineComments
 -> Either CommentParseError (DhallComment 'DhallDocsComment))
-> Either CommentParseError ListOfSingleLineComments
-> Either CommentParseError (DhallComment 'DhallDocsComment)
forall a b. (a -> b) -> a -> b
$ ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkAlignment ListOfSingleLineComments
lineComments Either CommentParseError ListOfSingleLineComments
-> (ListOfSingleLineComments
    -> Either CommentParseError ListOfSingleLineComments)
-> Either CommentParseError ListOfSingleLineComments
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
checkAmountOfMarkers Either CommentParseError ListOfSingleLineComments
-> (ListOfSingleLineComments
    -> Either CommentParseError ListOfSingleLineComments)
-> Either CommentParseError ListOfSingleLineComments
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 (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then CommentParseError
-> Either CommentParseError ListOfSingleLineComments
forall a b. a -> Either a b
Left CommentParseError
SeveralSubseqDhallDocsComments
        else case [(SourcePos, Text)]
newLines of
            [] -> Text -> Either CommentParseError ListOfSingleLineComments
forall a. Text -> a
fileAnIssue Text
"checkAmountOfMarkers failed with newLines = []"
            (SourcePos, Text)
l : [(SourcePos, Text)]
remainder -> ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
forall a b. b -> Either a b
Right (ListOfSingleLineComments
 -> Either CommentParseError ListOfSingleLineComments)
-> ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
forall a b. (a -> b) -> a -> b
$ (SourcePos, Text)
l (SourcePos, Text)
-> [(SourcePos, Text)] -> ListOfSingleLineComments
forall a. a -> [a] -> NonEmpty a
:| [(SourcePos, Text)]
remainder
      where
        commentLines :: [(SourcePos, Text)]
commentLines = ListOfSingleLineComments -> [(SourcePos, Text)]
forall a. NonEmpty a -> [a]
NonEmpty.toList ListOfSingleLineComments
ls
        numberOfMarkers :: Int
numberOfMarkers = [(SourcePos, Text)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(SourcePos, Text)] -> Int) -> [(SourcePos, Text)] -> Int
forall a b. (a -> b) -> a -> b
$ ((SourcePos, Text) -> Bool)
-> [(SourcePos, Text)] -> [(SourcePos, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
Data.Text.isPrefixOf Text
"--|" (Text -> Bool)
-> ((SourcePos, Text) -> Text) -> (SourcePos, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, Text) -> Text
forall a b. (a, b) -> b
snd) [(SourcePos, Text)]
commentLines
        ([(SourcePos, Text)]
_, [(SourcePos, Text)]
newLines) = ((SourcePos, Text) -> Bool)
-> [(SourcePos, Text)]
-> ([(SourcePos, Text)], [(SourcePos, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text -> Text -> Bool
Data.Text.isPrefixOf Text
"--|" (Text -> Bool)
-> ((SourcePos, Text) -> Text) -> (SourcePos, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, Text) -> Text
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)
        | ((SourcePos, Text) -> Bool) -> [(SourcePos, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos -> Int
sourceCol SourcePos
first) (Int -> Bool)
-> ((SourcePos, Text) -> Int) -> (SourcePos, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Int
sourceCol (SourcePos -> Int)
-> ((SourcePos, Text) -> SourcePos) -> (SourcePos, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, Text) -> SourcePos
forall a b. (a, b) -> a
fst) [(SourcePos, Text)]
rest = ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
forall a b. b -> Either a b
Right ListOfSingleLineComments
ls
        | Bool
otherwise = CommentParseError
-> Either CommentParseError ListOfSingleLineComments
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
&& ((SourcePos, Text) -> Bool) -> [(SourcePos, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
p (Text -> Bool)
-> ((SourcePos, Text) -> Text) -> (SourcePos, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, Text) -> Text
forall a b. (a, b) -> b
snd) [(SourcePos, Text)]
rest
            = ListOfSingleLineComments
-> Either CommentParseError ListOfSingleLineComments
forall a b. b -> Either a b
Right ListOfSingleLineComments
ls
        | Bool
otherwise = CommentParseError
-> Either CommentParseError ListOfSingleLineComments
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 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ Bool -> Bool -> Bool
&& Text
"--" Text -> Text -> Bool
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 -> Text -> DhallDocsText
forall a. Text -> a
fileAnIssue (Text
"Obtained 'Nothing' on extractText.stripSuffix with text: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
joinedText Text -> Text -> Text
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Data.Text.unlines [Text]
reIndentedLines
    (Text
_ : [Text]
commentLines) = 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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

    nonEmptyCommentLines :: [Text]
nonEmptyCommentLines = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
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 (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$
        case (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
leadingSpaces [Text]
nonEmptyCommentLines of
            Text
l : [Text]
ls -> (Text -> Text -> Text) -> Text -> [Text] -> Text
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 = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Data.Text.drop Int
commonIndentation) [Text]
commentLines

parseDhallDocsText (SingleLineComments (((SourcePos, Text) -> Text)
-> ListOfSingleLineComments -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SourcePos, Text) -> Text
forall a b. (a, b) -> b
snd -> (Text
first :| [Text]
rest))) =
    Text -> DhallDocsText
DhallDocsText (Text -> DhallDocsText) -> Text -> DhallDocsText
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Data.Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
firstLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
cleanRest [Text]
rest
  where
    debugLines :: Text
debugLines = [Text] -> Text
Data.Text.unlines (Text
first Text -> [Text] -> [Text]
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 -> Text -> Text
forall a. Text -> a
fileAnIssue (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
            Text
"Error strippping \"--| \" prefix on parseDhallDocsText. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"All comment lines are here:\n" Text -> Text -> Text
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 Maybe Text -> Maybe Text -> Maybe Text
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 -> Text -> Text
forall a. Text -> a
fileAnIssue (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
            Text
"Error strippping \"--  \" prefix on parseDhallDocsText. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"All comment lines are here:\n" Text -> Text -> Text
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 :: String -> Text -> Maybe (Either [CommentParseError] DhallDocsText)
parseSingleDhallDocsComment String
delta Text
text = do
    let rawComments :: [DhallComment 'RawComment]
rawComments = String -> Text -> [DhallComment 'RawComment]
parseComments String
delta Text
text
    let markedComments :: [DhallComment 'MarkedComment]
markedComments = (DhallComment 'RawComment -> Maybe (DhallComment 'MarkedComment))
-> [DhallComment 'RawComment] -> [DhallComment 'MarkedComment]
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) = [Either CommentParseError (DhallComment 'DhallDocsComment)]
-> ([CommentParseError], [DhallComment 'DhallDocsComment])
forall a b. [Either a b] -> ([a], [b])
Data.Either.partitionEithers ([Either CommentParseError (DhallComment 'DhallDocsComment)]
 -> ([CommentParseError], [DhallComment 'DhallDocsComment]))
-> [Either CommentParseError (DhallComment 'DhallDocsComment)]
-> ([CommentParseError], [DhallComment 'DhallDocsComment])
forall a b. (a -> b) -> a -> b
$ (DhallComment 'MarkedComment
 -> Either CommentParseError (DhallComment 'DhallDocsComment))
-> [DhallComment 'MarkedComment]
-> [Either CommentParseError (DhallComment 'DhallDocsComment)]
forall a b. (a -> b) -> [a] -> [b]
map DhallComment 'MarkedComment
-> Either CommentParseError (DhallComment 'DhallDocsComment)
parseDhallDocsComment [DhallComment 'MarkedComment]
markedComments

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

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