{-# OPTIONS_GHC -Wno-orphans #-}
{-|
    Module      :  AERN2.Real.CKleenean
    Description :  lazy Kleenean
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    Lazy Kleenean, ie a sequence of Kleeneans, usually indexed by increasing precisions.
-}
module AERN2.Real.CKleenean
(
  CKleenean, CanBeCKleenean, ckleenean
)
where

import MixedTypesNumPrelude

import qualified Numeric.CollectErrors as CN

-- import Data.Complex

import qualified Data.List as List

import AERN2.Select

import AERN2.MP

import AERN2.Real.Type

type CKleenean = CSequence Kleenean

type CanBeCKleenean t = ConvertibleExactly t CKleenean

ckleenean :: (CanBeCKleenean t) => t -> CKleenean
ckleenean :: t -> CKleenean
ckleenean = t -> CKleenean
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

-- IsBool CKleenean:

instance (ConvertibleExactly t Kleenean) => ConvertibleExactly t CKleenean where
  safeConvertExactly :: t -> ConvertResult CKleenean
safeConvertExactly t
b = CKleenean -> ConvertResult CKleenean
forall a b. b -> Either a b
Right (CKleenean -> ConvertResult CKleenean)
-> CKleenean -> ConvertResult CKleenean
forall a b. (a -> b) -> a -> b
$ [CN Kleenean] -> CKleenean
forall t. [CN t] -> CSequence t
CSequence ([CN Kleenean] -> CKleenean) -> [CN Kleenean] -> CKleenean
forall a b. (a -> b) -> a -> b
$ CN Kleenean -> [CN Kleenean]
forall a. a -> [a]
List.repeat (CN Kleenean -> [CN Kleenean]) -> CN Kleenean -> [CN Kleenean]
forall a b. (a -> b) -> a -> b
$ Kleenean -> CN Kleenean
forall v. v -> CN v
cn (Kleenean -> CN Kleenean) -> Kleenean -> CN Kleenean
forall a b. (a -> b) -> a -> b
$ t -> Kleenean
forall t. CanBeKleenean t => t -> Kleenean
kleenean t
b

instance (CanNeg t) => CanNeg (CSequence t) where
  type NegType (CSequence t) = CSequence (NegType t)
  negate :: CSequence t -> NegType (CSequence t)
negate = (CN t -> CN (NegType t)) -> CSequence t -> CSequence (NegType t)
forall t1 t2. (CN t1 -> CN t2) -> CSequence t1 -> CSequence t2
lift1 CN t -> CN (NegType t)
forall t. CanNeg t => t -> NegType t
negate

instance (CanAndOrAsymmetric t1 t2) => CanAndOrAsymmetric (CSequence t1) (CSequence t2) where
  type AndOrType (CSequence t1)  (CSequence t2) = CSequence (AndOrType t1 t2)
  and2 :: CSequence t1
-> CSequence t2 -> AndOrType (CSequence t1) (CSequence t2)
and2 = (CN t1 -> CN t2 -> CN (AndOrType t1 t2))
-> CSequence t1 -> CSequence t2 -> CSequence (AndOrType t1 t2)
forall t1 t2 t3.
(CN t1 -> CN t2 -> CN t3)
-> CSequence t1 -> CSequence t2 -> CSequence t3
lift2 CN t1 -> CN t2 -> CN (AndOrType t1 t2)
forall t1 t2.
CanAndOrAsymmetric t1 t2 =>
t1 -> t2 -> AndOrType t1 t2
and2
  or2 :: CSequence t1
-> CSequence t2 -> AndOrType (CSequence t1) (CSequence t2)
or2 = (CN t1 -> CN t2 -> CN (AndOrType t1 t2))
-> CSequence t1 -> CSequence t2 -> CSequence (AndOrType t1 t2)
forall t1 t2 t3.
(CN t1 -> CN t2 -> CN t3)
-> CSequence t1 -> CSequence t2 -> CSequence t3
lift2 CN t1 -> CN t2 -> CN (AndOrType t1 t2)
forall t1 t2.
CanAndOrAsymmetric t1 t2 =>
t1 -> t2 -> AndOrType t1 t2
or2

instance CanSelect CKleenean where
  type SelectType CKleenean = CN Bool
  select :: CKleenean -> CKleenean -> SelectType CKleenean
select (CSequence [CN Kleenean]
s1) (CSequence [CN Kleenean]
s2) = [CN Kleenean] -> [CN Kleenean] -> CN Bool
forall es es.
(Monoid es, Monoid es, Eq es, Eq es, Show es, Show es,
 CanTestErrorsCertain es, CanTestErrorsCertain es,
 CanTestErrorsPresent es, CanTestErrorsPresent es) =>
[CollectErrors es Kleenean]
-> [CollectErrors es Kleenean] -> CN Bool
aux [CN Kleenean]
s1 [CN Kleenean]
s2
    where
    aux :: [CollectErrors es Kleenean]
-> [CollectErrors es Kleenean] -> CN Bool
aux (CollectErrors es Kleenean
k1 : [CollectErrors es Kleenean]
rest1) (CollectErrors es Kleenean
k2 : [CollectErrors es Kleenean]
rest2) =
      case (CollectErrors es Kleenean -> Either es Kleenean
forall es v. CanBeErrors es => CollectErrors es v -> Either es v
CN.toEither CollectErrors es Kleenean
k1, CollectErrors es Kleenean -> Either es Kleenean
forall es v. CanBeErrors es => CollectErrors es v -> Either es v
CN.toEither CollectErrors es Kleenean
k2) of
        (Right Kleenean
CertainTrue, Either es Kleenean
_) -> Bool -> CN Bool
forall v. v -> CN v
cn Bool
True 
        (Either es Kleenean
_, Right Kleenean
CertainTrue) -> Bool -> CN Bool
forall v. v -> CN v
cn Bool
False
        (Right Kleenean
CertainFalse, Right Kleenean
CertainFalse) -> 
          NumError -> CN Bool
forall v. NumError -> CN v
CN.noValueNumErrorCertain (NumError -> CN Bool) -> NumError -> CN Bool
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.NumError String
"select: Both branches failed!"
        (Either es Kleenean, Either es Kleenean)
_ -> [CollectErrors es Kleenean]
-> [CollectErrors es Kleenean] -> CN Bool
aux [CollectErrors es Kleenean]
rest1 [CollectErrors es Kleenean]
rest2
    aux [CollectErrors es Kleenean]
_ [CollectErrors es Kleenean]
_ = NumError -> CN Bool
forall v. NumError -> CN v
CN.noValueNumErrorCertain (NumError -> CN Bool) -> NumError -> CN Bool
forall a b. (a -> b) -> a -> b
$ String -> NumError
CN.NumError String
"select: internal error"

instance (CanUnionCNSameType t) =>
  HasIfThenElse CKleenean (CSequence t)
  where
  type IfThenElseType CKleenean (CSequence t) = (CSequence t)
  ifThenElse :: CKleenean
-> CSequence t
-> CSequence t
-> IfThenElseType CKleenean (CSequence t)
ifThenElse (CSequence [CN Kleenean]
sc) (CSequence [CN t]
s1) (CSequence [CN t]
s2) = ([CN t] -> CSequence t
forall t. [CN t] -> CSequence t
CSequence [CN t]
r)
    where
    r :: [CN t]
r = (CN Kleenean -> CN t -> CN t -> CN t)
-> [CN Kleenean] -> [CN t] -> [CN t] -> [CN t]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 CN Kleenean -> CN t -> CN t -> CN t
forall b t. HasIfThenElse b t => b -> t -> t -> IfThenElseType b t
ifThenElse [CN Kleenean]
sc [CN t]
s1 [CN t]
s2