{-# LANGUAGE OverloadedStrings #-}

module Codec.Sarsi.SBT where

import Codec.Sarsi (Level (..), Location (..), Message (..))
import Data.Attoparsec.Combinator (lookAhead)
import Data.Attoparsec.Text
import qualified Data.Attoparsec.Text as AttoText
import Data.Text (Text)
import qualified Data.Text as Text

data SBTEvent = CompileStart Text | TaskFinish Bool Text | Throw Message
  deriving (Int -> SBTEvent -> ShowS
[SBTEvent] -> ShowS
SBTEvent -> String
(Int -> SBTEvent -> ShowS)
-> (SBTEvent -> String) -> ([SBTEvent] -> ShowS) -> Show SBTEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SBTEvent] -> ShowS
$cshowList :: [SBTEvent] -> ShowS
show :: SBTEvent -> String
$cshow :: SBTEvent -> String
showsPrec :: Int -> SBTEvent -> ShowS
$cshowsPrec :: Int -> SBTEvent -> ShowS
Show)

cleaningCursesSBT :: Parser Text
cleaningCursesSBT :: Parser Text
cleaningCursesSBT = [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text
silent, Parser Text
empty, Parser Text
keep]
  where
    silent :: Parser Text
silent = Parser Text
"  | =>" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text
untilLineBreak Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text
"\n" Parser Text -> Parser Text -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
Text.empty
    empty :: Parser Text
empty = do
      Text
_ <- (Char -> Bool) -> Parser Text
AttoText.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'
      Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
Text.empty
    keep :: Parser Text
keep = do
      Text
content <- ((Char -> Bool) -> Parser Text
AttoText.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') Parser Text -> Parser Text () -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
end
      Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text
content Text -> Char -> Text
`Text.snoc` Char
'\n'

eventParser :: Parser SBTEvent
eventParser :: Parser SBTEvent
eventParser = [Parser SBTEvent] -> Parser SBTEvent
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser SBTEvent
compile, Parser SBTEvent
finish, Message -> SBTEvent
Throw (Message -> SBTEvent) -> Parser Text Message -> Parser SBTEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Message
messageParser]
  where
    compile :: Parser SBTEvent
compile = do
      Text
txt <- Text -> Parser Text
string Text
"[info] " Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Parser Text] -> Parser Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text
"Build triggered", Parser Text
"Compiling"] 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 ()
end
      SBTEvent -> Parser SBTEvent
forall (m :: * -> *) a. Monad m => a -> m a
return (SBTEvent -> Parser SBTEvent) -> SBTEvent -> Parser SBTEvent
forall a b. (a -> b) -> a -> b
$ Text -> SBTEvent
CompileStart Text
txt
    finish :: Parser SBTEvent
finish = do
      Bool
res <- Parser Text Bool
status Parser Text Bool -> Parser Text Char -> Parser Text Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char
space
      Text
txt <- Text -> Parser Text
string Text
"Total time: " 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 ()
end
      ()
_ <- Parser Text ()
end
      SBTEvent -> Parser SBTEvent
forall (m :: * -> *) a. Monad m => a -> m a
return (SBTEvent -> Parser SBTEvent) -> SBTEvent -> Parser SBTEvent
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> SBTEvent
TaskFinish Bool
res Text
txt
      where
        status :: Parser Text Bool
status = [Parser Text Bool] -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Text -> Parser Text
string Text
"[success]" Parser Text -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Text Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True, Text -> Parser Text
string Text
"[error]" Parser Text -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser Text Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False]

messageParser :: Parser Message
messageParser :: Parser Text Message
messageParser = do
  Level
lvl <- Parser Text Level
lineStart
  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') 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
ln <- 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
col <- 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
  Text
t <- 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
untilLineBreak Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
"\n")
  [Text]
ts <- Parser Text -> Parser Int -> Parser Text [Text]
forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
manyTill' (Parser Text Level
lineStart Parser Text Level -> 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 Int -> Parser Int
forall i a. Parser i a -> Parser i a
lookAhead (Parser Int -> Parser Int) -> Parser Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ Parser Int
column')
  Int
_ <- Parser Int
column' -- ignored as it was parsed above
  ()
_ <- Parser Text ()
end
  Message -> Parser Text Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Parser Text Message) -> Message -> Parser Text Message
forall a b. (a -> b) -> a -> b
$ Location -> Level -> [Text] -> Message
Message (Text -> Int -> Int -> Location
Location Text
fp Int
col Int
ln) Level
lvl ([Text] -> Message) -> [Text] -> Message
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
formatTxts Text
t [Text]
ts
  where
    level :: Parser Text Level
level = [Parser Text Level] -> Parser Text Level
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [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, Text -> Parser Text
string Text
"[warn]" 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]
    lineStart :: Parser Text Level
lineStart = Parser Text Level
level Parser Text Level -> Parser Text Char -> Parser Text Level
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char
space
    sepChar :: Char
sepChar = Char
':'
    formatTxts :: a -> [a] -> [a]
formatTxts a
t [] = [a
t]
    formatTxts a
t [a]
ts = a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. [a] -> [a]
init [a]
ts
    column' :: Parser Int
column' = Parser Text Level
level Parser Text Level -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Parser Text String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text Char
space) Parser Int -> Parser Text -> Parser Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
"^\n")

untilLineBreak :: Parser Text
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'

end :: Parser ()
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 ()]