on 1238607 help sign in
elk/compiler/src/Reporting/Annotation.hs
103 lines 1.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Annotation
3 ( Located(..)
4 , Position(..)
5 , Region(..)
6 , traverse
7 , toValue
8 , merge
9 , at
10 , toRegion
11 , mergeRegions
12 , zero
13 , one
14 )
15 where
18import Prelude hiding (traverse)
19import Control.Monad (liftM2)
20import Data.Binary (Binary, get, put)
21import Data.Word (Word16)
25-- LOCATED
28data Located a =
29 At Region a -- TODO see if unpacking region is helpful
32instance Functor Located where
33 fmap f (At region a) =
34 At region (f a)
37traverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)
38traverse func (At region value) =
39 At region <$> func value
42toValue :: Located a -> a
43toValue (At _ value) =
44 value
47merge :: Located a -> Located b -> value -> Located value
48merge (At r1 _) (At r2 _) value =
49 At (mergeRegions r1 r2) value
53-- POSITION
56data Position =
57 Position
58 {-# UNPACK #-} !Word16
59 {-# UNPACK #-} !Word16
60 deriving (Eq)
63at :: Position -> Position -> a -> Located a
64at start end a =
65 At (Region start end) a
69-- REGION
72data Region = Region Position Position
73 deriving (Eq)
76toRegion :: Located a -> Region
77toRegion (At region _) =
78 region
81mergeRegions :: Region -> Region -> Region
82mergeRegions (Region start _) (Region _ end) =
83 Region start end
86zero :: Region
87zero =
88 Region (Position 0 0) (Position 0 0)
91one :: Region
92one =
93 Region (Position 1 1) (Position 1 1)
96instance Binary Region where
97 put (Region a b) = put a >> put b
98 get = liftM2 Region get get
101instance Binary Position where
102 put (Position a b) = put a >> put b
103 get = liftM2 Position get get