{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables       #-}

{-# OPTIONS_GHC -Wno-orphans           #-}
{-# LANGUAGE DeriveAnyClass #-}

module Language.Fixpoint.Types.Spans (

  -- * Concrete Location Type
    SourcePos(..)
  , SourceName
  , SrcSpan (..)
  , Pos
  , predPos
  , safePos
  , safeSourcePos
  , succPos
  , unPos
  , mkPos

  -- * Located Values
  , Loc (..)
  , Located (..)

  -- * Constructing spans
  , dummySpan
  , panicSpan
  , locAt
  , dummyLoc
  , dummyPos
  , atLoc
  , toSourcePos
  , ofSourcePos

  -- * Destructing spans
  , sourcePosElts
  , srcLine
  ) where

-- import           Control.Exception
import           Control.DeepSeq
-- import qualified Control.Monad.Error           as E
import           Data.Serialize                (Serialize (..))
import           Data.Generics                 (Data)
import           Data.Hashable
import           Data.Typeable
import           Data.String
import qualified Data.Store                   as S
import           GHC.Generics                  (Generic)
import           Language.Fixpoint.Types.PrettyPrint
-- import           Language.Fixpoint.Misc
import           Text.Megaparsec.Pos
import           Text.PrettyPrint.HughesPJ
import           Text.Printf
import Data.Functor.Contravariant (Contravariant(contramap))
import qualified Data.Binary as B
import           Data.Aeson
-- import           Debug.Trace


-----------------------------------------------------------------------
-- | Located Values ---------------------------------------------------
-----------------------------------------------------------------------

class Loc a where
  srcSpan :: a -> SrcSpan

-----------------------------------------------------------------------
-- Additional (orphan) instances for megaparsec's Pos type ------------
-----------------------------------------------------------------------
instance S.Store Pos where
  poke :: Line -> Poke ()
poke = Int -> Poke ()
forall a. Store a => a -> Poke ()
S.poke (Int -> Poke ()) -> (Line -> Int) -> Line -> Poke ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Int
unPos
  peek :: Peek Line
peek = Int -> Line
mkPos (Int -> Line) -> Peek Int -> Peek Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek Int
forall a. Store a => Peek a
S.peek
  size :: Size Line
size = (Line -> Int) -> Size Int -> Size Line
forall a' a. (a' -> a) -> Size a -> Size a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap Line -> Int
unPos Size Int
forall a. Store a => Size a
S.size

instance Serialize Pos where
  put :: Putter Line
put = Putter Int
forall t. Serialize t => Putter t
put Putter Int -> (Line -> Int) -> Putter Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Int
unPos
  get :: Get Line
get = Int -> Line
mkPos (Int -> Line) -> Get Int -> Get Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Serialize t => Get t
get

instance Hashable Pos where
  hashWithSalt :: Int -> Line -> Int
hashWithSalt Int
i = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (Int -> Int) -> (Line -> Int) -> Line -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Int
unPos

instance PrintfArg Pos where
  formatArg :: Line -> FieldFormatter
formatArg = Int -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Int -> FieldFormatter) -> (Line -> Int) -> Line -> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Int
unPos
  parseFormat :: Line -> ModifierParser
parseFormat = Int -> ModifierParser
forall a. PrintfArg a => a -> ModifierParser
parseFormat (Int -> ModifierParser) -> (Line -> Int) -> Line -> ModifierParser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Int
unPos

-- | Computes, safely, the predecessor of a 'Pos' value, stopping at 1.
predPos :: Pos -> Pos
predPos :: Line -> Line
predPos Line
pos =
  Int -> Line
mkPos (Int -> Line) -> Int -> Line
forall a b. (a -> b) -> a -> b
$
  case Line -> Int
unPos Line
pos of
    Int
1 -> Int
1
    Int
atLeastTwo -> Int
atLeastTwo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Computes the successor of a 'Pos' value.
succPos :: Pos -> Pos
succPos :: Line -> Line
succPos Line
pos =
  Int -> Line
mkPos (Int -> Line) -> Int -> Line
forall a b. (a -> b) -> a -> b
$ Line -> Int
unPos Line
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Create, safely, as position. If a non-positive number is given,
-- we use 1.
--
safePos :: Int -> Pos
safePos :: Int -> Line
safePos Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Int -> Line
mkPos Int
1
  | Bool
otherwise = Int -> Line
mkPos Int
i

-- | Create a source position from integers, using 1 in case of
-- non-positive numbers.
safeSourcePos :: FilePath -> Int -> Int -> SourcePos
safeSourcePos :: SourceName -> Int -> Int -> SourcePos
safeSourcePos SourceName
file Int
line Int
col =
  SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
file (Int -> Line
safePos Int
line) (Int -> Line
safePos Int
col)

-----------------------------------------------------------------------
-- | Retrofitting instances to SourcePos ------------------------------
-----------------------------------------------------------------------

instance S.Store SourcePos where
  -- poke = S.poke . ofSourcePos
  -- peek = toSourcePos <$> S.peek

instance Serialize SourcePos where
  put :: Putter SourcePos
put = Putter (SourceName, Line, Line)
forall t. Serialize t => Putter t
put Putter (SourceName, Line, Line)
-> (SourcePos -> (SourceName, Line, Line)) -> Putter SourcePos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> (SourceName, Line, Line)
ofSourcePos
  get :: Get SourcePos
get = (SourceName, Line, Line) -> SourcePos
toSourcePos ((SourceName, Line, Line) -> SourcePos)
-> Get (SourceName, Line, Line) -> Get SourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (SourceName, Line, Line)
forall t. Serialize t => Get t
get

instance PPrint SourcePos where
  pprintTidy :: Tidy -> SourcePos -> Doc
pprintTidy Tidy
_ = SourcePos -> Doc
ppSourcePos

instance Hashable SourcePos where
  hashWithSalt :: Int -> SourcePos -> Int
hashWithSalt Int
i   = Int -> (SourceName, Line, Line) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i ((SourceName, Line, Line) -> Int)
-> (SourcePos -> (SourceName, Line, Line)) -> SourcePos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> (SourceName, Line, Line)
sourcePosElts

-- | This is a compatibility type synonym for megaparsec vs. parsec.
type SourceName = FilePath

-- | This is a compatibility type synonym for megaparsec vs. parsec.
type Line = Pos

-- | This is a compatibility type synonym for megaparsec vs. parsec.
type Column = Pos

ofSourcePos :: SourcePos -> (SourceName, Line, Column)
ofSourcePos :: SourcePos -> (SourceName, Line, Line)
ofSourcePos SourcePos
p = (SourceName
f, Line
l, Line
c)
  where
   f :: SourceName
f = SourcePos -> SourceName
sourceName   SourcePos
p
   l :: Line
l = SourcePos -> Line
sourceLine   SourcePos
p
   c :: Line
c = SourcePos -> Line
sourceColumn SourcePos
p

toSourcePos :: (SourceName, Line, Column) -> SourcePos
toSourcePos :: (SourceName, Line, Line) -> SourcePos
toSourcePos (SourceName
f, Line
l, Line
c) = SourceName -> Line -> Line -> SourcePos
SourcePos SourceName
f Line
l Line
c

sourcePosElts :: SourcePos -> (SourceName, Line, Column)
sourcePosElts :: SourcePos -> (SourceName, Line, Line)
sourcePosElts = SourcePos -> (SourceName, Line, Line)
ofSourcePos

ppSourcePos :: SourcePos -> Doc
ppSourcePos :: SourcePos -> Doc
ppSourcePos SourcePos
z = SourceName -> Doc
text (SourceName -> SourceName -> Line -> Line -> SourceName
forall r. PrintfType r => SourceName -> r
printf SourceName
"%s:%d:%d" SourceName
f Line
l Line
c)
  where
    (SourceName
f,Line
l,Line
c) = SourcePos -> (SourceName, Line, Line)
sourcePosElts SourcePos
z

instance Fixpoint SourcePos where
  toFix :: SourcePos -> Doc
toFix = SourceName -> Doc
text (SourceName -> Doc)
-> (SourcePos -> SourceName) -> SourcePos -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> SourceName
forall a. Show a => a -> SourceName
show


data Located a = Loc 
  { forall a. Located a -> SourcePos
loc  :: !SourcePos -- ^ Start Position
  , forall a. Located a -> SourcePos
locE :: !SourcePos -- ^ End Position
  , forall a. Located a -> a
val  :: !a
  } 
  deriving (Typeable (Located a)
Typeable (Located a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Located a -> c (Located a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Located a))
-> (Located a -> Constr)
-> (Located a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Located a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Located a)))
-> ((forall b. Data b => b -> b) -> Located a -> Located a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Located a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Located a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Located a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Located a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Located a -> m (Located a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Located a -> m (Located a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Located a -> m (Located a))
-> Data (Located a)
Located a -> Constr
Located a -> DataType
(forall b. Data b => b -> b) -> Located a -> Located a
forall a. Data a => Typeable (Located a)
forall a. Data a => Located a -> Constr
forall a. Data a => Located a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Located a -> Located a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Located a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Located a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Located a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Located a -> c (Located a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Located a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Located a))
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) -> Located a -> u
forall u. (forall d. Data d => d -> u) -> Located a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Located a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Located a -> c (Located a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Located a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Located a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Located a -> c (Located a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Located a -> c (Located a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Located a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Located a)
$ctoConstr :: forall a. Data a => Located a -> Constr
toConstr :: Located a -> Constr
$cdataTypeOf :: forall a. Data a => Located a -> DataType
dataTypeOf :: Located a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Located a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Located a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Located a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Located a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Located a -> Located a
gmapT :: (forall b. Data b => b -> b) -> Located a -> Located a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Located a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Located a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Located a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Located a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Located a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Located a -> m (Located a)
Data, Typeable, (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] -> Value
[Located a] -> Encoding
Located a -> Bool
Located a -> Value
Located a -> Encoding
(Located a -> Value)
-> (Located a -> Encoding)
-> ([Located a] -> Value)
-> ([Located a] -> Encoding)
-> (Located a -> Bool)
-> ToJSON (Located a)
forall a. ToJSON a => [Located a] -> Value
forall a. ToJSON a => [Located a] -> Encoding
forall a. ToJSON a => Located a -> Bool
forall a. ToJSON a => Located a -> Value
forall a. ToJSON a => Located a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => Located a -> Value
toJSON :: Located a -> Value
$ctoEncoding :: forall a. ToJSON a => Located a -> Encoding
toEncoding :: Located a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [Located a] -> Value
toJSONList :: [Located a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [Located a] -> Encoding
toEncodingList :: [Located a] -> Encoding
$comitField :: forall a. ToJSON a => Located a -> Bool
omitField :: Located a -> Bool
ToJSON, Maybe (Located a)
Value -> Parser [Located a]
Value -> Parser (Located a)
(Value -> Parser (Located a))
-> (Value -> Parser [Located a])
-> Maybe (Located a)
-> FromJSON (Located a)
forall a. FromJSON a => Maybe (Located a)
forall a. FromJSON a => Value -> Parser [Located a]
forall a. FromJSON a => Value -> Parser (Located a)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Located a)
parseJSON :: Value -> Parser (Located a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Located a]
parseJSONList :: Value -> Parser [Located a]
$comittedField :: forall a. FromJSON a => Maybe (Located a)
omittedField :: Maybe (Located a)
FromJSON)

instance ToJSON SourcePos where
instance FromJSON SourcePos where

instance Loc (Located a) where
  srcSpan :: Located a -> SrcSpan
srcSpan (Loc SourcePos
l SourcePos
l' a
_) = SourcePos -> SourcePos -> SrcSpan
SS SourcePos
l SourcePos
l'


instance (NFData a) => NFData (Located a)

instance Fixpoint a => Fixpoint (Located a) where
  toFix :: Located a -> Doc
toFix = a -> Doc
forall a. Fixpoint a => a -> Doc
toFix (a -> Doc) -> (Located a -> a) -> Located a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> a
forall a. Located a -> a
val

instance Functor Located where
  fmap :: forall a b. (a -> b) -> Located a -> Located b
fmap a -> b
f (Loc SourcePos
l SourcePos
l' a
x) =  SourcePos -> SourcePos -> b -> Located b
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
l SourcePos
l' (a -> b
f a
x)

instance Foldable Located where
  foldMap :: forall m a. Monoid m => (a -> m) -> Located a -> m
foldMap a -> m
f (Loc SourcePos
_ SourcePos
_ a
x) = a -> m
f a
x

instance Traversable Located where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
traverse a -> f b
f (Loc SourcePos
l SourcePos
l' a
x) = SourcePos -> SourcePos -> b -> Located b
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
l SourcePos
l' (b -> Located b) -> f b -> f (Located b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

instance Show a => Show (Located a) where
  show :: Located a -> SourceName
show (Loc SourcePos
l SourcePos
l' a
x)
    | SourcePos
l SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
l' Bool -> Bool -> Bool
&& SourcePos
l SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName -> SourcePos
dummyPos SourceName
"Fixpoint.Types.dummyLoc" = a -> SourceName
forall a. Show a => a -> SourceName
show a
x SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
" (dummyLoc)"
    | Bool
otherwise  = a -> SourceName
forall a. Show a => a -> SourceName
show a
x SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName
" defined at: " SourceName -> ShowS
forall a. [a] -> [a] -> [a]
++ Doc -> SourceName
render (SrcSpan -> Doc
ppSrcSpan (SourcePos -> SourcePos -> SrcSpan
SS SourcePos
l SourcePos
l'))

instance PPrint a => PPrint (Located a) where
  pprintTidy :: Tidy -> Located a -> Doc
pprintTidy Tidy
k (Loc SourcePos
_ SourcePos
_ a
x) = Tidy -> a -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k a
x

instance Eq a => Eq (Located a) where
  (Loc SourcePos
_ SourcePos
_ a
x) == :: Located a -> Located a -> Bool
== (Loc SourcePos
_ SourcePos
_ a
y) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

instance Ord a => Ord (Located a) where
  compare :: Located a -> Located a -> Ordering
compare Located a
x Located a
y = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Located a -> a
forall a. Located a -> a
val Located a
x) (Located a -> a
forall a. Located a -> a
val Located a
y)

instance (S.Store a) => S.Store (Located a)

instance Hashable a => Hashable (Located a) where
  hashWithSalt :: Int -> Located a -> Int
hashWithSalt Int
i = Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (a -> Int) -> (Located a -> a) -> Located a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> a
forall a. Located a -> a
val

instance (IsString a) => IsString (Located a) where
  fromString :: SourceName -> Located a
fromString = a -> Located a
forall a. a -> Located a
dummyLoc (a -> Located a) -> (SourceName -> a) -> SourceName -> Located a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> a
forall a. IsString a => SourceName -> a
fromString

-- | We need the Binary instances for LH's spec serialization
instance B.Binary Pos where
  put :: Line -> Put
put = Int -> Put
forall t. Binary t => t -> Put
B.put (Int -> Put) -> (Line -> Int) -> Line -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Int
unPos
  get :: Get Line
get = Int -> Line
mkPos (Int -> Line) -> Get Int -> Get Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
B.get

instance B.Binary SourcePos

instance (B.Binary a) => B.Binary (Located a)


instance ToJSON Pos where 

instance FromJSON Pos where

srcLine :: (Loc a) => a -> Pos
srcLine :: forall a. Loc a => a -> Line
srcLine = SourcePos -> Line
sourceLine (SourcePos -> Line) -> (a -> SourcePos) -> a -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SourcePos
sp_start (SrcSpan -> SourcePos) -> (a -> SrcSpan) -> a -> SourcePos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SrcSpan
forall a. Loc a => a -> SrcSpan
srcSpan

-----------------------------------------------------------------------
-- | A Reusable SrcSpan Type ------------------------------------------
-----------------------------------------------------------------------

data SrcSpan = SS { SrcSpan -> SourcePos
sp_start :: !SourcePos
                  , SrcSpan -> SourcePos
sp_stop  :: !SourcePos}
                 deriving (SrcSpan -> SrcSpan -> Bool
(SrcSpan -> SrcSpan -> Bool)
-> (SrcSpan -> SrcSpan -> Bool) -> Eq SrcSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcSpan -> SrcSpan -> Bool
== :: SrcSpan -> SrcSpan -> Bool
$c/= :: SrcSpan -> SrcSpan -> Bool
/= :: 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
$ccompare :: SrcSpan -> SrcSpan -> Ordering
compare :: SrcSpan -> SrcSpan -> Ordering
$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
>= :: SrcSpan -> SrcSpan -> Bool
$cmax :: SrcSpan -> SrcSpan -> SrcSpan
max :: SrcSpan -> SrcSpan -> SrcSpan
$cmin :: SrcSpan -> SrcSpan -> SrcSpan
min :: SrcSpan -> SrcSpan -> SrcSpan
Ord, Int -> SrcSpan -> ShowS
[SrcSpan] -> ShowS
SrcSpan -> SourceName
(Int -> SrcSpan -> ShowS)
-> (SrcSpan -> SourceName) -> ([SrcSpan] -> ShowS) -> Show SrcSpan
forall a.
(Int -> a -> ShowS)
-> (a -> SourceName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrcSpan -> ShowS
showsPrec :: Int -> SrcSpan -> ShowS
$cshow :: SrcSpan -> SourceName
show :: SrcSpan -> SourceName
$cshowList :: [SrcSpan] -> ShowS
showList :: [SrcSpan] -> ShowS
Show, 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 -> Constr
SrcSpan -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcSpan -> c SrcSpan
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SrcSpan -> c SrcSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcSpan
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SrcSpan
$ctoConstr :: SrcSpan -> Constr
toConstr :: SrcSpan -> Constr
$cdataTypeOf :: SrcSpan -> DataType
dataTypeOf :: SrcSpan -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcSpan)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SrcSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcSpan)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SrcSpan)
$cgmapT :: (forall b. Data b => b -> b) -> SrcSpan -> SrcSpan
gmapT :: (forall b. Data b => b -> b) -> SrcSpan -> SrcSpan
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SrcSpan -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SrcSpan -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SrcSpan -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcSpan -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SrcSpan -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SrcSpan -> m SrcSpan
Data, Typeable, (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
$cfrom :: forall x. SrcSpan -> Rep SrcSpan x
from :: forall x. SrcSpan -> Rep SrcSpan x
$cto :: forall x. Rep SrcSpan x -> SrcSpan
to :: forall x. Rep SrcSpan x -> SrcSpan
Generic, [SrcSpan] -> Value
[SrcSpan] -> Encoding
SrcSpan -> Bool
SrcSpan -> Value
SrcSpan -> Encoding
(SrcSpan -> Value)
-> (SrcSpan -> Encoding)
-> ([SrcSpan] -> Value)
-> ([SrcSpan] -> Encoding)
-> (SrcSpan -> Bool)
-> ToJSON SrcSpan
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SrcSpan -> Value
toJSON :: SrcSpan -> Value
$ctoEncoding :: SrcSpan -> Encoding
toEncoding :: SrcSpan -> Encoding
$ctoJSONList :: [SrcSpan] -> Value
toJSONList :: [SrcSpan] -> Value
$ctoEncodingList :: [SrcSpan] -> Encoding
toEncodingList :: [SrcSpan] -> Encoding
$comitField :: SrcSpan -> Bool
omitField :: SrcSpan -> Bool
ToJSON, Maybe SrcSpan
Value -> Parser [SrcSpan]
Value -> Parser SrcSpan
(Value -> Parser SrcSpan)
-> (Value -> Parser [SrcSpan]) -> Maybe SrcSpan -> FromJSON SrcSpan
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SrcSpan
parseJSON :: Value -> Parser SrcSpan
$cparseJSONList :: Value -> Parser [SrcSpan]
parseJSONList :: Value -> Parser [SrcSpan]
$comittedField :: Maybe SrcSpan
omittedField :: Maybe SrcSpan
FromJSON)

instance NFData SrcSpan
instance S.Store SrcSpan
instance Serialize SrcSpan
instance B.Binary SrcSpan

instance PPrint SrcSpan where
  pprintTidy :: Tidy -> SrcSpan -> Doc
pprintTidy Tidy
_ = SrcSpan -> Doc
ppSrcSpan

-- ppSrcSpan_short z = parens
--                   $ text (printf "file %s: (%d, %d) - (%d, %d)" (takeFileName f) l c l' c')
--   where
--     (f,l ,c )     = sourcePosElts $ sp_start z
--     (_,l',c')     = sourcePosElts $ sp_stop  z

ppSrcSpan :: SrcSpan -> Doc
ppSrcSpan :: SrcSpan -> Doc
ppSrcSpan SrcSpan
z       = SourceName -> Doc
text (SourceName
-> SourceName -> Line -> Line -> Line -> Line -> SourceName
forall r. PrintfType r => SourceName -> r
printf SourceName
"%s:%d:%d-%d:%d" SourceName
f Line
l Line
c Line
l' Line
c')
                -- parens $ text (printf "file %s: (%d, %d) - (%d, %d)" (takeFileName f) l c l' c')
  where
    (SourceName
f,Line
l ,Line
c )     = SourcePos -> (SourceName, Line, Line)
sourcePosElts (SourcePos -> (SourceName, Line, Line))
-> SourcePos -> (SourceName, Line, Line)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SourcePos
sp_start SrcSpan
z
    (SourceName
_,Line
l',Line
c')     = SourcePos -> (SourceName, Line, Line)
sourcePosElts (SourcePos -> (SourceName, Line, Line))
-> SourcePos -> (SourceName, Line, Line)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> SourcePos
sp_stop  SrcSpan
z


instance Hashable SrcSpan where
  hashWithSalt :: Int -> SrcSpan -> Int
hashWithSalt Int
i SrcSpan
z = Int -> (SourcePos, SourcePos) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (SrcSpan -> SourcePos
sp_start SrcSpan
z, SrcSpan -> SourcePos
sp_stop SrcSpan
z)

instance Loc SrcSpan where
  srcSpan :: SrcSpan -> SrcSpan
srcSpan SrcSpan
x = SrcSpan
x

instance Loc () where
  srcSpan :: () -> SrcSpan
srcSpan ()
_ = SrcSpan
dummySpan

instance Loc SourcePos where
  srcSpan :: SourcePos -> SrcSpan
srcSpan SourcePos
l = SourcePos -> SourcePos -> SrcSpan
SS SourcePos
l SourcePos
l

dummySpan :: SrcSpan
dummySpan :: SrcSpan
dummySpan = SourceName -> SrcSpan
panicSpan SourceName
""

panicSpan :: String -> SrcSpan
panicSpan :: SourceName -> SrcSpan
panicSpan SourceName
s = SourcePos -> SourcePos -> SrcSpan
SS SourcePos
l SourcePos
l
  where l :: SourcePos
l = SourceName -> SourcePos
initialPos SourceName
s

-- atLoc :: Located a -> b -> Located b
-- atLoc (Loc l l' _) = Loc l l'

atLoc :: (Loc l) => l -> b -> Located b
atLoc :: forall l b. Loc l => l -> b -> Located b
atLoc l
z b
x   = SourcePos -> SourcePos -> b -> Located b
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
l SourcePos
l' b
x
  where
    SS SourcePos
l SourcePos
l' = l -> SrcSpan
forall a. Loc a => a -> SrcSpan
srcSpan l
z


locAt :: String -> a -> Located a
locAt :: forall a. SourceName -> a -> Located a
locAt SourceName
s  = SourcePos -> SourcePos -> a -> Located a
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
l SourcePos
l
  where
    l :: SourcePos
l    = SourceName -> SourcePos
dummyPos SourceName
s

dummyLoc :: a -> Located a
dummyLoc :: forall a. a -> Located a
dummyLoc = SourcePos -> SourcePos -> a -> Located a
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
l SourcePos
l
  where
    l :: SourcePos
l    = SourceName -> SourcePos
dummyPos SourceName
"Fixpoint.Types.dummyLoc"

dummyPos   :: FilePath -> SourcePos
dummyPos :: SourceName -> SourcePos
dummyPos = SourceName -> SourcePos
initialPos