{-# LANGUAGE CPP, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Language.Python.Common.SrcLocation 
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- Source location information for the Python lexer and parser. This module
-- provides single-point locations and spans, and conversions between them.
-----------------------------------------------------------------------------

module Language.Python.Common.SrcLocation (
  -- * Construction 
  SrcLocation (..),
  SrcSpan (..),
  Span (..),
  spanning,
  mkSrcSpan,
  combineSrcSpans,
  initialSrcLocation,
  spanStartPoint,
  -- * Modification
  incColumn, 
  decColumn,
  incLine,
  incTab,
  endCol,
  -- * Projection of components of a span
  endRow,
  startCol,
  startRow
) where

#if __GLASGOW_HASKELL__ >= 803
import Prelude hiding ((<>))
#endif

import Language.Python.Common.Pretty
import Data.Data

-- | A location for a syntactic entity from the source code.
-- The location is specified by its filename, and starting row
-- and column. 
data SrcLocation = 
   Sloc { SrcLocation -> String
sloc_filename :: !String
        , SrcLocation -> Int
sloc_row :: {-# UNPACK #-} !Int
        , SrcLocation -> Int
sloc_column :: {-# UNPACK #-} !Int 
        } 
   | NoLocation
   deriving (SrcLocation -> SrcLocation -> Bool
(SrcLocation -> SrcLocation -> Bool)
-> (SrcLocation -> SrcLocation -> Bool) -> Eq SrcLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrcLocation -> SrcLocation -> Bool
$c/= :: SrcLocation -> SrcLocation -> Bool
== :: SrcLocation -> SrcLocation -> Bool
$c== :: SrcLocation -> SrcLocation -> Bool
Eq,Eq SrcLocation
Eq SrcLocation =>
(SrcLocation -> SrcLocation -> Ordering)
-> (SrcLocation -> SrcLocation -> Bool)
-> (SrcLocation -> SrcLocation -> Bool)
-> (SrcLocation -> SrcLocation -> Bool)
-> (SrcLocation -> SrcLocation -> Bool)
-> (SrcLocation -> SrcLocation -> SrcLocation)
-> (SrcLocation -> SrcLocation -> SrcLocation)
-> Ord SrcLocation
SrcLocation -> SrcLocation -> Bool
SrcLocation -> SrcLocation -> Ordering
SrcLocation -> SrcLocation -> SrcLocation
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 :: SrcLocation -> SrcLocation -> SrcLocation
$cmin :: SrcLocation -> SrcLocation -> SrcLocation
max :: SrcLocation -> SrcLocation -> SrcLocation
$cmax :: SrcLocation -> SrcLocation -> SrcLocation
>= :: SrcLocation -> SrcLocation -> Bool
$c>= :: SrcLocation -> SrcLocation -> Bool
> :: SrcLocation -> SrcLocation -> Bool
$c> :: SrcLocation -> SrcLocation -> Bool
<= :: SrcLocation -> SrcLocation -> Bool
$c<= :: SrcLocation -> SrcLocation -> Bool
< :: SrcLocation -> SrcLocation -> Bool
$c< :: SrcLocation -> SrcLocation -> Bool
compare :: SrcLocation -> SrcLocation -> Ordering
$ccompare :: SrcLocation -> SrcLocation -> Ordering
$cp1Ord :: Eq SrcLocation
Ord,Int -> SrcLocation -> ShowS
[SrcLocation] -> ShowS
SrcLocation -> String
(Int -> SrcLocation -> ShowS)
-> (SrcLocation -> String)
-> ([SrcLocation] -> ShowS)
-> Show SrcLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SrcLocation] -> ShowS
$cshowList :: [SrcLocation] -> ShowS
show :: SrcLocation -> String
$cshow :: SrcLocation -> String
showsPrec :: Int -> SrcLocation -> ShowS
$cshowsPrec :: Int -> SrcLocation -> ShowS
Show,Typeable,Typeable SrcLocation
Constr
DataType
Typeable SrcLocation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SrcLocation -> c SrcLocation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SrcLocation)
-> (SrcLocation -> Constr)
-> (SrcLocation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SrcLocation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SrcLocation))
-> ((forall b. Data b => b -> b) -> SrcLocation -> SrcLocation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcLocation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcLocation -> r)
-> (forall u. (forall d. Data d => d -> u) -> SrcLocation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SrcLocation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation)
-> Data SrcLocation
SrcLocation -> Constr
SrcLocation -> DataType
(forall b. Data b => b -> b) -> SrcLocation -> SrcLocation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLocation -> c SrcLocation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLocation
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) -> SrcLocation -> u
forall u. (forall d. Data d => d -> u) -> SrcLocation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLocation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLocation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLocation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLocation -> c SrcLocation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLocation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcLocation)
$cNoLocation :: Constr
$cSloc :: Constr
$tSrcLocation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
gmapMp :: (forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
gmapM :: (forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcLocation -> m SrcLocation
gmapQi :: Int -> (forall d. Data d => d -> u) -> SrcLocation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcLocation -> u
gmapQ :: (forall d. Data d => d -> u) -> SrcLocation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcLocation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLocation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLocation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLocation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcLocation -> r
gmapT :: (forall b. Data b => b -> b) -> SrcLocation -> SrcLocation
$cgmapT :: (forall b. Data b => b -> b) -> SrcLocation -> SrcLocation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcLocation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SrcLocation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SrcLocation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcLocation)
dataTypeOf :: SrcLocation -> DataType
$cdataTypeOf :: SrcLocation -> DataType
toConstr :: SrcLocation -> Constr
$ctoConstr :: SrcLocation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLocation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcLocation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLocation -> c SrcLocation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcLocation -> c SrcLocation
$cp1Data :: Typeable SrcLocation
Data)

instance Pretty SrcLocation where
   pretty :: SrcLocation -> Doc
pretty = SrcSpan -> Doc
forall a. Pretty a => a -> Doc
pretty (SrcSpan -> Doc) -> (SrcLocation -> SrcSpan) -> SrcLocation -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLocation -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan

-- | Types which have a span.
class Span a where
   getSpan :: a -> SrcSpan
   getSpan x :: a
x = SrcSpan
SpanEmpty

-- | Create a new span which encloses two spanned things.
spanning :: (Span a, Span b) => a -> b -> SrcSpan
spanning :: a -> b -> SrcSpan
spanning x :: a
x y :: b
y = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (a -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan a
x) (b -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan b
y)

instance Span a => Span [a] where
   getSpan :: [a] -> SrcSpan
getSpan [] = SrcSpan
SpanEmpty
   getSpan [x :: a
x] = a -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan a
x 
   getSpan list :: [a]
list@(x :: a
x:xs :: [a]
xs) = SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (a -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan a
x) (a -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan ([a] -> a
forall a. [a] -> a
last [a]
list))

instance Span a => Span (Maybe a) where
   getSpan :: Maybe a -> SrcSpan
getSpan Nothing = SrcSpan
SpanEmpty
   getSpan (Just x :: a
x) = a -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan a
x

instance (Span a, Span b) => Span (Either a b) where
   getSpan :: Either a b -> SrcSpan
getSpan (Left x :: a
x) = a -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan a
x
   getSpan (Right x :: b
x) = b -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan b
x

instance (Span a, Span b) => Span (a, b) where
   getSpan :: (a, b) -> SrcSpan
getSpan (x :: a
x,y :: b
y) = a -> b -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning a
x b
y

instance Span SrcSpan where
   getSpan :: SrcSpan -> SrcSpan
getSpan = SrcSpan -> SrcSpan
forall a. a -> a
id

-- | Construct the initial source location for a file.
initialSrcLocation :: String -> SrcLocation
initialSrcLocation :: String -> SrcLocation
initialSrcLocation filename :: String
filename 
    = $WSloc :: String -> Int -> Int -> SrcLocation
Sloc 
      { sloc_filename :: String
sloc_filename = String
filename
      , sloc_row :: Int
sloc_row = 1
      , sloc_column :: Int
sloc_column = 1
      }

-- | Decrement the column of a location, only if they are on the same row.
decColumn :: Int -> SrcLocation -> SrcLocation
decColumn :: Int -> SrcLocation -> SrcLocation
decColumn n :: Int
n loc :: SrcLocation
loc
   | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
col = SrcLocation
loc { sloc_column :: Int
sloc_column = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n }
   | Bool
otherwise = SrcLocation
loc 
   where
   col :: Int
col = SrcLocation -> Int
sloc_column SrcLocation
loc

-- | Increment the column of a location. 
incColumn :: Int -> SrcLocation -> SrcLocation
incColumn :: Int -> SrcLocation -> SrcLocation
incColumn n :: Int
n loc :: SrcLocation
loc@(Sloc { sloc_column :: SrcLocation -> Int
sloc_column = Int
col })
   = SrcLocation
loc { sloc_column :: Int
sloc_column = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n }
incColumn _ NoLocation = SrcLocation
NoLocation

-- | Increment the column of a location by one tab stop.
incTab :: SrcLocation -> SrcLocation
incTab :: SrcLocation -> SrcLocation
incTab loc :: SrcLocation
loc@(Sloc { sloc_column :: SrcLocation -> Int
sloc_column = Int
col })
   = SrcLocation
loc { sloc_column :: Int
sloc_column = Int
newCol } 
   where
   newCol :: Int
newCol = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 8
incTab NoLocation = SrcLocation
NoLocation

-- | Increment the line number (row) of a location by one.
incLine :: Int -> SrcLocation -> SrcLocation
incLine :: Int -> SrcLocation -> SrcLocation
incLine n :: Int
n loc :: SrcLocation
loc@(Sloc { sloc_row :: SrcLocation -> Int
sloc_row = Int
row }) 
   = SrcLocation
loc { sloc_column :: Int
sloc_column = 1, sloc_row :: Int
sloc_row = Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n }
incLine _ NoLocation = SrcLocation
NoLocation

{-
Inspired heavily by compiler/basicTypes/SrcLoc.lhs 
A SrcSpan delimits a portion of a text file.  
-}

-- | Source location spanning a contiguous section of a file.
data SrcSpan
    -- | A span which starts and ends on the same line.
  = SpanCoLinear
    { SrcSpan -> String
span_filename     :: !String
    , SrcSpan -> Int
span_row          :: {-# UNPACK #-} !Int
    , SrcSpan -> Int
span_start_column :: {-# UNPACK #-} !Int
    , SrcSpan -> Int
span_end_column   :: {-# UNPACK #-} !Int
    }
    -- | A span which starts and ends on different lines.
  | SpanMultiLine
    { span_filename     :: !String
    , SrcSpan -> Int
span_start_row    :: {-# UNPACK #-} !Int
    , span_start_column :: {-# UNPACK #-} !Int
    , SrcSpan -> Int
span_end_row      :: {-# UNPACK #-} !Int
    , span_end_column   :: {-# UNPACK #-} !Int
    }
    -- | A span which is actually just one point in the file.
  | SpanPoint
    { span_filename :: !String
    , span_row      :: {-# UNPACK #-} !Int
    , SrcSpan -> Int
span_column   :: {-# UNPACK #-} !Int
    }
    -- | No span information.
  | SpanEmpty 
   deriving (SrcSpan -> SrcSpan -> Bool
(SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool) -> Eq SrcSpan
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,Eq SrcSpan
Eq SrcSpan =>
(SrcSpan -> SrcSpan -> Ordering)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> SrcSpan)
-> (SrcSpan -> SrcSpan -> SrcSpan)
-> Ord SrcSpan
SrcSpan -> SrcSpan -> Bool
SrcSpan -> SrcSpan -> Ordering
SrcSpan -> SrcSpan -> SrcSpan
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 :: SrcSpan -> SrcSpan -> SrcSpan
$cmin :: SrcSpan -> SrcSpan -> SrcSpan
max :: SrcSpan -> SrcSpan -> SrcSpan
$cmax :: SrcSpan -> SrcSpan -> SrcSpan
>= :: SrcSpan -> SrcSpan -> Bool
$c>= :: SrcSpan -> SrcSpan -> Bool
> :: SrcSpan -> SrcSpan -> Bool
$c> :: SrcSpan -> SrcSpan -> Bool
<= :: SrcSpan -> SrcSpan -> Bool
$c<= :: SrcSpan -> SrcSpan -> Bool
< :: SrcSpan -> SrcSpan -> Bool
$c< :: SrcSpan -> SrcSpan -> Bool
compare :: SrcSpan -> SrcSpan -> Ordering
$ccompare :: SrcSpan -> SrcSpan -> Ordering
$cp1Ord :: Eq SrcSpan
Ord,Int -> SrcSpan -> ShowS
[SrcSpan] -> ShowS
SrcSpan -> String
(Int -> SrcSpan -> ShowS)
-> (SrcSpan -> String) -> ([SrcSpan] -> ShowS) -> Show SrcSpan
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,Typeable,Typeable SrcSpan
Constr
DataType
Typeable SrcSpan =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SrcSpan -> c SrcSpan)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SrcSpan)
-> (SrcSpan -> Constr)
-> (SrcSpan -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SrcSpan))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcSpan))
-> ((forall b. Data b => b -> b) -> SrcSpan -> SrcSpan)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcSpan -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SrcSpan -> r)
-> (forall u. (forall d. Data d => d -> u) -> SrcSpan -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SrcSpan -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan)
-> Data SrcSpan
SrcSpan -> Constr
SrcSpan -> DataType
(forall b. Data b => b -> b) -> SrcSpan -> SrcSpan
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcSpan -> c SrcSpan
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcSpan
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) -> SrcSpan -> u
forall u. (forall d. Data d => d -> u) -> SrcSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcSpan -> c SrcSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcSpan)
$cSpanEmpty :: Constr
$cSpanPoint :: Constr
$cSpanMultiLine :: Constr
$cSpanCoLinear :: Constr
$tSrcSpan :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
gmapMp :: (forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
gmapM :: (forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
gmapQi :: Int -> (forall d. Data d => d -> u) -> SrcSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcSpan -> u
gmapQ :: (forall d. Data d => d -> u) -> SrcSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcSpan -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
gmapT :: (forall b. Data b => b -> b) -> SrcSpan -> SrcSpan
$cgmapT :: (forall b. Data b => b -> b) -> SrcSpan -> SrcSpan
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcSpan)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SrcSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcSpan)
dataTypeOf :: SrcSpan -> DataType
$cdataTypeOf :: SrcSpan -> DataType
toConstr :: SrcSpan -> Constr
$ctoConstr :: SrcSpan -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcSpan
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcSpan -> c SrcSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcSpan -> c SrcSpan
$cp1Data :: Typeable SrcSpan
Data)

instance Pretty SrcSpan where
   pretty :: SrcSpan -> Doc
pretty span :: SrcSpan
span@(SpanCoLinear {}) = SrcSpan -> Doc
prettyMultiSpan SrcSpan
span
   pretty span :: SrcSpan
span@(SpanMultiLine {}) = SrcSpan -> Doc
prettyMultiSpan SrcSpan
span
   pretty span :: SrcSpan
span@(SpanPoint {})
      = String -> Doc
text (SrcSpan -> String
span_filename SrcSpan
span) Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+>
        Doc -> Doc
parens (Int -> Doc
forall a. Pretty a => a -> Doc
pretty (SrcSpan -> Int
span_row SrcSpan
span) Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<> Int -> Doc
forall a. Pretty a => a -> Doc
pretty (SrcSpan -> Int
span_column SrcSpan
span))
   pretty SpanEmpty = Doc
empty

prettyMultiSpan :: SrcSpan -> Doc 
prettyMultiSpan :: SrcSpan -> Doc
prettyMultiSpan span :: SrcSpan
span 
  = String -> Doc
text (SrcSpan -> String
span_filename SrcSpan
span) Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+>
    Doc -> Doc
parens (Int -> Doc
forall a. Pretty a => a -> Doc
pretty (SrcSpan -> Int
startRow SrcSpan
span) Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<> Int -> Doc
forall a. Pretty a => a -> Doc
pretty (SrcSpan -> Int
startCol SrcSpan
span)) Doc -> Doc -> Doc
<> Char -> Doc
char '-' Doc -> Doc -> Doc
<>
    Doc -> Doc
parens (Int -> Doc
forall a. Pretty a => a -> Doc
pretty (SrcSpan -> Int
endRow SrcSpan
span) Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<> Int -> Doc
forall a. Pretty a => a -> Doc
pretty (SrcSpan -> Int
endCol SrcSpan
span))

instance Span SrcLocation where
   getSpan :: SrcLocation -> SrcSpan
getSpan loc :: SrcLocation
loc@(Sloc {})
      = $WSpanPoint :: String -> Int -> Int -> SrcSpan
SpanPoint 
        { span_filename :: String
span_filename = SrcLocation -> String
sloc_filename SrcLocation
loc
        , span_row :: Int
span_row = SrcLocation -> Int
sloc_row SrcLocation
loc
        , span_column :: Int
span_column = SrcLocation -> Int
sloc_column SrcLocation
loc
        }
   getSpan NoLocation = SrcSpan
SpanEmpty 

-- | Make a point span from the start of a span
spanStartPoint :: SrcSpan -> SrcSpan
spanStartPoint :: SrcSpan -> SrcSpan
spanStartPoint SpanEmpty = SrcSpan
SpanEmpty
spanStartPoint span :: SrcSpan
span = 
   $WSpanPoint :: String -> Int -> Int -> SrcSpan
SpanPoint 
   { span_filename :: String
span_filename = SrcSpan -> String
span_filename SrcSpan
span
   , span_row :: Int
span_row = SrcSpan -> Int
startRow SrcSpan
span
   , span_column :: Int
span_column = SrcSpan -> Int
startCol SrcSpan
span
   }

-- | Make a span from two locations. Assumption: either the
-- arguments are the same, or the left one preceeds the right one.
mkSrcSpan :: SrcLocation -> SrcLocation -> SrcSpan
mkSrcSpan :: SrcLocation -> SrcLocation -> SrcSpan
mkSrcSpan NoLocation _ = SrcSpan
SpanEmpty
mkSrcSpan _ NoLocation = SrcSpan
SpanEmpty 
mkSrcSpan loc1 :: SrcLocation
loc1 loc2 :: SrcLocation
loc2
  | Int
line1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2 = 
       if Int
col2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
col1 
          then String -> Int -> Int -> SrcSpan
SpanPoint String
file Int
line1 Int
col1
          else String -> Int -> Int -> Int -> SrcSpan
SpanCoLinear String
file Int
line1 Int
col1 Int
col2
  | Bool
otherwise = 
       String -> Int -> Int -> Int -> Int -> SrcSpan
SpanMultiLine String
file Int
line1 Int
col1 Int
line2 Int
col2
  where
  line1 :: Int
line1 = SrcLocation -> Int
sloc_row SrcLocation
loc1
  line2 :: Int
line2 = SrcLocation -> Int
sloc_row SrcLocation
loc2
  col1 :: Int
col1 = SrcLocation -> Int
sloc_column SrcLocation
loc1
  col2 :: Int
col2 = SrcLocation -> Int
sloc_column SrcLocation
loc2
  file :: String
file = SrcLocation -> String
sloc_filename SrcLocation
loc1

-- | 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
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SpanEmpty r :: SrcSpan
r = SrcSpan
r -- this seems more useful
combineSrcSpans l :: SrcSpan
l SpanEmpty = SrcSpan
l
combineSrcSpans start :: SrcSpan
start end :: SrcSpan
end
 = case Int
row1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
row2 of
     EQ -> case Int
col1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
col2 of
                EQ -> String -> Int -> Int -> SrcSpan
SpanPoint String
file Int
row1 Int
col1
                LT -> String -> Int -> Int -> Int -> SrcSpan
SpanCoLinear String
file Int
row1 Int
col1 Int
col2
                GT -> String -> Int -> Int -> Int -> SrcSpan
SpanCoLinear String
file Int
row1 Int
col2 Int
col1
     LT -> String -> Int -> Int -> Int -> Int -> SrcSpan
SpanMultiLine String
file Int
row1 Int
col1 Int
row2 Int
col2
     GT -> String -> Int -> Int -> Int -> Int -> SrcSpan
SpanMultiLine String
file Int
row2 Int
col2 Int
row1 Int
col1
  where
  row1 :: Int
row1 = SrcSpan -> Int
startRow SrcSpan
start
  col1 :: Int
col1 = SrcSpan -> Int
startCol SrcSpan
start
  row2 :: Int
row2 = SrcSpan -> Int
endRow SrcSpan
end
  col2 :: Int
col2 = SrcSpan -> Int
endCol SrcSpan
end
  file :: String
file = SrcSpan -> String
span_filename SrcSpan
start

-- | Get the row of the start of a span.
startRow :: SrcSpan -> Int
startRow :: SrcSpan -> Int
startRow (SpanCoLinear { span_row :: SrcSpan -> Int
span_row = Int
row }) = Int
row
startRow (SpanMultiLine { span_start_row :: SrcSpan -> Int
span_start_row = Int
row }) = Int
row
startRow (SpanPoint { span_row :: SrcSpan -> Int
span_row = Int
row }) = Int
row
startRow SpanEmpty = String -> Int
forall a. HasCallStack => String -> a
error "startRow called on empty span"

-- | Get the row of the end of a span.
endRow :: SrcSpan -> Int
endRow :: SrcSpan -> Int
endRow (SpanCoLinear { span_row :: SrcSpan -> Int
span_row = Int
row }) = Int
row
endRow (SpanMultiLine { span_end_row :: SrcSpan -> Int
span_end_row = Int
row }) = Int
row
endRow (SpanPoint { span_row :: SrcSpan -> Int
span_row = Int
row }) = Int
row
endRow SpanEmpty = String -> Int
forall a. HasCallStack => String -> a
error "endRow called on empty span"

-- | Get the column of the start of a span.
startCol :: SrcSpan -> Int
startCol :: SrcSpan -> Int
startCol (SpanCoLinear { span_start_column :: SrcSpan -> Int
span_start_column = Int
col }) = Int
col 
startCol (SpanMultiLine { span_start_column :: SrcSpan -> Int
span_start_column = Int
col }) = Int
col 
startCol (SpanPoint { span_column :: SrcSpan -> Int
span_column = Int
col }) = Int
col 
startCol SpanEmpty = String -> Int
forall a. HasCallStack => String -> a
error "startCol called on empty span"

-- | Get the column of the end of a span.
endCol :: SrcSpan -> Int
endCol :: SrcSpan -> Int
endCol (SpanCoLinear { span_end_column :: SrcSpan -> Int
span_end_column = Int
col }) = Int
col 
endCol (SpanMultiLine { span_end_column :: SrcSpan -> Int
span_end_column = Int
col }) = Int
col 
endCol (SpanPoint { span_column :: SrcSpan -> Int
span_column = Int
col }) = Int
col 
endCol SpanEmpty = String -> Int
forall a. HasCallStack => String -> a
error "endCol called on empty span"