{-# LANGUAGE BangPatterns #-}
module Language.Haskell.Liquid.GHC.SpanStack
(
Span (..)
, SpanStack
, empty, push
, srcSpan
, showSpan
) where
import Prelude hiding (error)
import Data.Maybe (listToMaybe, fromMaybe)
import Language.Haskell.Liquid.GHC.Misc (tickSrcSpan, showPpr)
import qualified Liquid.GHC.API as Ghc
import Liquid.GHC.API ( SrcSpan
, fsLit
, getSrcSpan
, isGoodSrcSpan
, mkGeneralSrcSpan
)
newtype SpanStack = SpanStack { SpanStack -> [(Span, SrcSpan)]
unStack :: [(Span, SrcSpan)] }
empty :: SpanStack
empty :: SpanStack
empty = [(Span, SrcSpan)] -> SpanStack
SpanStack []
push :: Span -> SpanStack -> SpanStack
push :: Span -> SpanStack -> SpanStack
push !Span
s SpanStack
stk
| Just SrcSpan
sp <- Span -> Maybe SrcSpan
spanSrcSpan Span
s = [(Span, SrcSpan)] -> SpanStack
SpanStack ((Span
s, SrcSpan
sp) (Span, SrcSpan) -> [(Span, SrcSpan)] -> [(Span, SrcSpan)]
forall a. a -> [a] -> [a]
: SpanStack -> [(Span, SrcSpan)]
unStack SpanStack
stk)
| Bool
otherwise = SpanStack
stk
data Span
= Var !Ghc.Var
| Tick !Ghc.CoreTickish
| Span SrcSpan
instance Show Span where
show :: Span -> String
show (Var Var
x) = Var -> String
forall a. Show a => a -> String
show Var
x
show (Tick CoreTickish
tt) = CoreTickish -> String
forall a. Outputable a => a -> String
showPpr CoreTickish
tt
show (Span SrcSpan
s) = SrcSpan -> String
forall a. Show a => a -> String
show SrcSpan
s
srcSpan :: SpanStack -> SrcSpan
srcSpan :: SpanStack -> SrcSpan
srcSpan SpanStack
s = SrcSpan -> Maybe SrcSpan -> SrcSpan
forall a. a -> Maybe a -> a
fromMaybe SrcSpan
noSpan (SpanStack -> Maybe SrcSpan
mbSrcSpan SpanStack
s)
where
noSpan :: SrcSpan
noSpan = String -> SrcSpan
forall a. Show a => a -> SrcSpan
showSpan String
"Yikes! No source information"
mbSrcSpan :: SpanStack -> Maybe SrcSpan
mbSrcSpan :: SpanStack -> Maybe SrcSpan
mbSrcSpan = ((Span, SrcSpan) -> SrcSpan)
-> Maybe (Span, SrcSpan) -> Maybe SrcSpan
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Span, SrcSpan) -> SrcSpan
forall a b. (a, b) -> b
snd (Maybe (Span, SrcSpan) -> Maybe SrcSpan)
-> (SpanStack -> Maybe (Span, SrcSpan))
-> SpanStack
-> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Span, SrcSpan)] -> Maybe (Span, SrcSpan)
forall a. [a] -> Maybe a
listToMaybe ([(Span, SrcSpan)] -> Maybe (Span, SrcSpan))
-> (SpanStack -> [(Span, SrcSpan)])
-> SpanStack
-> Maybe (Span, SrcSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanStack -> [(Span, SrcSpan)]
unStack
spanSrcSpan :: Span -> Maybe SrcSpan
spanSrcSpan :: Span -> Maybe SrcSpan
spanSrcSpan = Maybe SrcSpan -> SrcSpan -> Maybe SrcSpan
maybeSpan Maybe SrcSpan
forall a. Maybe a
Nothing (SrcSpan -> Maybe SrcSpan)
-> (Span -> SrcSpan) -> Span -> Maybe SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> SrcSpan
go
where
go :: Span -> SrcSpan
go (Var Var
x) = Var -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Var
x
go (Tick CoreTickish
tt) = CoreTickish -> SrcSpan
tickSrcSpan CoreTickish
tt
go (Span SrcSpan
s) = SrcSpan
s
maybeSpan :: Maybe SrcSpan -> SrcSpan -> Maybe SrcSpan
maybeSpan :: Maybe SrcSpan -> SrcSpan -> Maybe SrcSpan
maybeSpan Maybe SrcSpan
d SrcSpan
sp
| SrcSpan -> Bool
isGoodSrcSpan SrcSpan
sp = SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
sp
| Bool
otherwise = Maybe SrcSpan
d
showSpan :: (Show a) => a -> SrcSpan
showSpan :: forall a. Show a => a -> SrcSpan
showSpan = FastString -> SrcSpan
mkGeneralSrcSpan (FastString -> SrcSpan) -> (a -> FastString) -> a -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
fsLit (String -> FastString) -> (a -> String) -> a -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show