{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} module Test.HMock.Internal.Util where import Data.MonoTraversable (Element) import qualified Data.Sequences as Seq import GHC.Stack (CallStack, getCallStack, prettySrcLoc) 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) 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 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 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) 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'