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

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

-- | 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 :: Position -> Position -> String -> Range
Range { from :: Position
from = Position
start, to :: Position
to = Position
start, source :: String
source = String
"" }

start :: Position
start :: Position
start = Position :: Int -> Int -> Position
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 :: Int
col = ((Position -> Int
col Position
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
            Char
'\n' -> Position
p { col :: Int
col = Int
1, line :: Int
line = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Position -> Int
line Position
p }
            Char
_    -> Position
p { col :: Int
col = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Position -> Int
col Position
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 :: Position -> Position -> String -> Range
Range { from :: Position
from = Position
rFrom, to :: Position
to = Position
rTo, source :: String
source = Range -> String
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 (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 = String -> Doc
text (Range -> String
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
<.> String -> Doc
text String
"--" 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 (String -> Doc
text String
"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
thing :: a
srcRange :: Range
thing :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
.. } = a -> Maybe Fixity
forall a. PPName a => a -> Maybe Fixity
ppNameFixity a
thing
  ppPrefixName :: Located a -> Doc
ppPrefixName  Located { a
Range
thing :: a
srcRange :: Range
thing :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
.. } = a -> Doc
forall a. PPName a => a -> Doc
ppPrefixName a
thing
  ppInfixName :: Located a -> Doc
ppInfixName   Located { a
Range
thing :: a
srcRange :: Range
thing :: forall a. Located a -> a
srcRange :: forall a. Located a -> Range
.. } = 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 (m :: * -> *) a. Monad m => a -> m a
return Range
l
                        Just Range
l1 -> Range -> Maybe Range
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 :: Range
srcRange = Range
r }
  dropLoc :: Located a -> Located a
dropLoc Located a
r  = Located a
r

at :: (HasLoc l, AddLoc t) => l -> t -> t
at :: 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 :: (a -> b -> c) -> Located a -> Located b -> Located c
combLoc a -> b -> c
f Located a
l1 Located b
l2 = Located :: forall a. Range -> a -> Located a
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)
                          }