{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Hedgehog.Internal.Source (
    LineNo(..)
  , ColumnNo(..)
  , Span(..)
  , getCaller

  -- * Re-exports from "GHC.Stack"
  , CallStack
  , HasCallStack
  , callStack
  , withFrozenCallStack
  ) where

import GHC.Stack (CallStack, HasCallStack, SrcLoc(..))
import GHC.Stack (callStack, getCallStack, withFrozenCallStack)


newtype LineNo =
  LineNo {
      LineNo -> Int
unLineNo :: Int
    } deriving (LineNo -> LineNo -> Bool
(LineNo -> LineNo -> Bool)
-> (LineNo -> LineNo -> Bool) -> Eq LineNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineNo -> LineNo -> Bool
== :: LineNo -> LineNo -> Bool
$c/= :: LineNo -> LineNo -> Bool
/= :: LineNo -> LineNo -> Bool
Eq, Eq LineNo
Eq LineNo =>
(LineNo -> LineNo -> Ordering)
-> (LineNo -> LineNo -> Bool)
-> (LineNo -> LineNo -> Bool)
-> (LineNo -> LineNo -> Bool)
-> (LineNo -> LineNo -> Bool)
-> (LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo -> LineNo)
-> Ord LineNo
LineNo -> LineNo -> Bool
LineNo -> LineNo -> Ordering
LineNo -> LineNo -> LineNo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LineNo -> LineNo -> Ordering
compare :: LineNo -> LineNo -> Ordering
$c< :: LineNo -> LineNo -> Bool
< :: LineNo -> LineNo -> Bool
$c<= :: LineNo -> LineNo -> Bool
<= :: LineNo -> LineNo -> Bool
$c> :: LineNo -> LineNo -> Bool
> :: LineNo -> LineNo -> Bool
$c>= :: LineNo -> LineNo -> Bool
>= :: LineNo -> LineNo -> Bool
$cmax :: LineNo -> LineNo -> LineNo
max :: LineNo -> LineNo -> LineNo
$cmin :: LineNo -> LineNo -> LineNo
min :: LineNo -> LineNo -> LineNo
Ord, Integer -> LineNo
LineNo -> LineNo
LineNo -> LineNo -> LineNo
(LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo)
-> (LineNo -> LineNo)
-> (LineNo -> LineNo)
-> (Integer -> LineNo)
-> Num LineNo
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: LineNo -> LineNo -> LineNo
+ :: LineNo -> LineNo -> LineNo
$c- :: LineNo -> LineNo -> LineNo
- :: LineNo -> LineNo -> LineNo
$c* :: LineNo -> LineNo -> LineNo
* :: LineNo -> LineNo -> LineNo
$cnegate :: LineNo -> LineNo
negate :: LineNo -> LineNo
$cabs :: LineNo -> LineNo
abs :: LineNo -> LineNo
$csignum :: LineNo -> LineNo
signum :: LineNo -> LineNo
$cfromInteger :: Integer -> LineNo
fromInteger :: Integer -> LineNo
Num, Int -> LineNo
LineNo -> Int
LineNo -> [LineNo]
LineNo -> LineNo
LineNo -> LineNo -> [LineNo]
LineNo -> LineNo -> LineNo -> [LineNo]
(LineNo -> LineNo)
-> (LineNo -> LineNo)
-> (Int -> LineNo)
-> (LineNo -> Int)
-> (LineNo -> [LineNo])
-> (LineNo -> LineNo -> [LineNo])
-> (LineNo -> LineNo -> [LineNo])
-> (LineNo -> LineNo -> LineNo -> [LineNo])
-> Enum LineNo
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LineNo -> LineNo
succ :: LineNo -> LineNo
$cpred :: LineNo -> LineNo
pred :: LineNo -> LineNo
$ctoEnum :: Int -> LineNo
toEnum :: Int -> LineNo
$cfromEnum :: LineNo -> Int
fromEnum :: LineNo -> Int
$cenumFrom :: LineNo -> [LineNo]
enumFrom :: LineNo -> [LineNo]
$cenumFromThen :: LineNo -> LineNo -> [LineNo]
enumFromThen :: LineNo -> LineNo -> [LineNo]
$cenumFromTo :: LineNo -> LineNo -> [LineNo]
enumFromTo :: LineNo -> LineNo -> [LineNo]
$cenumFromThenTo :: LineNo -> LineNo -> LineNo -> [LineNo]
enumFromThenTo :: LineNo -> LineNo -> LineNo -> [LineNo]
Enum, Num LineNo
Ord LineNo
(Num LineNo, Ord LineNo) => (LineNo -> Rational) -> Real LineNo
LineNo -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: LineNo -> Rational
toRational :: LineNo -> Rational
Real, Enum LineNo
Real LineNo
(Real LineNo, Enum LineNo) =>
(LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo -> LineNo)
-> (LineNo -> LineNo -> (LineNo, LineNo))
-> (LineNo -> LineNo -> (LineNo, LineNo))
-> (LineNo -> Integer)
-> Integral LineNo
LineNo -> Integer
LineNo -> LineNo -> (LineNo, LineNo)
LineNo -> LineNo -> LineNo
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: LineNo -> LineNo -> LineNo
quot :: LineNo -> LineNo -> LineNo
$crem :: LineNo -> LineNo -> LineNo
rem :: LineNo -> LineNo -> LineNo
$cdiv :: LineNo -> LineNo -> LineNo
div :: LineNo -> LineNo -> LineNo
$cmod :: LineNo -> LineNo -> LineNo
mod :: LineNo -> LineNo -> LineNo
$cquotRem :: LineNo -> LineNo -> (LineNo, LineNo)
quotRem :: LineNo -> LineNo -> (LineNo, LineNo)
$cdivMod :: LineNo -> LineNo -> (LineNo, LineNo)
divMod :: LineNo -> LineNo -> (LineNo, LineNo)
$ctoInteger :: LineNo -> Integer
toInteger :: LineNo -> Integer
Integral)

newtype ColumnNo =
  ColumnNo {
      ColumnNo -> Int
unColumnNo :: Int
    } deriving (ColumnNo -> ColumnNo -> Bool
(ColumnNo -> ColumnNo -> Bool)
-> (ColumnNo -> ColumnNo -> Bool) -> Eq ColumnNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnNo -> ColumnNo -> Bool
== :: ColumnNo -> ColumnNo -> Bool
$c/= :: ColumnNo -> ColumnNo -> Bool
/= :: ColumnNo -> ColumnNo -> Bool
Eq, Eq ColumnNo
Eq ColumnNo =>
(ColumnNo -> ColumnNo -> Ordering)
-> (ColumnNo -> ColumnNo -> Bool)
-> (ColumnNo -> ColumnNo -> Bool)
-> (ColumnNo -> ColumnNo -> Bool)
-> (ColumnNo -> ColumnNo -> Bool)
-> (ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo -> ColumnNo)
-> Ord ColumnNo
ColumnNo -> ColumnNo -> Bool
ColumnNo -> ColumnNo -> Ordering
ColumnNo -> ColumnNo -> ColumnNo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ColumnNo -> ColumnNo -> Ordering
compare :: ColumnNo -> ColumnNo -> Ordering
$c< :: ColumnNo -> ColumnNo -> Bool
< :: ColumnNo -> ColumnNo -> Bool
$c<= :: ColumnNo -> ColumnNo -> Bool
<= :: ColumnNo -> ColumnNo -> Bool
$c> :: ColumnNo -> ColumnNo -> Bool
> :: ColumnNo -> ColumnNo -> Bool
$c>= :: ColumnNo -> ColumnNo -> Bool
>= :: ColumnNo -> ColumnNo -> Bool
$cmax :: ColumnNo -> ColumnNo -> ColumnNo
max :: ColumnNo -> ColumnNo -> ColumnNo
$cmin :: ColumnNo -> ColumnNo -> ColumnNo
min :: ColumnNo -> ColumnNo -> ColumnNo
Ord, Integer -> ColumnNo
ColumnNo -> ColumnNo
ColumnNo -> ColumnNo -> ColumnNo
(ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo)
-> (Integer -> ColumnNo)
-> Num ColumnNo
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ColumnNo -> ColumnNo -> ColumnNo
+ :: ColumnNo -> ColumnNo -> ColumnNo
$c- :: ColumnNo -> ColumnNo -> ColumnNo
- :: ColumnNo -> ColumnNo -> ColumnNo
$c* :: ColumnNo -> ColumnNo -> ColumnNo
* :: ColumnNo -> ColumnNo -> ColumnNo
$cnegate :: ColumnNo -> ColumnNo
negate :: ColumnNo -> ColumnNo
$cabs :: ColumnNo -> ColumnNo
abs :: ColumnNo -> ColumnNo
$csignum :: ColumnNo -> ColumnNo
signum :: ColumnNo -> ColumnNo
$cfromInteger :: Integer -> ColumnNo
fromInteger :: Integer -> ColumnNo
Num, Int -> ColumnNo
ColumnNo -> Int
ColumnNo -> [ColumnNo]
ColumnNo -> ColumnNo
ColumnNo -> ColumnNo -> [ColumnNo]
ColumnNo -> ColumnNo -> ColumnNo -> [ColumnNo]
(ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo)
-> (Int -> ColumnNo)
-> (ColumnNo -> Int)
-> (ColumnNo -> [ColumnNo])
-> (ColumnNo -> ColumnNo -> [ColumnNo])
-> (ColumnNo -> ColumnNo -> [ColumnNo])
-> (ColumnNo -> ColumnNo -> ColumnNo -> [ColumnNo])
-> Enum ColumnNo
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ColumnNo -> ColumnNo
succ :: ColumnNo -> ColumnNo
$cpred :: ColumnNo -> ColumnNo
pred :: ColumnNo -> ColumnNo
$ctoEnum :: Int -> ColumnNo
toEnum :: Int -> ColumnNo
$cfromEnum :: ColumnNo -> Int
fromEnum :: ColumnNo -> Int
$cenumFrom :: ColumnNo -> [ColumnNo]
enumFrom :: ColumnNo -> [ColumnNo]
$cenumFromThen :: ColumnNo -> ColumnNo -> [ColumnNo]
enumFromThen :: ColumnNo -> ColumnNo -> [ColumnNo]
$cenumFromTo :: ColumnNo -> ColumnNo -> [ColumnNo]
enumFromTo :: ColumnNo -> ColumnNo -> [ColumnNo]
$cenumFromThenTo :: ColumnNo -> ColumnNo -> ColumnNo -> [ColumnNo]
enumFromThenTo :: ColumnNo -> ColumnNo -> ColumnNo -> [ColumnNo]
Enum, Num ColumnNo
Ord ColumnNo
(Num ColumnNo, Ord ColumnNo) =>
(ColumnNo -> Rational) -> Real ColumnNo
ColumnNo -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ColumnNo -> Rational
toRational :: ColumnNo -> Rational
Real, Enum ColumnNo
Real ColumnNo
(Real ColumnNo, Enum ColumnNo) =>
(ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo -> ColumnNo)
-> (ColumnNo -> ColumnNo -> (ColumnNo, ColumnNo))
-> (ColumnNo -> ColumnNo -> (ColumnNo, ColumnNo))
-> (ColumnNo -> Integer)
-> Integral ColumnNo
ColumnNo -> Integer
ColumnNo -> ColumnNo -> (ColumnNo, ColumnNo)
ColumnNo -> ColumnNo -> ColumnNo
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ColumnNo -> ColumnNo -> ColumnNo
quot :: ColumnNo -> ColumnNo -> ColumnNo
$crem :: ColumnNo -> ColumnNo -> ColumnNo
rem :: ColumnNo -> ColumnNo -> ColumnNo
$cdiv :: ColumnNo -> ColumnNo -> ColumnNo
div :: ColumnNo -> ColumnNo -> ColumnNo
$cmod :: ColumnNo -> ColumnNo -> ColumnNo
mod :: ColumnNo -> ColumnNo -> ColumnNo
$cquotRem :: ColumnNo -> ColumnNo -> (ColumnNo, ColumnNo)
quotRem :: ColumnNo -> ColumnNo -> (ColumnNo, ColumnNo)
$cdivMod :: ColumnNo -> ColumnNo -> (ColumnNo, ColumnNo)
divMod :: ColumnNo -> ColumnNo -> (ColumnNo, ColumnNo)
$ctoInteger :: ColumnNo -> Integer
toInteger :: ColumnNo -> Integer
Integral)

data Span =
  Span {
      Span -> FilePath
spanFile :: !FilePath
    , Span -> LineNo
spanStartLine :: !LineNo
    , Span -> ColumnNo
spanStartColumn :: !ColumnNo
    , Span -> LineNo
spanEndLine :: !LineNo
    , Span -> ColumnNo
spanEndColumn :: !ColumnNo
    } deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Eq, Eq Span
Eq Span =>
(Span -> Span -> Ordering)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Span)
-> (Span -> Span -> Span)
-> Ord Span
Span -> Span -> Bool
Span -> Span -> Ordering
Span -> Span -> Span
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Span -> Span -> Ordering
compare :: Span -> Span -> Ordering
$c< :: Span -> Span -> Bool
< :: Span -> Span -> Bool
$c<= :: Span -> Span -> Bool
<= :: Span -> Span -> Bool
$c> :: Span -> Span -> Bool
> :: Span -> Span -> Bool
$c>= :: Span -> Span -> Bool
>= :: Span -> Span -> Bool
$cmax :: Span -> Span -> Span
max :: Span -> Span -> Span
$cmin :: Span -> Span -> Span
min :: Span -> Span -> Span
Ord)

getCaller :: CallStack -> Maybe Span
getCaller :: CallStack -> Maybe Span
getCaller CallStack
stack =
  case CallStack -> [(FilePath, SrcLoc)]
getCallStack CallStack
stack of
    [] ->
      Maybe Span
forall a. Maybe a
Nothing
    (FilePath
_, SrcLoc
x) : [(FilePath, SrcLoc)]
_ ->
      Span -> Maybe Span
forall a. a -> Maybe a
Just (Span -> Maybe Span) -> Span -> Maybe Span
forall a b. (a -> b) -> a -> b
$ FilePath -> LineNo -> ColumnNo -> LineNo -> ColumnNo -> Span
Span
        (SrcLoc -> FilePath
srcLocFile SrcLoc
x)
        (Int -> LineNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> LineNo) -> Int -> LineNo
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocStartLine SrcLoc
x)
        (Int -> ColumnNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ColumnNo) -> Int -> ColumnNo
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocStartCol SrcLoc
x)
        (Int -> LineNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> LineNo) -> Int -> LineNo
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocEndLine SrcLoc
x)
        (Int -> ColumnNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ColumnNo) -> Int -> ColumnNo
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocEndCol SrcLoc
x)

------------------------------------------------------------------------
-- Show instances

instance Show Span where
  showsPrec :: Int -> Span -> ShowS
showsPrec Int
p (Span FilePath
file LineNo
sl ColumnNo
sc LineNo
el ColumnNo
ec) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath -> ShowS
showString FilePath
"Span " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> FilePath -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 FilePath
file ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> LineNo -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 LineNo
sl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> ColumnNo -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ColumnNo
sc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> LineNo -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 LineNo
el ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> ColumnNo -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ColumnNo
ec

instance Show LineNo where
  showsPrec :: Int -> LineNo -> ShowS
showsPrec Int
p (LineNo Int
x) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath -> ShowS
showString FilePath
"LineNo " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
x

instance Show ColumnNo where
  showsPrec :: Int -> ColumnNo -> ShowS
showsPrec Int
p (ColumnNo Int
x) =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      FilePath -> ShowS
showString FilePath
"ColumnNo " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
x