-- |
-- Module      :  Cryptol.Parser.Position
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE Safe #-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE RecordWildCards #-}
module Cryptol.Parser.Position where

import           Data.Text(Text)
import qualified Data.Text as T

import GHC.Generics (Generic)
import Control.DeepSeq

import Cryptol.Utils.PP

data Located a  = Located { forall a. Located a -> Range
srcRange :: !Range, forall a. Located a -> a
thing :: !a }
                  deriving (Located a -> Located a -> Bool
(Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool) -> Eq (Located a)
forall a. Eq a => Located a -> Located a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Located a -> Located a -> Bool
== :: Located a -> Located a -> Bool
$c/= :: forall a. Eq a => Located a -> Located a -> Bool
/= :: Located a -> Located a -> Bool
Eq, Eq (Located a)
Eq (Located a) =>
(Located a -> Located a -> Ordering)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Located a)
-> (Located a -> Located a -> Located a)
-> Ord (Located a)
Located a -> Located a -> Bool
Located a -> Located a -> Ordering
Located a -> Located a -> Located a
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 a. Ord a => Eq (Located a)
forall a. Ord a => Located a -> Located a -> Bool
forall a. Ord a => Located a -> Located a -> Ordering
forall a. Ord a => Located a -> Located a -> Located a
$ccompare :: forall a. Ord a => Located a -> Located a -> Ordering
compare :: Located a -> Located a -> Ordering
$c< :: forall a. Ord a => Located a -> Located a -> Bool
< :: Located a -> Located a -> Bool
$c<= :: forall a. Ord a => Located a -> Located a -> Bool
<= :: Located a -> Located a -> Bool
$c> :: forall a. Ord a => Located a -> Located a -> Bool
> :: Located a -> Located a -> Bool
$c>= :: forall a. Ord a => Located a -> Located a -> Bool
>= :: Located a -> Located a -> Bool
$cmax :: forall a. Ord a => Located a -> Located a -> Located a
max :: Located a -> Located a -> Located a
$cmin :: forall a. Ord a => Located a -> Located a -> Located a
min :: Located a -> Located a -> Located a
Ord, Int -> Located a -> ShowS
[Located a] -> ShowS
Located a -> FilePath
(Int -> Located a -> ShowS)
-> (Located a -> FilePath)
-> ([Located a] -> ShowS)
-> Show (Located a)
forall a. Show a => Int -> Located a -> ShowS
forall a. Show a => [Located a] -> ShowS
forall a. Show a => Located a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Located a -> ShowS
showsPrec :: Int -> Located a -> ShowS
$cshow :: forall a. Show a => Located a -> FilePath
show :: Located a -> FilePath
$cshowList :: forall a. Show a => [Located a] -> ShowS
showList :: [Located a] -> ShowS
Show, (forall x. Located a -> Rep (Located a) x)
-> (forall x. Rep (Located a) x -> Located a)
-> Generic (Located a)
forall x. Rep (Located a) x -> Located a
forall x. Located a -> Rep (Located a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Located a) x -> Located a
forall a x. Located a -> Rep (Located a) x
$cfrom :: forall a x. Located a -> Rep (Located a) x
from :: forall x. Located a -> Rep (Located a) x
$cto :: forall a x. Rep (Located a) x -> Located a
to :: forall x. Rep (Located a) x -> Located a
Generic, Located a -> ()
(Located a -> ()) -> NFData (Located a)
forall a. NFData a => Located a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => Located a -> ()
rnf :: Located a -> ()
NFData
                           , (forall a b. (a -> b) -> Located a -> Located b)
-> (forall a b. a -> Located b -> Located a) -> Functor Located
forall a b. a -> Located b -> Located a
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Located a -> Located b
fmap :: forall a b. (a -> b) -> Located a -> Located b
$c<$ :: forall a b. a -> Located b -> Located a
<$ :: forall a b. a -> Located b -> Located a
Functor, (forall m. Monoid m => Located m -> m)
-> (forall m a. Monoid m => (a -> m) -> Located a -> m)
-> (forall m a. Monoid m => (a -> m) -> Located a -> m)
-> (forall a b. (a -> b -> b) -> b -> Located a -> b)
-> (forall a b. (a -> b -> b) -> b -> Located a -> b)
-> (forall b a. (b -> a -> b) -> b -> Located a -> b)
-> (forall b a. (b -> a -> b) -> b -> Located a -> b)
-> (forall a. (a -> a -> a) -> Located a -> a)
-> (forall a. (a -> a -> a) -> Located a -> a)
-> (forall a. Located a -> [a])
-> (forall a. Located a -> Bool)
-> (forall a. Located a -> Int)
-> (forall a. Eq a => a -> Located a -> Bool)
-> (forall a. Ord a => Located a -> a)
-> (forall a. Ord a => Located a -> a)
-> (forall a. Num a => Located a -> a)
-> (forall a. Num a => Located a -> a)
-> Foldable Located
forall a. Eq a => a -> Located a -> Bool
forall a. Num a => Located a -> a
forall a. Ord a => Located a -> a
forall m. Monoid m => Located m -> m
forall a. Located a -> Bool
forall a. Located a -> Int
forall a. Located a -> [a]
forall a. (a -> a -> a) -> Located a -> a
forall m a. Monoid m => (a -> m) -> Located a -> m
forall b a. (b -> a -> b) -> b -> Located a -> b
forall a b. (a -> b -> b) -> b -> Located 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
$cfold :: forall m. Monoid m => Located m -> m
fold :: forall m. Monoid m => Located m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Located a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Located a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Located a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Located a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Located a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Located a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Located a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Located a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Located a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Located a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Located a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Located a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Located a -> a
foldr1 :: forall a. (a -> a -> a) -> Located a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Located a -> a
foldl1 :: forall a. (a -> a -> a) -> Located a -> a
$ctoList :: forall a. Located a -> [a]
toList :: forall a. Located a -> [a]
$cnull :: forall a. Located a -> Bool
null :: forall a. Located a -> Bool
$clength :: forall a. Located a -> Int
length :: forall a. Located a -> Int
$celem :: forall a. Eq a => a -> Located a -> Bool
elem :: forall a. Eq a => a -> Located a -> Bool
$cmaximum :: forall a. Ord a => Located a -> a
maximum :: forall a. Ord a => Located a -> a
$cminimum :: forall a. Ord a => Located a -> a
minimum :: forall a. Ord a => Located a -> a
$csum :: forall a. Num a => Located a -> a
sum :: forall a. Num a => Located a -> a
$cproduct :: forall a. Num a => Located a -> a
product :: forall a. Num a => Located a -> a
Foldable, Functor Located
Foldable Located
(Functor Located, Foldable Located) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Located a -> f (Located b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Located (f a) -> f (Located a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Located a -> m (Located b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Located (m a) -> m (Located a))
-> Traversable Located
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 (m :: * -> *) a. Monad m => Located (m a) -> m (Located a)
forall (f :: * -> *) a.
Applicative f =>
Located (f a) -> f (Located a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located a -> m (Located b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Located (f a) -> f (Located a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Located (f a) -> f (Located a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located a -> m (Located b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Located a -> m (Located b)
$csequence :: forall (m :: * -> *) a. Monad m => Located (m a) -> m (Located a)
sequence :: forall (m :: * -> *) a. Monad m => Located (m a) -> m (Located a)
Traversable )


data Position   = Position { Position -> Int
line :: !Int, Position -> Int
col :: !Int }
                  deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: 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
$ccompare :: Position -> Position -> Ordering
compare :: Position -> Position -> Ordering
$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
>= :: Position -> Position -> Bool
$cmax :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
min :: Position -> Position -> Position
Ord, Int -> Position -> ShowS
[Position] -> ShowS
Position -> FilePath
(Int -> Position -> ShowS)
-> (Position -> FilePath) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> FilePath
show :: Position -> FilePath
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show, (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
$cfrom :: forall x. Position -> Rep Position x
from :: forall x. Position -> Rep Position x
$cto :: forall x. Rep Position x -> Position
to :: forall x. Rep Position x -> Position
Generic, Position -> ()
(Position -> ()) -> NFData Position
forall a. (a -> ()) -> NFData a
$crnf :: Position -> ()
rnf :: Position -> ()
NFData)

data Range      = Range { Range -> Position
from   :: !Position
                        , Range -> Position
to     :: !Position
                        , Range -> FilePath
source :: FilePath }
                  deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Eq Range
Eq Range =>
(Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
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
$ccompare :: Range -> Range -> Ordering
compare :: Range -> Range -> Ordering
$c< :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
>= :: Range -> Range -> Bool
$cmax :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
min :: Range -> Range -> Range
Ord, Int -> Range -> ShowS
[Range] -> ShowS
Range -> FilePath
(Int -> Range -> ShowS)
-> (Range -> FilePath) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> FilePath
show :: Range -> FilePath
$cshowList :: [Range] -> ShowS
showList :: [Range] -> ShowS
Show, (forall x. Range -> Rep Range x)
-> (forall x. Rep Range x -> Range) -> Generic Range
forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Range -> Rep Range x
from :: forall x. Range -> Rep Range x
$cto :: forall x. Rep Range x -> Range
to :: forall x. Rep Range x -> Range
Generic, Range -> ()
(Range -> ()) -> NFData Range
forall a. (a -> ()) -> NFData a
$crnf :: Range -> ()
rnf :: Range -> ()
NFData)

-- | Returns `True` if the first range is contained in the second one.
rangeWithin :: Range -> Range -> Bool
Range
a rangeWithin :: Range -> Range -> Bool
`rangeWithin` Range
b =
  Range -> FilePath
source Range
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Range -> FilePath
source Range
b Bool -> Bool -> Bool
&& Range -> Position
from Range
a Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= Range -> Position
from Range
b Bool -> Bool -> Bool
&& Range -> Position
to Range
a Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Range -> Position
to Range
b

-- | An empty range.
--
-- Caution: using this on the LHS of a use of rComb will cause the empty source
-- to propagate.
emptyRange :: Range
emptyRange :: Range
emptyRange  = Range { from :: Position
from = Position
start, to :: Position
to = Position
start, source :: FilePath
source = FilePath
"" }

start :: Position
start :: Position
start = Position { line :: Int
line = Int
1, col :: Int
col = Int
1 }

move :: Position -> Char -> Position
move :: Position -> Char -> Position
move Position
p Char
c = case Char
c of
            Char
'\t' -> Position
p { col = ((col p + 7) `div` 8) * 8 + 1 }
            Char
'\n' -> Position
p { col = 1, line = 1 + line p }
            Char
_    -> Position
p { col = 1 + col p }

moves :: Position -> Text -> Position
moves :: Position -> Text -> Position
moves Position
p Text
cs = (Position -> Char -> Position) -> Position -> Text -> Position
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Position -> Char -> Position
move Position
p Text
cs

rComb :: Range -> Range -> Range
rComb :: Range -> Range -> Range
rComb Range
r1 Range
r2  = Range { from :: Position
from = Position
rFrom, to :: Position
to = Position
rTo, source :: FilePath
source = Range -> FilePath
source Range
r1 }
  where rFrom :: Position
rFrom = Position -> Position -> Position
forall a. Ord a => a -> a -> a
min (Range -> Position
from Range
r1) (Range -> Position
from Range
r2)
        rTo :: Position
rTo   = Position -> Position -> Position
forall a. Ord a => a -> a -> a
max (Range -> Position
to Range
r1)   (Range -> Position
to Range
r2)

rCombMaybe :: Maybe Range -> Maybe Range -> Maybe Range
rCombMaybe :: Maybe Range -> Maybe Range -> Maybe Range
rCombMaybe Maybe Range
Nothing Maybe Range
y = Maybe Range
y
rCombMaybe Maybe Range
x Maybe Range
Nothing = Maybe Range
x
rCombMaybe (Just Range
x) (Just Range
y) = Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Range -> Range
rComb Range
x Range
y)

rCombs :: [Range] -> Range
rCombs :: [Range] -> Range
rCombs  = (Range -> Range -> Range) -> [Range] -> Range
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Range -> Range -> Range
rComb


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

instance PP Position where
  ppPrec :: Int -> Position -> Doc
ppPrec Int
_ Position
p = Int -> Doc
int (Position -> Int
line Position
p) Doc -> Doc -> Doc
<.> Doc
colon Doc -> Doc -> Doc
<.> Int -> Doc
int (Position -> Int
col Position
p)

instance PP Range where
  ppPrec :: Int -> Range -> Doc
ppPrec Int
_ Range
r = FilePath -> Doc
text (Range -> FilePath
source Range
r) Doc -> Doc -> Doc
<.> Char -> Doc
char Char
':'
            Doc -> Doc -> Doc
<.> Position -> Doc
forall a. PP a => a -> Doc
pp (Range -> Position
from Range
r) Doc -> Doc -> Doc
<.> FilePath -> Doc
text FilePath
"--" Doc -> Doc -> Doc
<.> Position -> Doc
forall a. PP a => a -> Doc
pp (Range -> Position
to Range
r)

instance PP a => PP (Located a) where
  ppPrec :: Int -> Located a -> Doc
ppPrec Int
_ Located a
l = Doc -> Doc
parens (FilePath -> Doc
text FilePath
"at" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located a -> Range
forall a. Located a -> Range
srcRange Located a
l) Doc -> Doc -> Doc
<.> Doc
comma Doc -> Doc -> Doc
<+> a -> Doc
forall a. PP a => a -> Doc
pp (Located a -> a
forall a. Located a -> a
thing Located a
l))

instance PPName a => PPName (Located a) where
  ppNameFixity :: Located a -> Maybe Fixity
ppNameFixity  Located { a
Range
srcRange :: forall a. Located a -> Range
thing :: forall a. Located a -> a
srcRange :: Range
thing :: a
.. } = a -> Maybe Fixity
forall a. PPName a => a -> Maybe Fixity
ppNameFixity a
thing
  ppPrefixName :: Located a -> Doc
ppPrefixName  Located { a
Range
srcRange :: forall a. Located a -> Range
thing :: forall a. Located a -> a
srcRange :: Range
thing :: a
.. } = a -> Doc
forall a. PPName a => a -> Doc
ppPrefixName a
thing
  ppInfixName :: Located a -> Doc
ppInfixName   Located { a
Range
srcRange :: forall a. Located a -> Range
thing :: forall a. Located a -> a
srcRange :: Range
thing :: a
.. } = a -> Doc
forall a. PPName a => a -> Doc
ppInfixName  a
thing

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

class HasLoc t where
  getLoc :: t -> Maybe Range

instance HasLoc Range where
  getLoc :: Range -> Maybe Range
getLoc Range
r = Range -> Maybe Range
forall a. a -> Maybe a
Just Range
r

instance HasLoc (Located a) where
  getLoc :: Located a -> Maybe Range
getLoc Located a
r = Range -> Maybe Range
forall a. a -> Maybe a
Just (Located a -> Range
forall a. Located a -> Range
srcRange Located a
r)

instance (HasLoc a, HasLoc b) => HasLoc (a,b) where
  getLoc :: (a, b) -> Maybe Range
getLoc (a
f,b
t) = case a -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc a
f of
                   Maybe Range
Nothing -> b -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc b
t
                   Just Range
l ->
                      case b -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc b
t of
                        Maybe Range
Nothing -> Range -> Maybe Range
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Range
l
                        Just Range
l1 -> Range -> Maybe Range
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> Range -> Range
rComb Range
l Range
l1)

instance HasLoc a => HasLoc [a] where
  getLoc :: [a] -> Maybe Range
getLoc = Maybe Range -> [a] -> Maybe Range
forall {t}. HasLoc t => Maybe Range -> [t] -> Maybe Range
go Maybe Range
forall a. Maybe a
Nothing
    where
    go :: Maybe Range -> [t] -> Maybe Range
go Maybe Range
x [] = Maybe Range
x
    go Maybe Range
Nothing (t
x : [t]
xs)  = Maybe Range -> [t] -> Maybe Range
go (t -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc t
x) [t]
xs
    go (Just Range
l) (t
x : [t]
xs) = case t -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc t
x of
                             Maybe Range
Nothing -> Maybe Range -> [t] -> Maybe Range
go (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
l) [t]
xs
                             Just Range
l1 -> Maybe Range -> [t] -> Maybe Range
go (Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Range -> Range
rComb Range
l Range
l1)) [t]
xs

class HasLoc t => AddLoc t where
  addLoc  :: t -> Range -> t
  dropLoc :: t -> t

instance AddLoc (Located a) where
  addLoc :: Located a -> Range -> Located a
addLoc Located a
t Range
r = Located a
t { srcRange = r }
  dropLoc :: Located a -> Located a
dropLoc Located a
r  = Located a
r

at :: (HasLoc l, AddLoc t) => l -> t -> t
at :: forall l t. (HasLoc l, AddLoc t) => l -> t -> t
at l
l t
e = t -> (Range -> t) -> Maybe Range -> t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe t
e (t -> Range -> t
forall t. AddLoc t => t -> Range -> t
addLoc t
e) (l -> Maybe Range
forall t. HasLoc t => t -> Maybe Range
getLoc l
l)

combLoc :: (a -> b -> c) -> Located a -> Located b -> Located c
combLoc :: forall a b c. (a -> b -> c) -> Located a -> Located b -> Located c
combLoc a -> b -> c
f Located a
l1 Located b
l2 = Located { srcRange :: Range
srcRange = Range -> Range -> Range
rComb (Located a -> Range
forall a. Located a -> Range
srcRange Located a
l1) (Located b -> Range
forall a. Located a -> Range
srcRange Located b
l2)
                          , thing :: c
thing    = a -> b -> c
f (Located a -> a
forall a. Located a -> a
thing Located a
l1) (Located b -> b
forall a. Located a -> a
thing Located b
l2)
                          }