{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TypeFamilies       #-}

-- (c) The University of Glasgow, 1992-2006

-- | This module contains types that relate to the positions of things
-- in source files, and allow tagging of those things with locations
module GHC.Types.SrcLoc (
        -- * SrcLoc
        RealSrcLoc,             -- Abstract
        SrcLoc(..),

        -- ** Constructing SrcLoc
        mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
        leftmostColumn,

        noSrcLoc,               -- "I'm sorry, I haven't a clue"
        generatedSrcLoc,        -- Code generated within the compiler
        interactiveSrcLoc,      -- Code from an interactive session

        advanceSrcLoc,
        advanceBufPos,

        -- ** Unsafely deconstructing SrcLoc
        -- These are dubious exports, because they crash on some inputs
        srcLocFile,             -- return the file name part
        srcLocLine,             -- return the line part
        srcLocCol,              -- return the column part

        -- * SrcSpan
        RealSrcSpan,            -- Abstract
        SrcSpan(..),
        UnhelpfulSpanReason(..),

        -- ** Constructing SrcSpan
        mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
        noSrcSpan, generatedSrcSpan, isGeneratedSrcSpan,
        wiredInSrcSpan,         -- Something wired into the compiler
        interactiveSrcSpan,
        srcLocSpan, realSrcLocSpan,
        combineSrcSpans,
        srcSpanFirstCharacter,

        -- ** Deconstructing SrcSpan
        srcSpanStart, srcSpanEnd,
        realSrcSpanStart, realSrcSpanEnd,
        srcSpanFileName_maybe,
        pprUserRealSpan, pprUnhelpfulSpanReason,
        pprUserSpan,
        unhelpfulSpanFS,
        srcSpanToRealSrcSpan,

        -- ** Unsafely deconstructing SrcSpan
        -- These are dubious exports, because they crash on some inputs
        srcSpanFile,
        srcSpanStartLine, srcSpanEndLine,
        srcSpanStartCol, srcSpanEndCol,

        -- ** Predicates on SrcSpan
        isGoodSrcSpan, isOneLineSpan, isZeroWidthSpan,
        containsSpan, isNoSrcSpan,

        -- * StringBuffer locations
        BufPos(..),
        getBufPos,
        BufSpan(..),
        getBufSpan,
        removeBufSpan,
        combineBufSpans,

        -- * Located
        Located,
        RealLocated,
        GenLocated(..),

        -- ** Constructing Located
        noLoc,
        mkGeneralLocated,

        -- ** Deconstructing Located
        getLoc, unLoc,
        unRealSrcSpan, getRealSrcSpan,
        pprLocated,
        pprLocatedAlways,

        -- ** Combining and comparing Located values
        eqLocated, cmpLocated, cmpBufSpan,
        combineLocs, addCLoc,
        leftmost_smallest, leftmost_largest, rightmost_smallest,
        spans, isSubspanOf, isRealSubspanOf,
        sortLocated, sortRealLocated,
        lookupSrcLoc, lookupSrcSpan,

        -- * Parser locations
        PsLoc(..),
        PsSpan(..),
        PsLocated,
        advancePsLoc,
        mkPsSpan,
        psSpanStart,
        psSpanEnd,
        mkSrcSpanPs,
        combineRealSrcSpans,
        psLocatedToLocated,
    ) where

import GHC.Prelude

import GHC.Utils.Misc
import GHC.Utils.Json
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
import qualified GHC.Data.Strict as Strict

import Control.DeepSeq
import Data.Data
import Data.List (sortBy, intercalate)
import Data.Function (on)
import qualified Data.Map as Map
import qualified Data.Semigroup as S

{-
************************************************************************
*                                                                      *
\subsection[SrcLoc-SrcLocations]{Source-location information}
*                                                                      *
************************************************************************

We keep information about the {\em definition} point for each entity;
this is the obvious stuff:
-}

-- | Real Source Location
--
-- Represents a single point within a file
data RealSrcLoc
  = SrcLoc      LexicalFastString       -- A precise location (file name)
                {-# UNPACK #-} !Int     -- line number, begins at 1
                {-# UNPACK #-} !Int     -- column number, begins at 1
  deriving (RealSrcLoc -> RealSrcLoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealSrcLoc -> RealSrcLoc -> Bool
$c/= :: RealSrcLoc -> RealSrcLoc -> Bool
== :: RealSrcLoc -> RealSrcLoc -> Bool
$c== :: RealSrcLoc -> RealSrcLoc -> Bool
Eq, Eq RealSrcLoc
RealSrcLoc -> RealSrcLoc -> Bool
RealSrcLoc -> RealSrcLoc -> Ordering
RealSrcLoc -> RealSrcLoc -> RealSrcLoc
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 :: RealSrcLoc -> RealSrcLoc -> RealSrcLoc
$cmin :: RealSrcLoc -> RealSrcLoc -> RealSrcLoc
max :: RealSrcLoc -> RealSrcLoc -> RealSrcLoc
$cmax :: RealSrcLoc -> RealSrcLoc -> RealSrcLoc
>= :: RealSrcLoc -> RealSrcLoc -> Bool
$c>= :: RealSrcLoc -> RealSrcLoc -> Bool
> :: RealSrcLoc -> RealSrcLoc -> Bool
$c> :: RealSrcLoc -> RealSrcLoc -> Bool
<= :: RealSrcLoc -> RealSrcLoc -> Bool
$c<= :: RealSrcLoc -> RealSrcLoc -> Bool
< :: RealSrcLoc -> RealSrcLoc -> Bool
$c< :: RealSrcLoc -> RealSrcLoc -> Bool
compare :: RealSrcLoc -> RealSrcLoc -> Ordering
$ccompare :: RealSrcLoc -> RealSrcLoc -> Ordering
Ord)

-- | 0-based offset identifying the raw location in the 'StringBuffer'.
--
-- The lexer increments the 'BufPos' every time a character (UTF-8 code point)
-- is read from the input buffer. As UTF-8 is a variable-length encoding and
-- 'StringBuffer' needs a byte offset for indexing, a 'BufPos' cannot be used
-- for indexing.
--
-- The parser guarantees that 'BufPos' are monotonic. See #17632. This means
-- that syntactic constructs that appear later in the 'StringBuffer' are guaranteed to
-- have a higher 'BufPos'. Contrast that with 'RealSrcLoc', which does *not* make the
-- analogous guarantee about higher line/column numbers.
--
-- This is due to #line and {-# LINE ... #-} pragmas that can arbitrarily
-- modify 'RealSrcLoc'. Notice how 'setSrcLoc' and 'resetAlrLastLoc' in
-- "GHC.Parser.Lexer" update 'PsLoc', modifying 'RealSrcLoc' but preserving
-- 'BufPos'.
--
-- Monotonicity makes 'BufPos' useful to determine the order in which syntactic
-- elements appear in the source. Consider this example (haddockA041 in the test suite):
--
--  haddockA041.hs
--      {-# LANGUAGE CPP #-}
--      -- | Module header documentation
--      module Comments_and_CPP_include where
--      #include "IncludeMe.hs"
--
--  IncludeMe.hs:
--      -- | Comment on T
--      data T = MkT -- ^ Comment on MkT
--
-- After the C preprocessor runs, the 'StringBuffer' will contain a program that
-- looks like this (unimportant lines at the beginning removed):
--
--    # 1 "haddockA041.hs"
--    {-# LANGUAGE CPP #-}
--    -- | Module header documentation
--    module Comments_and_CPP_include where
--    # 1 "IncludeMe.hs" 1
--    -- | Comment on T
--    data T = MkT -- ^ Comment on MkT
--    # 7 "haddockA041.hs" 2
--
-- The line pragmas inserted by CPP make the error messages more informative.
-- The downside is that we can't use RealSrcLoc to determine the ordering of
-- syntactic elements.
--
-- With RealSrcLoc, we have the following location information recorded in the AST:
--   * The module name is located at haddockA041.hs:3:8-31
--   * The Haddock comment "Comment on T" is located at IncludeMe:1:1-17
--   * The data declaration is located at IncludeMe.hs:2:1-32
--
-- Is the Haddock comment located between the module name and the data
-- declaration? This is impossible to tell because the locations are not
-- comparable; they even refer to different files.
--
-- On the other hand, with 'BufPos', we have the following location information:
--   * The module name is located at 846-870
--   * The Haddock comment "Comment on T" is located at 898-915
--   * The data declaration is located at 916-928
--
-- Aside:  if you're wondering why the numbers are so high, try running
--           @ghc -E haddockA041.hs@
--         and see the extra fluff that CPP inserts at the start of the file.
--
-- For error messages, 'BufPos' is not useful at all. On the other hand, this is
-- exactly what we need to determine the order of syntactic elements:
--    870 < 898, therefore the Haddock comment appears *after* the module name.
--    915 < 916, therefore the Haddock comment appears *before* the data declaration.
--
-- We use 'BufPos' in in GHC.Parser.PostProcess.Haddock to associate Haddock
-- comments with parts of the AST using location information (#17544).
newtype BufPos = BufPos { BufPos -> Int
bufPos :: Int }
  deriving (BufPos -> BufPos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufPos -> BufPos -> Bool
$c/= :: BufPos -> BufPos -> Bool
== :: BufPos -> BufPos -> Bool
$c== :: BufPos -> BufPos -> Bool
Eq, Eq BufPos
BufPos -> BufPos -> Bool
BufPos -> BufPos -> Ordering
BufPos -> BufPos -> BufPos
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 :: BufPos -> BufPos -> BufPos
$cmin :: BufPos -> BufPos -> BufPos
max :: BufPos -> BufPos -> BufPos
$cmax :: BufPos -> BufPos -> BufPos
>= :: BufPos -> BufPos -> Bool
$c>= :: BufPos -> BufPos -> Bool
> :: BufPos -> BufPos -> Bool
$c> :: BufPos -> BufPos -> Bool
<= :: BufPos -> BufPos -> Bool
$c<= :: BufPos -> BufPos -> Bool
< :: BufPos -> BufPos -> Bool
$c< :: BufPos -> BufPos -> Bool
compare :: BufPos -> BufPos -> Ordering
$ccompare :: BufPos -> BufPos -> Ordering
Ord, Int -> BufPos -> ShowS
[BufPos] -> ShowS
BufPos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufPos] -> ShowS
$cshowList :: [BufPos] -> ShowS
show :: BufPos -> String
$cshow :: BufPos -> String
showsPrec :: Int -> BufPos -> ShowS
$cshowsPrec :: Int -> BufPos -> ShowS
Show, Typeable BufPos
BufPos -> DataType
BufPos -> Constr
(forall b. Data b => b -> b) -> BufPos -> BufPos
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) -> BufPos -> u
forall u. (forall d. Data d => d -> u) -> BufPos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BufPos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BufPos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BufPos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BufPos -> c BufPos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BufPos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BufPos)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BufPos -> m BufPos
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BufPos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BufPos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BufPos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BufPos -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BufPos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BufPos -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BufPos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BufPos -> r
gmapT :: (forall b. Data b => b -> b) -> BufPos -> BufPos
$cgmapT :: (forall b. Data b => b -> b) -> BufPos -> BufPos
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BufPos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BufPos)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BufPos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BufPos)
dataTypeOf :: BufPos -> DataType
$cdataTypeOf :: BufPos -> DataType
toConstr :: BufPos -> Constr
$ctoConstr :: BufPos -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BufPos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BufPos
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BufPos -> c BufPos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BufPos -> c BufPos
Data)

-- | Source Location
data SrcLoc
  = RealSrcLoc !RealSrcLoc !(Strict.Maybe BufPos)  -- See Note [Why Maybe BufPos]
  | UnhelpfulLoc !FastString     -- Just a general indication
  deriving (SrcLoc -> SrcLoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcLoc -> SrcLoc -> Bool
$c/= :: SrcLoc -> SrcLoc -> Bool
== :: SrcLoc -> SrcLoc -> Bool
$c== :: SrcLoc -> SrcLoc -> Bool
Eq, Int -> SrcLoc -> ShowS
[SrcLoc] -> ShowS
SrcLoc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcLoc] -> ShowS
$cshowList :: [SrcLoc] -> ShowS
show :: SrcLoc -> String
$cshow :: SrcLoc -> String
showsPrec :: Int -> SrcLoc -> ShowS
$cshowsPrec :: Int -> SrcLoc -> ShowS
Show)

{-
************************************************************************
*                                                                      *
\subsection[SrcLoc-access-fns]{Access functions}
*                                                                      *
************************************************************************
-}

mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
mkSrcLoc FastString
x Int
line Int
col = RealSrcLoc -> Maybe BufPos -> SrcLoc
RealSrcLoc (FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
x Int
line Int
col) forall a. Maybe a
Strict.Nothing

mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
x Int
line Int
col = LexicalFastString -> Int -> Int -> RealSrcLoc
SrcLoc (FastString -> LexicalFastString
LexicalFastString FastString
x) Int
line Int
col

-- | Indentation level is 1-indexed, so the leftmost column is 1.
leftmostColumn :: Int
leftmostColumn :: Int
leftmostColumn = Int
1

getBufPos :: SrcLoc -> Strict.Maybe BufPos
getBufPos :: SrcLoc -> Maybe BufPos
getBufPos (RealSrcLoc RealSrcLoc
_ Maybe BufPos
mbpos) = Maybe BufPos
mbpos
getBufPos (UnhelpfulLoc FastString
_) = forall a. Maybe a
Strict.Nothing

-- | Built-in "bad" 'SrcLoc' values for particular locations
noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
noSrcLoc :: SrcLoc
noSrcLoc          = FastString -> SrcLoc
UnhelpfulLoc (String -> FastString
fsLit String
"<no location info>")
generatedSrcLoc :: SrcLoc
generatedSrcLoc   = FastString -> SrcLoc
UnhelpfulLoc (String -> FastString
fsLit String
"<compiler-generated code>")
interactiveSrcLoc :: SrcLoc
interactiveSrcLoc = FastString -> SrcLoc
UnhelpfulLoc (String -> FastString
fsLit String
"<interactive>")

-- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
mkGeneralSrcLoc :: FastString -> SrcLoc
mkGeneralSrcLoc :: FastString -> SrcLoc
mkGeneralSrcLoc = FastString -> SrcLoc
UnhelpfulLoc

-- | Gives the filename of the 'RealSrcLoc'
srcLocFile :: RealSrcLoc -> FastString
srcLocFile :: RealSrcLoc -> FastString
srcLocFile (SrcLoc (LexicalFastString FastString
fname) Int
_ Int
_) = FastString
fname

-- | Raises an error when used on a "bad" 'SrcLoc'
srcLocLine :: RealSrcLoc -> Int
srcLocLine :: RealSrcLoc -> Int
srcLocLine (SrcLoc LexicalFastString
_ Int
l Int
_) = Int
l

-- | Raises an error when used on a "bad" 'SrcLoc'
srcLocCol :: RealSrcLoc -> Int
srcLocCol :: RealSrcLoc -> Int
srcLocCol (SrcLoc LexicalFastString
_ Int
_ Int
c) = Int
c

-- | Move the 'SrcLoc' down by one line if the character is a newline,
-- to the next 8-char tabstop if it is a tab, and across by one
-- character in any other case
advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
advanceSrcLoc (SrcLoc LexicalFastString
f Int
l Int
_) Char
'\n' = LexicalFastString -> Int -> Int -> RealSrcLoc
SrcLoc LexicalFastString
f  (Int
l forall a. Num a => a -> a -> a
+ Int
1) Int
1
advanceSrcLoc (SrcLoc LexicalFastString
f Int
l Int
c) Char
'\t' = LexicalFastString -> Int -> Int -> RealSrcLoc
SrcLoc LexicalFastString
f  Int
l (Int -> Int
advance_tabstop Int
c)
advanceSrcLoc (SrcLoc LexicalFastString
f Int
l Int
c) Char
_    = LexicalFastString -> Int -> Int -> RealSrcLoc
SrcLoc LexicalFastString
f  Int
l (Int
c forall a. Num a => a -> a -> a
+ Int
1)

advance_tabstop :: Int -> Int
advance_tabstop :: Int -> Int
advance_tabstop Int
c = ((((Int
c forall a. Num a => a -> a -> a
- Int
1) forall a. Bits a => a -> Int -> a
`shiftR` Int
3) forall a. Num a => a -> a -> a
+ Int
1) forall a. Bits a => a -> Int -> a
`shiftL` Int
3) forall a. Num a => a -> a -> a
+ Int
1

advanceBufPos :: BufPos -> BufPos
advanceBufPos :: BufPos -> BufPos
advanceBufPos (BufPos Int
i) = Int -> BufPos
BufPos (Int
iforall a. Num a => a -> a -> a
+Int
1)

{-
************************************************************************
*                                                                      *
\subsection[SrcLoc-instances]{Instance declarations for various names}
*                                                                      *
************************************************************************
-}

sortLocated :: [Located a] -> [Located a]
sortLocated :: forall a. [Located a] -> [Located a]
sortLocated = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall l e. GenLocated l e -> l
getLoc)

sortRealLocated :: [RealLocated a] -> [RealLocated a]
sortRealLocated :: forall a. [RealLocated a] -> [RealLocated a]
sortRealLocated = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall l e. GenLocated l e -> l
getLoc)

lookupSrcLoc :: SrcLoc -> Map.Map RealSrcLoc a -> Maybe a
lookupSrcLoc :: forall a. SrcLoc -> Map RealSrcLoc a -> Maybe a
lookupSrcLoc (RealSrcLoc RealSrcLoc
l Maybe BufPos
_) = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RealSrcLoc
l
lookupSrcLoc (UnhelpfulLoc FastString
_) = forall a b. a -> b -> a
const forall a. Maybe a
Nothing

lookupSrcSpan :: SrcSpan -> Map.Map RealSrcSpan a -> Maybe a
lookupSrcSpan :: forall a. SrcSpan -> Map RealSrcSpan a -> Maybe a
lookupSrcSpan (RealSrcSpan RealSrcSpan
l Maybe BufSpan
_) = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RealSrcSpan
l
lookupSrcSpan (UnhelpfulSpan UnhelpfulSpanReason
_) = forall a b. a -> b -> a
const forall a. Maybe a
Nothing

instance Outputable RealSrcLoc where
    ppr :: RealSrcLoc -> SDoc
ppr (SrcLoc (LexicalFastString FastString
src_path) Int
src_line Int
src_col)
      = forall doc. IsLine doc => [doc] -> doc
hcat [ FastString -> SDoc
pprFastFilePath FastString
src_path forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
             , forall doc. IsLine doc => Int -> doc
int Int
src_line forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
             , forall doc. IsLine doc => Int -> doc
int Int
src_col ]

-- I don't know why there is this style-based difference
--        if userStyle sty || debugStyle sty then
--            hcat [ pprFastFilePath src_path, char ':',
--                   int src_line,
--                   char ':', int src_col
--                 ]
--        else
--            hcat [text "{-# LINE ", int src_line, space,
--                  char '\"', pprFastFilePath src_path, text " #-}"]

instance Outputable SrcLoc where
    ppr :: SrcLoc -> SDoc
ppr (RealSrcLoc RealSrcLoc
l Maybe BufPos
_) = forall a. Outputable a => a -> SDoc
ppr RealSrcLoc
l
    ppr (UnhelpfulLoc FastString
s)  = forall doc. IsLine doc => FastString -> doc
ftext FastString
s

instance Data RealSrcSpan where
  -- don't traverse?
  toConstr :: RealSrcSpan -> Constr
toConstr RealSrcSpan
_   = String -> Constr
abstractConstr String
"RealSrcSpan"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RealSrcSpan
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: RealSrcSpan -> DataType
dataTypeOf RealSrcSpan
_ = String -> DataType
mkNoRepType String
"RealSrcSpan"

instance Data SrcSpan where
  -- don't traverse?
  toConstr :: SrcSpan -> Constr
toConstr SrcSpan
_   = String -> Constr
abstractConstr String
"SrcSpan"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcSpan
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: SrcSpan -> DataType
dataTypeOf SrcSpan
_ = String -> DataType
mkNoRepType String
"SrcSpan"

{-
************************************************************************
*                                                                      *
\subsection[SrcSpan]{Source Spans}
*                                                                      *
************************************************************************
-}

{- |
A 'RealSrcSpan' delimits a portion of a text file.  It could be represented
by a pair of (line,column) coordinates, but in fact we optimise
slightly by using more compact representations for single-line and
zero-length spans, both of which are quite common.

The end position is defined to be the column /after/ the end of the
span.  That is, a span of (1,1)-(1,2) is one character long, and a
span of (1,1)-(1,1) is zero characters long.
-}

-- | Real Source Span
data RealSrcSpan
  = RealSrcSpan'
        { RealSrcSpan -> FastString
srcSpanFile     :: !FastString,
          RealSrcSpan -> Int
srcSpanSLine    :: {-# UNPACK #-} !Int,
          RealSrcSpan -> Int
srcSpanSCol     :: {-# UNPACK #-} !Int,
          RealSrcSpan -> Int
srcSpanELine    :: {-# UNPACK #-} !Int,
          RealSrcSpan -> Int
srcSpanECol     :: {-# UNPACK #-} !Int
        }
  deriving RealSrcSpan -> RealSrcSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealSrcSpan -> RealSrcSpan -> Bool
$c/= :: RealSrcSpan -> RealSrcSpan -> Bool
== :: RealSrcSpan -> RealSrcSpan -> Bool
$c== :: RealSrcSpan -> RealSrcSpan -> Bool
Eq

-- | StringBuffer Source Span
data BufSpan =
  BufSpan { BufSpan -> BufPos
bufSpanStart, BufSpan -> BufPos
bufSpanEnd :: {-# UNPACK #-} !BufPos }
  deriving (BufSpan -> BufSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BufSpan -> BufSpan -> Bool
$c/= :: BufSpan -> BufSpan -> Bool
== :: BufSpan -> BufSpan -> Bool
$c== :: BufSpan -> BufSpan -> Bool
Eq, Eq BufSpan
BufSpan -> BufSpan -> Bool
BufSpan -> BufSpan -> Ordering
BufSpan -> BufSpan -> BufSpan
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 :: BufSpan -> BufSpan -> BufSpan
$cmin :: BufSpan -> BufSpan -> BufSpan
max :: BufSpan -> BufSpan -> BufSpan
$cmax :: BufSpan -> BufSpan -> BufSpan
>= :: BufSpan -> BufSpan -> Bool
$c>= :: BufSpan -> BufSpan -> Bool
> :: BufSpan -> BufSpan -> Bool
$c> :: BufSpan -> BufSpan -> Bool
<= :: BufSpan -> BufSpan -> Bool
$c<= :: BufSpan -> BufSpan -> Bool
< :: BufSpan -> BufSpan -> Bool
$c< :: BufSpan -> BufSpan -> Bool
compare :: BufSpan -> BufSpan -> Ordering
$ccompare :: BufSpan -> BufSpan -> Ordering
Ord, Int -> BufSpan -> ShowS
[BufSpan] -> ShowS
BufSpan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BufSpan] -> ShowS
$cshowList :: [BufSpan] -> ShowS
show :: BufSpan -> String
$cshow :: BufSpan -> String
showsPrec :: Int -> BufSpan -> ShowS
$cshowsPrec :: Int -> BufSpan -> ShowS
Show, Typeable BufSpan
BufSpan -> DataType
BufSpan -> Constr
(forall b. Data b => b -> b) -> BufSpan -> BufSpan
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) -> BufSpan -> u
forall u. (forall d. Data d => d -> u) -> BufSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BufSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BufSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BufSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BufSpan -> c BufSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BufSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BufSpan)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BufSpan -> m BufSpan
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BufSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BufSpan -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BufSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BufSpan -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BufSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BufSpan -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BufSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BufSpan -> r
gmapT :: (forall b. Data b => b -> b) -> BufSpan -> BufSpan
$cgmapT :: (forall b. Data b => b -> b) -> BufSpan -> BufSpan
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BufSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BufSpan)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BufSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BufSpan)
dataTypeOf :: BufSpan -> DataType
$cdataTypeOf :: BufSpan -> DataType
toConstr :: BufSpan -> Constr
$ctoConstr :: BufSpan -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BufSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BufSpan
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BufSpan -> c BufSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BufSpan -> c BufSpan
Data)

instance Semigroup BufSpan where
  BufSpan BufPos
start1 BufPos
end1 <> :: BufSpan -> BufSpan -> BufSpan
<> BufSpan BufPos
start2 BufPos
end2 =
    BufPos -> BufPos -> BufSpan
BufSpan (forall a. Ord a => a -> a -> a
min BufPos
start1 BufPos
start2) (forall a. Ord a => a -> a -> a
max BufPos
end1 BufPos
end2)

-- | Source Span
--
-- A 'SrcSpan' identifies either a specific portion of a text file
-- or a human-readable description of a location.
data SrcSpan =
    RealSrcSpan !RealSrcSpan !(Strict.Maybe BufSpan)  -- See Note [Why Maybe BufPos]
  | UnhelpfulSpan !UnhelpfulSpanReason

  deriving (SrcSpan -> SrcSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcSpan -> SrcSpan -> Bool
$c/= :: SrcSpan -> SrcSpan -> Bool
== :: SrcSpan -> SrcSpan -> Bool
$c== :: SrcSpan -> SrcSpan -> Bool
Eq, Int -> SrcSpan -> ShowS
[SrcSpan] -> ShowS
SrcSpan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcSpan] -> ShowS
$cshowList :: [SrcSpan] -> ShowS
show :: SrcSpan -> String
$cshow :: SrcSpan -> String
showsPrec :: Int -> SrcSpan -> ShowS
$cshowsPrec :: Int -> SrcSpan -> ShowS
Show) -- Show is used by GHC.Parser.Lexer, because we
                      -- derive Show for Token

data UnhelpfulSpanReason
  = UnhelpfulNoLocationInfo
  | UnhelpfulWiredIn
  | UnhelpfulInteractive
  | UnhelpfulGenerated
  | UnhelpfulOther !FastString
  deriving (UnhelpfulSpanReason -> UnhelpfulSpanReason -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnhelpfulSpanReason -> UnhelpfulSpanReason -> Bool
$c/= :: UnhelpfulSpanReason -> UnhelpfulSpanReason -> Bool
== :: UnhelpfulSpanReason -> UnhelpfulSpanReason -> Bool
$c== :: UnhelpfulSpanReason -> UnhelpfulSpanReason -> Bool
Eq, Int -> UnhelpfulSpanReason -> ShowS
[UnhelpfulSpanReason] -> ShowS
UnhelpfulSpanReason -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnhelpfulSpanReason] -> ShowS
$cshowList :: [UnhelpfulSpanReason] -> ShowS
show :: UnhelpfulSpanReason -> String
$cshow :: UnhelpfulSpanReason -> String
showsPrec :: Int -> UnhelpfulSpanReason -> ShowS
$cshowsPrec :: Int -> UnhelpfulSpanReason -> ShowS
Show)

removeBufSpan :: SrcSpan -> SrcSpan
removeBufSpan :: SrcSpan -> SrcSpan
removeBufSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
s forall a. Maybe a
Strict.Nothing
removeBufSpan SrcSpan
s = SrcSpan
s

{- Note [Why Maybe BufPos]
~~~~~~~~~~~~~~~~~~~~~~~~~~
In SrcLoc we store (Maybe BufPos); in SrcSpan we store (Maybe BufSpan).
Why the Maybe?

Surely, the lexer can always fill in the buffer position, and it guarantees to do so.
However, sometimes the SrcLoc/SrcSpan is constructed in a different context
where the buffer location is not available, and then we use Nothing instead of
a fake value like BufPos (-1).

Perhaps the compiler could be re-engineered to pass around BufPos more
carefully and never discard it, and this 'Maybe' could be removed. If you're
interested in doing so, you may find this ripgrep query useful:

  rg "RealSrc(Loc|Span).*?Nothing"

For example, it is not uncommon to whip up source locations for e.g. error
messages, constructing a SrcSpan without a BufSpan.
-}

instance ToJson SrcSpan where
  json :: SrcSpan -> JsonDoc
json (UnhelpfulSpan {} ) = JsonDoc
JSNull --JSObject [( "type", "unhelpful")]
  json (RealSrcSpan RealSrcSpan
rss Maybe BufSpan
_) = forall a. ToJson a => a -> JsonDoc
json RealSrcSpan
rss

instance ToJson RealSrcSpan where
  json :: RealSrcSpan -> JsonDoc
json (RealSrcSpan'{Int
FastString
srcSpanECol :: Int
srcSpanELine :: Int
srcSpanSCol :: Int
srcSpanSLine :: Int
srcSpanFile :: FastString
srcSpanECol :: RealSrcSpan -> Int
srcSpanELine :: RealSrcSpan -> Int
srcSpanSCol :: RealSrcSpan -> Int
srcSpanSLine :: RealSrcSpan -> Int
srcSpanFile :: RealSrcSpan -> FastString
..}) = [(String, JsonDoc)] -> JsonDoc
JSObject [ (String
"file", String -> JsonDoc
JSString (FastString -> String
unpackFS FastString
srcSpanFile))
                                     , (String
"startLine", Int -> JsonDoc
JSInt Int
srcSpanSLine)
                                     , (String
"startCol", Int -> JsonDoc
JSInt Int
srcSpanSCol)
                                     , (String
"endLine", Int -> JsonDoc
JSInt Int
srcSpanELine)
                                     , (String
"endCol", Int -> JsonDoc
JSInt Int
srcSpanECol)
                                     ]

instance NFData SrcSpan where
  rnf :: SrcSpan -> ()
rnf SrcSpan
x = SrcSpan
x seq :: forall a b. a -> b -> b
`seq` ()

getBufSpan :: SrcSpan -> Strict.Maybe BufSpan
getBufSpan :: SrcSpan -> Maybe BufSpan
getBufSpan (RealSrcSpan RealSrcSpan
_ Maybe BufSpan
mbspan) = Maybe BufSpan
mbspan
getBufSpan (UnhelpfulSpan UnhelpfulSpanReason
_) = forall a. Maybe a
Strict.Nothing

-- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
noSrcSpan, generatedSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan
noSrcSpan :: SrcSpan
noSrcSpan          = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulNoLocationInfo
wiredInSrcSpan :: SrcSpan
wiredInSrcSpan     = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulWiredIn
interactiveSrcSpan :: SrcSpan
interactiveSrcSpan = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulInteractive
generatedSrcSpan :: SrcSpan
generatedSrcSpan   = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulGenerated

isGeneratedSrcSpan :: SrcSpan -> Bool
isGeneratedSrcSpan :: SrcSpan -> Bool
isGeneratedSrcSpan (UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulGenerated) = Bool
True
isGeneratedSrcSpan SrcSpan
_                                  = Bool
False

isNoSrcSpan :: SrcSpan -> Bool
isNoSrcSpan :: SrcSpan -> Bool
isNoSrcSpan (UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulNoLocationInfo) = Bool
True
isNoSrcSpan SrcSpan
_                                       = Bool
False

-- | Create a "bad" 'SrcSpan' that has not location information
mkGeneralSrcSpan :: FastString -> SrcSpan
mkGeneralSrcSpan :: FastString -> SrcSpan
mkGeneralSrcSpan = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> UnhelpfulSpanReason
UnhelpfulOther

-- | Create a 'SrcSpan' corresponding to a single point
srcLocSpan :: SrcLoc -> SrcSpan
srcLocSpan :: SrcLoc -> SrcSpan
srcLocSpan (UnhelpfulLoc FastString
str) = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan (FastString -> UnhelpfulSpanReason
UnhelpfulOther FastString
str)
srcLocSpan (RealSrcLoc RealSrcLoc
l Maybe BufPos
mb) = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (RealSrcLoc -> RealSrcSpan
realSrcLocSpan RealSrcLoc
l) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\BufPos
b -> BufPos -> BufPos -> BufSpan
BufSpan BufPos
b BufPos
b) Maybe BufPos
mb)

realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
realSrcLocSpan (SrcLoc (LexicalFastString FastString
file) Int
line Int
col) = FastString -> Int -> Int -> Int -> Int -> RealSrcSpan
RealSrcSpan' FastString
file Int
line Int
col Int
line Int
col

-- | Create a 'SrcSpan' between two points in a file
mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
loc1 RealSrcLoc
loc2 = FastString -> Int -> Int -> Int -> Int -> RealSrcSpan
RealSrcSpan' FastString
file Int
line1 Int
col1 Int
line2 Int
col2
  where
        line1 :: Int
line1 = RealSrcLoc -> Int
srcLocLine RealSrcLoc
loc1
        line2 :: Int
line2 = RealSrcLoc -> Int
srcLocLine RealSrcLoc
loc2
        col1 :: Int
col1 = RealSrcLoc -> Int
srcLocCol RealSrcLoc
loc1
        col2 :: Int
col2 = RealSrcLoc -> Int
srcLocCol RealSrcLoc
loc2
        file :: FastString
file = RealSrcLoc -> FastString
srcLocFile RealSrcLoc
loc1

-- | 'True' if the span is known to straddle only one line.
isOneLineRealSpan :: RealSrcSpan -> Bool
isOneLineRealSpan :: RealSrcSpan -> Bool
isOneLineRealSpan (RealSrcSpan' FastString
_ Int
line1 Int
_ Int
line2 Int
_)
  = Int
line1 forall a. Eq a => a -> a -> Bool
== Int
line2

-- | 'True' if the span is a single point
isPointRealSpan :: RealSrcSpan -> Bool
isPointRealSpan :: RealSrcSpan -> Bool
isPointRealSpan (RealSrcSpan' FastString
_ Int
line1 Int
col1 Int
line2 Int
col2)
  = Int
line1 forall a. Eq a => a -> a -> Bool
== Int
line2 Bool -> Bool -> Bool
&& Int
col1 forall a. Eq a => a -> a -> Bool
== Int
col2

-- | Create a 'SrcSpan' between two points in a file
mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (UnhelpfulLoc FastString
str) SrcLoc
_ = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan (FastString -> UnhelpfulSpanReason
UnhelpfulOther FastString
str)
mkSrcSpan SrcLoc
_ (UnhelpfulLoc FastString
str) = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan (FastString -> UnhelpfulSpanReason
UnhelpfulOther FastString
str)
mkSrcSpan (RealSrcLoc RealSrcLoc
loc1 Maybe BufPos
mbpos1) (RealSrcLoc RealSrcLoc
loc2 Maybe BufPos
mbpos2)
    = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
loc1 RealSrcLoc
loc2) (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 BufPos -> BufPos -> BufSpan
BufSpan Maybe BufPos
mbpos1 Maybe BufPos
mbpos2)

-- | Combines two 'SrcSpan' into one that spans at least all the characters
-- within both spans. Returns UnhelpfulSpan if the files differ.
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (UnhelpfulSpan UnhelpfulSpanReason
_) SrcSpan
r = SrcSpan
r -- this seems more useful
combineSrcSpans SrcSpan
l (UnhelpfulSpan UnhelpfulSpanReason
_) = SrcSpan
l
combineSrcSpans (RealSrcSpan RealSrcSpan
span1 Maybe BufSpan
mbspan1) (RealSrcSpan RealSrcSpan
span2 Maybe BufSpan
mbspan2)
  | RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
span1 forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
span2
      = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans RealSrcSpan
span1 RealSrcSpan
span2) (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 BufSpan -> BufSpan -> BufSpan
combineBufSpans Maybe BufSpan
mbspan1 Maybe BufSpan
mbspan2)
  | Bool
otherwise = UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan forall a b. (a -> b) -> a -> b
$
      FastString -> UnhelpfulSpanReason
UnhelpfulOther (String -> FastString
fsLit String
"<combineSrcSpans: files differ>")

-- | Combines two 'SrcSpan' into one that spans at least all the characters
-- within both spans. Assumes the "file" part is the same in both inputs
combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans RealSrcSpan
span1 RealSrcSpan
span2
  = FastString -> Int -> Int -> Int -> Int -> RealSrcSpan
RealSrcSpan' FastString
file Int
line_start Int
col_start Int
line_end Int
col_end
  where
    (Int
line_start, Int
col_start) = forall a. Ord a => a -> a -> a
min (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
span1, RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
span1)
                                  (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
span2, RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
span2)
    (Int
line_end, Int
col_end)     = forall a. Ord a => a -> a -> a
max (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
span1, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
span1)
                                  (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
span2, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
span2)
    file :: FastString
file = RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
span1

combineBufSpans :: BufSpan -> BufSpan -> BufSpan
combineBufSpans :: BufSpan -> BufSpan -> BufSpan
combineBufSpans BufSpan
span1 BufSpan
span2 = BufPos -> BufPos -> BufSpan
BufSpan BufPos
start BufPos
end
  where
    start :: BufPos
start = forall a. Ord a => a -> a -> a
min (BufSpan -> BufPos
bufSpanStart BufSpan
span1) (BufSpan -> BufPos
bufSpanStart BufSpan
span2)
    end :: BufPos
end   = forall a. Ord a => a -> a -> a
max (BufSpan -> BufPos
bufSpanEnd   BufSpan
span1) (BufSpan -> BufPos
bufSpanEnd   BufSpan
span2)


-- | Convert a SrcSpan into one that represents only its first character
srcSpanFirstCharacter :: SrcSpan -> SrcSpan
srcSpanFirstCharacter :: SrcSpan -> SrcSpan
srcSpanFirstCharacter l :: SrcSpan
l@(UnhelpfulSpan {}) = SrcSpan
l
srcSpanFirstCharacter (RealSrcSpan RealSrcSpan
span Maybe BufSpan
mbspan) =
    RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
loc1 RealSrcLoc
loc2) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BufSpan -> BufSpan
mkBufSpan Maybe BufSpan
mbspan)
  where
    loc1 :: RealSrcLoc
loc1@(SrcLoc LexicalFastString
f Int
l Int
c) = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
span
    loc2 :: RealSrcLoc
loc2 = LexicalFastString -> Int -> Int -> RealSrcLoc
SrcLoc LexicalFastString
f Int
l (Int
cforall a. Num a => a -> a -> a
+Int
1)
    mkBufSpan :: BufSpan -> BufSpan
mkBufSpan BufSpan
bspan =
      let bpos1 :: BufPos
bpos1@(BufPos Int
i) = BufSpan -> BufPos
bufSpanStart BufSpan
bspan
          bpos2 :: BufPos
bpos2 = Int -> BufPos
BufPos (Int
iforall a. Num a => a -> a -> a
+Int
1)
      in BufPos -> BufPos -> BufSpan
BufSpan BufPos
bpos1 BufPos
bpos2

{-
************************************************************************
*                                                                      *
\subsection[SrcSpan-predicates]{Predicates}
*                                                                      *
************************************************************************
-}

-- | Test if a 'SrcSpan' is "good", i.e. has precise location information
isGoodSrcSpan :: SrcSpan -> Bool
isGoodSrcSpan :: SrcSpan -> Bool
isGoodSrcSpan (RealSrcSpan RealSrcSpan
_ Maybe BufSpan
_) = Bool
True
isGoodSrcSpan (UnhelpfulSpan UnhelpfulSpanReason
_) = Bool
False

isOneLineSpan :: SrcSpan -> Bool
-- ^ True if the span is known to straddle only one line.
-- For "bad" 'SrcSpan', it returns False
isOneLineSpan :: SrcSpan -> Bool
isOneLineSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s
isOneLineSpan (UnhelpfulSpan UnhelpfulSpanReason
_) = Bool
False

isZeroWidthSpan :: SrcSpan -> Bool
-- ^ True if the span has a width of zero, as returned for "virtual"
-- semicolons in the lexer.
-- For "bad" 'SrcSpan', it returns False
isZeroWidthSpan :: SrcSpan -> Bool
isZeroWidthSpan (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s
                                 Bool -> Bool -> Bool
&& RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
s forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
s
isZeroWidthSpan (UnhelpfulSpan UnhelpfulSpanReason
_) = Bool
False

-- | Tests whether the first span "contains" the other span, meaning
-- that it covers at least as much source code. True where spans are equal.
containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool
containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool
containsSpan RealSrcSpan
s1 RealSrcSpan
s2
  = (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s1, RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
s1)
       forall a. Ord a => a -> a -> Bool
<= (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s2, RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
s2)
    Bool -> Bool -> Bool
&& (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s1, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
s1)
       forall a. Ord a => a -> a -> Bool
>= (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s2, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
s2)
    Bool -> Bool -> Bool
&& (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s1 forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s2)
    -- We check file equality last because it is (presumably?) least
    -- likely to fail.
{-
%************************************************************************
%*                                                                      *
\subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
*                                                                      *
************************************************************************
-}

srcSpanStartLine :: RealSrcSpan -> Int
srcSpanEndLine :: RealSrcSpan -> Int
srcSpanStartCol :: RealSrcSpan -> Int
srcSpanEndCol :: RealSrcSpan -> Int

srcSpanStartLine :: RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan'{ srcSpanSLine :: RealSrcSpan -> Int
srcSpanSLine=Int
l } = Int
l
srcSpanEndLine :: RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan'{ srcSpanELine :: RealSrcSpan -> Int
srcSpanELine=Int
l } = Int
l
srcSpanStartCol :: RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan'{ srcSpanSCol :: RealSrcSpan -> Int
srcSpanSCol=Int
l } = Int
l
srcSpanEndCol :: RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan'{ srcSpanECol :: RealSrcSpan -> Int
srcSpanECol=Int
c } = Int
c

{-
************************************************************************
*                                                                      *
\subsection[SrcSpan-access-fns]{Access functions}
*                                                                      *
************************************************************************
-}

-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan UnhelpfulSpanReason
r) = FastString -> SrcLoc
UnhelpfulLoc (UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
r)
srcSpanStart (RealSrcSpan RealSrcSpan
s Maybe BufSpan
b) = RealSrcLoc -> Maybe BufPos -> SrcLoc
RealSrcLoc (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BufSpan -> BufPos
bufSpanStart Maybe BufSpan
b)

-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan UnhelpfulSpanReason
r) = FastString -> SrcLoc
UnhelpfulLoc (UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
r)
srcSpanEnd (RealSrcSpan RealSrcSpan
s Maybe BufSpan
b) = RealSrcLoc -> Maybe BufPos -> SrcLoc
RealSrcLoc (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BufSpan -> BufPos
bufSpanEnd Maybe BufSpan
b)

realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s)
                                  (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s)
                                  (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
s)

realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
s = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s)
                                (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s)
                                (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
s)

-- | Obtains the filename for a 'SrcSpan' if it is "good"
srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
srcSpanFileName_maybe (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) = forall a. a -> Maybe a
Just (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s)
srcSpanFileName_maybe (UnhelpfulSpan UnhelpfulSpanReason
_) = forall a. Maybe a
Nothing

srcSpanToRealSrcSpan :: SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan :: SrcSpan -> Maybe RealSrcSpan
srcSpanToRealSrcSpan (RealSrcSpan RealSrcSpan
ss Maybe BufSpan
_) = forall a. a -> Maybe a
Just RealSrcSpan
ss
srcSpanToRealSrcSpan SrcSpan
_ = forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
\subsection[SrcSpan-instances]{Instances}
*                                                                      *
************************************************************************
-}

-- We want to order RealSrcSpans first by the start point, then by the
-- end point.
instance Ord RealSrcSpan where
  compare :: RealSrcSpan -> RealSrcSpan -> Ordering
compare = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Ord a => a -> a -> Ordering
compare RealSrcSpan -> RealSrcLoc
realSrcSpanStart forall a. Semigroup a => a -> a -> a
S.<> forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Ord a => a -> a -> Ordering
compare RealSrcSpan -> RealSrcLoc
realSrcSpanEnd

instance Show RealSrcLoc where
  show :: RealSrcLoc -> String
show (SrcLoc LexicalFastString
filename Int
row Int
col)
      = String
"SrcLoc " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LexicalFastString
filename forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
row forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
col

-- Show is used by GHC.Parser.Lexer, because we derive Show for Token
instance Show RealSrcSpan where
  show :: RealSrcSpan -> String
show span :: RealSrcSpan
span@(RealSrcSpan' FastString
file Int
sl Int
sc Int
el Int
ec)
    | RealSrcSpan -> Bool
isPointRealSpan RealSrcSpan
span
    = String
"SrcSpanPoint " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FastString
file forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int
sl,Int
sc])

    | RealSrcSpan -> Bool
isOneLineRealSpan RealSrcSpan
span
    = String
"SrcSpanOneLine " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FastString
file forall a. [a] -> [a] -> [a]
++ String
" "
                        forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int
sl,Int
sc,Int
ec])

    | Bool
otherwise
    = String
"SrcSpanMultiLine " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FastString
file forall a. [a] -> [a] -> [a]
++ String
" "
                          forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int
sl,Int
sc,Int
el,Int
ec])


instance Outputable RealSrcSpan where
    ppr :: RealSrcSpan -> SDoc
ppr RealSrcSpan
span = Bool -> RealSrcSpan -> SDoc
pprUserRealSpan Bool
True RealSrcSpan
span

-- I don't know why there is this style-based difference
--      = getPprStyle $ \ sty ->
--        if userStyle sty || debugStyle sty then
--           text (showUserRealSpan True span)
--        else
--           hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
--                 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]

instance Outputable SrcSpan where
    ppr :: SrcSpan -> SDoc
ppr SrcSpan
span = Bool -> SrcSpan -> SDoc
pprUserSpan Bool
True SrcSpan
span

instance Outputable UnhelpfulSpanReason where
    ppr :: UnhelpfulSpanReason -> SDoc
ppr = UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason

-- I don't know why there is this style-based difference
--      = getPprStyle $ \ sty ->
--        if userStyle sty || debugStyle sty then
--           pprUserSpan True span
--        else
--           case span of
--           UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
--           RealSrcSpan s -> ppr s

unhelpfulSpanFS :: UnhelpfulSpanReason -> FastString
unhelpfulSpanFS :: UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
r = case UnhelpfulSpanReason
r of
  UnhelpfulOther FastString
s        -> FastString
s
  UnhelpfulSpanReason
UnhelpfulNoLocationInfo -> String -> FastString
fsLit String
"<no location info>"
  UnhelpfulSpanReason
UnhelpfulWiredIn        -> String -> FastString
fsLit String
"<wired into compiler>"
  UnhelpfulSpanReason
UnhelpfulInteractive    -> String -> FastString
fsLit String
"<interactive>"
  UnhelpfulSpanReason
UnhelpfulGenerated      -> String -> FastString
fsLit String
"<generated>"

pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason UnhelpfulSpanReason
r = forall doc. IsLine doc => FastString -> doc
ftext (UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
r)

pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan Bool
_         (UnhelpfulSpan UnhelpfulSpanReason
r) = UnhelpfulSpanReason -> SDoc
pprUnhelpfulSpanReason UnhelpfulSpanReason
r
pprUserSpan Bool
show_path (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_) = Bool -> RealSrcSpan -> SDoc
pprUserRealSpan Bool
show_path RealSrcSpan
s

pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
pprUserRealSpan Bool
show_path span :: RealSrcSpan
span@(RealSrcSpan' FastString
src_path Int
line Int
col Int
_ Int
_)
  | RealSrcSpan -> Bool
isPointRealSpan RealSrcSpan
span
  = forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
show_path (FastString -> SDoc
pprFastFilePath FastString
src_path forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
         , forall doc. IsLine doc => Int -> doc
int Int
line forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
         , forall doc. IsLine doc => Int -> doc
int Int
col ]

pprUserRealSpan Bool
show_path span :: RealSrcSpan
span@(RealSrcSpan' FastString
src_path Int
line Int
scol Int
_ Int
ecol)
  | RealSrcSpan -> Bool
isOneLineRealSpan RealSrcSpan
span
  = forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
show_path (FastString -> SDoc
pprFastFilePath FastString
src_path forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
         , forall doc. IsLine doc => Int -> doc
int Int
line forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
         , forall doc. IsLine doc => Int -> doc
int Int
scol
         , forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Int
ecol forall a. Num a => a -> a -> a
- Int
scol forall a. Ord a => a -> a -> Bool
<= Int
1) (forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int (Int
ecol forall a. Num a => a -> a -> a
- Int
1)) ]
            -- For single-character or point spans, we just
            -- output the starting column number

pprUserRealSpan Bool
show_path (RealSrcSpan' FastString
src_path Int
sline Int
scol Int
eline Int
ecol)
  = forall doc. IsLine doc => [doc] -> doc
hcat [ forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
show_path (FastString -> SDoc
pprFastFilePath FastString
src_path forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
         , forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => Int -> doc
int Int
sline forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
scol)
         , forall doc. IsLine doc => Char -> doc
char Char
'-'
         , forall doc. IsLine doc => doc -> doc
parens (forall doc. IsLine doc => Int -> doc
int Int
eline forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
comma forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Int -> doc
int Int
ecol') ]
 where
   ecol' :: Int
ecol' = if Int
ecol forall a. Eq a => a -> a -> Bool
== Int
0 then Int
ecol else Int
ecol forall a. Num a => a -> a -> a
- Int
1

{-
************************************************************************
*                                                                      *
\subsection[Located]{Attaching SrcSpans to things}
*                                                                      *
************************************************************************
-}

-- | We attach SrcSpans to lots of things, so let's have a datatype for it.
data GenLocated l e = L l e
  deriving (GenLocated l e -> GenLocated l e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l e.
(Eq l, Eq e) =>
GenLocated l e -> GenLocated l e -> Bool
/= :: GenLocated l e -> GenLocated l e -> Bool
$c/= :: forall l e.
(Eq l, Eq e) =>
GenLocated l e -> GenLocated l e -> Bool
== :: GenLocated l e -> GenLocated l e -> Bool
$c== :: forall l e.
(Eq l, Eq e) =>
GenLocated l e -> GenLocated l e -> Bool
Eq, GenLocated l e -> GenLocated l e -> Bool
GenLocated l e -> GenLocated l e -> Ordering
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
forall {l} {e}. (Ord l, Ord e) => Eq (GenLocated l e)
forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> Bool
forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> Ordering
forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> GenLocated l e
min :: GenLocated l e -> GenLocated l e -> GenLocated l e
$cmin :: forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> GenLocated l e
max :: GenLocated l e -> GenLocated l e -> GenLocated l e
$cmax :: forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> GenLocated l e
>= :: GenLocated l e -> GenLocated l e -> Bool
$c>= :: forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> Bool
> :: GenLocated l e -> GenLocated l e -> Bool
$c> :: forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> Bool
<= :: GenLocated l e -> GenLocated l e -> Bool
$c<= :: forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> Bool
< :: GenLocated l e -> GenLocated l e -> Bool
$c< :: forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> Bool
compare :: GenLocated l e -> GenLocated l e -> Ordering
$ccompare :: forall l e.
(Ord l, Ord e) =>
GenLocated l e -> GenLocated l e -> Ordering
Ord, Int -> GenLocated l e -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l e. (Show l, Show e) => Int -> GenLocated l e -> ShowS
forall l e. (Show l, Show e) => [GenLocated l e] -> ShowS
forall l e. (Show l, Show e) => GenLocated l e -> String
showList :: [GenLocated l e] -> ShowS
$cshowList :: forall l e. (Show l, Show e) => [GenLocated l e] -> ShowS
show :: GenLocated l e -> String
$cshow :: forall l e. (Show l, Show e) => GenLocated l e -> String
showsPrec :: Int -> GenLocated l e -> ShowS
$cshowsPrec :: forall l e. (Show l, Show e) => Int -> GenLocated l e -> ShowS
Show, GenLocated l e -> DataType
GenLocated l e -> Constr
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 {l} {e}. (Data l, Data e) => Typeable (GenLocated l e)
forall l e. (Data l, Data e) => GenLocated l e -> DataType
forall l e. (Data l, Data e) => GenLocated l e -> Constr
forall l e.
(Data l, Data e) =>
(forall b. Data b => b -> b) -> GenLocated l e -> GenLocated l e
forall l e u.
(Data l, Data e) =>
Int -> (forall d. Data d => d -> u) -> GenLocated l e -> u
forall l e u.
(Data l, Data e) =>
(forall d. Data d => d -> u) -> GenLocated l e -> [u]
forall l e r r'.
(Data l, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenLocated l e -> r
forall l e r r'.
(Data l, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenLocated l e -> r
forall l e (m :: * -> *).
(Data l, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
forall l e (m :: * -> *).
(Data l, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
forall l e (c :: * -> *).
(Data l, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenLocated l e)
forall l e (c :: * -> *).
(Data l, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenLocated l e -> c (GenLocated l e)
forall l e (t :: * -> *) (c :: * -> *).
(Data l, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GenLocated l e))
forall l e (t :: * -> * -> *) (c :: * -> *).
(Data l, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenLocated l e))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenLocated l e)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenLocated l e -> c (GenLocated l e)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenLocated l e))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
$cgmapMo :: forall l e (m :: * -> *).
(Data l, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
$cgmapMp :: forall l e (m :: * -> *).
(Data l, Data e, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
$cgmapM :: forall l e (m :: * -> *).
(Data l, Data e, Monad m) =>
(forall d. Data d => d -> m d)
-> GenLocated l e -> m (GenLocated l e)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GenLocated l e -> u
$cgmapQi :: forall l e u.
(Data l, Data e) =>
Int -> (forall d. Data d => d -> u) -> GenLocated l e -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> GenLocated l e -> [u]
$cgmapQ :: forall l e u.
(Data l, Data e) =>
(forall d. Data d => d -> u) -> GenLocated l e -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenLocated l e -> r
$cgmapQr :: forall l e r r'.
(Data l, Data e) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenLocated l e -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenLocated l e -> r
$cgmapQl :: forall l e r r'.
(Data l, Data e) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenLocated l e -> r
gmapT :: (forall b. Data b => b -> b) -> GenLocated l e -> GenLocated l e
$cgmapT :: forall l e.
(Data l, Data e) =>
(forall b. Data b => b -> b) -> GenLocated l e -> GenLocated l e
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenLocated l e))
$cdataCast2 :: forall l e (t :: * -> * -> *) (c :: * -> *).
(Data l, Data e, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenLocated l e))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (GenLocated l e))
$cdataCast1 :: forall l e (t :: * -> *) (c :: * -> *).
(Data l, Data e, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GenLocated l e))
dataTypeOf :: GenLocated l e -> DataType
$cdataTypeOf :: forall l e. (Data l, Data e) => GenLocated l e -> DataType
toConstr :: GenLocated l e -> Constr
$ctoConstr :: forall l e. (Data l, Data e) => GenLocated l e -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenLocated l e)
$cgunfold :: forall l e (c :: * -> *).
(Data l, Data e) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenLocated l e)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenLocated l e -> c (GenLocated l e)
$cgfoldl :: forall l e (c :: * -> *).
(Data l, Data e) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenLocated l e -> c (GenLocated l e)
Data, forall a b. a -> GenLocated l b -> GenLocated l a
forall a b. (a -> b) -> GenLocated l a -> GenLocated l b
forall l a b. a -> GenLocated l b -> GenLocated l a
forall l a b. (a -> b) -> GenLocated l a -> GenLocated l b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GenLocated l b -> GenLocated l a
$c<$ :: forall l a b. a -> GenLocated l b -> GenLocated l a
fmap :: forall a b. (a -> b) -> GenLocated l a -> GenLocated l b
$cfmap :: forall l a b. (a -> b) -> GenLocated l a -> GenLocated l b
Functor, forall a. GenLocated l a -> Bool
forall l a. Eq a => a -> GenLocated l a -> Bool
forall l a. Num a => GenLocated l a -> a
forall l a. Ord a => GenLocated l a -> a
forall m a. Monoid m => (a -> m) -> GenLocated l a -> m
forall l m. Monoid m => GenLocated l m -> m
forall l a. GenLocated l a -> Bool
forall l a. GenLocated l a -> Int
forall l a. GenLocated l a -> [a]
forall a b. (a -> b -> b) -> b -> GenLocated l a -> b
forall l a. (a -> a -> a) -> GenLocated l a -> a
forall l m a. Monoid m => (a -> m) -> GenLocated l a -> m
forall l b a. (b -> a -> b) -> b -> GenLocated l a -> b
forall l a b. (a -> b -> b) -> b -> GenLocated l a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => GenLocated l a -> a
$cproduct :: forall l a. Num a => GenLocated l a -> a
sum :: forall a. Num a => GenLocated l a -> a
$csum :: forall l a. Num a => GenLocated l a -> a
minimum :: forall a. Ord a => GenLocated l a -> a
$cminimum :: forall l a. Ord a => GenLocated l a -> a
maximum :: forall a. Ord a => GenLocated l a -> a
$cmaximum :: forall l a. Ord a => GenLocated l a -> a
elem :: forall a. Eq a => a -> GenLocated l a -> Bool
$celem :: forall l a. Eq a => a -> GenLocated l a -> Bool
length :: forall a. GenLocated l a -> Int
$clength :: forall l a. GenLocated l a -> Int
null :: forall a. GenLocated l a -> Bool
$cnull :: forall l a. GenLocated l a -> Bool
toList :: forall a. GenLocated l a -> [a]
$ctoList :: forall l a. GenLocated l a -> [a]
foldl1 :: forall a. (a -> a -> a) -> GenLocated l a -> a
$cfoldl1 :: forall l a. (a -> a -> a) -> GenLocated l a -> a
foldr1 :: forall a. (a -> a -> a) -> GenLocated l a -> a
$cfoldr1 :: forall l a. (a -> a -> a) -> GenLocated l a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> GenLocated l a -> b
$cfoldl' :: forall l b a. (b -> a -> b) -> b -> GenLocated l a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GenLocated l a -> b
$cfoldl :: forall l b a. (b -> a -> b) -> b -> GenLocated l a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GenLocated l a -> b
$cfoldr' :: forall l a b. (a -> b -> b) -> b -> GenLocated l a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GenLocated l a -> b
$cfoldr :: forall l a b. (a -> b -> b) -> b -> GenLocated l a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> GenLocated l a -> m
$cfoldMap' :: forall l m a. Monoid m => (a -> m) -> GenLocated l a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GenLocated l a -> m
$cfoldMap :: forall l m a. Monoid m => (a -> m) -> GenLocated l a -> m
fold :: forall m. Monoid m => GenLocated l m -> m
$cfold :: forall l m. Monoid m => GenLocated l m -> m
Foldable, forall l. Functor (GenLocated l)
forall l. Foldable (GenLocated l)
forall l (m :: * -> *) a.
Monad m =>
GenLocated l (m a) -> m (GenLocated l a)
forall l (f :: * -> *) a.
Applicative f =>
GenLocated l (f a) -> f (GenLocated l a)
forall l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenLocated l a -> m (GenLocated l b)
forall l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenLocated l a -> f (GenLocated l b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenLocated l a -> f (GenLocated l b)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenLocated l (m a) -> m (GenLocated l a)
$csequence :: forall l (m :: * -> *) a.
Monad m =>
GenLocated l (m a) -> m (GenLocated l a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenLocated l a -> m (GenLocated l b)
$cmapM :: forall l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenLocated l a -> m (GenLocated l b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenLocated l (f a) -> f (GenLocated l a)
$csequenceA :: forall l (f :: * -> *) a.
Applicative f =>
GenLocated l (f a) -> f (GenLocated l a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenLocated l a -> f (GenLocated l b)
$ctraverse :: forall l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenLocated l a -> f (GenLocated l b)
Traversable)
instance (NFData l, NFData e) => NFData (GenLocated l e) where
  rnf :: GenLocated l e -> ()
rnf (L l
l e
e) = forall a. NFData a => a -> ()
rnf l
l seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf e
e

type Located = GenLocated SrcSpan
type RealLocated = GenLocated RealSrcSpan

unLoc :: GenLocated l e -> e
unLoc :: forall l e. GenLocated l e -> e
unLoc (L l
_ e
e) = e
e

getLoc :: GenLocated l e -> l
getLoc :: forall l e. GenLocated l e -> l
getLoc (L l
l e
_) = l
l

noLoc :: e -> Located e
noLoc :: forall e. e -> Located e
noLoc e
e = forall l e. l -> e -> GenLocated l e
L SrcSpan
noSrcSpan e
e

mkGeneralLocated :: String -> e -> Located e
mkGeneralLocated :: forall e. String -> e -> Located e
mkGeneralLocated String
s e
e = forall l e. l -> e -> GenLocated l e
L (FastString -> SrcSpan
mkGeneralSrcSpan (String -> FastString
fsLit String
s)) e
e

combineLocs :: Located a -> Located b -> SrcSpan
combineLocs :: forall a b. Located a -> Located b -> SrcSpan
combineLocs Located a
a Located b
b = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (forall l e. GenLocated l e -> l
getLoc Located a
a) (forall l e. GenLocated l e -> l
getLoc Located b
b)

-- | Combine locations from two 'Located' things and add them to a third thing
addCLoc :: Located a -> Located b -> c -> Located c
addCLoc :: forall a b c. Located a -> Located b -> c -> Located c
addCLoc Located a
a Located b
b c
c = forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (forall l e. GenLocated l e -> l
getLoc Located a
a) (forall l e. GenLocated l e -> l
getLoc Located b
b)) c
c

-- not clear whether to add a general Eq instance, but this is useful sometimes:

-- | Tests whether the two located things are equal
eqLocated :: Eq a => GenLocated l a -> GenLocated l a -> Bool
eqLocated :: forall a l. Eq a => GenLocated l a -> GenLocated l a -> Bool
eqLocated GenLocated l a
a GenLocated l a
b = forall l e. GenLocated l e -> e
unLoc GenLocated l a
a forall a. Eq a => a -> a -> Bool
== forall l e. GenLocated l e -> e
unLoc GenLocated l a
b

-- not clear whether to add a general Ord instance, but this is useful sometimes:

-- | Tests the ordering of the two located things
cmpLocated :: Ord a => GenLocated l a -> GenLocated l a -> Ordering
cmpLocated :: forall a l. Ord a => GenLocated l a -> GenLocated l a -> Ordering
cmpLocated GenLocated l a
a GenLocated l a
b = forall l e. GenLocated l e -> e
unLoc GenLocated l a
a forall a. Ord a => a -> a -> Ordering
`compare` forall l e. GenLocated l e -> e
unLoc GenLocated l a
b

-- | Compare the 'BufSpan' of two located things.
--
-- Precondition: both operands have an associated 'BufSpan'.
cmpBufSpan :: HasDebugCallStack => Located a -> Located a -> Ordering
cmpBufSpan :: forall a. HasDebugCallStack => Located a -> Located a -> Ordering
cmpBufSpan (L SrcSpan
l1 a
_) (L SrcSpan
l2  a
_)
  | Strict.Just BufSpan
a <- SrcSpan -> Maybe BufSpan
getBufSpan SrcSpan
l1
  , Strict.Just BufSpan
b <- SrcSpan -> Maybe BufSpan
getBufSpan SrcSpan
l2
  = forall a. Ord a => a -> a -> Ordering
compare BufSpan
a BufSpan
b

  | Bool
otherwise = forall a. HasCallStack => String -> a
panic String
"cmpBufSpan: no BufSpan"

instance (Outputable e) => Outputable (Located e) where
  ppr :: Located e -> SDoc
ppr (L SrcSpan
l e
e) = -- GenLocated:
                -- Print spans without the file name etc
                forall doc. IsOutput doc => doc -> doc
whenPprDebug (forall doc. IsLine doc => doc -> doc
braces (Bool -> SrcSpan -> SDoc
pprUserSpan Bool
False SrcSpan
l))
             forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr e
e
instance (Outputable e) => Outputable (GenLocated RealSrcSpan e) where
  ppr :: GenLocated RealSrcSpan e -> SDoc
ppr (L RealSrcSpan
l e
e) = -- GenLocated:
                -- Print spans without the file name etc
                forall doc. IsOutput doc => doc -> doc
whenPprDebug (forall doc. IsLine doc => doc -> doc
braces (Bool -> SrcSpan -> SDoc
pprUserSpan Bool
False (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
l forall a. Maybe a
Strict.Nothing)))
             forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr e
e


pprLocated :: (Outputable l, Outputable e) => GenLocated l e -> SDoc
pprLocated :: forall l e. (Outputable l, Outputable e) => GenLocated l e -> SDoc
pprLocated (L l
l e
e) =
                -- Print spans without the file name etc
                forall doc. IsOutput doc => doc -> doc
whenPprDebug (forall doc. IsLine doc => doc -> doc
braces (forall a. Outputable a => a -> SDoc
ppr l
l))
             forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr e
e

-- | Always prints the location, even without -dppr-debug
pprLocatedAlways :: (Outputable l, Outputable e) => GenLocated l e -> SDoc
pprLocatedAlways :: forall l e. (Outputable l, Outputable e) => GenLocated l e -> SDoc
pprLocatedAlways (L l
l e
e) =
     forall doc. IsLine doc => doc -> doc
braces (forall a. Outputable a => a -> SDoc
ppr l
l)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall a. Outputable a => a -> SDoc
ppr e
e

{-
************************************************************************
*                                                                      *
\subsection{Ordering SrcSpans for InteractiveUI}
*                                                                      *
************************************************************************
-}

-- | Strategies for ordering 'SrcSpan's
leftmost_smallest, leftmost_largest, rightmost_smallest :: SrcSpan -> SrcSpan -> Ordering
rightmost_smallest :: SrcSpan -> SrcSpan -> Ordering
rightmost_smallest = (RealSrcSpan -> RealSrcSpan -> Ordering)
-> SrcSpan -> SrcSpan -> Ordering
compareSrcSpanBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare)
leftmost_smallest :: SrcSpan -> SrcSpan -> Ordering
leftmost_smallest = (RealSrcSpan -> RealSrcSpan -> Ordering)
-> SrcSpan -> SrcSpan -> Ordering
compareSrcSpanBy forall a. Ord a => a -> a -> Ordering
compare
leftmost_largest :: SrcSpan -> SrcSpan -> Ordering
leftmost_largest = (RealSrcSpan -> RealSrcSpan -> Ordering)
-> SrcSpan -> SrcSpan -> Ordering
compareSrcSpanBy forall a b. (a -> b) -> a -> b
$
  forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Ord a => a -> a -> Ordering
compare RealSrcSpan -> RealSrcLoc
realSrcSpanStart forall a. Semigroup a => a -> a -> a
S.<> forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Ord a => a -> a -> Ordering
compare RealSrcSpan -> RealSrcLoc
realSrcSpanEnd)

compareSrcSpanBy :: (RealSrcSpan -> RealSrcSpan -> Ordering) -> SrcSpan -> SrcSpan -> Ordering
compareSrcSpanBy :: (RealSrcSpan -> RealSrcSpan -> Ordering)
-> SrcSpan -> SrcSpan -> Ordering
compareSrcSpanBy RealSrcSpan -> RealSrcSpan -> Ordering
cmp (RealSrcSpan RealSrcSpan
a Maybe BufSpan
_) (RealSrcSpan RealSrcSpan
b Maybe BufSpan
_) = RealSrcSpan -> RealSrcSpan -> Ordering
cmp RealSrcSpan
a RealSrcSpan
b
compareSrcSpanBy RealSrcSpan -> RealSrcSpan -> Ordering
_   (RealSrcSpan RealSrcSpan
_ Maybe BufSpan
_) (UnhelpfulSpan UnhelpfulSpanReason
_) = Ordering
LT
compareSrcSpanBy RealSrcSpan -> RealSrcSpan -> Ordering
_   (UnhelpfulSpan UnhelpfulSpanReason
_) (RealSrcSpan RealSrcSpan
_ Maybe BufSpan
_) = Ordering
GT
compareSrcSpanBy RealSrcSpan -> RealSrcSpan -> Ordering
_   (UnhelpfulSpan UnhelpfulSpanReason
_) (UnhelpfulSpan UnhelpfulSpanReason
_) = Ordering
EQ

-- | Determines whether a span encloses a given line and column index
spans :: SrcSpan -> (Int, Int) -> Bool
spans :: SrcSpan -> (Int, Int) -> Bool
spans (UnhelpfulSpan UnhelpfulSpanReason
_) (Int, Int)
_ = forall a. HasCallStack => String -> a
panic String
"spans UnhelpfulSpan"
spans (RealSrcSpan RealSrcSpan
span Maybe BufSpan
_) (Int
l,Int
c) = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
span forall a. Ord a => a -> a -> Bool
<= RealSrcLoc
loc Bool -> Bool -> Bool
&& RealSrcLoc
loc forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
span
   where loc :: RealSrcLoc
loc = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
span) Int
l Int
c

-- | Determines whether a span is enclosed by another one
isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
            -> SrcSpan -- ^ The span it may be enclosed by
            -> Bool
isSubspanOf :: SrcSpan -> SrcSpan -> Bool
isSubspanOf (RealSrcSpan RealSrcSpan
src Maybe BufSpan
_) (RealSrcSpan RealSrcSpan
parent Maybe BufSpan
_) = RealSrcSpan -> RealSrcSpan -> Bool
isRealSubspanOf RealSrcSpan
src RealSrcSpan
parent
isSubspanOf SrcSpan
_ SrcSpan
_ = Bool
False

-- | Determines whether a span is enclosed by another one
isRealSubspanOf :: RealSrcSpan -- ^ The span that may be enclosed by the other
                -> RealSrcSpan -- ^ The span it may be enclosed by
                -> Bool
isRealSubspanOf :: RealSrcSpan -> RealSrcSpan -> Bool
isRealSubspanOf RealSrcSpan
src RealSrcSpan
parent
    | RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
parent forall a. Eq a => a -> a -> Bool
/= RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
src = Bool
False
    | Bool
otherwise = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
parent forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
src Bool -> Bool -> Bool
&&
                  RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
parent   forall a. Ord a => a -> a -> Bool
>= RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
src

getRealSrcSpan :: RealLocated a -> RealSrcSpan
getRealSrcSpan :: forall a. RealLocated a -> RealSrcSpan
getRealSrcSpan (L RealSrcSpan
l a
_) = RealSrcSpan
l

unRealSrcSpan :: RealLocated a -> a
unRealSrcSpan :: forall a. RealLocated a -> a
unRealSrcSpan  (L RealSrcSpan
_ a
e) = a
e


-- | A location as produced by the parser. Consists of two components:
--
-- * The location in the file, adjusted for #line and {-# LINE ... #-} pragmas (RealSrcLoc)
-- * The location in the string buffer (BufPos) with monotonicity guarantees (see #17632)
data PsLoc
  = PsLoc { PsLoc -> RealSrcLoc
psRealLoc :: !RealSrcLoc, PsLoc -> BufPos
psBufPos :: !BufPos }
  deriving (PsLoc -> PsLoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PsLoc -> PsLoc -> Bool
$c/= :: PsLoc -> PsLoc -> Bool
== :: PsLoc -> PsLoc -> Bool
$c== :: PsLoc -> PsLoc -> Bool
Eq, Eq PsLoc
PsLoc -> PsLoc -> Bool
PsLoc -> PsLoc -> Ordering
PsLoc -> PsLoc -> PsLoc
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 :: PsLoc -> PsLoc -> PsLoc
$cmin :: PsLoc -> PsLoc -> PsLoc
max :: PsLoc -> PsLoc -> PsLoc
$cmax :: PsLoc -> PsLoc -> PsLoc
>= :: PsLoc -> PsLoc -> Bool
$c>= :: PsLoc -> PsLoc -> Bool
> :: PsLoc -> PsLoc -> Bool
$c> :: PsLoc -> PsLoc -> Bool
<= :: PsLoc -> PsLoc -> Bool
$c<= :: PsLoc -> PsLoc -> Bool
< :: PsLoc -> PsLoc -> Bool
$c< :: PsLoc -> PsLoc -> Bool
compare :: PsLoc -> PsLoc -> Ordering
$ccompare :: PsLoc -> PsLoc -> Ordering
Ord, Int -> PsLoc -> ShowS
[PsLoc] -> ShowS
PsLoc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PsLoc] -> ShowS
$cshowList :: [PsLoc] -> ShowS
show :: PsLoc -> String
$cshow :: PsLoc -> String
showsPrec :: Int -> PsLoc -> ShowS
$cshowsPrec :: Int -> PsLoc -> ShowS
Show)

data PsSpan
  = PsSpan { PsSpan -> RealSrcSpan
psRealSpan :: !RealSrcSpan, PsSpan -> BufSpan
psBufSpan :: !BufSpan }
  deriving (PsSpan -> PsSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PsSpan -> PsSpan -> Bool
$c/= :: PsSpan -> PsSpan -> Bool
== :: PsSpan -> PsSpan -> Bool
$c== :: PsSpan -> PsSpan -> Bool
Eq, Eq PsSpan
PsSpan -> PsSpan -> Bool
PsSpan -> PsSpan -> Ordering
PsSpan -> PsSpan -> PsSpan
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 :: PsSpan -> PsSpan -> PsSpan
$cmin :: PsSpan -> PsSpan -> PsSpan
max :: PsSpan -> PsSpan -> PsSpan
$cmax :: PsSpan -> PsSpan -> PsSpan
>= :: PsSpan -> PsSpan -> Bool
$c>= :: PsSpan -> PsSpan -> Bool
> :: PsSpan -> PsSpan -> Bool
$c> :: PsSpan -> PsSpan -> Bool
<= :: PsSpan -> PsSpan -> Bool
$c<= :: PsSpan -> PsSpan -> Bool
< :: PsSpan -> PsSpan -> Bool
$c< :: PsSpan -> PsSpan -> Bool
compare :: PsSpan -> PsSpan -> Ordering
$ccompare :: PsSpan -> PsSpan -> Ordering
Ord, Int -> PsSpan -> ShowS
[PsSpan] -> ShowS
PsSpan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PsSpan] -> ShowS
$cshowList :: [PsSpan] -> ShowS
show :: PsSpan -> String
$cshow :: PsSpan -> String
showsPrec :: Int -> PsSpan -> ShowS
$cshowsPrec :: Int -> PsSpan -> ShowS
Show, Typeable PsSpan
PsSpan -> DataType
PsSpan -> Constr
(forall b. Data b => b -> b) -> PsSpan -> PsSpan
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) -> PsSpan -> u
forall u. (forall d. Data d => d -> u) -> PsSpan -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PsSpan -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PsSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PsSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PsSpan -> c PsSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PsSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PsSpan)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PsSpan -> m PsSpan
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PsSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PsSpan -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PsSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PsSpan -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PsSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PsSpan -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PsSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PsSpan -> r
gmapT :: (forall b. Data b => b -> b) -> PsSpan -> PsSpan
$cgmapT :: (forall b. Data b => b -> b) -> PsSpan -> PsSpan
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PsSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PsSpan)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PsSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PsSpan)
dataTypeOf :: PsSpan -> DataType
$cdataTypeOf :: PsSpan -> DataType
toConstr :: PsSpan -> Constr
$ctoConstr :: PsSpan -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PsSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PsSpan
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PsSpan -> c PsSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PsSpan -> c PsSpan
Data)

type PsLocated = GenLocated PsSpan

psLocatedToLocated :: PsLocated a -> Located a
psLocatedToLocated :: forall a. PsLocated a -> Located a
psLocatedToLocated (L PsSpan
sp a
a) = forall l e. l -> e -> GenLocated l e
L (PsSpan -> SrcSpan
mkSrcSpanPs PsSpan
sp) a
a

advancePsLoc :: PsLoc -> Char -> PsLoc
advancePsLoc :: PsLoc -> Char -> PsLoc
advancePsLoc (PsLoc RealSrcLoc
real_loc BufPos
buf_loc) Char
c =
  RealSrcLoc -> BufPos -> PsLoc
PsLoc (RealSrcLoc -> Char -> RealSrcLoc
advanceSrcLoc RealSrcLoc
real_loc Char
c) (BufPos -> BufPos
advanceBufPos BufPos
buf_loc)

mkPsSpan :: PsLoc -> PsLoc -> PsSpan
mkPsSpan :: PsLoc -> PsLoc -> PsSpan
mkPsSpan (PsLoc RealSrcLoc
r1 BufPos
b1) (PsLoc RealSrcLoc
r2 BufPos
b2) = RealSrcSpan -> BufSpan -> PsSpan
PsSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
r1 RealSrcLoc
r2) (BufPos -> BufPos -> BufSpan
BufSpan BufPos
b1 BufPos
b2)

psSpanStart :: PsSpan -> PsLoc
psSpanStart :: PsSpan -> PsLoc
psSpanStart (PsSpan RealSrcSpan
r BufSpan
b) = RealSrcLoc -> BufPos -> PsLoc
PsLoc (RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
r) (BufSpan -> BufPos
bufSpanStart BufSpan
b)

psSpanEnd :: PsSpan -> PsLoc
psSpanEnd :: PsSpan -> PsLoc
psSpanEnd (PsSpan RealSrcSpan
r BufSpan
b) = RealSrcLoc -> BufPos -> PsLoc
PsLoc (RealSrcSpan -> RealSrcLoc
realSrcSpanEnd RealSrcSpan
r) (BufSpan -> BufPos
bufSpanEnd BufSpan
b)

mkSrcSpanPs :: PsSpan -> SrcSpan
mkSrcSpanPs :: PsSpan -> SrcSpan
mkSrcSpanPs (PsSpan RealSrcSpan
r BufSpan
b) = RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
r (forall a. a -> Maybe a
Strict.Just BufSpan
b)