module Codec.Sarsi where

import Data.Binary (Get, Put)
import qualified Data.MessagePack.Get as Get
import qualified Data.MessagePack.Put as Put
import Data.Text (Text, unpack)
import qualified Data.Text as Text
import qualified Data.Vector as Vector

data Event
  = Start {Event -> Text
label :: Text}
  | Finish {Event -> Int
errors :: Int, Event -> Int
warnings :: Int}
  | Notify {Event -> Message
message :: Message}

instance Show Event where
  show :: Event -> String
show (Start Text
lbl) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"starting ", Text -> String
unpack Text
lbl, String
" build"]
  show (Finish Int
0 Int
0) = String
"build success"
  show (Finish Int
0 Int
w) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"build success with ", Int -> String
forall a. Show a => a -> String
show Int
w, String
" warning(s)"]
  show (Finish Int
e Int
0) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"build failure with ", Int -> String
forall a. Show a => a -> String
show Int
e, String
" error(s)"]
  show (Finish Int
e Int
w) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"build failure with ", Int -> String
forall a. Show a => a -> String
show Int
e, String
" error(s) and ", Int -> String
forall a. Show a => a -> String
show Int
w, String
" warning(s)"]
  show (Notify Message
msg) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"message=", Message -> String
forall a. Show a => a -> String
show Message
msg]

getEvent :: Get Event
getEvent :: Get Event
getEvent = do
  Int
tpe <- Get Int
Get.getInt
  case Int
tpe of
    Int
0 -> Text -> Event
Start (Text -> Event) -> Get Text -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
Get.getStr
    Int
1 -> Int -> Int -> Event
Finish (Int -> Int -> Event) -> Get Int -> Get (Int -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
Get.getInt Get (Int -> Event) -> Get Int -> Get Event
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
Get.getInt
    Int
2 -> Message -> Event
Notify (Message -> Event) -> Get Message -> Get Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Message
getMessage
    Int
_ -> String -> Get Event
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unsupported event type"

putEvent :: Event -> Put
putEvent :: Event -> Put
putEvent (Start Text
t) = Int -> Put
Put.putInt Int
0 Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Put
Put.putStr Text
t
putEvent (Finish Int
es Int
ws) = Int -> Put
Put.putInt Int
1 Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Put
Put.putInt Int
es Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Put
Put.putInt Int
ws
putEvent (Notify Message
m) = Int -> Put
Put.putInt Int
2 Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Message -> Put
putMessage Message
m

data Message = Message Location Level [Text]

-- TODO Remove me
messageTest :: Message
messageTest :: Message
messageTest = Location -> Level -> [Text] -> Message
Message (Location :: Text -> Int -> Int -> Location
Location {filePath :: Text
filePath = String -> Text
Text.pack String
"foo", column :: Int
column = Int
42, line :: Int
line = Int
42}) Level
Error []

instance Show Message where
  show :: Message -> String
show (Message Location
loc Level
lvl [Text]
txts) =
    ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Location -> String
forall a. Show a => a -> String
show Location
loc, String
" ", Level -> String
forall a. Show a => a -> String
show Level
lvl, String
"\n"]) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
txts)

getMessage :: Get Message
getMessage :: Get Message
getMessage = Location -> Level -> [Text] -> Message
Message (Location -> Level -> [Text] -> Message)
-> Get Location -> Get (Level -> [Text] -> Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Location
getLocation Get (Level -> [Text] -> Message)
-> Get Level -> Get ([Text] -> Message)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Level
getLevel Get ([Text] -> Message) -> Get [Text] -> Get Message
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Vector Text -> [Text]
forall a. Vector a -> [a]
Vector.toList (Vector Text -> [Text]) -> Get (Vector Text) -> Get [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text -> Get (Vector Text)
forall a. Get a -> Get (Vector a)
Get.getArray Get Text
Get.getStr)

putMessage :: Message -> Put
putMessage :: Message -> Put
putMessage (Message Location
loc Level
lvl [Text]
txt) = Location -> Put
putLocation Location
loc Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Level -> Put
putLevel Level
lvl Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Put) -> Vector Text -> Put
forall a. (a -> Put) -> Vector a -> Put
Put.putArray Text -> Put
Put.putStr ([Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList [Text]
txt)

data Location = Location {Location -> Text
filePath :: Text, Location -> Int
column :: Int, Location -> Int
line :: Int}

instance Show Location where
  show :: Location -> String
show (Location Text
fp Int
c Int
l) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Text -> String
Text.unpack Text
fp, String
"@", Int -> String
forall a. Show a => a -> String
show Int
l, String
":", Int -> String
forall a. Show a => a -> String
show Int
c]

getLocation :: Get Location
getLocation :: Get Location
getLocation = Text -> Int -> Int -> Location
Location (Text -> Int -> Int -> Location)
-> Get Text -> Get (Int -> Int -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
Get.getStr Get (Int -> Int -> Location) -> Get Int -> Get (Int -> Location)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
Get.getInt Get (Int -> Location) -> Get Int -> Get Location
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
Get.getInt

putLocation :: Location -> Put
putLocation :: Location -> Put
putLocation (Location Text
fp Int
c Int
l) = Text -> Put
Put.putStr Text
fp Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Put
Put.putInt Int
c Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Put
Put.putInt Int
l

data Level = Warning | Error
  deriving (Int -> Level
Level -> Int
Level -> [Level]
Level -> Level
Level -> Level -> [Level]
Level -> Level -> Level -> [Level]
(Level -> Level)
-> (Level -> Level)
-> (Int -> Level)
-> (Level -> Int)
-> (Level -> [Level])
-> (Level -> Level -> [Level])
-> (Level -> Level -> [Level])
-> (Level -> Level -> Level -> [Level])
-> Enum Level
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Level -> Level -> Level -> [Level]
$cenumFromThenTo :: Level -> Level -> Level -> [Level]
enumFromTo :: Level -> Level -> [Level]
$cenumFromTo :: Level -> Level -> [Level]
enumFromThen :: Level -> Level -> [Level]
$cenumFromThen :: Level -> Level -> [Level]
enumFrom :: Level -> [Level]
$cenumFrom :: Level -> [Level]
fromEnum :: Level -> Int
$cfromEnum :: Level -> Int
toEnum :: Int -> Level
$ctoEnum :: Int -> Level
pred :: Level -> Level
$cpred :: Level -> Level
succ :: Level -> Level
$csucc :: Level -> Level
Enum, 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)

getLevel :: Get Level
getLevel :: Get Level
getLevel = (Int -> Level) -> Get Int -> Get Level
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Level
forall a. Enum a => Int -> a
toEnum (Int -> Level) -> (Int -> Int) -> Int -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Get Int
Get.getInt

putLevel :: Level -> Put
putLevel :: Level -> Put
putLevel = Int -> Put
Put.putInt (Int -> Put) -> (Level -> Int) -> Level -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Level -> Int) -> Level -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Level -> Int
forall a. Enum a => a -> Int
fromEnum