{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}

module Language.Fortran.Util.Position where

import Data.Data
import Text.PrettyPrint.GenericPretty
import Text.PrettyPrint
import Data.Binary
import Control.DeepSeq

import Language.Fortran.Util.SecondParameter

class Loc a where
  getPos :: a -> Position

data Position = Position
  { Position -> Int
posAbsoluteOffset   :: Int
  , Position -> Int
posColumn           :: Int
  , Position -> Int
posLine             :: Int
  , Position -> String
filePath            :: String
  , Position -> Maybe (Int, String)
posPragmaOffset     :: Maybe (Int, String)  -- ^ line-offset and filename as given by a pragma.
  } deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
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 :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord, Typeable Position
DataType
Constr
Typeable Position
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Position -> c Position)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Position)
-> (Position -> Constr)
-> (Position -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Position))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position))
-> ((forall b. Data b => b -> b) -> Position -> Position)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Position -> r)
-> (forall u. (forall d. Data d => d -> u) -> Position -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Position -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Position -> m Position)
-> Data Position
Position -> DataType
Position -> Constr
(forall b. Data b => b -> b) -> Position -> Position
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
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) -> Position -> u
forall u. (forall d. Data d => d -> u) -> Position -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cPosition :: Constr
$tPosition :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapMp :: (forall d. Data d => d -> m d) -> Position -> m Position
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapM :: (forall d. Data d => d -> m d) -> Position -> m Position
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Position -> m Position
gmapQi :: Int -> (forall d. Data d => d -> u) -> Position -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
gmapQ :: (forall d. Data d => d -> u) -> Position -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Position -> r
gmapT :: (forall b. Data b => b -> b) -> Position -> Position
$cgmapT :: (forall b. Data b => b -> b) -> Position -> Position
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Position)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Position)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Position)
dataTypeOf :: Position -> DataType
$cdataTypeOf :: Position -> DataType
toConstr :: Position -> Constr
$ctoConstr :: Position -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Position
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Position -> c Position
$cp1Data :: Typeable Position
Data, Typeable, (forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic)

instance Binary Position
instance NFData Position

instance Show Position where
  show :: Position -> String
show (Position Int
_ Int
c Int
l String
_ Maybe (Int, String)
_) = Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
c

initPosition :: Position
initPosition :: Position
initPosition = Position :: Int -> Int -> Int -> String -> Maybe (Int, String) -> Position
Position
  { posAbsoluteOffset :: Int
posAbsoluteOffset = Int
0
  , posColumn :: Int
posColumn = Int
1
  , posLine :: Int
posLine = Int
1
  , filePath :: String
filePath = String
""
  , posPragmaOffset :: Maybe (Int, String)
posPragmaOffset = Maybe (Int, String)
forall a. Maybe a
Nothing
  }

lineCol :: Position -> (Int, Int)
lineCol :: Position -> (Int, Int)
lineCol Position
p = (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Position -> Int
posLine Position
p, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Position -> Int
posColumn Position
p)

-- | (line, column) number taking into account any specified line pragmas.
apparentLineCol :: Position -> (Int, Int)
apparentLineCol :: Position -> (Int, Int)
apparentLineCol (Position Int
_ Int
c Int
l String
_ (Just (Int
o, String
_))) = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o, Int
c)
apparentLineCol (Position Int
_ Int
c Int
l String
_ Maybe (Int, String)
_)             = (Int
l, Int
c)

-- | Path of file taking into account any specified line pragmas.
apparentFilePath :: Position -> String
apparentFilePath :: Position -> String
apparentFilePath Position
p | Just (Int
_, String
f) <- Position -> Maybe (Int, String)
posPragmaOffset Position
p = String
f
                   | Bool
otherwise                        = Position -> String
filePath Position
p

data SrcSpan = SrcSpan Position Position 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, Typeable, Typeable SrcSpan
DataType
Constr
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 -> DataType
SrcSpan -> Constr
(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)
$cSrcSpan :: 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, (forall x. SrcSpan -> Rep SrcSpan x)
-> (forall x. Rep SrcSpan x -> SrcSpan) -> Generic SrcSpan
forall x. Rep SrcSpan x -> SrcSpan
forall x. SrcSpan -> Rep SrcSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrcSpan x -> SrcSpan
$cfrom :: forall x. SrcSpan -> Rep SrcSpan x
Generic)

instance Binary SrcSpan
instance NFData SrcSpan
instance Show SrcSpan where
  show :: SrcSpan -> String
show (SrcSpan Position
s1 Position
s2)= Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
: Position -> String
forall a. Show a => a -> String
show Position
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")-(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show Position
s2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Out SrcSpan where
  doc :: SrcSpan -> Doc
doc SrcSpan
s = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpan -> String
forall a. Show a => a -> String
show SrcSpan
s
  docPrec :: Int -> SrcSpan -> Doc
docPrec Int
_ = SrcSpan -> Doc
forall a. Out a => a -> Doc
doc

-- Difference between the column of the upper and lower positions in a span
columnDistance :: SrcSpan -> Int
columnDistance :: SrcSpan -> Int
columnDistance (SrcSpan (Position Int
_ Int
c1 Int
_ String
_ Maybe (Int, String)
_) (Position Int
_ Int
c2 Int
_ String
_ Maybe (Int, String)
_)) = Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c1

-- Difference between the lines of the upper and lower positions in a span
lineDistance :: SrcSpan -> Int
lineDistance :: SrcSpan -> Int
lineDistance (SrcSpan (Position Int
_ Int
_ Int
l1 String
_ Maybe (Int, String)
_) (Position Int
_ Int
_ Int
l2 String
_ Maybe (Int, String)
_)) = Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1

-- List of lines that are spanned
spannedLines :: SrcSpan -> [Int]
spannedLines :: SrcSpan -> [Int]
spannedLines (SrcSpan (Position Int
_ Int
_ Int
l1 String
_ Maybe (Int, String)
_) (Position Int
_ Int
_ Int
l2 String
_ Maybe (Int, String)
_)) = [Int
l1..Int
l2]

initSrcSpan :: SrcSpan
initSrcSpan :: SrcSpan
initSrcSpan = Position -> Position -> SrcSpan
SrcSpan Position
initPosition Position
initPosition

instance Spanned SrcSpan where
  getSpan :: SrcSpan -> SrcSpan
getSpan SrcSpan
s = SrcSpan
s
  setSpan :: SrcSpan -> SrcSpan -> SrcSpan
setSpan SrcSpan
_ SrcSpan
_ = SrcSpan
forall a. HasCallStack => a
undefined

class Spanned a where
  getSpan :: a -> SrcSpan
  setSpan :: SrcSpan -> a -> a

  default getSpan :: (SecondParameter a SrcSpan) => a -> SrcSpan
  getSpan = a -> SrcSpan
forall a e. SecondParameter a e => a -> e
getSecondParameter

  default setSpan :: (SecondParameter a SrcSpan) => SrcSpan -> a -> a
  setSpan = SrcSpan -> a -> a
forall a e. SecondParameter a e => e -> a -> a
setSecondParameter