{-# 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 ([String] -> Bool forall c. Collection c => c -> Bool null [String] args)) where printError :: [String] -> PropertyCheck -> (PropertyResult, Bool) printError [String] args 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 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 " 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 -> String forall a. Semigroup a => a -> a -> a <> String a String -> String -> String forall a. Semigroup a => a -> a -> a <> String "\n" String -> [String] -> [String] forall a. a -> [a] -> [a] : Word -> [String] -> [String] loop (Word iWord -> Word -> Word forall 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 " String -> String -> String forall a. Semigroup a => a -> a -> a <> String n String -> String -> String forall a. Semigroup a => a -> a -> a <> String " b' failed where:\n" , String " a = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String a String -> String -> String forall a. Semigroup a => a -> a -> a <> String "\n" , String " " String -> String -> String forall a. Semigroup a => a -> a -> a <> String bl1 String -> String -> String forall a. Semigroup a => a -> a -> a <> String "\n" , String " b = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String b String -> String -> String forall a. Semigroup a => a -> a -> a <> String "\n" , String " " String -> String -> String forall a. Semigroup a => a -> a -> a <> String bl2 String -> String -> String 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 " String -> String -> String forall a. Semigroup a => a -> a -> a <> String e String -> String -> String 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: " String -> String -> String 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 = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String h1 String -> String -> String forall a. Semigroup a => a -> a -> a <> String "\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] -> [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 <> [ String " cond2 = " String -> String -> String forall a. Semigroup a => a -> a -> a <> String h2 String -> String -> String forall a. Semigroup a => a -> a -> a <> String "\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] -> [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 String -> [String] -> [String] 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 = ([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 (a acc1, a acc2) [] [] = (a acc1, a acc2) go (a acc1, a acc2) [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 (a acc1, a acc2) [] [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 (a acc1, a acc2) (Char x:[Char] xs) (Char y:[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 " ", a acc2 a -> a -> a forall a. Semigroup a => 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 "^", a acc2 a -> a -> a forall a. Semigroup a => a -> a -> a <> a "^") [Char] xs [Char] ys blaming :: CountOf (Element c) -> c blaming 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 Char Element c '^'