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