{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Internal utilities used for HMock implementation.
module Test.HMock.Internal.Util where

import Data.MonoTraversable (Element)
import qualified Data.Sequences as Seq
import GHC.Stack (CallStack, getCallStack, prettySrcLoc)

-- | A value together with its source location.
data Located a = Loc (Maybe String) a deriving (Located a -> Located a -> Bool
(Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool) -> Eq (Located a)
forall a. Eq a => Located a -> Located a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Located a -> Located a -> Bool
$c/= :: forall a. Eq a => Located a -> Located a -> Bool
== :: Located a -> Located a -> Bool
$c== :: forall a. Eq a => Located a -> Located a -> Bool
Eq, Eq (Located a)
Eq (Located a)
-> (Located a -> Located a -> Ordering)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Located a)
-> (Located a -> Located a -> Located a)
-> Ord (Located a)
Located a -> Located a -> Bool
Located a -> Located a -> Ordering
Located a -> Located a -> Located a
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
forall a. Ord a => Eq (Located a)
forall a. Ord a => Located a -> Located a -> Bool
forall a. Ord a => Located a -> Located a -> Ordering
forall a. Ord a => Located a -> Located a -> Located a
min :: Located a -> Located a -> Located a
$cmin :: forall a. Ord a => Located a -> Located a -> Located a
max :: Located a -> Located a -> Located a
$cmax :: forall a. Ord a => Located a -> Located a -> Located a
>= :: Located a -> Located a -> Bool
$c>= :: forall a. Ord a => Located a -> Located a -> Bool
> :: Located a -> Located a -> Bool
$c> :: forall a. Ord a => Located a -> Located a -> Bool
<= :: Located a -> Located a -> Bool
$c<= :: forall a. Ord a => Located a -> Located a -> Bool
< :: Located a -> Located a -> Bool
$c< :: forall a. Ord a => Located a -> Located a -> Bool
compare :: Located a -> Located a -> Ordering
$ccompare :: forall a. Ord a => Located a -> Located a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Located a)
Ord, a -> Located b -> Located a
(a -> b) -> Located a -> Located b
(forall a b. (a -> b) -> Located a -> Located b)
-> (forall a b. a -> Located b -> Located a) -> Functor Located
forall a b. a -> Located b -> Located a
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Located b -> Located a
$c<$ :: forall a b. a -> Located b -> Located a
fmap :: (a -> b) -> Located a -> Located b
$cfmap :: forall a b. (a -> b) -> Located a -> Located b
Functor)

-- | Annotates a value with its source location from the call stack.
locate :: CallStack -> a -> Located a
locate :: CallStack -> a -> Located a
locate CallStack
stack = case (([Char], SrcLoc) -> SrcLoc) -> [([Char], SrcLoc)] -> [SrcLoc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd (CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
stack) of
  (SrcLoc
loc : [SrcLoc]
_) -> Maybe [Char] -> a -> Located a
forall a. Maybe [Char] -> a -> Located a
Loc ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (SrcLoc -> [Char]
prettySrcLoc SrcLoc
loc))
  [SrcLoc]
_ -> Maybe [Char] -> a -> Located a
forall a. Maybe [Char] -> a -> Located a
Loc Maybe [Char]
forall a. Maybe a
Nothing

-- | Formats a 'Located' 'String' to include its source location.
withLoc :: Located String -> String
withLoc :: Located [Char] -> [Char]
withLoc (Loc Maybe [Char]
Nothing [Char]
s) = [Char]
s
withLoc (Loc (Just [Char]
loc) [Char]
s) = [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
loc

-- | Returns all ways to choose one element from a list, and the corresponding
-- remaining list.
choices :: [a] -> [(a, [a])]
choices :: [a] -> [(a, [a])]
choices [] = []
choices (a
x : [a]
xs) = (a
x, [a]
xs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: (([a] -> [a]) -> (a, [a]) -> (a, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((a, [a]) -> (a, [a])) -> [(a, [a])] -> [(a, [a])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
choices [a]
xs)

-- | Checks if one sequence is a subsequence of another.
isSubsequenceOf :: (Seq.IsSequence t, Eq (Element t)) => t -> t -> Bool
t
xs isSubsequenceOf :: t -> t -> Bool
`isSubsequenceOf` t
ys = case t -> Maybe (Element t, t)
forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
Seq.uncons t
xs of
  Maybe (Element t, t)
Nothing -> Bool
True
  Just (Element t
x, t
xs') -> case t -> Maybe (Element t, t)
forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
Seq.uncons ((t, t) -> t
forall a b. (a, b) -> b
snd ((Element t -> Bool) -> t -> (t, t)
forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
Seq.break (Element t -> Element t -> Bool
forall a. Eq a => a -> a -> Bool
== Element t
x) t
ys)) of
    Maybe (Element t, t)
Nothing -> Bool
False
    Just (Element t
_, t
ys') -> t
xs' t -> t -> Bool
forall t. (IsSequence t, Eq (Element t)) => t -> t -> Bool
`isSubsequenceOf` t
ys'