{-# 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 =
        let args   = propertyGetArgs propertyTestArg
            checks = getChecks propertyTestArg
         in if checkHasFailed checks
                then printError args checks
                else (PropertySuccess, not (null args))
  where
    printError args checks = (PropertyFailed (mconcat $ loop 1 args), False)
      where
        loop :: Word -> [String] -> [String]
        loop _ []      = printChecks checks
        loop !i (a:as) = "parameter " <> show i <> " : " <> a <> "\n" : loop (i+1) as
    printChecks (PropertyBinaryOp True _ _ _)     = []
    printChecks (PropertyBinaryOp False n a b) =
        [ "Property `a " <> n <> " b' failed where:\n"
        , "    a = " <> a <> "\n"
        , "        " <> bl1 <> "\n"
        , "    b = " <> b <> "\n"
        , "        " <> bl2 <> "\n"
        ]
      where
        (bl1, bl2) = diffBlame a b
    printChecks (PropertyNamed True _)            = []
    printChecks (PropertyNamed False e)           = ["Property " <> e <> " failed"]
    printChecks (PropertyBoolean True)            = []
    printChecks (PropertyBoolean False)           = ["Property failed"]
    printChecks (PropertyFail _ e)                = ["Property failed: " <> e]
    printChecks (PropertyAnd True _ _)            = []
    printChecks (PropertyAnd False a1 a2) =
            [ "Property `cond1 && cond2' failed where:\n"
            , "   cond1 = " <> h1 <> "\n"

            ]
            <> ((<>) "           " <$>  hs1)
            <>
            [ "   cond2 = " <> h2 <> "\n"
            ]
            <> ((<>) "           " <$> hs2)
      where
        (h1, hs1) = f a1
        (h2, hs2) = f a2
        f a = case printChecks a of
                      [] -> ("Succeed", [])
                      (x:xs) -> (x, xs)

    propertyGetArgs (PropertyArg a p) = a : propertyGetArgs p
    propertyGetArgs (PropertyEOA _) = []

    getChecks (PropertyArg _ p) = getChecks p
    getChecks (PropertyEOA c  ) = c

diffBlame :: String -> String -> (String, String)
diffBlame a b = bimap fromList fromList $ go ([], []) (toList a) (toList b)
  where
    go (acc1, acc2) [] [] = (acc1, acc2)
    go (acc1, acc2) l1 [] = (acc1 <> blaming (length l1), acc2)
    go (acc1, acc2) [] l2 = (acc1                       , acc2 <> blaming (length l2))
    go (acc1, acc2) (x:xs) (y:ys)
        | x == y    = go (acc1 <> " ", acc2 <> " ") xs ys
        | otherwise = go (acc1 <> "^", acc2 <> "^") xs ys
    blaming n = replicate n '^'