{-# 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           SrcLoc
import qualified Var
import           CoreSyn                   hiding (Tick, Var)
import           Name                             (getSrcSpan)
import           FastString                       (fsLit)
import           Data.Maybe                       (listToMaybe, fromMaybe)
import           Language.Haskell.Liquid.GHC.Misc (tickSrcSpan, showPpr)

-- | 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) (Span, SrcSpan) -> [(Span, SrcSpan)] -> [(Span, SrcSpan)]
forall a. a -> [a] -> [a]
: SpanStack -> [(Span, SrcSpan)]
unStack SpanStack
stk)
  | Bool
otherwise                = SpanStack
stk

-- | A single span
data Span
  = Var  !Var.Var           -- ^ binder for whom we are generating constraint
  | Tick !(Tickish Var.Var) -- ^ nearest known Source Span
  | 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 Tickish Var
tt) = Tickish Var -> String
forall a. Outputable a => a -> String
showPpr Tickish Var
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 (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 Tickish Var
tt) = Tickish Var -> SrcSpan
forall a. Outputable a => Tickish a -> SrcSpan
tickSrcSpan Tickish Var
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 :: 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