summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Infra/Location.hs
blob: 36bfab0442e97e180f992cd3bea31fc232d80599 (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
-- | 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)
  | b == e    = fpath <> ":" <> b
  | otherwise = fpath <> ":" <> b <> "-" <> e


ppL (L loc x) msg = hang (ppLocation "" loc<>":") 4
                         ("In"<+>x<>":"<+>msg)