{-# LANGUAGE CPP, DeriveFunctor #-}
module Test.DocTest.Internal.Location where

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
(Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool) -> Eq (Located a)
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, Int -> Located a -> ShowS
[Located a] -> ShowS
Located a -> String
(Int -> Located a -> ShowS)
-> (Located a -> String)
-> ([Located a] -> ShowS)
-> Show (Located a)
forall a. Show a => Int -> Located a -> ShowS
forall a. Show a => [Located a] -> ShowS
forall a. Show a => Located a -> String
forall a.
(Int -> 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 :: Int -> Located a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Located a -> ShowS
Show, a -> Located b -> Located a
(a -> b) -> Located a -> Located b
(forall a b. (a -> b) -> Located a -> Located b)
-> (forall a b. a -> Located b -> Located a) -> Functor Located
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
<$ :: a -> Located b -> Located a
$c<$ :: forall a b. a -> Located b -> Located a
fmap :: (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 Location -> a -> a
forall a b. NFData a => a -> b -> b
`deepseq` a
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 :: Located a -> Located a
toLocated (L SrcSpan
loc a
a) = Location -> a -> Located a
forall a. Location -> a -> Located a
Located (SrcSpan -> Location
toLocation SrcSpan
loc) a
a

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

-- | Add dummy location information.
noLocation :: a -> Located a
noLocation :: a -> Located a
noLocation = Location -> a -> Located a
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
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
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 Int
line)  = String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line

instance NFData Location where
  rnf :: Location -> ()
rnf (UnhelpfulLocation String
str) = String
str String -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
  rnf (Location String
file Int
line)    = String
file String -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
line Int -> () -> ()
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
_ -> Location -> [Location]
forall a. a -> [a]
repeat Location
loc
  Location String
file Int
line  -> (Int -> Location) -> [Int] -> [Location]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> Location
Location String
file) [Int
line ..]

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