{- © 2019 Serokell <hi@serokell.io>
 - © 2019 Lars Jellema <lars.jellema@gmail.com>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# LANGUAGE LambdaCase, OverloadedStrings #-}

module Nixfmt.Lexer (lexeme) where

import Data.Char (isSpace)
import Data.List (dropWhileEnd)
import Data.Maybe (fromMaybe)
import Data.Text as Text
  (Text, intercalate, length, lines, null, pack, replace, replicate, strip,
  stripEnd, stripPrefix, stripStart, takeWhile)
import Text.Megaparsec
  (SourcePos(..), anySingle, chunk, getSourcePos, hidden, many, manyTill, some,
  try, unPos, (<|>))
import Text.Megaparsec.Char (eol)

import Nixfmt.Types (Ann(..), Parser, TrailingComment(..), Trivia, Trivium(..))
import Nixfmt.Util (manyP)

data ParseTrivium
    = PTNewlines     Int
    | PTLineComment  Text
    | PTBlockComment [Text]
    deriving (Int -> ParseTrivium -> ShowS
[ParseTrivium] -> ShowS
ParseTrivium -> String
(Int -> ParseTrivium -> ShowS)
-> (ParseTrivium -> String)
-> ([ParseTrivium] -> ShowS)
-> Show ParseTrivium
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseTrivium] -> ShowS
$cshowList :: [ParseTrivium] -> ShowS
show :: ParseTrivium -> String
$cshow :: ParseTrivium -> String
showsPrec :: Int -> ParseTrivium -> ShowS
$cshowsPrec :: Int -> ParseTrivium -> ShowS
Show)

preLexeme :: Parser a -> Parser a
preLexeme :: Parser a -> Parser a
preLexeme Parser a
p = Parser a
p Parser a -> ParsecT Void Text Identity Text -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall s e (m :: * -> *).
(Stream s, Ord e) =>
(Token s -> Bool) -> ParsecT e s m (Tokens s)
manyP (\Token Text
x -> Char -> Bool
isSpace Char
Token Text
x Bool -> Bool -> Bool
&& Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')

newlines :: Parser ParseTrivium
newlines :: Parser ParseTrivium
newlines = Int -> ParseTrivium
PTNewlines (Int -> ParseTrivium) -> ([Text] -> Int) -> [Text] -> ParseTrivium
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length ([Text] -> ParseTrivium)
-> ParsecT Void Text Identity [Text] -> Parser ParseTrivium
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
preLexeme ParsecT Void Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol)

splitLines :: Text -> [Text]
splitLines :: Text -> [Text]
splitLines = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Text -> Bool
Text.null ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Text -> Bool
Text.null
    ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.stripEnd ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replace Text
"\r\n" Text
"\n"

stripIndentation :: Int -> Text -> Text
stripIndentation :: Int -> Text -> Text
stripIndentation Int
n Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
stripStart Text
t) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
stripPrefix (Int -> Text -> Text
Text.replicate Int
n Text
" ") Text
t

commonIndentationLength :: Int -> [Text] -> Int
commonIndentationLength :: Int -> [Text] -> Int
commonIndentationLength Int
def = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
def ([Int] -> Int) -> ([Text] -> [Int]) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
Text.length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' '))

fixLines :: Int -> [Text] -> [Text]
fixLines :: Int -> [Text] -> [Text]
fixLines Int
_ []      = []
fixLines Int
n (Text
h : [Text]
t) = Text -> Text
strip Text
h
    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
stripIndentation (Int -> Text -> Text) -> Int -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> Int
commonIndentationLength Int
n ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
"") [Text]
t) [Text]
t

lineComment :: Parser ParseTrivium
lineComment :: Parser ParseTrivium
lineComment = Parser ParseTrivium -> Parser ParseTrivium
forall a. Parser a -> Parser a
preLexeme (Parser ParseTrivium -> Parser ParseTrivium)
-> Parser ParseTrivium -> Parser ParseTrivium
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"#" ParsecT Void Text Identity Text
-> Parser ParseTrivium -> Parser ParseTrivium
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    (Text -> ParseTrivium
PTLineComment (Text -> ParseTrivium)
-> ParsecT Void Text Identity Text -> Parser ParseTrivium
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall s e (m :: * -> *).
(Stream s, Ord e) =>
(Token s -> Bool) -> ParsecT e s m (Tokens s)
manyP (\Token Text
x -> Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'))

blockComment :: Parser ParseTrivium
blockComment :: Parser ParseTrivium
blockComment = Parser ParseTrivium -> Parser ParseTrivium
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser ParseTrivium -> Parser ParseTrivium)
-> Parser ParseTrivium -> Parser ParseTrivium
forall a b. (a -> b) -> a -> b
$ Parser ParseTrivium -> Parser ParseTrivium
forall a. Parser a -> Parser a
preLexeme (Parser ParseTrivium -> Parser ParseTrivium)
-> Parser ParseTrivium -> Parser ParseTrivium
forall a b. (a -> b) -> a -> b
$ do
    Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"/*"
    SourcePos{sourceColumn :: SourcePos -> Pos
sourceColumn = Pos
pos} <- ParsecT Void Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
    String
chars <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity String)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity String
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"*/"
    ParseTrivium -> Parser ParseTrivium
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseTrivium -> Parser ParseTrivium)
-> ParseTrivium -> Parser ParseTrivium
forall a b. (a -> b) -> a -> b
$ [Text] -> ParseTrivium
PTBlockComment ([Text] -> ParseTrivium) -> [Text] -> ParseTrivium
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
fixLines (Pos -> Int
unPos Pos
pos) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
splitLines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
chars

convertTrailing :: [ParseTrivium] -> Maybe TrailingComment
convertTrailing :: [ParseTrivium] -> Maybe TrailingComment
convertTrailing = Text -> Maybe TrailingComment
toMaybe (Text -> Maybe TrailingComment)
-> ([ParseTrivium] -> Text)
-> [ParseTrivium]
-> Maybe TrailingComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
join ([Text] -> Text)
-> ([ParseTrivium] -> [Text]) -> [ParseTrivium] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseTrivium -> Text) -> [ParseTrivium] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParseTrivium -> Text
toText
    where toText :: ParseTrivium -> Text
toText (PTLineComment Text
c)    = Text -> Text
strip Text
c
          toText (PTBlockComment [Text
c]) = Text -> Text
strip Text
c
          toText ParseTrivium
_                    = Text
""
          join :: [Text] -> Text
join = Text -> [Text] -> Text
intercalate Text
" " ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
"")
          toMaybe :: Text -> Maybe TrailingComment
toMaybe Text
"" = Maybe TrailingComment
forall a. Maybe a
Nothing
          toMaybe Text
c  = TrailingComment -> Maybe TrailingComment
forall a. a -> Maybe a
Just (TrailingComment -> Maybe TrailingComment)
-> TrailingComment -> Maybe TrailingComment
forall a b. (a -> b) -> a -> b
$ Text -> TrailingComment
TrailingComment Text
c

convertLeading :: [ParseTrivium] -> Trivia
convertLeading :: [ParseTrivium] -> Trivia
convertLeading = (ParseTrivium -> Trivia) -> [ParseTrivium] -> Trivia
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case
    PTNewlines Int
1       -> []
    PTNewlines Int
_       -> [Trivium
EmptyLine]
    PTLineComment Text
c    -> [Text -> Trivium
LineComment Text
c]
    PTBlockComment []  -> []
    PTBlockComment [Text
c] -> [Text -> Trivium
LineComment (Text -> Trivium) -> Text -> Trivium
forall a b. (a -> b) -> a -> b
$ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
strip Text
c]
    PTBlockComment [Text]
cs  -> [[Text] -> Trivium
BlockComment [Text]
cs])

isTrailing :: ParseTrivium -> Bool
isTrailing :: ParseTrivium -> Bool
isTrailing (PTLineComment Text
_)    = Bool
True
isTrailing (PTBlockComment [])  = Bool
True
isTrailing (PTBlockComment [Text
_]) = Bool
True
isTrailing ParseTrivium
_                    = Bool
False

convertTrivia :: [ParseTrivium] -> (Maybe TrailingComment, Trivia)
convertTrivia :: [ParseTrivium] -> (Maybe TrailingComment, Trivia)
convertTrivia [ParseTrivium]
pts =
    let ([ParseTrivium]
trailing, [ParseTrivium]
leading) = (ParseTrivium -> Bool)
-> [ParseTrivium] -> ([ParseTrivium], [ParseTrivium])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ParseTrivium -> Bool
isTrailing [ParseTrivium]
pts
    in ([ParseTrivium] -> Maybe TrailingComment
convertTrailing [ParseTrivium]
trailing, [ParseTrivium] -> Trivia
convertLeading [ParseTrivium]
leading)

trivia :: Parser [ParseTrivium]
trivia :: Parser [ParseTrivium]
trivia = Parser ParseTrivium -> Parser [ParseTrivium]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser ParseTrivium -> Parser [ParseTrivium])
-> Parser ParseTrivium -> Parser [ParseTrivium]
forall a b. (a -> b) -> a -> b
$ Parser ParseTrivium -> Parser ParseTrivium
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser ParseTrivium -> Parser ParseTrivium)
-> Parser ParseTrivium -> Parser ParseTrivium
forall a b. (a -> b) -> a -> b
$ Parser ParseTrivium
lineComment Parser ParseTrivium -> Parser ParseTrivium -> Parser ParseTrivium
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParseTrivium
blockComment Parser ParseTrivium -> Parser ParseTrivium -> Parser ParseTrivium
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ParseTrivium
newlines

lexeme :: Parser a -> Parser (Ann a)
lexeme :: Parser a -> Parser (Ann a)
lexeme Parser a
p = do
    a
token <- Parser a -> Parser a
forall a. Parser a -> Parser a
preLexeme Parser a
p
    (Maybe TrailingComment
trailing, Trivia
leading) <- [ParseTrivium] -> (Maybe TrailingComment, Trivia)
convertTrivia ([ParseTrivium] -> (Maybe TrailingComment, Trivia))
-> Parser [ParseTrivium]
-> ParsecT Void Text Identity (Maybe TrailingComment, Trivia)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParseTrivium]
trivia
    Ann a -> Parser (Ann a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ann a -> Parser (Ann a)) -> Ann a -> Parser (Ann a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe TrailingComment -> Trivia -> Ann a
forall a. a -> Maybe TrailingComment -> Trivia -> Ann a
Ann a
token Maybe TrailingComment
trailing Trivia
leading