{-# LANGUAGE BangPatterns #-}

module Language.Haskell.Liquid.GHC.SpanStack
   ( -- * Stack of positions
     Span (..)
   , SpanStack

     -- * Creating Stacks
   , empty, push

     -- * Using Stacks
   , srcSpan

     -- * Creating general spans
   , 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
                                                  )

-- | Opaque type for a stack of spans
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 -- @(SpanStack stk)
  | Just SrcSpan
sp <- Span -> Maybe SrcSpan
spanSrcSpan Span
s = [(Span, SrcSpan)] -> SpanStack
SpanStack ((Span
s, SrcSpan
sp) forall a. a -> [a] -> [a]
: SpanStack -> [(Span, SrcSpan)]
unStack SpanStack
stk)
  | Bool
otherwise                = SpanStack
stk

-- | A single span
data Span
  = Var  !Ghc.Var         -- ^ binder for whom we are generating constraint
  | Tick !Ghc.CoreTickish -- ^ nearest known Source Span
  | Span SrcSpan

instance Show Span where
  show :: Span -> String
show (Var Var
x)   = forall a. Show a => a -> String
show Var
x
  show (Tick CoreTickish
tt) = forall a. Outputable a => a -> String
showPpr CoreTickish
tt
  show (Span SrcSpan
s)  = forall a. Show a => a -> String
show SrcSpan
s 

--------------------------------------------------------------------------------
srcSpan :: SpanStack -> SrcSpan
--------------------------------------------------------------------------------
srcSpan :: SpanStack -> SrcSpan
srcSpan SpanStack
s  = forall a. a -> Maybe a -> a
fromMaybe SrcSpan
noSpan (SpanStack -> Maybe SrcSpan
mbSrcSpan SpanStack
s)
  where
    noSpan :: SrcSpan
noSpan = forall a. Show a => a -> SrcSpan
showSpan String
"Yikes! No source information"

mbSrcSpan :: SpanStack -> Maybe SrcSpan
mbSrcSpan :: SpanStack -> Maybe SrcSpan
mbSrcSpan = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe  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 forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> SrcSpan
go
  where
    go :: Span -> SrcSpan
go (Var Var
x)   = 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
fsLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show