{-# 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 = 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 (forall c. Collection c => c -> Bool null [String] args)) where printError :: [String] -> PropertyCheck -> (PropertyResult, Bool) printError [String] args PropertyCheck checks = (String -> PropertyResult PropertyFailed (forall a. Monoid a => [a] -> a mconcat forall a b. (a -> b) -> a -> b $ Word -> [String] -> [String] loop Word 1 [String] args), Bool False) where loop :: Word -> [String] -> [String] loop :: Word -> [String] -> [String] loop Word _ [] = PropertyCheck -> [String] printChecks PropertyCheck checks loop !Word i (String a:[String] as) = String "parameter " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> String show Word i forall a. Semigroup a => a -> a -> a <> String " : " forall a. Semigroup a => a -> a -> a <> String a forall a. Semigroup a => a -> a -> a <> String "\n" forall a. a -> [a] -> [a] : Word -> [String] -> [String] loop (Word iforall a. Additive a => a -> a -> a +Word 1) [String] as printChecks :: PropertyCheck -> [String] printChecks (PropertyBinaryOp Bool True String _ String _ String _) = [] printChecks (PropertyBinaryOp Bool False String n String a String b) = [ String "Property `a " forall a. Semigroup a => a -> a -> a <> String n forall a. Semigroup a => a -> a -> a <> String " b' failed where:\n" , String " a = " forall a. Semigroup a => a -> a -> a <> String a forall a. Semigroup a => a -> a -> a <> String "\n" , String " " forall a. Semigroup a => a -> a -> a <> String bl1 forall a. Semigroup a => a -> a -> a <> String "\n" , String " b = " forall a. Semigroup a => a -> a -> a <> String b forall a. Semigroup a => a -> a -> a <> String "\n" , String " " forall a. Semigroup a => a -> a -> a <> String bl2 forall a. Semigroup a => a -> a -> a <> String "\n" ] where (String bl1, String bl2) = String -> String -> (String, String) diffBlame String a String b printChecks (PropertyNamed Bool True String _) = [] printChecks (PropertyNamed Bool False String e) = [String "Property " forall a. Semigroup a => a -> a -> a <> String e forall a. Semigroup a => a -> a -> a <> String " failed"] printChecks (PropertyBoolean Bool True) = [] printChecks (PropertyBoolean Bool False) = [String "Property failed"] printChecks (PropertyFail Bool _ String e) = [String "Property failed: " forall a. Semigroup a => a -> a -> a <> String e] printChecks (PropertyAnd Bool True PropertyCheck _ PropertyCheck _) = [] printChecks (PropertyAnd Bool False PropertyCheck a1 PropertyCheck a2) = [ String "Property `cond1 && cond2' failed where:\n" , String " cond1 = " forall a. Semigroup a => a -> a -> a <> String h1 forall a. Semigroup a => a -> a -> a <> String "\n" ] forall a. Semigroup a => a -> a -> a <> (forall a. Semigroup a => a -> a -> a (<>) String " " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] hs1) forall a. Semigroup a => a -> a -> a <> [ String " cond2 = " forall a. Semigroup a => a -> a -> a <> String h2 forall a. Semigroup a => a -> a -> a <> String "\n" ] forall a. Semigroup a => a -> a -> a <> (forall a. Semigroup a => a -> a -> a (<>) String " " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] hs2) where (String h1, [String] hs1) = PropertyCheck -> (String, [String]) f PropertyCheck a1 (String h2, [String] hs2) = PropertyCheck -> (String, [String]) f PropertyCheck a2 f :: PropertyCheck -> (String, [String]) f PropertyCheck a = case PropertyCheck -> [String] printChecks PropertyCheck a of [] -> (String "Succeed", []) (String x:[String] xs) -> (String x, [String] xs) propertyGetArgs :: PropertyTestArg -> [String] propertyGetArgs (PropertyArg String a PropertyTestArg p) = String a forall a. a -> [a] -> [a] : PropertyTestArg -> [String] propertyGetArgs PropertyTestArg p propertyGetArgs (PropertyEOA PropertyCheck _) = [] getChecks :: PropertyTestArg -> PropertyCheck getChecks (PropertyArg String _ PropertyTestArg p) = PropertyTestArg -> PropertyCheck getChecks PropertyTestArg p getChecks (PropertyEOA PropertyCheck c ) = PropertyCheck c diffBlame :: String -> String -> (String, String) diffBlame :: String -> String -> (String, String) diffBlame String a String b = forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap forall l. IsList l => [Item l] -> l fromList forall l. IsList l => [Item l] -> l fromList forall a b. (a -> b) -> a -> b $ forall {b} {a}. (Element b ~ Char, Element a ~ Char, Element a ~ Element b, Sequential a, Sequential b, Eq (Element a), IsString a, IsString b) => (a, b) -> [Element a] -> [Element a] -> (a, b) go ([], []) (forall l. IsList l => l -> [Item l] toList String a) (forall l. IsList l => l -> [Item l] toList String b) where go :: (a, b) -> [Element a] -> [Element a] -> (a, b) go (a acc1, b acc2) [] [] = (a acc1, b acc2) go (a acc1, b acc2) [Element a] l1 [] = (a acc1 forall a. Semigroup a => a -> a -> a <> forall {c}. (Element c ~ Char, Sequential c) => CountOf (Element c) -> c blaming (forall c. Collection c => c -> CountOf (Element c) length [Element a] l1), b acc2) go (a acc1, b acc2) [] [Element a] l2 = (a acc1 , b acc2 forall a. Semigroup a => a -> a -> a <> forall {c}. (Element c ~ Char, Sequential c) => CountOf (Element c) -> c blaming (forall c. Collection c => c -> CountOf (Element c) length [Element a] l2)) go (a acc1, b acc2) (Element a x:[Element a] xs) (Element a y:[Element a] ys) | Element a x forall a. Eq a => a -> a -> Bool == Element a y = (a, b) -> [Element a] -> [Element a] -> (a, b) go (a acc1 forall a. Semigroup a => a -> a -> a <> a " ", b acc2 forall a. Semigroup a => a -> a -> a <> b " ") [Element a] xs [Element a] ys | Bool otherwise = (a, b) -> [Element a] -> [Element a] -> (a, b) go (a acc1 forall a. Semigroup a => a -> a -> a <> a "^", b acc2 forall a. Semigroup a => a -> a -> a <> b "^") [Element a] xs [Element a] ys blaming :: CountOf (Element c) -> c blaming CountOf (Element c) n = forall c. Sequential c => CountOf (Element c) -> Element c -> c replicate CountOf (Element c) n Char '^'