git.iko.soy/elk
on master help sign in
Collapse Reporting.Region into Reporting.Annotation
dba8208Evan Czaplicki
compiler/src/Reporting/Annotation.hs+67−24
compare with master
unifiedsplit
@@ -1,60 +1,103 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Annotation
2module Reporting.Annotation
3 ( Located(..)
3 ( Located(..)
4− , at, merge
4+ , Position(..)
5− , map
5+ , Region(..)
6+ , traverse
6 , toValue
7 , toValue
8+ , merge
9+ , at
7 , toRegion
10 , toRegion
8− , traverse
11+ , mergeRegions
12+ , zero
13+ , one
9 )
14 )
10 where
15 where
11
16
12
17
13−import Prelude hiding (map, traverse)
18+import Prelude hiding (traverse)
14−import qualified Reporting.Region as R
19+import Control.Monad (liftM2)
20+import Data.Binary (Binary, get, put)
21+import Data.Word (Word16)
15
22
16
23
17
24
18−-- ANNOTATION
25+-- LOCATED
19
26
20
27
21data Located a =
28data Located a =
22− At R.Region a
29+ At Region a -- TODO see if unpacking region is helpful
23
30
24
31
32+instance Functor Located where
33+ fmap f (At region a) =
34+ At region (f a)
25
35
26−-- CREATE
36+
37+traverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)
38+traverse func (At region value) =
39+ At region <$> func value
27
40
28
41
29−at :: R.Position -> R.Position -> a -> Located a
42+toValue :: Located a -> a
30−at start end value =
43+toValue (At _ value) =
31− At (R.Region start end) value
44+ value
32
45
33
46
34merge :: Located a -> Located b -> value -> Located value
47merge :: Located a -> Located b -> value -> Located value
35−merge (At region1 _) (At region2 _) value =
48+merge (At r1 _) (At r2 _) value =
36− At (R.merge region1 region2) value
49+ At (mergeRegions r1 r2) value
37
50
38
51
39
52
40−-- MANIPULATE
53+-- POSITION
41
54
42
55
43−map :: (a -> b) -> Located a -> Located b
56+data Position =
44−map f (At info value) =
57+ Position
45− At info (f value)
58+ {-# UNPACK #-} !Word16
59+ {-# UNPACK #-} !Word16
60+ deriving (Eq)
61+
62+
63+at :: Position -> Position -> a -> Located a
64+at start end a =
65+ At (Region start end) a
46
66
47
67
48−toValue :: Located a -> a
49−toValue (At _ value) =
50− value
51
68
69+-- REGION
52
70
71+
72+data Region = Region Position Position
73+ deriving (Eq)
74+
75+
53−toRegion :: Located a -> R.Region
76+toRegion :: Located a -> Region
54toRegion (At region _) =
77toRegion (At region _) =
55 region
78 region
56
79
57
80
58−traverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)
81+mergeRegions :: Region -> Region -> Region
59−traverse func (At region value) =
82+mergeRegions (Region start _) (Region _ end) =
60− At region <$> func value
83+ Region start end
84+
85+
86+zero :: Region
87+zero =
88+ Region (Position 0 0) (Position 0 0)
89+
90+
91+one :: Region
92+one =
93+ Region (Position 1 1) (Position 1 1)
94+
95+
96+instance Binary Region where
97+ put (Region a b) = put a >> put b
98+ get = liftM2 Region get get
99+
100+
101+instance Binary Position where
102+ put (Position a b) = put a >> put b
103+ get = liftM2 Position get get
compiler/src/Reporting/Region.hsdeleted−93
@@ -1,93 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Reporting.Region
3− ( Region(..)
4− , Position(..)
5− , zero
6− , one
7− , merge
8− , encode
9− )
10− where
11−
12−
13−import qualified Json.Encode as Json
14−import Data.Binary (Binary, get, put)
15−
16−
17−
18−-- REGION
19−
20−
21−data Region =
22− Region
23− { _start :: !Position
24− , _end :: !Position
25− }
26− deriving (Eq, Ord)
27−
28−
29−data Position =
30− Position
31− { _line :: !Int
32− , _column :: !Int
33− }
34− deriving (Eq, Ord)
35−
36−
37−merge :: Region -> Region -> Region
38−merge (Region start _) (Region _ end) =
39− Region start end
40−
41−
42−{-# NOINLINE zero #-}
43−zero :: Region
44−zero =
45− Region (Position 0 0) (Position 0 0)
46−
47−
48−{-# NOINLINE one #-}
49−one :: Region
50−one =
51− Region (Position 1 1) (Position 1 1)
52−
53−
54−
55−-- JSON
56−
57−
58−encode :: Region -> Json.Value
59−encode (Region start end) =
60− Json.object
61− [ ("start", encodePosition start)
62− , ("end", encodePosition end)
63− ]
64−
65−
66−encodePosition :: Position -> Json.Value
67−encodePosition (Position line column) =
68− Json.object
69− [ ("line", Json.int line)
70− , ("column", Json.int column)
71− ]
72−
73−
74−
75−-- BINARY
76−
77−
78−instance Binary Region where
79− get =
80− Region <$> get <*> get
81−
82− put (Region start end) =
83− do put start
84− put end
85−
86−
87−instance Binary Position where
88− get =
89− Position <$> get <*> get
90−
91− put (Position line column) =
92− do put line
93− put column