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

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

import GHC.Stack (CallStack, getCallStack, prettySrcLoc)

-- | A value together with its source location.
data Located a = Loc (Maybe String) a deriving (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
<$ :: forall a b. a -> Located b -> Located a
$c<$ :: forall a b. a -> Located b -> Located a
fmap :: forall a b. (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 :: forall a. CallStack -> a -> Located a
locate CallStack
stack = case forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
stack) of
  (SrcLoc
loc : [SrcLoc]
_) -> forall a. Maybe [Char] -> a -> Located a
Loc (forall a. a -> Maybe a
Just (SrcLoc -> [Char]
prettySrcLoc SrcLoc
loc))
  [SrcLoc]
_ -> forall a. Maybe [Char] -> a -> Located a
Loc 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 forall a. [a] -> [a] -> [a]
++ [Char]
" at " 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 :: forall a. [a] -> [(a, [a])]
choices [] = []
choices (a
x : [a]
xs) = (a
x, [a]
xs) forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [(a, [a])]
choices [a]
xs)