blob: 0bf85b37fa62ae760125ee41b0834571b1a0d894 (
plain)
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
|
-- | Source locations
module GF.Infra.Location where
import GF.Text.Pretty
-- ** Source locations
class HasSourcePath a where sourcePath :: a -> FilePath
data Location
= NoLoc
| Local Int Int
| External FilePath Location
deriving (Show,Eq,Ord)
-- | Attaching location information
data L a = L Location a deriving Show
instance Functor L where fmap f (L loc x) = L loc (f x)
unLoc :: L a -> a
unLoc (L _ x) = x
noLoc = L NoLoc
ppLocation :: FilePath -> Location -> Doc
ppLocation fpath NoLoc = pp fpath
ppLocation fpath (External p l) = ppLocation p l
ppLocation fpath (Local b e) =
opt (fpath/="") (fpath <> ":") <> b <> opt (b/=e) ("-" <> e)
where
opt False x = empty
opt True x = x
ppL (L loc x) msg = hang (loc<>":") 4 ("In"<+>x<>":"<+>msg)
instance Pretty Location where pp = ppLocation ""
instance Pretty a => Pretty (L a) where pp (L loc x) = loc<>":"<>x
|