{-# LANGUAGE CPP #-}
module Location where

import           Imports

import           Control.DeepSeq (deepseq, NFData(rnf))

#if __GLASGOW_HASKELL__ < 900
import           SrcLoc hiding (Located)
import qualified SrcLoc as GHC
import           FastString (unpackFS)
#else
import           GHC.Types.SrcLoc hiding (Located)
import qualified GHC.Types.SrcLoc as GHC
import           GHC.Data.FastString (unpackFS)
#endif

-- | A thing with a location attached.
data Located a = Located Location a
  deriving (Located a -> Located a -> Bool
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, Line -> Located a -> ShowS
forall a. Show a => Line -> Located a -> ShowS
forall a. Show a => [Located a] -> ShowS
forall a. Show a => Located a -> String
forall a.
(Line -> 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 :: Line -> Located a -> ShowS
$cshowsPrec :: forall a. Show a => Line -> Located a -> ShowS
Show, 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
<$ :: forall a b. a -> Located b -> Located a
$c<$ :: forall a b. a -> Located b -> Located a
fmap :: forall a b. (a -> b) -> Located a -> Located b
$cfmap :: forall a b. (a -> b) -> Located a -> Located b
Functor)

instance NFData a => NFData (Located a) where
  rnf :: Located a -> ()
rnf (Located Location
loc a
a) = Location
loc forall a b. NFData a => a -> b -> b
`deepseq` a
a forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | Convert a GHC located thing to a located thing.
toLocated :: GHC.Located a -> Located a
toLocated :: forall a. Located a -> Located a
toLocated (L SrcSpan
loc a
a) = forall a. Location -> a -> Located a
Located (SrcSpan -> Location
toLocation SrcSpan
loc) a
a

-- | Discard location information.
unLoc :: Located a -> a
unLoc :: forall a. Located a -> a
unLoc (Located Location
_ a
a) = a
a

-- | Add dummy location information.
noLocation :: a -> Located a
noLocation :: forall a. a -> Located a
noLocation = forall a. Location -> a -> Located a
Located (String -> Location
UnhelpfulLocation String
"<no location info>")

-- | A line number.
type Line = Int

-- | A combination of file name and line number.
data Location = UnhelpfulLocation String | Location FilePath Line
  deriving Location -> Location -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq

instance Show Location where
  show :: Location -> String
show (UnhelpfulLocation String
s) = String
s
  show (Location String
file Line
line)  = String
file forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Line
line

instance NFData Location where
  rnf :: Location -> ()
rnf (UnhelpfulLocation String
str) = String
str forall a b. NFData a => a -> b -> b
`deepseq` ()
  rnf (Location String
file Line
line)    = String
file forall a b. NFData a => a -> b -> b
`deepseq` Line
line forall a b. NFData a => a -> b -> b
`deepseq` ()

-- |
-- Create a list from a location, by repeatedly increasing the line number by
-- one.
enumerate :: Location -> [Location]
enumerate :: Location -> [Location]
enumerate Location
loc = case Location
loc of
  UnhelpfulLocation String
_ -> forall a. a -> [a]
repeat Location
loc
  Location String
file Line
line  -> forall a b. (a -> b) -> [a] -> [b]
map (String -> Line -> Location
Location String
file) [Line
line ..]

-- | Convert a GHC source span to a location.
toLocation :: SrcSpan -> Location
#if __GLASGOW_HASKELL__ < 900
toLocation loc = case loc of
  UnhelpfulSpan str -> UnhelpfulLocation (unpackFS str)
  RealSrcSpan sp    -> Location (unpackFS . srcSpanFile $ sp) (srcSpanStartLine sp)
#else
toLocation :: SrcSpan -> Location
toLocation SrcSpan
loc = case SrcSpan
loc of
  UnhelpfulSpan UnhelpfulSpanReason
str -> String -> Location
UnhelpfulLocation (FastString -> String
unpackFS forall a b. (a -> b) -> a -> b
$ UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
str)
  RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_  -> String -> Line -> Location
Location (FastString -> String
unpackFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealSrcSpan -> FastString
srcSpanFile forall a b. (a -> b) -> a -> b
$ RealSrcSpan
sp) (RealSrcSpan -> Line
srcSpanStartLine RealSrcSpan
sp)
#endif