    {-# 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 a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap [Char] -> String
    [Item String] -> String
    forall l. IsList l => [Item l] -> l
    fromList [Char] -> String
    [Item String] -> 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 {b} {a}.
    (Element b ~ Char, Element a ~ Char, Item a ~ Char, Item b ~ Char,
     Sequential a, Sequential b, IsString a, IsString b) =>
    (a, b) -> [Char] -> [Char] -> (a, b)
    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, b) -> [Char] -> [Char] -> (a, b)
    go (a
    acc1, b
    acc2) [] [] = (a
    acc1, b
    acc2)
        go (a
    acc1, b
    acc2) [Char]
    l1 [] = (a
    acc1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> CountOf (Element a) -> a
    forall {c}.
    (Element c ~ Char, Item c ~ Char, Sequential c) =>
    CountOf (Element c) -> c
    blaming ([Char] -> CountOf (Element [Char])
    forall c. Collection c => c -> CountOf (Element c)
    length [Char]
    l1), b
    acc2)
        go (a
    acc1, b
    acc2) [] [Char]
    l2 = (a
    acc1                       , b
    acc2 b -> b -> b
    forall a. Semigroup a => a -> a -> a
    <> CountOf (Element b) -> b
    forall {c}.
    (Element c ~ Char, Item c ~ Char, Sequential c) =>
    CountOf (Element c) -> c
    blaming ([Char] -> CountOf (Element [Char])
    forall c. Collection c => c -> CountOf (Element c)
    length [Char]
    l2))
        go (a
    acc1, b
    acc2) (Char
    x:[Char]
    xs) (Char
    y:[Char]
    ys)
            | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    y    = (a, b) -> [Char] -> [Char] -> (a, b)
    go (a
    acc1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    " ", b
    acc2 b -> b -> b
    forall a. Semigroup a => a -> a -> a
    <> b
    " ") [Char]
    xs [Char]
    ys
            | Bool
    otherwise = (a, b) -> [Char] -> [Char] -> (a, b)
    go (a
    acc1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    "^", b
    acc2 b -> b -> b
    forall a. Semigroup a => a -> a -> a
    <> b
    "^") [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
    '^'