@@ -1,21 +1,14 @@
11{-# OPTIONS_GHC -Wall #-}
22module Reporting.Annotation
3− ( Annotated(..)
4− , Located
5− , Commented
6− , at, merge, sameAs
3+ ( Located(..)
4+ , at, merge
75 , map, drop
8− , listToDict
6+ , traverse
97 )
108 where
119
1210
13−import Prelude hiding (drop, map)
14−import qualified Data.List as List
15−import Data.List.NonEmpty (NonEmpty((:|)))
16−import qualified Data.Map as Map
17−import Data.Semigroup ((<>))
18−import Data.Text (Text)
11+import Prelude hiding (drop, map, traverse)
1912import qualified Reporting.Region as R
2013
2114
@@ -23,16 +16,8 @@ import qualified Reporting.Region as R
2316-- ANNOTATION
2417
2518
26−data Annotated annotation a =
27− A annotation a
28−
29−
30−type Located a =
31− Annotated R.Region a
32−
33−
34−type Commented a =
35− Annotated (R.Region, Maybe Text) a
19+data Located a =
20+ At R.Region a
3621
3722
3823
@@ -41,41 +26,28 @@ type Commented a =
4126
4227at :: R.Position -> R.Position -> a -> Located a
4328at start end value =
44− A (R.Region start end) value
29+ At (R.Region start end) value
4530
4631
4732merge :: Located a -> Located b -> value -> Located value
48−merge (A region1 _) (A region2 _) value =
49− A (R.merge region1 region2) value
50−
51−
52−sameAs :: Annotated info a -> b -> Annotated info b
53−sameAs (A annotation _) value =
54− A annotation value
33+merge (At region1 _) (At region2 _) value =
34+ At (R.merge region1 region2) value
5535
5636
5737
5838-- MANIPULATE
5939
6040
61−map :: (a -> b) -> Annotated info a -> Annotated info b
62−map f (A info value) =
63− A info (f value)
41+map :: (a -> b) -> Located a -> Located b
42+map f (At info value) =
43+ At info (f value)
6444
6545
66−drop :: Annotated info a -> a
67−drop (A _ value) =
46+drop :: Located a -> a
47+drop (At _ value) =
6848 value
6949
7050
71−
72−-- ANALYZE
73−
74−
75−listToDict :: (Ord key) => (a -> key) -> [Annotated i a] -> Map.Map key (NonEmpty i)
76−listToDict toKey list =
77− let
78− add dict (A info value) =
79− Map.insertWith (<>) (toKey value) (info :| []) dict
80− in
81− List.foldl' add Map.empty list
51+traverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)
52+traverse func (At region value) =
53+ At region <$> func value