{-# LANGUAGE OverloadedStrings #-}
module Codec.GHC.Log where

import Data.Attoparsec.Text
import Data.Text (Text)

data Message = Message Text Pos Level [Text]
  deriving Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show

data Pos = Pos { Pos -> Int
column :: Int, Pos -> Int
line :: Int }
  deriving Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show

data Level = Warning | Error
  deriving Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show

messageParser :: Parser Message
messageParser :: Parser Message
messageParser = do
  Text
fp  <- (Char -> Bool) -> Parser Text
takeWhile1 (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
sepChar Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') 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 Char -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
sepChar
  Level
l   <- [Parser Text Level] -> Parser Text Level
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
    [ [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 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 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 ]
    -- Before GHC 8.0
    , [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 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
      , Level -> Parser Text Level
forall (m :: * -> *) a. Monad m => a -> m a
return Level
Error ] ]
  [Text]
txt <- [Parser Text [Text]] -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
    [ (Text -> Parser Text
string Text
" [" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 -> Parser Text [Text] -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text [Text]
multilinesComment Parser Text [Text] -> Parser Text () -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
end)
    , Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
untilLineBreak Parser Text [Text] -> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text
"\n" Parser Text -> Parser Text () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
end)
    , Parser Text
takeLineBreak Parser Text -> Parser Text [Text] -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text [Text]
multilinesComment Parser Text [Text] -> Parser Text () -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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
$ Text -> Pos -> Level -> [Text] -> Message
Message Text
fp (Int -> Int -> Pos
Pos Int
c Int
n) Level
l [Text]
txt
  where
    multilinesComment :: Parser Text [Text]
multilinesComment = Parser Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser Text -> Parser Text [Text])
-> Parser Text -> Parser Text [Text]
forall a b. (a -> b) -> a -> b
$ (Parser Text
"    " Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text
untilLineBreak Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
"\n"))
    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' Bool -> Bool -> Bool
&& Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r'
    takeLineBreak :: Parser Text
takeLineBreak = (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' Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
    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
':'