{-# 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
'^'