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