{-# 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.List
import           Data.Char
import           Data.Maybe
import           GHC.IO.Exception

-- | @Location@ is used to represent source locations.
data Location = Location {
  Location -> FilePath
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 -> FilePath
(Int -> Location -> ShowS)
-> (Location -> FilePath) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> FilePath
$cshow :: Location -> FilePath
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 FilePath
s) -> [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe (FilePath -> [FilePath]
words FilePath
s) Maybe FilePath -> (FilePath -> Maybe Location) -> Maybe Location
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> 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 FilePath
loc) -> FilePath -> Maybe Location
parseAssertionFailed FilePath
loc
  Maybe AssertionFailed
Nothing -> Maybe Location
forall a. Maybe a
Nothing

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

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

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

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

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

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

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