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

-- for testing
, parseAssertionFailed
, parseCallStack
, parseLocation
, parseSourceSpan
) where

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

import           Control.Exception
import           Data.Char
import           Data.Maybe
import           GHC.IO.Exception

-- | @Location@ is used to represent source locations.
data Location = Location {
  Location -> [Char]
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
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Int -> Location -> ShowS
[Location] -> ShowS
Location -> [Char]
(Int -> Location -> ShowS)
-> (Location -> [Char]) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> [Char]
$cshow :: Location -> [Char]
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> 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
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
  Maybe Location -> Maybe Location -> Maybe Location
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromPatternMatchFail SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromRecConError SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromIOException SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeException -> Maybe Location
locationFromNoMethodError SomeException
e
  Maybe Location -> Maybe Location -> Maybe Location
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 [Char]
s) -> [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe ([Char] -> [[Char]]
words [Char]
s) Maybe [Char] -> ([Char] -> Maybe Location) -> Maybe Location
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> 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 [Char]
loc) -> [Char] -> Maybe Location
parseAssertionFailed [Char]
loc
  Maybe AssertionFailed
Nothing -> Maybe Location
forall a. Maybe a
Nothing

parseAssertionFailed :: String -> Maybe Location
parseAssertionFailed :: [Char] -> Maybe Location
parseAssertionFailed [Char]
loc = [Char] -> Maybe Location
parseCallStack [Char]
loc Maybe Location -> Maybe Location -> Maybe Location
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Maybe Location
parseSourceSpan [Char]
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
#if MIN_VERSION_base(4,9,0)
  Just (ErrorCallWithLocation [Char]
err [Char]
loc) ->
    [Char] -> Maybe Location
parseCallStack [Char]
loc Maybe Location -> Maybe Location -> Maybe Location
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
#else
  Just (ErrorCall err) ->
#endif
    [Char] -> Maybe Location
fromPatternMatchFailureInDoExpression [Char]
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 [Char]
s) -> [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe ([Char] -> [[Char]]
words [Char]
s) Maybe [Char] -> ([Char] -> Maybe Location) -> Maybe Location
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> 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 [Char]
s) -> [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe ([Char] -> [[Char]]
words [Char]
s) Maybe [Char] -> ([Char] -> Maybe Location) -> Maybe Location
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> 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 -> [Char]
ioe_description = [Char]
xs}) -> [Char] -> Maybe Location
fromPatternMatchFailureInDoExpression [Char]
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 :: [Char] -> Maybe Location
fromPatternMatchFailureInDoExpression [Char]
input =
#if MIN_VERSION_base(4,16,0)
  stripPrefix "Pattern match failure in 'do' block at " input >>= parseSourceSpan
#else
  [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"Pattern match failure in do expression at " [Char]
input Maybe [Char] -> ([Char] -> Maybe Location) -> Maybe Location
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe Location
parseSourceSpan
#endif

parseCallStack :: String -> Maybe Location
parseCallStack :: [Char] -> Maybe Location
parseCallStack [Char]
input = case [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([Char] -> [[Char]]
lines [Char]
input) of
  [] -> Maybe Location
forall a. Maybe a
Nothing
  [Char]
line : [[Char]]
_ -> [Char] -> Maybe Location
findLocation [Char]
line
  where
    findLocation :: [Char] -> Maybe Location
findLocation [Char]
xs = case [Char]
xs of
      [] -> Maybe Location
forall a. Maybe a
Nothing
      Char
_ : [Char]
ys -> case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
prefix [Char]
xs of
        Just [Char]
zs -> [Char] -> 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) [Char]
zs)
        Maybe [Char]
Nothing -> [Char] -> Maybe Location
findLocation [Char]
ys
    prefix :: [Char]
prefix = [Char]
", called at "

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

parseSourceSpan :: String -> Maybe Location
parseSourceSpan :: [Char] -> Maybe Location
parseSourceSpan [Char]
input = case [Char] -> ([Char], [Char])
breakColon [Char]
input of
  ([Char]
file, [Char]
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
$ [Char] -> Int -> Int -> Location
Location [Char]
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, Int)
colonSeparated)
    where
      lineAndColumn :: String
      lineAndColumn :: [Char]
lineAndColumn = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') [Char]
xs

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

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

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