-- | Source locations
module GF.Infra.Location where
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
import GF.Text.Pretty

-- ** Source locations

class HasSourcePath a where sourcePath :: a -> FilePath

data Location 
  = NoLoc
  | Local Int Int
  | External FilePath Location
  deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show,Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq,Eq Location
Eq Location
-> (Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
$cp1Ord :: Eq Location
Ord)

-- | Attaching location information
data L a = L Location a deriving Int -> L a -> ShowS
[L a] -> ShowS
L a -> String
(Int -> L a -> ShowS)
-> (L a -> String) -> ([L a] -> ShowS) -> Show (L a)
forall a. Show a => Int -> L a -> ShowS
forall a. Show a => [L a] -> ShowS
forall a. Show a => L a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L a] -> ShowS
$cshowList :: forall a. Show a => [L a] -> ShowS
show :: L a -> String
$cshow :: forall a. Show a => L a -> String
showsPrec :: Int -> L a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> L a -> ShowS
Show

instance Functor L where fmap :: (a -> b) -> L a -> L b
fmap a -> b
f (L Location
loc a
x) = Location -> b -> L b
forall a. Location -> a -> L a
L Location
loc (a -> b
f a
x)

unLoc :: L a -> a
unLoc :: L a -> a
unLoc (L Location
_ a
x) = a
x

noLoc :: a -> L a
noLoc = Location -> a -> L a
forall a. Location -> a -> L a
L Location
NoLoc

ppLocation :: FilePath -> Location -> Doc
ppLocation :: String -> Location -> Doc
ppLocation String
fpath Location
NoLoc          = String -> Doc
forall a. Pretty a => a -> Doc
pp String
fpath
ppLocation String
fpath (External String
p Location
l) = String -> Location -> Doc
ppLocation String
p Location
l
ppLocation String
fpath (Local Int
b Int
e) =
    Bool -> Doc -> Doc
opt (String
fpathString -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"") (String
fpath String -> String -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> String
":") Doc -> Int -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Int
b Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Bool -> Doc -> Doc
opt (Int
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
e) (String
"-" String -> Int -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<> Int
e)
  where
    opt :: Bool -> Doc -> Doc
opt Bool
False Doc
x = Doc
empty
    opt Bool
True Doc
x = Doc
x

ppL :: L a2 -> a2 -> Doc
ppL (L Location
loc a2
x) a2
msg = Doc -> Int -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> Int -> a2 -> Doc
hang (Location
locLocation -> String -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<>String
":") Int
4 (String
"In"String -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>a2
xDoc -> String -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<>String
":"Doc -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+>a2
msg)


instance Pretty Location where pp :: Location -> Doc
pp = String -> Location -> Doc
ppLocation String
""

instance Pretty a => Pretty (L a) where pp :: L a -> Doc
pp (L Location
loc a
x) = Location
locLocation -> String -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<>String
":"Doc -> a -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<>a
x