{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE Safe #-}

-- |
-- Module      :  Data.Loc
-- Copyright   :  (c) Harvard University 2006-2011
--                (c) Geoffrey Mainland 2011-2015
-- License     :  BSD-style
-- Maintainer  :  Geoffrey Mainland <mainland@cs.drexel.edu>

module Data.Loc (
    Pos(..),
    posFile,
    posLine,
    posCol,
    posCoff,
    startPos,
    linePos,
    advancePos,
    displayPos,
    displaySPos,

    Loc(..),
    locStart,
    locEnd,

    (<-->),

    displayLoc,
    displaySLoc,

    SrcLoc(..),
    srclocOf,
    srcspan,

    IsLocation(..),
    noLoc,

    Located(..),

    Relocatable(..),

    L(..),
    unLoc
  ) where

import Data.Data (Data(..))
import Data.Typeable (Typeable(..))
import Data.List (foldl')
import Data.Monoid (Monoid(..))
#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

-- | Position type.
data Pos = -- | Source file name, line, column, and character offset.
           --
           -- Line numbering starts at 1, column offset starts at 1, and
           -- character offset starts at 0.
           Pos !FilePath
               {-# UNPACK #-} !Int
               {-# UNPACK #-} !Int
               {-# UNPACK #-} !Int
  deriving (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, ReadPrec [Pos]
ReadPrec Pos
Int -> ReadS Pos
ReadS [Pos]
(Int -> ReadS Pos)
-> ReadS [Pos] -> ReadPrec Pos -> ReadPrec [Pos] -> Read Pos
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pos]
$creadListPrec :: ReadPrec [Pos]
readPrec :: ReadPrec Pos
$creadPrec :: ReadPrec Pos
readList :: ReadS [Pos]
$creadList :: ReadS [Pos]
readsPrec :: Int -> ReadS Pos
$creadsPrec :: Int -> ReadS Pos
Read, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, Typeable Pos
DataType
Constr
Typeable Pos
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pos -> c Pos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pos)
-> (Pos -> Constr)
-> (Pos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos))
-> ((forall b. Data b => b -> b) -> Pos -> Pos)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pos -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> Data Pos
Pos -> DataType
Pos -> Constr
(forall b. Data b => b -> b) -> Pos -> Pos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
forall u. (forall d. Data d => d -> u) -> Pos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cPos :: Constr
$tPos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapMp :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapM :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
$cgmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
dataTypeOf :: Pos -> DataType
$cdataTypeOf :: Pos -> DataType
toConstr :: Pos -> Constr
$ctoConstr :: Pos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cp1Data :: Typeable Pos
Data, Typeable)

instance Ord Pos where
    compare :: Pos -> Pos -> Ordering
compare (Pos String
f1 Int
l1 Int
c1 Int
_) (Pos String
f2 Int
l2 Int
c2 Int
_) =
        (String, Int, Int) -> (String, Int, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String
f1, Int
l1, Int
c1) (String
f2, Int
l2, Int
c2)

-- | Position file.
posFile :: Pos -> FilePath
posFile :: Pos -> String
posFile (Pos String
f Int
_ Int
_ Int
_) = String
f

-- | Position line.
posLine :: Pos -> Int
posLine :: Pos -> Int
posLine (Pos String
_ Int
l Int
_ Int
_) = Int
l

-- | Position column.
posCol :: Pos -> Int
posCol :: Pos -> Int
posCol (Pos String
_ Int
_ Int
c Int
_) = Int
c

-- | Position character offset.
posCoff :: Pos -> Int
posCoff :: Pos -> Int
posCoff (Pos String
_ Int
_ Int
_ Int
coff) = Int
coff

-- | Starting position for given file.
startPos :: FilePath -> Pos
startPos :: String -> Pos
startPos String
f = String -> Int -> Int -> Int -> Pos
Pos String
f Int
startLine Int
startCol Int
startCoff

startLine :: Int
startLine :: Int
startLine = Int
1

startCol :: Int
startCol :: Int
startCol = Int
1

startCoff :: Int
startCoff :: Int
startCoff = Int
0

-- | Position corresponding to given file and line.
--
-- Note that the associated character offset is set to 0.
linePos :: FilePath -> Int -> Pos
linePos :: String -> Int -> Pos
linePos String
f Int
l = String -> Int -> Int -> Int -> Pos
Pos String
f Int
l Int
startCol Int
startCoff

-- | Advance a position by a single character. Newlines increment the line
-- number, tabs increase the position column following a tab stop width of 8,
-- and all other characters increase the position column by one. All characters,
-- including newlines and tabs, increase the character offset by 1.
--
-- Note that 'advancePos' assumes UNIX-style newlines.
advancePos :: Pos -> Char -> Pos
advancePos :: Pos -> Char -> Pos
advancePos (Pos String
f Int
l Int
_ Int
coff) Char
'\n' = String -> Int -> Int -> Int -> Pos
Pos String
f (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
startCol     (Int
coff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
advancePos (Pos String
f Int
l Int
c Int
coff) Char
'\t' = String -> Int -> Int -> Int -> Pos
Pos String
f Int
l     Int
nextTabStop  (Int
coff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  where nextTabStop :: Int
nextTabStop = ((Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
advancePos (Pos String
f Int
l Int
c Int
coff) Char
_    = String -> Int -> Int -> Int -> Pos
Pos String
f Int
l     (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)      (Int
coff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Location type, consisting of a beginning position and an end position.
data Loc =  NoLoc
         |  -- | Beginning and end positions
            Loc  {-# UNPACK #-} !Pos
                 {-# UNPACK #-} !Pos
  deriving (Loc -> Loc -> Bool
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c== :: Loc -> Loc -> Bool
Eq, Eq Loc
Eq Loc
-> (Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
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 :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmax :: Loc -> Loc -> Loc
>= :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c< :: Loc -> Loc -> Bool
compare :: Loc -> Loc -> Ordering
$ccompare :: Loc -> Loc -> Ordering
$cp1Ord :: Eq Loc
Ord, ReadPrec [Loc]
ReadPrec Loc
Int -> ReadS Loc
ReadS [Loc]
(Int -> ReadS Loc)
-> ReadS [Loc] -> ReadPrec Loc -> ReadPrec [Loc] -> Read Loc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Loc]
$creadListPrec :: ReadPrec [Loc]
readPrec :: ReadPrec Loc
$creadPrec :: ReadPrec Loc
readList :: ReadS [Loc]
$creadList :: ReadS [Loc]
readsPrec :: Int -> ReadS Loc
$creadsPrec :: Int -> ReadS Loc
Read, Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
(Int -> Loc -> ShowS)
-> (Loc -> String) -> ([Loc] -> ShowS) -> Show Loc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Loc] -> ShowS
$cshowList :: [Loc] -> ShowS
show :: Loc -> String
$cshow :: Loc -> String
showsPrec :: Int -> Loc -> ShowS
$cshowsPrec :: Int -> Loc -> ShowS
Show, Typeable Loc
DataType
Constr
Typeable Loc
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Loc -> c Loc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Loc)
-> (Loc -> Constr)
-> (Loc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Loc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Loc))
-> ((forall b. Data b => b -> b) -> Loc -> Loc)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r)
-> (forall u. (forall d. Data d => d -> u) -> Loc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Loc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Loc -> m Loc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Loc -> m Loc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Loc -> m Loc)
-> Data Loc
Loc -> DataType
Loc -> Constr
(forall b. Data b => b -> b) -> Loc -> Loc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Loc -> c Loc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Loc
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Loc -> u
forall u. (forall d. Data d => d -> u) -> Loc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Loc -> m Loc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Loc -> m Loc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Loc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Loc -> c Loc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Loc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Loc)
$cLoc :: Constr
$cNoLoc :: Constr
$tLoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Loc -> m Loc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Loc -> m Loc
gmapMp :: (forall d. Data d => d -> m d) -> Loc -> m Loc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Loc -> m Loc
gmapM :: (forall d. Data d => d -> m d) -> Loc -> m Loc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Loc -> m Loc
gmapQi :: Int -> (forall d. Data d => d -> u) -> Loc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Loc -> u
gmapQ :: (forall d. Data d => d -> u) -> Loc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Loc -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Loc -> r
gmapT :: (forall b. Data b => b -> b) -> Loc -> Loc
$cgmapT :: (forall b. Data b => b -> b) -> Loc -> Loc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Loc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Loc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Loc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Loc)
dataTypeOf :: Loc -> DataType
$cdataTypeOf :: Loc -> DataType
toConstr :: Loc -> Constr
$ctoConstr :: Loc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Loc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Loc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Loc -> c Loc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Loc -> c Loc
$cp1Data :: Typeable Loc
Data, Typeable)

-- | Starting position of the location.
locStart :: Loc -> Loc
locStart :: Loc -> Loc
locStart  Loc
NoLoc      = Loc
NoLoc
locStart  (Loc Pos
p Pos
_)  = Pos -> Pos -> Loc
Loc Pos
p Pos
p

-- | Ending position of the location.
locEnd :: Loc -> Loc
locEnd :: Loc -> Loc
locEnd  Loc
NoLoc      = Loc
NoLoc
locEnd  (Loc Pos
_ Pos
p)  = Pos -> Pos -> Loc
Loc Pos
p Pos
p

-- | Append two locations.
locAppend :: Loc -> Loc -> Loc
locAppend :: Loc -> Loc -> Loc
locAppend Loc
NoLoc       Loc
l           = Loc
l
locAppend Loc
l           Loc
NoLoc       = Loc
l
locAppend (Loc Pos
b1 Pos
e1) (Loc Pos
b2 Pos
e2) = Pos -> Pos -> Loc
Loc (Pos -> Pos -> Pos
forall a. Ord a => a -> a -> a
min Pos
b1 Pos
b2) (Pos -> Pos -> Pos
forall a. Ord a => a -> a -> a
max Pos
e1 Pos
e2)

#if MIN_VERSION_base(4,9,0)
instance Semigroup Loc where
    <> :: Loc -> Loc -> Loc
(<>) = Loc -> Loc -> Loc
locAppend
#endif

instance Monoid Loc where
    mempty :: Loc
mempty = Loc
NoLoc
#if !(MIN_VERSION_base(4,11,0))
    mappend = locAppend
#endif

-- | Merge the locations of two 'Located' values.
(<-->) :: (Located a, Located b) => a -> b -> Loc
a
x <--> :: a -> b -> Loc
<--> b
y = a -> Loc
forall a. Located a => a -> Loc
locOf a
x Loc -> Loc -> Loc
forall a. Monoid a => a -> a -> a
`mappend` b -> Loc
forall a. Located a => a -> Loc
locOf b
y

infixl 6 <-->

-- | Source location type. Source location are all equal, which allows AST nodes
-- to be compared modulo location information.
newtype SrcLoc = SrcLoc Loc
  deriving (Typeable SrcLoc
DataType
Constr
Typeable SrcLoc
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SrcLoc -> c SrcLoc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SrcLoc)
-> (SrcLoc -> Constr)
-> (SrcLoc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SrcLoc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc))
-> ((forall b. Data b => b -> b) -> SrcLoc -> SrcLoc)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r)
-> (forall u. (forall d. Data d => d -> u) -> SrcLoc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SrcLoc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc)
-> Data SrcLoc
SrcLoc -> DataType
SrcLoc -> Constr
(forall b. Data b => b -> b) -> SrcLoc -> SrcLoc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLoc -> c SrcLoc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLoc
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SrcLoc -> u
forall u. (forall d. Data d => d -> u) -> SrcLoc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLoc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLoc -> c SrcLoc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLoc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc)
$cSrcLoc :: Constr
$tSrcLoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
gmapMp :: (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
gmapM :: (forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLoc -> m SrcLoc
gmapQi :: Int -> (forall d. Data d => d -> u) -> SrcLoc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcLoc -> u
gmapQ :: (forall d. Data d => d -> u) -> SrcLoc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcLoc -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SrcLoc -> r
gmapT :: (forall b. Data b => b -> b) -> SrcLoc -> SrcLoc
$cgmapT :: (forall b. Data b => b -> b) -> SrcLoc -> SrcLoc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcLoc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SrcLoc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLoc)
dataTypeOf :: SrcLoc -> DataType
$cdataTypeOf :: SrcLoc -> DataType
toConstr :: SrcLoc -> Constr
$ctoConstr :: SrcLoc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLoc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLoc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLoc -> c SrcLoc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLoc -> c SrcLoc
$cp1Data :: Typeable SrcLoc
Data, Typeable)

instance Monoid SrcLoc where
    mempty :: SrcLoc
mempty = Loc -> SrcLoc
SrcLoc Loc
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
    mappend (SrcLoc l1) (SrcLoc l2) = SrcLoc (l1 `mappend` l2)
#endif

#if MIN_VERSION_base(4,9,0)
instance Semigroup SrcLoc where
  SrcLoc Loc
l1 <> :: SrcLoc -> SrcLoc -> SrcLoc
<> SrcLoc Loc
l2 = Loc -> SrcLoc
SrcLoc (Loc
l1 Loc -> Loc -> Loc
forall a. Semigroup a => a -> a -> a
<> Loc
l2)
#endif

instance Eq SrcLoc where
    SrcLoc
_ == :: SrcLoc -> SrcLoc -> Bool
== SrcLoc
_ = Bool
True

instance Ord SrcLoc where
    compare :: SrcLoc -> SrcLoc -> Ordering
compare SrcLoc
_ SrcLoc
_ = Ordering
EQ

instance Show SrcLoc where
    showsPrec :: Int -> SrcLoc -> ShowS
showsPrec Int
_ SrcLoc
_ = String -> ShowS
showString String
"noLoc"

instance Read SrcLoc where
    readsPrec :: Int -> ReadS SrcLoc
readsPrec Int
p String
s =
        Bool -> ReadS SrcLoc -> ReadS SrcLoc
forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False
          (\String
s -> [(Loc -> SrcLoc
SrcLoc Loc
NoLoc, String
s') |
                  (String
"noLoc", String
s') <- ReadS String
lex String
s])
          String
s
        [(SrcLoc, String)] -> [(SrcLoc, String)] -> [(SrcLoc, String)]
forall a. [a] -> [a] -> [a]
++
        Bool -> ReadS SrcLoc -> ReadS SrcLoc
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
          (\String
s -> [(Loc -> SrcLoc
SrcLoc Loc
l, String
s'') |
                  (String
"SrcLoc", String
s') <- ReadS String
lex String
s,
                  (Loc
l, String
s'') <- Int -> ReadS Loc
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
s'])
          String
s
      where
        app_prec :: Int
app_prec = Int
10

-- | The 'SrcLoc' of a 'Located' value.
srclocOf :: Located a => a -> SrcLoc
srclocOf :: a -> SrcLoc
srclocOf = Loc -> SrcLoc
forall a. IsLocation a => Loc -> a
fromLoc (Loc -> SrcLoc) -> (a -> Loc) -> a -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Loc
forall a. Located a => a -> Loc
locOf

-- | A 'SrcLoc' with (minimal) span that includes two 'Located' values.
srcspan :: (Located a, Located b) => a -> b -> SrcLoc
a
x srcspan :: a -> b -> SrcLoc
`srcspan` b
y = Loc -> SrcLoc
SrcLoc (a -> Loc
forall a. Located a => a -> Loc
locOf a
x Loc -> Loc -> Loc
forall a. Monoid a => a -> a -> a
`mappend` b -> Loc
forall a. Located a => a -> Loc
locOf b
y)

infixl 6 `srcspan`

-- | Locations
class IsLocation a where
    fromLoc :: Loc -> a
    fromPos :: Pos -> a
    fromPos Pos
p = Loc -> a
forall a. IsLocation a => Loc -> a
fromLoc (Pos -> Pos -> Loc
Loc Pos
p Pos
p)

instance IsLocation Loc where
    fromLoc :: Loc -> Loc
fromLoc = Loc -> Loc
forall a. a -> a
id

instance IsLocation SrcLoc where
    fromLoc :: Loc -> SrcLoc
fromLoc = Loc -> SrcLoc
SrcLoc

-- | No location.
noLoc :: IsLocation a => a
noLoc :: a
noLoc = Loc -> a
forall a. IsLocation a => Loc -> a
fromLoc Loc
NoLoc

-- | Located values have a location.
class Located a where
    locOf :: a -> Loc

    locOfList :: [a] -> Loc
    locOfList [a]
xs = [Loc] -> Loc
forall a. Monoid a => [a] -> a
mconcat ((a -> Loc) -> [a] -> [Loc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Loc
forall a. Located a => a -> Loc
locOf [a]
xs)

instance Located a => Located [a] where
    locOf :: [a] -> Loc
locOf = [a] -> Loc
forall a. Located a => [a] -> Loc
locOfList

instance Located a => Located (Maybe a) where
    locOf :: Maybe a -> Loc
locOf Maybe a
Nothing   = Loc
NoLoc
    locOf (Just a
x)  = a -> Loc
forall a. Located a => a -> Loc
locOf a
x

instance Located Pos where
    locOf :: Pos -> Loc
locOf Pos
p = Pos -> Pos -> Loc
Loc Pos
p Pos
p

instance Located Loc where
    locOf :: Loc -> Loc
locOf = Loc -> Loc
forall a. a -> a
id

instance Located SrcLoc where
    locOf :: SrcLoc -> Loc
locOf (SrcLoc Loc
loc) = Loc
loc

-- | Values that can be relocated
class Relocatable a where
    reloc :: Loc -> a -> a

-- | A value of type @L a@ is a value of type @a@ with an associated 'Loc', but
-- this location is ignored when performing comparisons.
data L a = L Loc a
  deriving (a -> L b -> L a
(a -> b) -> L a -> L b
(forall a b. (a -> b) -> L a -> L b)
-> (forall a b. a -> L b -> L a) -> Functor L
forall a b. a -> L b -> L a
forall a b. (a -> b) -> L a -> L b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> L b -> L a
$c<$ :: forall a b. a -> L b -> L a
fmap :: (a -> b) -> L a -> L b
$cfmap :: forall a b. (a -> b) -> L a -> L b
Functor, Typeable (L a)
DataType
Constr
Typeable (L a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> L a -> c (L a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (L a))
-> (L a -> Constr)
-> (L a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (L a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (L a)))
-> ((forall b. Data b => b -> b) -> L a -> L a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r)
-> (forall u. (forall d. Data d => d -> u) -> L a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> L a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> L a -> m (L a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> L a -> m (L a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> L a -> m (L a))
-> Data (L a)
L a -> DataType
L a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (L a))
(forall b. Data b => b -> b) -> L a -> L a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> L a -> c (L a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (L a)
forall a. Data a => Typeable (L a)
forall a. Data a => L a -> DataType
forall a. Data a => L a -> Constr
forall a. Data a => (forall b. Data b => b -> b) -> L a -> L a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> L a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> L a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> L a -> m (L a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> L a -> m (L a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (L a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> L a -> c (L a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (L a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (L a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> L a -> u
forall u. (forall d. Data d => d -> u) -> L a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> L a -> m (L a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> L a -> m (L a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (L a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> L a -> c (L a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (L a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (L a))
$cL :: Constr
$tL :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> L a -> m (L a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> L a -> m (L a)
gmapMp :: (forall d. Data d => d -> m d) -> L a -> m (L a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> L a -> m (L a)
gmapM :: (forall d. Data d => d -> m d) -> L a -> m (L a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> L a -> m (L a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> L a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> L a -> u
gmapQ :: (forall d. Data d => d -> u) -> L a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> L a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> L a -> r
gmapT :: (forall b. Data b => b -> b) -> L a -> L a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> L a -> L a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (L a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (L a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (L a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (L a))
dataTypeOf :: L a -> DataType
$cdataTypeOf :: forall a. Data a => L a -> DataType
toConstr :: L a -> Constr
$ctoConstr :: forall a. Data a => L a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (L a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (L a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> L a -> c (L a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> L a -> c (L a)
$cp1Data :: forall a. Data a => Typeable (L a)
Data, Typeable)

unLoc :: L a -> a
unLoc :: L a -> a
unLoc (L Loc
_ a
a) = a
a

instance Eq x => Eq (L x) where
    (L Loc
_ x
x) == :: L x -> L x -> Bool
== (L Loc
_ x
y) = x
x x -> x -> Bool
forall a. Eq a => a -> a -> Bool
== x
y

instance Ord x => Ord (L x) where
    compare :: L x -> L x -> Ordering
compare (L Loc
_ x
x) (L Loc
_ x
y) = x -> x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare x
x x
y

instance Show x => Show (L x) where
    show :: L x -> String
show (L Loc
_ x
x) = x -> String
forall a. Show a => a -> String
show x
x

instance Located (L a) where
    locOf :: L a -> Loc
locOf (L Loc
loc a
_) = Loc
loc

instance Relocatable (L a) where
    reloc :: Loc -> L a -> L a
reloc Loc
loc (L Loc
_ a
x) = Loc -> a -> L a
forall a. Loc -> a -> L a
L Loc
loc a
x

-- | Format a position in a human-readable way, returning an ordinary
-- 'String'.
displayPos :: Pos -> String
displayPos :: Pos -> String
displayPos Pos
p = Loc -> String
displayLoc (Pos -> Pos -> Loc
Loc Pos
p Pos
p)

-- | Format a position in a human-readable way.
displaySPos :: Pos -> ShowS
displaySPos :: Pos -> ShowS
displaySPos Pos
p = Loc -> ShowS
displaySLoc (Pos -> Pos -> Loc
Loc Pos
p Pos
p)

-- | Format a location in a human-readable way, returning an ordinary
-- 'String'.
displayLoc :: Loc -> String
displayLoc :: Loc -> String
displayLoc Loc
loc = Loc -> ShowS
displaySLoc Loc
loc String
""

-- | Format a location in a human-readable way.
displaySLoc :: Loc -> ShowS
displaySLoc :: Loc -> ShowS
displaySLoc Loc
NoLoc =
    String -> ShowS
showString String
"<no location>"

displaySLoc (Loc p1 :: Pos
p1@(Pos String
src Int
line1 Int
col1 Int
_) (Pos String
_ Int
line2 Int
col2 Int
_))
  | (Int
line1, Int
col1) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
line2, Int
col2) =
      -- filename.txt:2:3
      String -> ShowS
showString String
src ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
colon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
line1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
colon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
col1
  | Int
line1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2 =
      -- filename.txt:2:3-5
      String -> ShowS
showString String
src ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ShowS
colon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
line1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ShowS
colon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
col1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ShowS
dash  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
col2
  | Bool
otherwise =
      -- filename.txt:2:3-4:5
      String -> ShowS
showString String
src ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ShowS
colon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
line1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ShowS
colon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
col1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ShowS
dash  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
line2 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ShowS
colon ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
col2
  where
    colon :: ShowS
colon = (Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
:)
    dash :: ShowS
dash  = (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
:)