{-# 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
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, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Location]
$creadListPrec :: ReadPrec [Location]
readPrec :: ReadPrec Location
$creadPrec :: ReadPrec Location
readList :: ReadS [Location]
$creadList :: ReadS [Location]
readsPrec :: Int -> ReadS Location
$creadsPrec :: Int -> ReadS Location
Read)

extractLocation :: SomeException -> Maybe Location
extractLocation :: SomeException -> Maybe Location
extractLocation SomeException
e =
      SomeException -> Maybe Location
locationFromErrorCall SomeException
e
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromPatternMatchFail SomeException
e
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromRecConError SomeException
e
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromIOException SomeException
e
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromNoMethodError SomeException
e
  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 forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
  Just (NoMethodError String
s) -> forall a. [a] -> Maybe a
listToMaybe (String -> [String]
words String
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Location
parseSourceSpan
  Maybe NoMethodError
Nothing -> forall a. Maybe a
Nothing

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

parseAssertionFailed :: String -> Maybe Location
parseAssertionFailed :: String -> Maybe Location
parseAssertionFailed String
loc = String -> Maybe Location
parseCallStack String
loc 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 forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
#if MIN_VERSION_base(4,9,0)
  Just (ErrorCallWithLocation String
err String
loc) ->
    String -> Maybe Location
parseCallStack String
loc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
#else
  Just (ErrorCall err) ->
#endif
    String -> Maybe Location
fromPatternMatchFailureInDoExpression String
err
  Maybe ErrorCall
Nothing -> forall a. Maybe a
Nothing

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

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

locationFromIOException :: SomeException -> Maybe Location
locationFromIOException :: SomeException -> Maybe Location
locationFromIOException SomeException
e = case 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
_ -> forall a. Maybe a
Nothing
  Maybe IOException
Nothing -> forall a. Maybe a
Nothing

fromPatternMatchFailureInDoExpression :: String -> Maybe Location
fromPatternMatchFailureInDoExpression :: String -> Maybe Location
fromPatternMatchFailureInDoExpression String
input =
#if MIN_VERSION_base(4,16,0)
  forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"Pattern match failure in 'do' block at " String
input 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 forall a. [a] -> [a]
reverse (String -> [String]
lines String
input) of
  [] -> 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
      [] -> forall a. Maybe a
Nothing
      Char
_ : String
ys -> case forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
xs of
        Just String
zs -> String -> Maybe Location
parseLocation (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => String -> Maybe a
readMaybe String
line forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) -> (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Location
mkLocation String
file) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Int, Int)
tuple forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, Int)
colonSeparated)
    where
      lineAndColumn :: String
      lineAndColumn :: String
lineAndColumn = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'-') String
xs

      tuple :: Maybe (Int, Int)
      tuple :: Maybe (Int, Int)
tuple = 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) -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => String -> Maybe a
readMaybe String
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => String -> Maybe a
readMaybe String
c

breakColon :: String -> (String, String)
breakColon :: String -> (String, String)
breakColon = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> [a] -> [a]
drop Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break (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
  forall a. a -> a
id
#endif