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