-
Notifications
You must be signed in to change notification settings - Fork 4
/
Sarsi.hs
69 lines (51 loc) · 2.18 KB
/
Sarsi.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
module Codec.Sarsi where
import Data.Int (Int64)
import Data.Text (Text, unpack)
import Data.Binary (Get, Put)
import qualified Data.MessagePack.Get as Get
import qualified Data.MessagePack.Put as Put
import qualified Data.Text as Text
data Event
= Start { label :: Text }
| Finish { errors :: Int64, warnings :: Int64 }
| Notify { message :: Message }
instance Show Event where
show (Start lbl) = concat ["starting ", unpack lbl, " build"]
show (Finish 0 0) = "build success"
show (Finish 0 w) = concat ["build success with ", show w, " warning(s)"]
show (Finish e 0) = concat ["build failure with ", show e, " error(s)"]
show (Finish e w) = concat ["build failure with ", show e, " error(s) and ", show w, " warning(s)"]
show (Notify msg) = concat ["message=", show msg]
getEvent :: Get Event
getEvent = do
tpe <- Get.getInt
case tpe of
0 -> Start <$> Get.getStr
1 -> Finish <$> Get.getInt <*> Get.getInt
2 -> Notify <$> getMessage
_ -> fail "unsupported event type"
putEvent :: Event -> Put
putEvent (Start t) = Put.putInt 0 *> Put.putStr t
putEvent (Finish es ws) = Put.putInt 1 *> Put.putInt es *> Put.putInt ws
putEvent (Notify m) = Put.putInt 2 *> putMessage m
data Message = Message Location Level [Text]
instance Show Message where
show (Message loc lvl txts) =
(concat [show loc, " ", show lvl, "\n"]) ++ (unlines $ Text.unpack <$> txts)
getMessage :: Get Message
getMessage = Message <$> getLocation <*> getLevel <*> Get.getArray Get.getStr
putMessage :: Message -> Put
putMessage (Message loc lvl txt) = putLocation loc *> putLevel lvl *> Put.putArray Put.putStr txt
data Location = Location { filePath :: Text, column :: Int64, line :: Int64 }
instance Show Location where
show (Location fp c l) = concat [Text.unpack fp, "@", show l, ":", show c]
getLocation :: Get Location
getLocation = Location <$> Get.getStr <*> Get.getInt <*> Get.getInt
putLocation :: Location -> Put
putLocation (Location fp c l) = Put.putStr fp *> Put.putInt c *> Put.putInt l
data Level = Warning | Error
deriving (Enum, Show)
getLevel :: Get Level
getLevel = fmap (toEnum . fromIntegral) Get.getInt
putLevel :: Level -> Put
putLevel = Put.putInt . fromIntegral . fromEnum