{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} module Foundation.Check.Print ( propertyToResult , PropertyResult(..) , diffBlame ) where import Foundation.Check.Property import Foundation.Check.Types import Basement.Imports import Foundation.Collection import Basement.Compat.Bifunctor (bimap) import Foundation.Numerical propertyToResult :: PropertyTestArg -> (PropertyResult, Bool) propertyToResult :: PropertyTestArg -> (PropertyResult, Bool) propertyToResult propertyTestArg :: PropertyTestArg propertyTestArg = let args :: [String] args = PropertyTestArg -> [String] propertyGetArgs PropertyTestArg propertyTestArg checks :: PropertyCheck checks = PropertyTestArg -> PropertyCheck getChecks PropertyTestArg propertyTestArg in if PropertyCheck -> Bool checkHasFailed PropertyCheck checks then [String] -> PropertyCheck -> (PropertyResult, Bool) printError [String] args PropertyCheck checks else (PropertyResult PropertySuccess, Bool -> Bool not ([String] -> Bool forall c. Collection c => c -> Bool null [String] args)) where printError :: [String] -> PropertyCheck -> (PropertyResult, Bool) printError args :: [String] args checks :: PropertyCheck checks = (String -> PropertyResult PropertyFailed ([String] -> String forall a. Monoid a => [a] -> a mconcat ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ Word -> [String] -> [String] loop 1 [String] args), Bool False) where loop :: Word -> [String] -> [String] loop :: Word -> [String] -> [String] loop _ [] = PropertyCheck -> [String] printChecks PropertyCheck checks loop !Word i (a :: String a:as :: [String] as) = "parameter " String -> String -> String forall a. Semigroup a => a -> a -> a <> Word -> String forall a. Show a => a -> String show Word i String -> String -> String forall a. Semigroup a => a -> a -> a <> " : " String -> String -> String forall a. Semigroup a => a -> a -> a <> String a String -> String -> String forall a. Semigroup a => a -> a -> a <> "\n" String -> [String] -> [String] forall a. a -> [a] -> [a] : Word -> [String] -> [String] loop (Word iWord -> Word -> Word forall a. Additive a => a -> a -> a +1) [String] as printChecks :: PropertyCheck -> [String] printChecks (PropertyBinaryOp True _ _ _) = [] printChecks (PropertyBinaryOp False n :: String n a :: String a b :: String b) = [ "Property `a " String -> String -> String forall a. Semigroup a => a -> a -> a <> String n String -> String -> String forall a. Semigroup a => a -> a -> a <> " b' failed where:\n" , " a = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String a String -> String -> String forall a. Semigroup a => a -> a -> a <> "\n" , " " String -> String -> String forall a. Semigroup a => a -> a -> a <> String bl1 String -> String -> String forall a. Semigroup a => a -> a -> a <> "\n" , " b = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String b String -> String -> String forall a. Semigroup a => a -> a -> a <> "\n" , " " String -> String -> String forall a. Semigroup a => a -> a -> a <> String bl2 String -> String -> String forall a. Semigroup a => a -> a -> a <> "\n" ] where (bl1 :: String bl1, bl2 :: String bl2) = String -> String -> (String, String) diffBlame String a String b printChecks (PropertyNamed True _) = [] printChecks (PropertyNamed False e :: String e) = ["Property " String -> String -> String forall a. Semigroup a => a -> a -> a <> String e String -> String -> String forall a. Semigroup a => a -> a -> a <> " failed"] printChecks (PropertyBoolean True) = [] printChecks (PropertyBoolean False) = ["Property failed"] printChecks (PropertyFail _ e :: String e) = ["Property failed: " String -> String -> String forall a. Semigroup a => a -> a -> a <> String e] printChecks (PropertyAnd True _ _) = [] printChecks (PropertyAnd False a1 :: PropertyCheck a1 a2 :: PropertyCheck a2) = [ "Property `cond1 && cond2' failed where:\n" , " cond1 = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String h1 String -> String -> String forall a. Semigroup a => a -> a -> a <> "\n" ] [String] -> [String] -> [String] forall a. Semigroup a => a -> a -> a <> (String -> String -> String forall a. Semigroup a => a -> a -> a (<>) " " (String -> String) -> [String] -> [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] hs1) [String] -> [String] -> [String] forall a. Semigroup a => a -> a -> a <> [ " cond2 = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String h2 String -> String -> String forall a. Semigroup a => a -> a -> a <> "\n" ] [String] -> [String] -> [String] forall a. Semigroup a => a -> a -> a <> (String -> String -> String forall a. Semigroup a => a -> a -> a (<>) " " (String -> String) -> [String] -> [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] hs2) where (h1 :: String h1, hs1 :: [String] hs1) = PropertyCheck -> (String, [String]) f PropertyCheck a1 (h2 :: String h2, hs2 :: [String] hs2) = PropertyCheck -> (String, [String]) f PropertyCheck a2 f :: PropertyCheck -> (String, [String]) f a :: PropertyCheck a = case PropertyCheck -> [String] printChecks PropertyCheck a of [] -> ("Succeed", []) (x :: String x:xs :: [String] xs) -> (String x, [String] xs) propertyGetArgs :: PropertyTestArg -> [String] propertyGetArgs (PropertyArg a :: String a p :: PropertyTestArg p) = String a String -> [String] -> [String] forall a. a -> [a] -> [a] : PropertyTestArg -> [String] propertyGetArgs PropertyTestArg p propertyGetArgs (PropertyEOA _) = [] getChecks :: PropertyTestArg -> PropertyCheck getChecks (PropertyArg _ p :: PropertyTestArg p) = PropertyTestArg -> PropertyCheck getChecks PropertyTestArg p getChecks (PropertyEOA c :: PropertyCheck c ) = PropertyCheck c diffBlame :: String -> String -> (String, String) diffBlame :: String -> String -> (String, String) diffBlame a :: String a b :: String b = ([Char] -> String) -> ([Char] -> String) -> ([Char], [Char]) -> (String, String) forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap [Char] -> String forall l. IsList l => [Item l] -> l fromList [Char] -> String forall l. IsList l => [Item l] -> l fromList (([Char], [Char]) -> (String, String)) -> ([Char], [Char]) -> (String, String) forall a b. (a -> b) -> a -> b $ ([Char], [Char]) -> [Char] -> [Char] -> ([Char], [Char]) forall a a. (Sequential a, Sequential a, IsString a, IsString a, Element a ~ Char, Element a ~ Char) => (a, a) -> [Char] -> [Char] -> (a, a) go ([], []) (String -> [Item String] forall l. IsList l => l -> [Item l] toList String a) (String -> [Item String] forall l. IsList l => l -> [Item l] toList String b) where go :: (a, a) -> [Char] -> [Char] -> (a, a) go (acc1 :: a acc1, acc2 :: a acc2) [] [] = (a acc1, a acc2) go (acc1 :: a acc1, acc2 :: a acc2) l1 :: [Char] l1 [] = (a acc1 a -> a -> a forall a. Semigroup a => a -> a -> a <> CountOf (Element a) -> a forall c. (Sequential c, Element c ~ Char) => CountOf (Element c) -> c blaming ([Char] -> CountOf (Element [Char]) forall c. Collection c => c -> CountOf (Element c) length [Char] l1), a acc2) go (acc1 :: a acc1, acc2 :: a acc2) [] l2 :: [Char] l2 = (a acc1 , a acc2 a -> a -> a forall a. Semigroup a => a -> a -> a <> CountOf (Element a) -> a forall c. (Sequential c, Element c ~ Char) => CountOf (Element c) -> c blaming ([Char] -> CountOf (Element [Char]) forall c. Collection c => c -> CountOf (Element c) length [Char] l2)) go (acc1 :: a acc1, acc2 :: a acc2) (x :: Char x:xs :: [Char] xs) (y :: Char y:ys :: [Char] ys) | Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char y = (a, a) -> [Char] -> [Char] -> (a, a) go (a acc1 a -> a -> a forall a. Semigroup a => a -> a -> a <> " ", a acc2 a -> a -> a forall a. Semigroup a => a -> a -> a <> " ") [Char] xs [Char] ys | Bool otherwise = (a, a) -> [Char] -> [Char] -> (a, a) go (a acc1 a -> a -> a forall a. Semigroup a => a -> a -> a <> "^", a acc2 a -> a -> a forall a. Semigroup a => a -> a -> a <> "^") [Char] xs [Char] ys blaming :: CountOf (Element c) -> c blaming n :: CountOf (Element c) n = CountOf (Element c) -> Element c -> c forall c. Sequential c => CountOf (Element c) -> Element c -> c replicate CountOf (Element c) n Element c '^'