SBT.hs

{-# LANGUAGE OverloadedStrings #-}
module Codec.Sarsi.SBT where

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

import qualified Data.Attoparsec.Text as AttoText
import qualified Data.Text as Text

data SBTEvent = CompileStart Text | TaskFinish Bool Text | Throw Message
  deriving Show

eventParser :: Parser SBTEvent
eventParser = choice [compile, finish, Throw <$> messageParser]
  where
    compile = do
      txt <- string "[info] Compiling " *> untilLineBreak <* end
      return $ CompileStart txt
    finish = do
      res <- status <* space
      txt <- string "Total time: " *> untilLineBreak <* end
      _   <- end
      return $ TaskFinish res txt
        where
          status = choice [string "[success]" *> return True, string "[error]" *> return False]

messageParser :: Parser Message
messageParser = do
  lvl <- lineStart
  fp  <- takeWhile1 (\c -> c /= sepChar && c /= '\n' && c /= '\r') <* char sepChar
  ln  <- decimal <* char sepChar
  t   <- space *> (untilLineBreak <* "\n")
  ts  <- manyTill' (lineStart *> (untilLineBreak <* "\n")) (lookAhead $ column')
  col <- column'
  _   <- end
  return $ Message (Location fp (fromIntegral col) ln) lvl $ formatTxts t ts
    where
      level = choice [string "[error]" *> return Error, string "[warn]" *> return Warning]
      lineStart = level <* space
      sepChar = ':'
      formatTxts t [] = [t]
      formatTxts t ts = t : init ts
      column' = level *> ((length <$> many1 space) <* "^\n")

cleanEC :: Parser Text
cleanEC = choice [noEC, withEC]
  where
    noEC    = takeStart <* endOfInput
    withEC  = do
      before <- takeStart <* anyChar
      _      <- takeEnd   <* anyChar
      after  <- cleanEC
      return (Text.concat [before, after])
    takeStart = AttoText.takeWhile (not . isEscStart . fromEnum)
    takeEnd   = AttoText.takeWhile (not . isEscEnd . fromEnum)
    isEscStart 27 = True
    isEscStart _  = False
    isEscEnd 109 = True
    isEscEnd _ = False

untilLineBreak :: Parser Text
untilLineBreak = takeWhile1 $ \w -> w /= '\n' && w /= '\r'

end :: Parser ()
end = choice [const () <$> "\n", endOfInput, return ()]