{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveTraversable, MultiParamTypeClasses, Safe, TemplateHaskellQuotes #-}

{-|
Module      : Dep.Data.Three
Description : A module that defines a /three/ data structure, used for lookup tables with don't cares.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

This modules defines a /three/, a tree-like data structure with a leaf, a node, and a link where both
subtrees are the same. This is used to make more compact and efficient representations of a boolean function.
-}

module Dep.Data.Three (
    -- * Defining a three
    Three(Leaf, Link, Split)
    -- * Paths in a three
  , ThreePath, ThreeStep
    -- * Catamorphisms
  , three, depth, leftmost, rightmost
    -- * Manipulate a 'Three'
  , flipThree, flipAllThree
    -- * Lookups and constructions
  , nstep, apply, applyTo, wipe, wipeAll
    -- * Retrieve children according to a path
  , children, children'
    -- * Convert the 'Three' to an key-value list
  , toTraces, toTraces', toTraces''
  ) where

import Control.Applicative(Applicative(liftA2))
import Control.DeepSeq(NFData, NFData1)

import Data.Binary(Binary(put, get), getWord8, putWord8)
import Data.Bool(bool)
import Data.Data(Data)
import Data.Default(Default(def))
import Data.Functor.Classes(Eq1(liftEq), Ord1(liftCompare))
import Data.Hashable(Hashable)
import Data.Hashable.Lifted(Hashable1)

import Dep.Class.NonDeterministicWalkable(NonDeterministicWalkable(nstep, nstep'))
import Dep.Class.Opposite(Opposite)
import Dep.Class.Simplify(Simplify(simplify))
import Dep.Class.Walkable(Walkable(step))
import Dep.Data.ThreeValue(ThreeValue(DontCare, Zero, One), ThreeValues)
import Dep.Utils(applyExp')

import GHC.Generics(Generic, Generic1)

import Language.Haskell.TH.Syntax(Lift(lift, liftTyped), TExp(TExp))

import Test.QuickCheck(frequency)
import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary, shrink), Arbitrary1(liftArbitrary), arbitrary1)

-- | A data structure used to specify a mapping from a list of booleans
-- to a value in a more compact way. This datastructure can effectively
-- be used to define a sum of products or a product of sums.
data Three a
  = Leaf a  -- ^ A /leaf/ that contains a single value.
  | Link (Three a)  -- ^ A /link/ where it means that this variable does not matter but the next one(s) will.
  | Split (Three a) (Three a)  -- ^ A /split/ where this variable determines the outcome.
  deriving (Typeable (Three a)
DataType
Constr
Typeable (Three a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Three a -> c (Three a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Three a))
-> (Three a -> Constr)
-> (Three a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Three a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Three a)))
-> ((forall b. Data b => b -> b) -> Three a -> Three a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Three a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Three a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Three a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Three a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Three a -> m (Three a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Three a -> m (Three a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Three a -> m (Three a))
-> Data (Three a)
Three a -> DataType
Three a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Three a))
(forall b. Data b => b -> b) -> Three a -> Three a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Three a -> c (Three a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Three a)
forall a. Data a => Typeable (Three a)
forall a. Data a => Three a -> DataType
forall a. Data a => Three a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Three a -> Three a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Three a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Three a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Three a -> m (Three a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Three a -> m (Three a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Three a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Three a -> c (Three a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Three a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Three a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Three a -> u
forall u. (forall d. Data d => d -> u) -> Three a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Three a -> m (Three a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Three a -> m (Three a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Three a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Three a -> c (Three a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Three a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Three a))
$cSplit :: Constr
$cLink :: Constr
$cLeaf :: Constr
$tThree :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Three a -> m (Three a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Three a -> m (Three a)
gmapMp :: (forall d. Data d => d -> m d) -> Three a -> m (Three a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Three a -> m (Three a)
gmapM :: (forall d. Data d => d -> m d) -> Three a -> m (Three a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Three a -> m (Three a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Three a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Three a -> u
gmapQ :: (forall d. Data d => d -> u) -> Three a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Three a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Three a -> r
gmapT :: (forall b. Data b => b -> b) -> Three a -> Three a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Three a -> Three a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Three a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Three a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Three a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Three a))
dataTypeOf :: Three a -> DataType
$cdataTypeOf :: forall a. Data a => Three a -> DataType
toConstr :: Three a -> Constr
$ctoConstr :: forall a. Data a => Three a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Three a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Three a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Three a -> c (Three a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Three a -> c (Three a)
$cp1Data :: forall a. Data a => Typeable (Three a)
Data, Three a -> Three a -> Bool
(Three a -> Three a -> Bool)
-> (Three a -> Three a -> Bool) -> Eq (Three a)
forall a. Eq a => Three a -> Three a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Three a -> Three a -> Bool
$c/= :: forall a. Eq a => Three a -> Three a -> Bool
== :: Three a -> Three a -> Bool
$c== :: forall a. Eq a => Three a -> Three a -> Bool
Eq, Three a -> Bool
(a -> m) -> Three a -> m
(a -> b -> b) -> b -> Three a -> b
(forall m. Monoid m => Three m -> m)
-> (forall m a. Monoid m => (a -> m) -> Three a -> m)
-> (forall m a. Monoid m => (a -> m) -> Three a -> m)
-> (forall a b. (a -> b -> b) -> b -> Three a -> b)
-> (forall a b. (a -> b -> b) -> b -> Three a -> b)
-> (forall b a. (b -> a -> b) -> b -> Three a -> b)
-> (forall b a. (b -> a -> b) -> b -> Three a -> b)
-> (forall a. (a -> a -> a) -> Three a -> a)
-> (forall a. (a -> a -> a) -> Three a -> a)
-> (forall a. Three a -> [a])
-> (forall a. Three a -> Bool)
-> (forall a. Three a -> Int)
-> (forall a. Eq a => a -> Three a -> Bool)
-> (forall a. Ord a => Three a -> a)
-> (forall a. Ord a => Three a -> a)
-> (forall a. Num a => Three a -> a)
-> (forall a. Num a => Three a -> a)
-> Foldable Three
forall a. Eq a => a -> Three a -> Bool
forall a. Num a => Three a -> a
forall a. Ord a => Three a -> a
forall m. Monoid m => Three m -> m
forall a. Three a -> Bool
forall a. Three a -> Int
forall a. Three a -> [a]
forall a. (a -> a -> a) -> Three a -> a
forall m a. Monoid m => (a -> m) -> Three a -> m
forall b a. (b -> a -> b) -> b -> Three a -> b
forall a b. (a -> b -> b) -> b -> Three a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Three a -> a
$cproduct :: forall a. Num a => Three a -> a
sum :: Three a -> a
$csum :: forall a. Num a => Three a -> a
minimum :: Three a -> a
$cminimum :: forall a. Ord a => Three a -> a
maximum :: Three a -> a
$cmaximum :: forall a. Ord a => Three a -> a
elem :: a -> Three a -> Bool
$celem :: forall a. Eq a => a -> Three a -> Bool
length :: Three a -> Int
$clength :: forall a. Three a -> Int
null :: Three a -> Bool
$cnull :: forall a. Three a -> Bool
toList :: Three a -> [a]
$ctoList :: forall a. Three a -> [a]
foldl1 :: (a -> a -> a) -> Three a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Three a -> a
foldr1 :: (a -> a -> a) -> Three a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Three a -> a
foldl' :: (b -> a -> b) -> b -> Three a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Three a -> b
foldl :: (b -> a -> b) -> b -> Three a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Three a -> b
foldr' :: (a -> b -> b) -> b -> Three a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Three a -> b
foldr :: (a -> b -> b) -> b -> Three a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Three a -> b
foldMap' :: (a -> m) -> Three a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Three a -> m
foldMap :: (a -> m) -> Three a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Three a -> m
fold :: Three m -> m
$cfold :: forall m. Monoid m => Three m -> m
Foldable, a -> Three b -> Three a
(a -> b) -> Three a -> Three b
(forall a b. (a -> b) -> Three a -> Three b)
-> (forall a b. a -> Three b -> Three a) -> Functor Three
forall a b. a -> Three b -> Three a
forall a b. (a -> b) -> Three a -> Three b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Three b -> Three a
$c<$ :: forall a b. a -> Three b -> Three a
fmap :: (a -> b) -> Three a -> Three b
$cfmap :: forall a b. (a -> b) -> Three a -> Three b
Functor, (forall x. Three a -> Rep (Three a) x)
-> (forall x. Rep (Three a) x -> Three a) -> Generic (Three a)
forall x. Rep (Three a) x -> Three a
forall x. Three a -> Rep (Three a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Three a) x -> Three a
forall a x. Three a -> Rep (Three a) x
$cto :: forall a x. Rep (Three a) x -> Three a
$cfrom :: forall a x. Three a -> Rep (Three a) x
Generic, (forall a. Three a -> Rep1 Three a)
-> (forall a. Rep1 Three a -> Three a) -> Generic1 Three
forall a. Rep1 Three a -> Three a
forall a. Three a -> Rep1 Three a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Three a -> Three a
$cfrom1 :: forall a. Three a -> Rep1 Three a
Generic1, Eq (Three a)
Eq (Three a)
-> (Three a -> Three a -> Ordering)
-> (Three a -> Three a -> Bool)
-> (Three a -> Three a -> Bool)
-> (Three a -> Three a -> Bool)
-> (Three a -> Three a -> Bool)
-> (Three a -> Three a -> Three a)
-> (Three a -> Three a -> Three a)
-> Ord (Three a)
Three a -> Three a -> Bool
Three a -> Three a -> Ordering
Three a -> Three a -> Three a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Three a)
forall a. Ord a => Three a -> Three a -> Bool
forall a. Ord a => Three a -> Three a -> Ordering
forall a. Ord a => Three a -> Three a -> Three a
min :: Three a -> Three a -> Three a
$cmin :: forall a. Ord a => Three a -> Three a -> Three a
max :: Three a -> Three a -> Three a
$cmax :: forall a. Ord a => Three a -> Three a -> Three a
>= :: Three a -> Three a -> Bool
$c>= :: forall a. Ord a => Three a -> Three a -> Bool
> :: Three a -> Three a -> Bool
$c> :: forall a. Ord a => Three a -> Three a -> Bool
<= :: Three a -> Three a -> Bool
$c<= :: forall a. Ord a => Three a -> Three a -> Bool
< :: Three a -> Three a -> Bool
$c< :: forall a. Ord a => Three a -> Three a -> Bool
compare :: Three a -> Three a -> Ordering
$ccompare :: forall a. Ord a => Three a -> Three a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Three a)
Ord, ReadPrec [Three a]
ReadPrec (Three a)
Int -> ReadS (Three a)
ReadS [Three a]
(Int -> ReadS (Three a))
-> ReadS [Three a]
-> ReadPrec (Three a)
-> ReadPrec [Three a]
-> Read (Three a)
forall a. Read a => ReadPrec [Three a]
forall a. Read a => ReadPrec (Three a)
forall a. Read a => Int -> ReadS (Three a)
forall a. Read a => ReadS [Three a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Three a]
$creadListPrec :: forall a. Read a => ReadPrec [Three a]
readPrec :: ReadPrec (Three a)
$creadPrec :: forall a. Read a => ReadPrec (Three a)
readList :: ReadS [Three a]
$creadList :: forall a. Read a => ReadS [Three a]
readsPrec :: Int -> ReadS (Three a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Three a)
Read, Int -> Three a -> ShowS
[Three a] -> ShowS
Three a -> String
(Int -> Three a -> ShowS)
-> (Three a -> String) -> ([Three a] -> ShowS) -> Show (Three a)
forall a. Show a => Int -> Three a -> ShowS
forall a. Show a => [Three a] -> ShowS
forall a. Show a => Three a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Three a] -> ShowS
$cshowList :: forall a. Show a => [Three a] -> ShowS
show :: Three a -> String
$cshow :: forall a. Show a => Three a -> String
showsPrec :: Int -> Three a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Three a -> ShowS
Show, Functor Three
Foldable Three
Functor Three
-> Foldable Three
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Three a -> f (Three b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Three (f a) -> f (Three a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Three a -> m (Three b))
-> (forall (m :: * -> *) a. Monad m => Three (m a) -> m (Three a))
-> Traversable Three
(a -> f b) -> Three a -> f (Three b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Three (m a) -> m (Three a)
forall (f :: * -> *) a. Applicative f => Three (f a) -> f (Three a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Three a -> m (Three b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Three a -> f (Three b)
sequence :: Three (m a) -> m (Three a)
$csequence :: forall (m :: * -> *) a. Monad m => Three (m a) -> m (Three a)
mapM :: (a -> m b) -> Three a -> m (Three b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Three a -> m (Three b)
sequenceA :: Three (f a) -> f (Three a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Three (f a) -> f (Three a)
traverse :: (a -> f b) -> Three a -> f (Three b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Three a -> f (Three b)
$cp2Traversable :: Foldable Three
$cp1Traversable :: Functor Three
Traversable)

instance Eq1 Three where
  liftEq :: (a -> b -> Bool) -> Three a -> Three b -> Bool
liftEq a -> b -> Bool
eq = Three a -> Three b -> Bool
go
    where go :: Three a -> Three b -> Bool
go (Leaf a
a) (Leaf b
b) = a -> b -> Bool
eq a
a b
b
          go (Link Three a
a) (Link Three b
b) = Three a -> Three b -> Bool
go Three a
a Three b
b
          go (Split Three a
la Three a
lb) (Split Three b
ma Three b
mb) = Three a -> Three b -> Bool
go Three a
la Three b
ma Bool -> Bool -> Bool
&& Three a -> Three b -> Bool
go Three a
lb Three b
mb
          go Three a
_ Three b
_ = Bool
False

instance Hashable a => Hashable (Three a)

instance Hashable1 Three

instance Lift a => Lift (Three a) where
  liftTyped :: Three a -> Q (TExp (Three a))
liftTyped = (Exp -> TExp (Three a)) -> Q Exp -> Q (TExp (Three a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> TExp (Three a)
forall a. Exp -> TExp a
TExp (Q Exp -> Q (TExp (Three a)))
-> (Three a -> Q Exp) -> Three a -> Q (TExp (Three a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three a -> Q Exp
forall t. Lift t => t -> Q Exp
lift
  lift :: Three a -> Q Exp
lift (Leaf a
a) = Name -> [a] -> Q Exp
forall a (f :: * -> *).
(Lift a, Foldable f) =>
Name -> f a -> Q Exp
applyExp' 'Leaf [a
a]
  lift (Split Three a
a Three a
b) = Name -> [Three a] -> Q Exp
forall a (f :: * -> *).
(Lift a, Foldable f) =>
Name -> f a -> Q Exp
applyExp' 'Split [Three a
a, Three a
b]
  lift ~(Split Three a
a Three a
b) = Name -> [Three a] -> Q Exp
forall a (f :: * -> *).
(Lift a, Foldable f) =>
Name -> f a -> Q Exp
applyExp' 'Split [Three a
a, Three a
b]

instance NFData a => NFData (Three a)

instance NFData1 Three

instance Ord1 Three where
  liftCompare :: (a -> b -> Ordering) -> Three a -> Three b -> Ordering
liftCompare a -> b -> Ordering
cmp = Three a -> Three b -> Ordering
go
    where go :: Three a -> Three b -> Ordering
go (Leaf a
a) (Leaf b
b) = a -> b -> Ordering
cmp a
a b
b
          go (Leaf a
_) Three b
_ = Ordering
LT
          go Three a
_ (Leaf b
_) = Ordering
GT
          go (Link Three a
la) (Link Three b
lb) = Three a -> Three b -> Ordering
go Three a
la Three b
lb
          go (Link Three a
_) Three b
_ = Ordering
LT
          go Three a
_ (Link Three b
_) = Ordering
GT
          go (Split Three a
la Three a
lb) (Split Three b
ma Three b
mb) = Three a -> Three b -> Ordering
go Three a
la Three b
ma Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Three a -> Three b -> Ordering
go Three a
lb Three b
mb

-- | A type alias for (non-deterministic) steps in a 'Three' structure.
type ThreeStep = ThreeValue

-- | A type of a list (non-deterministic) steps in a 'Three' structure.
type ThreePath = [ThreeStep]

_linkLeaf :: Three a -> Three a
_linkLeaf :: Three a -> Three a
_linkLeaf (Link Three a
x) = Three a
x
_linkLeaf Three a
x = Three a
x

-- | A catamorphism on the 'Three' object. Here one can provide functions
-- to use for the 'Leaf', the 'Link' and the 'Split' to catamorph a 'Three'
-- object to another object.
three :: (a -> b) -> (b -> b) -> (b -> b -> b) -> Three a -> b
three :: (a -> b) -> (b -> b) -> (b -> b -> b) -> Three a -> b
three a -> b
f b -> b
g b -> b -> b
h = Three a -> b
go
  where go :: Three a -> b
go (Leaf a
a) = a -> b
f a
a
        go (Link Three a
l) = b -> b
g (Three a -> b
go Three a
l)
        go ~(Split Three a
la Three a
lb) = b -> b -> b
h (Three a -> b
go Three a
la) (Three a -> b
go Three a
lb)

-- | Construct a 'Three' that will apply the given function
-- for the items that satisfy the given /path/ of three-valued
-- objects.
apply
  :: (a -> a)  -- ^ The given function to apply for the items that satisfy the given path.
  -> ThreePath  -- ^ The given path to use.
  -> Three (a -> a)  -- ^ A 'Three' object of functions where the elements that satisfy
                     -- the path will use the given function and the others will use 'id'.
apply :: (a -> a) -> ThreePath -> Three (a -> a)
apply = (ThreeValue -> Three (a -> a) -> Three (a -> a))
-> Three (a -> a) -> ThreePath -> Three (a -> a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ThreeValue -> Three (a -> a) -> Three (a -> a)
forall a. ThreeValue -> Three (a -> a) -> Three (a -> a)
go (Three (a -> a) -> ThreePath -> Three (a -> a))
-> ((a -> a) -> Three (a -> a))
-> (a -> a)
-> ThreePath
-> Three (a -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> Three (a -> a)
forall a. a -> Three a
Leaf
  where go :: ThreeValue -> Three (a -> a) -> Three (a -> a)
go ThreeValue
Zero = (Three (a -> a) -> Three (a -> a) -> Three (a -> a)
forall a. Three a -> Three a -> Three a
`Split` Three (a -> a)
forall a. Three (a -> a)
lid)
        go ThreeValue
One = Three (a -> a) -> Three (a -> a) -> Three (a -> a)
forall a. Three a -> Three a -> Three a
Split Three (a -> a)
forall a. Three (a -> a)
lid
        go ~ThreeValue
DontCare = Three (a -> a) -> Three (a -> a)
forall a. Three a -> Three a
Link
        lid :: Three (a -> a)
lid = (a -> a) -> Three (a -> a)
forall a. a -> Three a
Leaf a -> a
forall a. a -> a
id

_getChildren :: Three a -> (Three a, Three a)
_getChildren :: Three a -> (Three a, Three a)
_getChildren l :: Three a
l@(Leaf a
_) = (Three a
l, Three a
l)
_getChildren (Link Three a
l) = (Three a
l, Three a
l)
_getChildren (Split Three a
la Three a
lb) = (Three a
la, Three a
lb)

-- | Convert the given items that match the given 'ThreePath' to the 'Leaf' with a given element.
wipe
  :: a  -- ^ The given value such that we replace parts of the three with the given 'ThreePath' to this value.
  -> ThreePath  -- ^ The given path that specifies what for what parts of the 'Three' we will set the value.
  -> Three a  -- ^ The given 'Three' where (part) of the 'Three' will be changed to a 'Leaf' with the given value.
  -> Three a  -- ^ The resulting 'Three' after changing the items that match the given 'ThreePath' to the given value.
wipe :: a -> ThreePath -> Three a -> Three a
wipe a
y = ThreePath -> Three a -> Three a
go
  where lf :: b -> Three a
lf = Three a -> b -> Three a
forall a b. a -> b -> a
const (a -> Three a
forall a. a -> Three a
Leaf a
y)
        go :: ThreePath -> Three a -> Three a
go [] = Three a -> Three a
forall b. b -> Three a
lf
        go (ThreeValue
DontCare:ThreePath
xs) = Three a -> Three a
go'
          where go' :: Three a -> Three a
go' (Split Three a
la Three a
lb) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
la) (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
lb)
                go' l :: Three a
l@(Leaf a
_) = Three a -> Three a
forall a. Three a -> Three a
Link (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
l)
                go' (Link Three a
l) = Three a -> Three a
forall a. Three a -> Three a
Link (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
l)
        go ~(ThreeValue
sl:ThreePath
xs) = ThreeValue -> (Three a, Three a) -> Three a
go' ThreeValue
sl ((Three a, Three a) -> Three a)
-> (Three a -> (Three a, Three a)) -> Three a -> Three a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three a -> (Three a, Three a)
forall a. Three a -> (Three a, Three a)
_getChildren
          where go' :: ThreeValue -> (Three a, Three a) -> Three a
go' ThreeValue
One ~(Three a
la, Three a
lb) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split Three a
la (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
lb)
                go' ~ThreeValue
Zero ~(Three a
la, Three a
lb) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
la) Three a
lb

-- | Wipe with the given value all the given 'ThreePath's.
wipeAll
  :: a  -- ^ The given element to use when we wipe.
  -> Three a  -- ^ The original 'Three' where we will wipe items.
  -> [ThreePath]  -- ^ The list of paths to wipe.
  -> Three a  -- ^ The 'Three' object after wiping each element in the given list.
wipeAll :: a -> Three a -> [ThreePath] -> Three a
wipeAll = (ThreePath -> Three a -> Three a)
-> Three a -> [ThreePath] -> Three a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ThreePath -> Three a -> Three a)
 -> Three a -> [ThreePath] -> Three a)
-> (a -> ThreePath -> Three a -> Three a)
-> a
-> Three a
-> [ThreePath]
-> Three a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ThreePath -> Three a -> Three a
forall a. a -> ThreePath -> Three a -> Three a
wipe

-- | Apply the given function to the elements in the given 'Three' that satisfy the given path.
applyTo
  :: (a -> a)  -- ^ The given function to apply to some parts of the 'Three'.
  -> ThreePath  -- ^ The given path that specifies what for what parts of the 'Three' we should apply the function.
  -> Three a  -- ^ The given 'Three' where (part) of the 'Three' will be modified with a given function.
  -> Three a  -- ^ The resulting 'Three' after applying the given function to parts of the 'Three' that satisfy the given path.
applyTo :: (a -> a) -> ThreePath -> Three a -> Three a
applyTo a -> a
f = ThreePath -> Three a -> Three a
go
  where go :: ThreePath -> Three a -> Three a
go [] = (a -> a) -> Three a -> Three a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f
        go (ThreeValue
DontCare:ThreePath
xs) = Three a -> Three a
go'
          where go' :: Three a -> Three a
go' (Split Three a
la Three a
lb) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
la) (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
lb)
                go' l :: Three a
l@(Leaf a
_) = Three a -> Three a
forall a. Three a -> Three a
Link (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
l)
                go' (Link Three a
l) = Three a -> Three a
forall a. Three a -> Three a
Link (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
l)
        go ~(ThreeValue
sl:ThreePath
xs) = ThreeValue -> (Three a, Three a) -> Three a
go' ThreeValue
sl ((Three a, Three a) -> Three a)
-> (Three a -> (Three a, Three a)) -> Three a -> Three a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three a -> (Three a, Three a)
forall a. Three a -> (Three a, Three a)
_getChildren
          where go' :: ThreeValue -> (Three a, Three a) -> Three a
go' ThreeValue
One ~(Three a
la, Three a
lb) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split Three a
la (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
lb)
                go' ~ThreeValue
Zero ~(Three a
la, Three a
lb) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split (ThreePath -> Three a -> Three a
go ThreePath
xs Three a
la) Three a
lb

-- | Determine the maximum depth of the 'Three' tree.
depth
  :: Three a  -- ^ The 'Three' object to determine the maximum depth from.
  -> Int  -- ^ The depth of the given 'Three' object.
depth :: Three a -> Int
depth = (a -> Int) -> (Int -> Int) -> (Int -> Int -> Int) -> Three a -> Int
forall a b. (a -> b) -> (b -> b) -> (b -> b -> b) -> Three a -> b
three (Int -> a -> Int
forall a b. a -> b -> a
const Int
0) Int -> Int
forall a. Enum a => a -> a
succ ((Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> Int) -> Int -> Int)
-> (Int -> Int -> Int) -> Int -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max)

_simplifyLink :: Three a -> Three a
_simplifyLink :: Three a -> Three a
_simplifyLink l :: Three a
l@(Leaf a
_) = Three a
l
_simplifyLink Three a
l = Three a -> Three a
forall a. Three a -> Three a
Link Three a
l

instance Eq a => Simplify (Three a) where
  -- | Simplify the given 'Three' object by minimizing common
  -- subtrees. This is used to determine sum-of-products and
  -- products-of-sums more efficiently, but can also be used
  -- to make a table more readable.
  simplify :: Three a -> Three a
simplify l :: Three a
l@(Leaf a
_) = Three a
l
  simplify (Link Three a
l) = Three a -> Three a
forall a. Three a -> Three a
_simplifyLink (Three a -> Three a
forall a. Simplify a => a -> a
simplify Three a
l)
  simplify (Split Three a
la Three a
lb)
    | Three a
sa Three a -> Three a -> Bool
forall a. Eq a => a -> a -> Bool
== Three a
sb = Three a -> Three a
forall a. Three a -> Three a
_simplifyLink Three a
sa
    | Bool
otherwise = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split Three a
sa Three a
sb
    where sa :: Three a
sa = Three a -> Three a
forall a. Simplify a => a -> a
simplify Three a
la
          sb :: Three a
sb = Three a -> Three a
forall a. Simplify a => a -> a
simplify Three a
lb


instance Walkable Three Bool where
  step :: Three a -> Bool -> Three a
step l :: Three a
l@(Leaf a
_) = Three a -> Bool -> Three a
forall a b. a -> b -> a
const Three a
l
  step (Link Three a
t) = Three a -> Bool -> Three a
forall a b. a -> b -> a
const Three a
t
  step ~(Split Three a
la Three a
lb) = Three a -> Three a -> Bool -> Three a
forall a. a -> a -> Bool -> a
bool Three a
la Three a
lb

instance NonDeterministicWalkable Three ThreeValue where
  nstep' :: Three a -> ThreeValue -> [Three a] -> [Three a]
nstep' l :: Three a
l@(Leaf a
_) = ([Three a] -> [Three a]) -> ThreeValue -> [Three a] -> [Three a]
forall a b. a -> b -> a
const (Three a
lThree a -> [Three a] -> [Three a]
forall a. a -> [a] -> [a]
:)
  nstep' (Link Three a
t) = ([Three a] -> [Three a]) -> ThreeValue -> [Three a] -> [Three a]
forall a b. a -> b -> a
const (Three a
tThree a -> [Three a] -> [Three a]
forall a. a -> [a] -> [a]
:)
  nstep' (Split Three a
la Three a
lb) = ThreeValue -> [Three a] -> [Three a]
go
    where go :: ThreeValue -> [Three a] -> [Three a]
go ThreeValue
Zero = (Three a
laThree a -> [Three a] -> [Three a]
forall a. a -> [a] -> [a]
:)
          go ThreeValue
One = (Three a
lbThree a -> [Three a] -> [Three a]
forall a. a -> [a] -> [a]
:)
          go ~ThreeValue
DontCare = (Three a
laThree a -> [Three a] -> [Three a]
forall a. a -> [a] -> [a]
:) ([Three a] -> [Three a])
-> ([Three a] -> [Three a]) -> [Three a] -> [Three a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Three a
lbThree a -> [Three a] -> [Three a]
forall a. a -> [a] -> [a]
:)

instance Opposite a => Opposite (Three a)

instance Default a => Default (Three a) where
  def :: Three a
def = a -> Three a
forall a. a -> Three a
Leaf a
forall a. Default a => a
def

-- | Obtain the children that satisfy a given 'ThreePath'.
children
  :: ThreePath  -- ^ The given 'ThreePath' for the query.
  -> Three a  -- ^ The given 'Three' that we query.
  -> [a]  -- ^ A list of /children/ that satisfy the given 'ThreePath'.
children :: ThreePath -> Three a -> [a]
children ThreePath
path Three a
thr = ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' ThreePath
path Three a
thr []

-- | Obtain the children that satisfy the given 'ThreePath'.
children'
  :: ThreePath  -- ^ The given 'ThreePath' for the query.
  -> Three a  -- ^ The given 'Three' that we query.
  -> [a]  -- ^ The list of tail elements.
  -> [a]  -- ^ The list of /children/ followed by the given list of tail elements.
children' :: ThreePath -> Three a -> [a] -> [a]
children' ThreePath
_ (Leaf a
x) = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
children' [] (Link Three a
x) = ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' [] Three a
x
children' [] (Split Three a
la Three a
lb) = ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' [] Three a
la ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' [] Three a
lb
children' (ThreeValue
_:ThreePath
ys) (Link Three a
x) = ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' ThreePath
ys Three a
x
children' (ThreeValue
DontCare:ThreePath
ys) (Split Three a
la Three a
lb) = Three a -> [a] -> [a]
forall a. Three a -> [a] -> [a]
go Three a
la ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three a -> [a] -> [a]
forall a. Three a -> [a] -> [a]
go Three a
lb
  where go :: Three a -> [a] -> [a]
go = ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' ThreePath
ys
children' (ThreeValue
Zero:ThreePath
ys) ~(Split Three a
la Three a
_) = ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' ThreePath
ys Three a
la
children' ~(~ThreeValue
One:ThreePath
ys) ~(Split Three a
_ Three a
lb) = ThreePath -> Three a -> [a] -> [a]
forall a. ThreePath -> Three a -> [a] -> [a]
children' ThreePath
ys Three a
lb

instance Applicative Three where
  pure :: a -> Three a
pure = a -> Three a
forall a. a -> Three a
Leaf
  <*> :: Three (a -> b) -> Three a -> Three b
(<*>) (Leaf a -> b
f) = (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
  (<*>) (Link Three (a -> b)
f) = Three a -> Three b
go
      where go :: Three a -> Three b
go (Split Three a
la Three a
lb) = Three b -> Three b -> Three b
forall a. Three a -> Three a -> Three a
Split (Three (a -> b)
f Three (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three a
la) (Three (a -> b)
f Three (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three a
lb)
            go Three a
l = Three b -> Three b
forall a. Three a -> Three a
Link (Three (a -> b)
f Three (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three a -> Three a
forall a. Three a -> Three a
_linkLeaf Three a
l)
  (<*>) ~(Split Three (a -> b)
fa Three (a -> b)
fb) = Three a -> Three b
go
      where go :: Three a -> Three b
go (Split Three a
xa Three a
xb) = Three b -> Three b -> Three b
forall a. Three a -> Three a -> Three a
Split (Three (a -> b)
fa Three (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three a
xa) (Three (a -> b)
fb Three (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three a
xb)
            go Three a
l = Three b -> Three b -> Three b
forall a. Three a -> Three a -> Three a
Split (Three (a -> b)
fa Three (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three a
x') (Three (a -> b)
fb Three (a -> b) -> Three a -> Three b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Three a
x') where x' :: Three a
x' = Three a -> Three a
forall a. Three a -> Three a
_linkLeaf Three a
l
  liftA2 :: (a -> b -> c) -> Three a -> Three b -> Three c
liftA2 a -> b -> c
f = Three a -> Three b -> Three c
go
      where go :: Three a -> Three b -> Three c
go (Leaf a
x) (Leaf b
y) = c -> Three c
forall a. a -> Three a
Leaf (a -> b -> c
f a
x b
y)
            go x :: Three a
x@(Leaf a
_) (Link Three b
y) = Three c -> Three c
forall a. Three a -> Three a
Link (Three a -> Three b -> Three c
go Three a
x Three b
y)
            go x :: Three a
x@(Leaf a
_) (Split Three b
ya Three b
yb) = Three c -> Three c -> Three c
forall a. Three a -> Three a -> Three a
Split (Three a -> Three b -> Three c
go Three a
x Three b
ya) (Three a -> Three b -> Three c
go Three a
x Three b
yb)
            go (Link Three a
x) (Split Three b
ya Three b
yb) = Three c -> Three c -> Three c
forall a. Three a -> Three a -> Three a
Split (Three a -> Three b -> Three c
go Three a
x Three b
ya) (Three a -> Three b -> Three c
go Three a
x Three b
yb)
            go (Link Three a
x) Three b
y = Three c -> Three c
forall a. Three a -> Three a
Link (Three a -> Three b -> Three c
go Three a
x (Three b -> Three b
forall a. Three a -> Three a
_linkLeaf Three b
y))
            go (Split Three a
xa Three a
xb) (Split Three b
ya Three b
yb) = Three c -> Three c -> Three c
forall a. Three a -> Three a -> Three a
Split (Three a -> Three b -> Three c
go Three a
xa Three b
ya) (Three a -> Three b -> Three c
go Three a
xb Three b
yb)
            go (Split Three a
xa Three a
xb) Three b
y = Three c -> Three c -> Three c
forall a. Three a -> Three a -> Three a
Split (Three a -> Three b -> Three c
go Three a
xa Three b
y') (Three a -> Three b -> Three c
go Three a
xb Three b
y')
              where y' :: Three b
y' = Three b -> Three b
forall a. Three a -> Three a
_linkLeaf Three b
y

instance Semigroup a => Semigroup (Three a) where
  <> :: Three a -> Three a -> Three a
(<>) = (a -> a -> a) -> Three a -> Three a -> Three a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid a => Monoid (Three a) where
  mempty :: Three a
mempty = a -> Three a
forall a. a -> Three a
Leaf a
forall a. Monoid a => a
mempty

instance Arbitrary1 Three where
    liftArbitrary :: Gen a -> Gen (Three a)
liftArbitrary Gen a
arb = Gen (Three a)
go
      where go :: Gen (Three a)
go = [(Int, Gen (Three a))] -> Gen (Three a)
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
4, a -> Three a
forall a. a -> Three a
Leaf (a -> Three a) -> Gen a -> Gen (Three a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb), (Int
2, Three a -> Three a
forall a. Three a -> Three a
Link (Three a -> Three a) -> Gen (Three a) -> Gen (Three a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Three a)
go), (Int
1, Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split (Three a -> Three a -> Three a)
-> Gen (Three a) -> Gen (Three a -> Three a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Three a)
go Gen (Three a -> Three a) -> Gen (Three a) -> Gen (Three a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Three a)
go)]

instance Arbitrary a => Arbitrary (Three a) where
    arbitrary :: Gen (Three a)
arbitrary = Gen (Three a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
    shrink :: Three a -> [Three a]
shrink (Leaf a
x) = a -> Three a
forall a. a -> Three a
Leaf (a -> Three a) -> [a] -> [Three a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x
    shrink (Link Three a
x) = [Three a
x]
    shrink (Split Three a
xa Three a
xb) = [Three a
xa, Three a
xb]

instance Binary a => Binary (Three a) where
    put :: Three a -> Put
put (Leaf a
x) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall t. Binary t => t -> Put
put a
x
    put (Link Three a
x) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Three a -> Put
forall t. Binary t => t -> Put
put Three a
x
    put (Split Three a
xa Three a
xb) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Three a -> Put
forall t. Binary t => t -> Put
put Three a
xa Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Three a -> Put
forall t. Binary t => t -> Put
put Three a
xb
    get :: Get (Three a)
get = do
        Word8
tp <- Get Word8
getWord8
        case Word8
tp of
          Word8
0 -> a -> Three a
forall a. a -> Three a
Leaf (a -> Three a) -> Get a -> Get (Three a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall t. Binary t => Get t
get
          Word8
1 -> Three a -> Three a
forall a. Three a -> Three a
Link (Three a -> Three a) -> Get (Three a) -> Get (Three a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Three a)
forall t. Binary t => Get t
get
          Word8
2 -> Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split (Three a -> Three a -> Three a)
-> Get (Three a) -> Get (Three a -> Three a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Three a)
forall t. Binary t => Get t
get Get (Three a -> Three a) -> Get (Three a) -> Get (Three a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Three a)
forall t. Binary t => Get t
get
          Word8
_ -> String -> Get (Three a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"The number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Three item.")

-- | Convert the given 'Three' to a list of 2-tuples with as first item the "address" in __reverse__,
-- and as second item the value associated with this.
toTraces
  :: Three a  -- The given 'Three' where we want to derive the traces from.
  -> [(ThreeValues, a)]  -- ^ The list of /addresses/ in *reverse* with the corresponding value.
toTraces :: Three a -> [(ThreePath, a)]
toTraces = (Three a -> [(ThreePath, a)] -> [(ThreePath, a)]
forall a. Three a -> [(ThreePath, a)] -> [(ThreePath, a)]
`toTraces'` [])

-- | Convert the given 'Three' to a list of 2-tuples with as first item the "address" in __reverse__,
-- and as second item the value associated with this.
toTraces'
  :: Three a  -- The given 'Three' where we want to derive the traces from.
  -> [(ThreeValues, a)]  -- ^ The list of /trailing/ items that can be added at the end.
  -> [(ThreeValues, a)]  -- ^ The list of /addresses/ in __reverse__ with the corresponding value.
toTraces' :: Three a -> [(ThreePath, a)] -> [(ThreePath, a)]
toTraces' = (Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
forall a.
Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
`toTraces''` [])

-- | Convert the given 'Three' to a list of 2-tuples with as first item the "address" in __reverse__,
-- and as second item the value associated with this.
toTraces''
  :: Three a  -- The given 'Three' where we want to derive the traces from.
  -> ThreeValues  -- ^ The current address that will be manipulated as we walk through the 'Three' in __reverse__ order.
  -> [(ThreeValues, a)]  -- ^ The list of /trailing/ items that can be added at the end.
  -> [(ThreeValues, a)]  -- ^ The list of /addresses/ in __reverse__ with the corresponding value.
toTraces'' :: Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
toTraces'' (Leaf a
x) ThreePath
adr = ((ThreePath
adr, a
x) (ThreePath, a) -> [(ThreePath, a)] -> [(ThreePath, a)]
forall a. a -> [a] -> [a]
:)
toTraces'' (Link Three a
x) ThreePath
adr = Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
forall a.
Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
toTraces'' Three a
x (ThreeValue
DontCareThreeValue -> ThreePath -> ThreePath
forall a. a -> [a] -> [a]
: ThreePath
adr)
toTraces'' ~(Split Three a
xa Three a
xb) ThreePath
adr = Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
forall a.
Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
toTraces'' Three a
xa (ThreeValue
ZeroThreeValue -> ThreePath -> ThreePath
forall a. a -> [a] -> [a]
: ThreePath
adr) ([(ThreePath, a)] -> [(ThreePath, a)])
-> ([(ThreePath, a)] -> [(ThreePath, a)])
-> [(ThreePath, a)]
-> [(ThreePath, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
forall a.
Three a -> ThreePath -> [(ThreePath, a)] -> [(ThreePath, a)]
toTraces'' Three a
xb (ThreeValue
OneThreeValue -> ThreePath -> ThreePath
forall a. a -> [a] -> [a]
: ThreePath
adr)

-- | Flip the most basic level such that 'True' now maps on 'False' and vice versa.
-- This is for example used to render /Karnaugh cards/.
flipThree
  :: Three a  -- ^ The given 'Three' to flip.
  -> Three a  -- ^ The corresponding flipped 'Three'.
flipThree :: Three a -> Three a
flipThree (Split Three a
l Three a
r) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split Three a
r Three a
l
flipThree Three a
l = Three a
l

-- | Flip all the nodes in the 'Three' such that the 'False' subtree is now a 'True'
-- subtree, and the 'True' subtree is now the 'False' subtree.
flipAllThree
  :: Three a  -- ^ The given 'Three' to flip.
  -> Three a  -- ^ The corresponding flipped 'Three'.
flipAllThree :: Three a -> Three a
flipAllThree l :: Three a
l@(Leaf a
_) = Three a
l
flipAllThree (Link Three a
l) = Three a -> Three a
forall a. Three a -> Three a
Link (Three a -> Three a
forall a. Three a -> Three a
flipAllThree Three a
l)
flipAllThree ~(Split Three a
l Three a
r) = Three a -> Three a -> Three a
forall a. Three a -> Three a -> Three a
Split (Three a -> Three a
forall a. Three a -> Three a
flipAllThree Three a
r) (Three a -> Three a
forall a. Three a -> Three a
flipAllThree Three a
l)

_most :: (a -> a -> a) -> Three a -> a
_most :: (a -> a -> a) -> Three a -> a
_most = (a -> a) -> (a -> a) -> (a -> a -> a) -> Three a -> a
forall a b. (a -> b) -> (b -> b) -> (b -> b -> b) -> Three a -> b
three a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id

-- | Obtain the leftmost item of the 'Three'.
leftmost
  :: Three a  -- ^ The 'Three' to obtain the leftmost item from.
  -> a  -- ^ The leftmost item in the given 'Three'.
leftmost :: Three a -> a
leftmost = (a -> a -> a) -> Three a -> a
forall a. (a -> a -> a) -> Three a -> a
_most a -> a -> a
forall a b. a -> b -> a
const

-- | Obtain the rightmost item of the 'Three'.
rightmost
  :: Three a  -- ^ The 'Three' to obtain the rightmost item from.
  -> a  -- ^ The rightmost item in the given 'Three'.
rightmost :: Three a -> a
rightmost = (a -> a -> a) -> Three a -> a
forall a. (a -> a -> a) -> Three a -> a
_most ((a -> a) -> a -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id)