{-# LANGUAGE CPP #-}
module Test.Hspec.Core.Example.Location (
  Location(..)
, extractLocation

#ifdef TEST
, parseAssertionFailed
, parseCallStack
, parseLocation
, parseSourceSpan

, workaroundForIssue19236
#endif
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           Data.Char
import           GHC.IO.Exception

#ifdef mingw32_HOST_OS
import           System.FilePath
#endif

-- | @Location@ is used to represent source locations.
data Location = Location {
  Location -> String
locationFile :: FilePath
, Location -> Int
locationLine :: Int
, Location -> Int
locationColumn :: Int
} deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> String
show :: Location -> String
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
(Int -> ReadS Location)
-> ReadS [Location]
-> ReadPrec Location
-> ReadPrec [Location]
-> Read Location
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Location
readsPrec :: Int -> ReadS Location
$creadList :: ReadS [Location]
readList :: ReadS [Location]
$creadPrec :: ReadPrec Location
readPrec :: ReadPrec Location
$creadListPrec :: ReadPrec [Location]
readListPrec :: ReadPrec [Location]
Read)

extractLocation :: SomeException -> Maybe Location
extractLocation :: SomeException -> Maybe Location
extractLocation SomeException
e =
      SomeException -> Maybe Location
locationFromErrorCall SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromPatternMatchFail SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromRecConError SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromIOException SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromNoMethodError SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromAssertionFailed SomeException
e

locationFromNoMethodError :: SomeException -> Maybe Location
locationFromNoMethodError :: SomeException -> Maybe Location
locationFromNoMethodError SomeException
e = case SomeException -> Maybe NoMethodError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
  Just (NoMethodError String
s) -> [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe (String -> [String]
words String
s) Maybe String -> (String -> Maybe Location) -> Maybe Location
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Location
parseSourceSpan
  Maybe NoMethodError
Nothing -> Maybe Location
forall a. Maybe a
Nothing

locationFromAssertionFailed :: SomeException -> Maybe Location
locationFromAssertionFailed :: SomeException -> Maybe Location
locationFromAssertionFailed SomeException
e = case SomeException -> Maybe AssertionFailed
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
  Just (AssertionFailed String
loc) -> String -> Maybe Location
parseAssertionFailed String
loc
  Maybe AssertionFailed
Nothing -> Maybe Location
forall a. Maybe a
Nothing

parseAssertionFailed :: String -> Maybe Location
parseAssertionFailed :: String -> Maybe Location
parseAssertionFailed String
loc = String -> Maybe Location
parseCallStack String
loc Maybe Location -> Maybe Location -> Maybe Location
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe Location
parseSourceSpan String
loc

locationFromErrorCall :: SomeException -> Maybe Location
locationFromErrorCall :: SomeException -> Maybe Location
locationFromErrorCall SomeException
e = case SomeException -> Maybe ErrorCall
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
  Just (ErrorCallWithLocation String
err String
loc) ->
    String -> Maybe Location
parseCallStack String
loc Maybe Location -> Maybe Location -> Maybe Location
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    String -> Maybe Location
fromPatternMatchFailureInDoExpression String
err
  Maybe ErrorCall
Nothing -> Maybe Location
forall a. Maybe a
Nothing

locationFromPatternMatchFail :: SomeException -> Maybe Location
locationFromPatternMatchFail :: SomeException -> Maybe Location
locationFromPatternMatchFail SomeException
e = case SomeException -> Maybe PatternMatchFail
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
  Just (PatternMatchFail String
s) -> [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe (String -> [String]
words String
s) Maybe String -> (String -> Maybe Location) -> Maybe Location
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Location
parseSourceSpan
  Maybe PatternMatchFail
Nothing -> Maybe Location
forall a. Maybe a
Nothing

locationFromRecConError :: SomeException -> Maybe Location
locationFromRecConError :: SomeException -> Maybe Location
locationFromRecConError SomeException
e = case SomeException -> Maybe RecConError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
  Just (RecConError String
s) -> [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe (String -> [String]
words String
s) Maybe String -> (String -> Maybe Location) -> Maybe Location
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Location
parseSourceSpan
  Maybe RecConError
Nothing -> Maybe Location
forall a. Maybe a
Nothing

locationFromIOException :: SomeException -> Maybe Location
locationFromIOException :: SomeException -> Maybe Location
locationFromIOException SomeException
e = case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
  Just (IOError {ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
UserError, ioe_description :: IOException -> String
ioe_description = String
xs}) -> String -> Maybe Location
fromPatternMatchFailureInDoExpression String
xs
  Just IOException
_ -> Maybe Location
forall a. Maybe a
Nothing
  Maybe IOException
Nothing -> Maybe Location
forall a. Maybe a
Nothing

fromPatternMatchFailureInDoExpression :: String -> Maybe Location
fromPatternMatchFailureInDoExpression :: String -> Maybe Location
fromPatternMatchFailureInDoExpression String
input =
#if MIN_VERSION_base(4,16,0)
  String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"Pattern match failure in 'do' block at " String
input Maybe String -> (String -> Maybe Location) -> Maybe Location
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Location
parseSourceSpan
#else
  stripPrefix "Pattern match failure in do expression at " input >>= parseSourceSpan
#endif

parseCallStack :: String -> Maybe Location
parseCallStack :: String -> Maybe Location
parseCallStack String
input = case [String] -> [String]
forall a. [a] -> [a]
reverse (String -> [String]
lines String
input) of
  [] -> Maybe Location
forall a. Maybe a
Nothing
  String
line : [String]
_ -> String -> Maybe Location
findLocation String
line
  where
    findLocation :: String -> Maybe Location
findLocation String
xs = case String
xs of
      [] -> Maybe Location
forall a. Maybe a
Nothing
      Char
_ : String
ys -> case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
xs of
        Just String
zs -> String -> Maybe Location
parseLocation ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
zs)
        Maybe String
Nothing -> String -> Maybe Location
findLocation String
ys
    prefix :: String
prefix = String
", called at "

parseLocation :: String -> Maybe Location
parseLocation :: String -> Maybe Location
parseLocation String
input = case (String -> (String, String))
-> (String, String) -> (String, (String, String))
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> (String, String)
breakColon (String -> (String, String)
breakColon String
input) of
  (String
file, (String
line, String
column)) -> String -> Int -> Int -> Location
mkLocation String
file (Int -> Int -> Location) -> Maybe Int -> Maybe (Int -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
line Maybe (Int -> Location) -> Maybe Int -> Maybe Location
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
column

parseSourceSpan :: String -> Maybe Location
parseSourceSpan :: String -> Maybe Location
parseSourceSpan String
input = case String -> (String, String)
breakColon String
input of
  (String
file, String
xs) -> ((Int -> Int -> Location) -> (Int, Int) -> Location
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Int -> Location) -> (Int, Int) -> Location)
-> (Int -> Int -> Location) -> (Int, Int) -> Location
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Location
mkLocation String
file) ((Int, Int) -> Location) -> Maybe (Int, Int) -> Maybe Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Int, Int)
tuple Maybe (Int, Int) -> Maybe (Int, Int) -> Maybe (Int, Int)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, Int)
colonSeparated)
    where
      lineAndColumn :: String
      lineAndColumn :: String
lineAndColumn = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') String
xs

      tuple :: Maybe (Int, Int)
      tuple :: Maybe (Int, Int)
tuple = String -> Maybe (Int, Int)
forall a. Read a => String -> Maybe a
readMaybe String
lineAndColumn

      colonSeparated :: Maybe (Int, Int)
      colonSeparated :: Maybe (Int, Int)
colonSeparated = case String -> (String, String)
breakColon String
lineAndColumn of
        (String
l, String
c) -> (,) (Int -> Int -> (Int, Int))
-> Maybe Int -> Maybe (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
l Maybe (Int -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
c

breakColon :: String -> (String, String)
breakColon :: String -> (String, String)
breakColon = ShowS -> (String, String) -> (String, String)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1) ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')

mkLocation :: FilePath -> Int -> Int -> Location
mkLocation :: String -> Int -> Int -> Location
mkLocation String
file Int
line Int
column = String -> Int -> Int -> Location
Location (ShowS
workaroundForIssue19236 String
file) Int
line Int
column

workaroundForIssue19236 :: FilePath -> FilePath -- https://gitlab.haskell.org/ghc/ghc/-/issues/19236
workaroundForIssue19236 :: ShowS
workaroundForIssue19236 =
#ifdef mingw32_HOST_OS
  joinPath . splitDirectories
#else
  ShowS
forall a. a -> a
id
#endif