{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}

-- | This module provides the 'Propagator' and 'HasPropagator' classes.
module Data.Recursive.Propagator.Class where

import Data.Monoid (Dual(..))
import qualified Data.Set as S
import Data.Coerce

import qualified Data.Recursive.Propagator.Naive as Naive
import Data.Recursive.Propagator.P2
import Data.POrder

-- | The Propagator class defines some functions shared by different propagator
-- implementations. This backs the generic "Data.Recursive.R.Internal" wrapper.
class Propagator p x | p -> x where
    -- | The type of values inside the propagator
    newProp :: IO p
    newConstProp :: x -> IO p
    readProp :: p -> IO x

instance Bottom x => Propagator (Naive.Prop x) x where
    newProp :: IO (Prop x)
newProp = forall a. a -> IO (Prop a)
Naive.newProp forall a. Bottom a => a
bottom
    newConstProp :: x -> IO (Prop x)
newConstProp = forall a. a -> IO (Prop a)
Naive.newProp
    readProp :: Prop x -> IO x
readProp = forall a. Prop a -> IO a
Naive.readProp

instance Propagator PBool Bool where
    newProp :: IO PBool
newProp = coerce :: forall a b. Coercible a b => a -> b
coerce IO P2
newP2
    newConstProp :: Bool -> IO PBool
newConstProp Bool
False = coerce :: forall a b. Coercible a b => a -> b
coerce IO P2
newP2
    newConstProp Bool
True = coerce :: forall a b. Coercible a b => a -> b
coerce IO P2
newTopP2
    readProp :: PBool -> IO Bool
readProp = coerce :: forall a b. Coercible a b => a -> b
coerce P2 -> IO Bool
isTop

instance Propagator PDualBool (Dual Bool) where
    newProp :: IO PDualBool
newProp = coerce :: forall a b. Coercible a b => a -> b
coerce IO P2
newP2
    newConstProp :: Dual Bool -> IO PDualBool
newConstProp (Dual Bool
True) = coerce :: forall a b. Coercible a b => a -> b
coerce IO P2
newP2
    newConstProp (Dual Bool
False) = coerce :: forall a b. Coercible a b => a -> b
coerce IO P2
newTopP2
    readProp :: PDualBool -> IO (Dual Bool)
readProp = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. P2 -> IO Bool
isTop

-- | The HasPropagator class is used to pick a propagator implementation for a
-- particular value type.
class Propagator (Prop x) x => HasPropagator x where
    type Prop x

instance HasPropagator Bool where
    type Prop Bool = PBool

instance HasPropagator (Dual Bool) where
    type Prop (Dual Bool) = PDualBool

instance Eq a => HasPropagator (S.Set a) where
    type Prop (S.Set a) = Naive.Prop (S.Set a)