{-# 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
data = | |
type = NonEmpty (SourcePos, Text)
data (a :: CommentType)
= Text
| 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
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
lineCommentParser :: Parser (NonEmpty (DhallComment 'RawComment))
= 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)
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)
= 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
parseComments :: String -> Text -> [DhallComment 'RawComment]
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
=
|
|
|
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
parseMarkedComment :: DhallComment 'RawComment -> Maybe (DhallComment 'MarkedComment)
(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
parseDhallDocsComment :: DhallComment 'MarkedComment -> Either CommentParseError (DhallComment 'DhallDocsComment)
(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
parseSingleDhallDocsComment :: String -> Text -> Maybe (Either [CommentParseError] DhallDocsText)
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"