{-# LANGUAGE DefaultSignatures #-}

module Language.Fortran.Util.Position where

import Data.Data
import Text.PrettyPrint.GenericPretty
import Text.PrettyPrint
import Data.Binary
import Control.DeepSeq
import Data.List.NonEmpty ( NonEmpty(..) )

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
posFilePath         :: 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
Ord, Typeable Position
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Position -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Position -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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
  { posAbsoluteOffset :: Int
posAbsoluteOffset = Int
0
  , posColumn :: Int
posColumn = Int
1
  , posLine :: Int
posLine = Int
1
  , posFilePath :: String
posFilePath = 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)
Nothing)       = (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
posFilePath Position
p

data SrcSpan = SrcSpan
  { SrcSpan -> Position
ssFrom :: Position
  , SrcSpan -> Position
ssTo   :: 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
Ord, Typeable, Typeable SrcSpan
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 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> SrcSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcSpan -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcSpan -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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

-- | Return the empty span at a given position (span between itself).
emptySpan :: Position -> SrcSpan
emptySpan :: Position -> SrcSpan
emptySpan Position
pos = Position -> Position -> SrcSpan
SrcSpan Position
pos Position
pos

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

instance Spanned SrcSpan where
  getSpan :: SrcSpan -> SrcSpan
getSpan = SrcSpan -> SrcSpan
forall a. a -> a
id
  setSpan :: SrcSpan -> SrcSpan -> SrcSpan
setSpan = SrcSpan -> SrcSpan -> SrcSpan
forall a b. a -> b -> a
const

class (Spanned a, Spanned b) => SpannedPair a b where
  getTransSpan :: a -> b -> SrcSpan

--------------------------------------------------------------------------------

instance (Spanned a) => Spanned [a] where
  getSpan :: [a] -> SrcSpan
getSpan [] = String -> SrcSpan
forall a. HasCallStack => String -> a
error String
"Trying to find how long an empty list spans for."
  getSpan [a
x]   = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  getSpan (a
x:[a]
xs) = a -> a -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x ([a] -> a
forall a. [a] -> a
last [a]
xs)
  setSpan :: SrcSpan -> [a] -> [a]
setSpan SrcSpan
_ [a]
_ = String -> [a]
forall a. HasCallStack => String -> a
error String
"Cannot set span to an array"

instance (Spanned a) => Spanned (NonEmpty a) where
  getSpan :: NonEmpty a -> SrcSpan
getSpan (a
x :| [])     = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  getSpan (a
x :| (a
y:[a]
ys)) = a -> a -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x ([a] -> a
forall a. [a] -> a
last (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys))
  setSpan :: SrcSpan -> NonEmpty a -> NonEmpty a
setSpan SrcSpan
_ NonEmpty a
_ = String -> NonEmpty a
forall a. HasCallStack => String -> a
error String
"Cannot set span to a non-empty list"

instance (Spanned a, Spanned b) => Spanned (a, Maybe b) where
  getSpan :: (a, Maybe b) -> SrcSpan
getSpan (a
x, Just b
y) = a -> b -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x b
y
  getSpan (a
x,Maybe b
_) = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  setSpan :: SrcSpan -> (a, Maybe b) -> (a, Maybe b)
setSpan SrcSpan
_ = (a, Maybe b) -> (a, Maybe b)
forall a. HasCallStack => a
undefined

instance (Spanned a, Spanned b) => Spanned (Maybe a, b) where
  getSpan :: (Maybe a, b) -> SrcSpan
getSpan (Just a
x,b
y) = a -> b -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x b
y
  getSpan (Maybe a
_,b
y) = b -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan b
y
  setSpan :: SrcSpan -> (Maybe a, b) -> (Maybe a, b)
setSpan SrcSpan
_ = (Maybe a, b) -> (Maybe a, b)
forall a. HasCallStack => a
undefined

instance (Spanned a, Spanned b) => Spanned (Either a b) where
  getSpan :: Either a b -> SrcSpan
getSpan (Left a
x) = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  getSpan (Right b
x) = b -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan b
x
  setSpan :: SrcSpan -> Either a b -> Either a b
setSpan SrcSpan
_ = Either a b -> Either a b
forall a. HasCallStack => a
undefined

instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b) => Spanned (a, b) where
  getSpan :: (a, b) -> SrcSpan
getSpan (a
x,b
y) = a -> b -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x b
y
  setSpan :: SrcSpan -> (a, b) -> (a, b)
setSpan SrcSpan
_ = (a, b) -> (a, b)
forall a. HasCallStack => a
undefined

instance {-# OVERLAPPING #-}(Spanned a, Spanned b, Spanned c) => Spanned (Maybe a, Maybe b, Maybe c) where
  getSpan :: (Maybe a, Maybe b, Maybe c) -> SrcSpan
getSpan (Just a
x,Maybe b
_,Just c
z) = a -> c -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x c
z
  getSpan (Just a
x,Just b
y,Maybe c
Nothing) = a -> b -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x b
y
  getSpan (Maybe a
Nothing,Just b
y,Just c
z) = b -> c -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan b
y c
z
  getSpan (Just a
x,Maybe b
Nothing,Maybe c
Nothing) = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  getSpan (Maybe a
Nothing,Just b
y,Maybe c
Nothing) = b -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan b
y
  getSpan (Maybe a
Nothing,Maybe b
Nothing,Just c
z) = c -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan c
z
  getSpan (Maybe a
Nothing,Maybe b
Nothing,Maybe c
Nothing) = SrcSpan
forall a. HasCallStack => a
undefined
  setSpan :: SrcSpan
-> (Maybe a, Maybe b, Maybe c) -> (Maybe a, Maybe b, Maybe c)
setSpan SrcSpan
_ = (Maybe a, Maybe b, Maybe c) -> (Maybe a, Maybe b, Maybe c)
forall a. HasCallStack => a
undefined

instance {-# OVERLAPPING #-}(Spanned a, Spanned b, Spanned c) => Spanned (a, Maybe b, Maybe c) where
  getSpan :: (a, Maybe b, Maybe c) -> SrcSpan
getSpan (a
x,Maybe b
_,Just c
z) = a -> c -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x c
z
  getSpan (a
x,Just b
y,Maybe c
Nothing) = a -> b -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x b
y
  getSpan (a
x,Maybe b
Nothing,Maybe c
Nothing) = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  setSpan :: SrcSpan -> (a, Maybe b, Maybe c) -> (a, Maybe b, Maybe c)
setSpan SrcSpan
_ = (a, Maybe b, Maybe c) -> (a, Maybe b, Maybe c)
forall a. HasCallStack => a
undefined

instance {-# OVERLAPPING #-} (Spanned a, Spanned b, Spanned c) => Spanned (Maybe a, b, c) where
  getSpan :: (Maybe a, b, c) -> SrcSpan
getSpan (Just a
x,b
_,c
z) = a -> c -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x c
z
  getSpan (Maybe a
_,b
y,c
z) = (b, c) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan (b
y,c
z)
  setSpan :: SrcSpan -> (Maybe a, b, c) -> (Maybe a, b, c)
setSpan SrcSpan
_ = (Maybe a, b, c) -> (Maybe a, b, c)
forall a. HasCallStack => a
undefined

instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b, Spanned c) => Spanned (a, b, c) where
  getSpan :: (a, b, c) -> SrcSpan
getSpan (a
x,b
_,c
z) = a -> c -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x c
z
  setSpan :: SrcSpan -> (a, b, c) -> (a, b, c)
setSpan SrcSpan
_ = (a, b, c) -> (a, b, c)
forall a. HasCallStack => a
undefined

instance {-# OVERLAPPABLE #-} (Spanned a, Spanned b) => SpannedPair a b where
  getTransSpan :: a -> b -> SrcSpan
getTransSpan a
x b
y = Position -> Position -> SrcSpan
SrcSpan Position
l1 Position
l2'
    where SrcSpan Position
l1 Position
_ = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
          SrcSpan Position
_ Position
l2' = b -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan b
y

instance {-# OVERLAPS #-} (Spanned a, Spanned b) => SpannedPair a [b] where
  getTransSpan :: a -> [b] -> SrcSpan
getTransSpan a
x [] = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  getTransSpan a
x [b]
y = Position -> Position -> SrcSpan
SrcSpan Position
l1 Position
l2'
    where SrcSpan Position
l1 Position
_ = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
          SrcSpan Position
_ Position
l2' = [b] -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan [b]
y

instance {-# OVERLAPS #-} (Spanned a, Spanned b) => SpannedPair a [[b]] where
  getTransSpan :: a -> [[b]] -> SrcSpan
getTransSpan a
x [] = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  getTransSpan a
x [[b]]
y | ([b] -> Bool) -> [[b]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[b]]
y = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
  getTransSpan a
x [[b]]
y | ([b] -> Bool) -> [[b]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[b]]
y = a -> [[b]] -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan a
x (([b] -> Bool) -> [[b]] -> [[b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([b] -> Bool) -> [b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[b]]
y)
  getTransSpan a
x [[b]]
y = Position -> Position -> SrcSpan
SrcSpan Position
l1 Position
l2'
    where SrcSpan Position
l1 Position
_ = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan a
x
          SrcSpan Position
_ Position
l2' = [[b]] -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan [[b]]
y