-- | A parser that takes a maximum line length as input, and emits warnings for any line that
-- exceeds it.
module GLua.LineLimitParser where

import Control.Applicative ((<|>))
import Control.Monad (void)
import GLua.Lexer (pPos)
import GLua.Position (Region (..))
import GLuaFixer.LintMessage (Issue (LineTooLong), LintMessage (..), Severity (LintWarning))
import Text.Parsec (endOfLine, eof, parse, satisfy, skipMany1)
import Text.Parsec.String (Parser)

-- | The maximum line length
newtype LineLimit = LineLimit Int

execParseLineLimits :: FilePath -> LineLimit -> String -> [LintMessage]
execParseLineLimits :: String -> LineLimit -> String -> [LintMessage]
execParseLineLimits String
filePath lineLimit :: LineLimit
lineLimit@(LineLimit Int
limit) String
contents =
  -- No point in parsing anything if the limit is 0
  if Int
limit forall a. Ord a => a -> a -> Bool
<= Int
0
    then []
    else case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (String -> LineLimit -> Parser [LintMessage]
lineLimitParser String
filePath LineLimit
lineLimit) String
"input" String
contents of
      Left ParseError
parseError -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Parse error while checking line limit: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
parseError
      Right [LintMessage]
lintWarnings -> [LintMessage]
lintWarnings

-- | Parser that produces warnings about lines being too long
lineLimitParser :: FilePath -> LineLimit -> Parser [LintMessage]
lineLimitParser :: String -> LineLimit -> Parser [LintMessage]
lineLimitParser String
filePath LineLimit
lineLimit =
  [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> LineLimit -> Parser [LintMessage]
recurse String
filePath LineLimit
lineLimit

-- | Recursive case of 'lineLimitParser',
recurse :: FilePath -> LineLimit -> Parser [LintMessage]
recurse :: String -> LineLimit -> Parser [LintMessage]
recurse String
filePath lineLimit :: LineLimit
lineLimit@(LineLimit Int
limit) = do
  forall a. Int -> Parser a -> Parser ()
countAtMost Int
limit Parser Char
notNewline
  -- If it finds line endings, it recurses without producing warnings. Otherwise, if it finds
  -- anything else, produce a warning and still recurse.
  Parser ()
endOfLines forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> LineLimit -> Parser [LintMessage]
lineLimitParser String
filePath LineLimit
lineLimit
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser LintMessage
lineLimitWarning String
filePath forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> LineLimit -> Parser [LintMessage]
lineLimitParser String
filePath LineLimit
lineLimit

-- | Succeeds when a character is not a line
notNewline :: Parser Char
notNewline :: Parser Char
notNewline = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\r'

-- | end of lines. Consumes all \r and \n characters it finds
endOfLines :: Parser ()
endOfLines :: Parser ()
endOfLines = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

-- | Produces a line limit warning
lineLimitWarning :: FilePath -> Parser LintMessage
lineLimitWarning :: String -> Parser LintMessage
lineLimitWarning String
filePath = do
  LineColPos
startPos <- Parser LineColPos
pPos
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 Parser Char
notNewline
  LineColPos
endPos <- Parser LineColPos
pPos

  let
    warnRegion :: Region
warnRegion = LineColPos -> LineColPos -> Region
Region LineColPos
startPos LineColPos
endPos

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Severity -> Region -> Issue -> String -> LintMessage
LintMessage Severity
LintWarning Region
warnRegion Issue
LineTooLong String
filePath

-- | Consume the parser until either it has been parsed the Int amount of times, or the parser fails
countAtMost :: Int -> Parser a -> Parser ()
countAtMost :: forall a. Int -> Parser a -> Parser ()
countAtMost Int
0 Parser a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
countAtMost Int
i Parser a
p = Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Int -> Parser a -> Parser ()
countAtMost (Int
i forall a. Num a => a -> a -> a
- Int
1) Parser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()