{-# LANGUAGE OverloadedStrings #-}

module Codec.Sarsi.Rust where

import Codec.Sarsi (Level (..), Location (..), Message (..))
import Data.Attoparsec.Text

messageParser :: Parser Message
messageParser :: Parser Message
messageParser = do
  Level
l <-
    [Parser Text Level] -> Parser Text Level
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Text -> Parser Text
string Text
"warning" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
untilSep0 Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
string Text
": " Parser Text -> Parser Text Level -> Parser Text Level
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Level -> Parser Text Level
forall (m :: * -> *) a. Monad m => a -> m a
return Level
Warning,
        Text -> Parser Text
string Text
"error" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
untilSep0 Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
string Text
": " Parser Text -> Parser Text Level -> Parser Text Level
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Level -> Parser Text Level
forall (m :: * -> *) a. Monad m => a -> m a
return Level
Error
      ]
  Text
body <- Parser Text
untilLineBreak Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
"\n"
  Text
fp <- Parser Text Char -> Parser Text [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text Char
space Parser Text [Char] -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
"--> " Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
untilSep Parser Text -> Parser Text Char -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
sepChar
  Int
n <- Parser Int
forall a. Integral a => Parser a
decimal Parser Int -> Parser Text Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
sepChar
  Int
c <- Parser Int
forall a. Integral a => Parser a
decimal Parser Int -> Parser Text -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
"\n"
  [Text]
comments <- Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser Text
untilLineBreak Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
"\n")
  ()
_ <- Parser Text ()
end
  Message -> Parser Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Message) -> Message -> Parser Message
forall a b. (a -> b) -> a -> b
$ Location -> Level -> [Text] -> Message
Message (Text -> Int -> Int -> Location
Location Text
fp Int
c Int
n) Level
l (Text
body Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
comments)
  where
    untilSep :: Parser Text
untilSep = (Char -> Bool) -> Parser Text
takeWhile1 ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Char
w -> Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
sepChar
    untilSep0 :: Parser Text
untilSep0 = (Char -> Bool) -> Parser Text
Data.Attoparsec.Text.takeWhile ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Char
w -> Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':'
    end :: Parser Text ()
end = [Parser Text ()] -> Parser Text ()
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [() -> Text -> ()
forall a b. a -> b -> a
const () (Text -> ()) -> Parser Text -> Parser Text ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
"\n", Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput, () -> Parser Text ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()]
    sepChar :: Char
sepChar = Char
':'
    untilLineBreak :: Parser Text
untilLineBreak = (Char -> Bool) -> Parser Text
takeWhile1 ((Char -> Bool) -> Parser Text) -> (Char -> Bool) -> Parser Text
forall a b. (a -> b) -> a -> b
$ \Char
w -> Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'