{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Data.Diagram.Simple
-- Copyright   : (c) Eddie Jones 2020
-- License     : BSD-3
-- Maintainer  : eddiejones2108@gmail.com
-- Stability   : experimental
--
-- Zero-suppressed Binary Decision Diagrams
module Data.Diagram.ZeroSup
  ( -- * Diagram
    Diagram,
    runDiagram,

    -- * Families of Sets
    Family,
    mkFamily,
    empty,
    base,
    change,
    subset,
    bindElem,

    -- * Combinations
    intersect,
    union,
    difference,

    -- * Summary
    fold,
    anySat,
  )
where

import Control.Monad
import Control.Monad.State
import qualified Data.Diagram as D
import Data.Functor.Classes
import Data.Functor.Identity
import Data.Hashable
import Data.Hashable.Lifted
import qualified Data.Map as M

data Memo l s
  = Intersect (Family l s) (Family l s)
  | Union (Family l s) (Family l s)
  | Difference (Family l s) (Family l s)
  | Subset l Bool (Family l s)
  | Change l (Family l s)
  deriving (Memo l s -> Memo l s -> Bool
(Memo l s -> Memo l s -> Bool)
-> (Memo l s -> Memo l s -> Bool) -> Eq (Memo l s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l s. Eq l => Memo l s -> Memo l s -> Bool
/= :: Memo l s -> Memo l s -> Bool
$c/= :: forall l s. Eq l => Memo l s -> Memo l s -> Bool
== :: Memo l s -> Memo l s -> Bool
$c== :: forall l s. Eq l => Memo l s -> Memo l s -> Bool
Eq, Eq (Memo l s)
Eq (Memo l s) =>
(Memo l s -> Memo l s -> Ordering)
-> (Memo l s -> Memo l s -> Bool)
-> (Memo l s -> Memo l s -> Bool)
-> (Memo l s -> Memo l s -> Bool)
-> (Memo l s -> Memo l s -> Bool)
-> (Memo l s -> Memo l s -> Memo l s)
-> (Memo l s -> Memo l s -> Memo l s)
-> Ord (Memo l s)
Memo l s -> Memo l s -> Bool
Memo l s -> Memo l s -> Ordering
Memo l s -> Memo l s -> Memo l s
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 l s. Ord l => Eq (Memo l s)
forall l s. Ord l => Memo l s -> Memo l s -> Bool
forall l s. Ord l => Memo l s -> Memo l s -> Ordering
forall l s. Ord l => Memo l s -> Memo l s -> Memo l s
min :: Memo l s -> Memo l s -> Memo l s
$cmin :: forall l s. Ord l => Memo l s -> Memo l s -> Memo l s
max :: Memo l s -> Memo l s -> Memo l s
$cmax :: forall l s. Ord l => Memo l s -> Memo l s -> Memo l s
>= :: Memo l s -> Memo l s -> Bool
$c>= :: forall l s. Ord l => Memo l s -> Memo l s -> Bool
> :: Memo l s -> Memo l s -> Bool
$c> :: forall l s. Ord l => Memo l s -> Memo l s -> Bool
<= :: Memo l s -> Memo l s -> Bool
$c<= :: forall l s. Ord l => Memo l s -> Memo l s -> Bool
< :: Memo l s -> Memo l s -> Bool
$c< :: forall l s. Ord l => Memo l s -> Memo l s -> Bool
compare :: Memo l s -> Memo l s -> Ordering
$ccompare :: forall l s. Ord l => Memo l s -> Memo l s -> Ordering
$cp1Ord :: forall l s. Ord l => Eq (Memo l s)
Ord)

-- Run an operation if not in the cache
memo :: Ord l => Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
memo :: Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
memo m :: Memo l s
m d :: Diagram l s (Family l s)
d = do
  Map (Memo l s) (Family l s)
cache <- Diagram
  (Node l)
  Bool
  s
  (State (Map (Memo l s) (Family l s)))
  (Map (Memo l s) (Family l s))
-> Diagram l s (Map (Memo l s) (Family l s))
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram
   (Node l)
   Bool
   s
   (State (Map (Memo l s) (Family l s)))
   (Map (Memo l s) (Family l s))
 -> Diagram l s (Map (Memo l s) (Family l s)))
-> Diagram
     (Node l)
     Bool
     s
     (State (Map (Memo l s) (Family l s)))
     (Map (Memo l s) (Family l s))
-> Diagram l s (Map (Memo l s) (Family l s))
forall a b. (a -> b) -> a -> b
$ State (Map (Memo l s) (Family l s)) (Map (Memo l s) (Family l s))
-> Diagram
     (Node l)
     Bool
     s
     (State (Map (Memo l s) (Family l s)))
     (Map (Memo l s) (Family l s))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift State (Map (Memo l s) (Family l s)) (Map (Memo l s) (Family l s))
forall s (m :: * -> *). MonadState s m => m s
get
  case Memo l s -> Map (Memo l s) (Family l s) -> Maybe (Family l s)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Memo l s
m Map (Memo l s) (Family l s)
cache of
    Just r :: Family l s
r -> Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
r
    Nothing -> do
      Family l s
r <- Diagram l s (Family l s)
d
      Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) ()
-> Diagram l s ()
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) ()
 -> Diagram l s ())
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) ()
-> Diagram l s ()
forall a b. (a -> b) -> a -> b
$ State (Map (Memo l s) (Family l s)) ()
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (Map (Memo l s) (Family l s)) ()
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) ())
-> State (Map (Memo l s) (Family l s)) ()
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) ()
forall a b. (a -> b) -> a -> b
$ Map (Memo l s) (Family l s)
-> State (Map (Memo l s) (Family l s)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Memo l s
-> Family l s
-> Map (Memo l s) (Family l s)
-> Map (Memo l s) (Family l s)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Memo l s
m Family l s
r Map (Memo l s) (Family l s)
cache)
      Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
r

-- | A binary decision diagram
newtype Diagram l s a = Diagram
  { Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag :: D.Diagram (Node l) Bool s (State (M.Map (Memo l s) (Family l s))) a
  }
  deriving (a -> Diagram l s b -> Diagram l s a
(a -> b) -> Diagram l s a -> Diagram l s b
(forall a b. (a -> b) -> Diagram l s a -> Diagram l s b)
-> (forall a b. a -> Diagram l s b -> Diagram l s a)
-> Functor (Diagram l s)
forall a b. a -> Diagram l s b -> Diagram l s a
forall a b. (a -> b) -> Diagram l s a -> Diagram l s b
forall l s a b. a -> Diagram l s b -> Diagram l s a
forall l s a b. (a -> b) -> Diagram l s a -> Diagram l s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Diagram l s b -> Diagram l s a
$c<$ :: forall l s a b. a -> Diagram l s b -> Diagram l s a
fmap :: (a -> b) -> Diagram l s a -> Diagram l s b
$cfmap :: forall l s a b. (a -> b) -> Diagram l s a -> Diagram l s b
Functor, Functor (Diagram l s)
a -> Diagram l s a
Functor (Diagram l s) =>
(forall a. a -> Diagram l s a)
-> (forall a b.
    Diagram l s (a -> b) -> Diagram l s a -> Diagram l s b)
-> (forall a b c.
    (a -> b -> c) -> Diagram l s a -> Diagram l s b -> Diagram l s c)
-> (forall a b. Diagram l s a -> Diagram l s b -> Diagram l s b)
-> (forall a b. Diagram l s a -> Diagram l s b -> Diagram l s a)
-> Applicative (Diagram l s)
Diagram l s a -> Diagram l s b -> Diagram l s b
Diagram l s a -> Diagram l s b -> Diagram l s a
Diagram l s (a -> b) -> Diagram l s a -> Diagram l s b
(a -> b -> c) -> Diagram l s a -> Diagram l s b -> Diagram l s c
forall a. a -> Diagram l s a
forall l s. Functor (Diagram l s)
forall a b. Diagram l s a -> Diagram l s b -> Diagram l s a
forall a b. Diagram l s a -> Diagram l s b -> Diagram l s b
forall a b. Diagram l s (a -> b) -> Diagram l s a -> Diagram l s b
forall l s a. a -> Diagram l s a
forall a b c.
(a -> b -> c) -> Diagram l s a -> Diagram l s b -> Diagram l s c
forall l s a b. Diagram l s a -> Diagram l s b -> Diagram l s a
forall l s a b. Diagram l s a -> Diagram l s b -> Diagram l s b
forall l s a b.
Diagram l s (a -> b) -> Diagram l s a -> Diagram l s b
forall l s a b c.
(a -> b -> c) -> Diagram l s a -> Diagram l s b -> Diagram l s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Diagram l s a -> Diagram l s b -> Diagram l s a
$c<* :: forall l s a b. Diagram l s a -> Diagram l s b -> Diagram l s a
*> :: Diagram l s a -> Diagram l s b -> Diagram l s b
$c*> :: forall l s a b. Diagram l s a -> Diagram l s b -> Diagram l s b
liftA2 :: (a -> b -> c) -> Diagram l s a -> Diagram l s b -> Diagram l s c
$cliftA2 :: forall l s a b c.
(a -> b -> c) -> Diagram l s a -> Diagram l s b -> Diagram l s c
<*> :: Diagram l s (a -> b) -> Diagram l s a -> Diagram l s b
$c<*> :: forall l s a b.
Diagram l s (a -> b) -> Diagram l s a -> Diagram l s b
pure :: a -> Diagram l s a
$cpure :: forall l s a. a -> Diagram l s a
$cp1Applicative :: forall l s. Functor (Diagram l s)
Applicative, Applicative (Diagram l s)
a -> Diagram l s a
Applicative (Diagram l s) =>
(forall a b.
 Diagram l s a -> (a -> Diagram l s b) -> Diagram l s b)
-> (forall a b. Diagram l s a -> Diagram l s b -> Diagram l s b)
-> (forall a. a -> Diagram l s a)
-> Monad (Diagram l s)
Diagram l s a -> (a -> Diagram l s b) -> Diagram l s b
Diagram l s a -> Diagram l s b -> Diagram l s b
forall a. a -> Diagram l s a
forall l s. Applicative (Diagram l s)
forall a b. Diagram l s a -> Diagram l s b -> Diagram l s b
forall a b. Diagram l s a -> (a -> Diagram l s b) -> Diagram l s b
forall l s a. a -> Diagram l s a
forall l s a b. Diagram l s a -> Diagram l s b -> Diagram l s b
forall l s a b.
Diagram l s a -> (a -> Diagram l s b) -> Diagram l s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Diagram l s a
$creturn :: forall l s a. a -> Diagram l s a
>> :: Diagram l s a -> Diagram l s b -> Diagram l s b
$c>> :: forall l s a b. Diagram l s a -> Diagram l s b -> Diagram l s b
>>= :: Diagram l s a -> (a -> Diagram l s b) -> Diagram l s b
$c>>= :: forall l s a b.
Diagram l s a -> (a -> Diagram l s b) -> Diagram l s b
$cp1Monad :: forall l s. Applicative (Diagram l s)
Monad)

-- | Extract non-diagrammatic information
runDiagram :: (forall s. Diagram l s a) -> a
runDiagram :: (forall s. Diagram l s a) -> a
runDiagram d :: forall s. Diagram l s a
d = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ (forall s. Diagram (Node l) Bool s Identity a) -> Identity a
forall (m :: * -> *) (f :: * -> *) a b.
Monad m =>
(forall s. Diagram f a s m b) -> m b
D.runDiagram ((State (Map (Memo l s) (Family l s)) a
-> Map (Memo l s) (Family l s) -> a
forall s a. State s a -> s -> a
`evalState` Map (Memo l s) (Family l s)
forall k a. Map k a
M.empty) (State (Map (Memo l s) (Family l s)) a -> a)
-> Diagram
     (Node l) Bool s Identity (State (Map (Memo l s) (Family l s)) a)
-> Diagram (Node l) Bool s Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram
     (Node l) Bool s Identity (State (Map (Memo l s) (Family l s)) a)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Diagram f a s m b -> Diagram f a s Identity (m b)
D.compress (Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag Diagram l s a
forall s. Diagram l s a
d))

-- | A diagramatic family of sets build on atomic elements of type @l@
newtype Family l s = Family
  { Family l s -> Free (Node l) Bool s
unFamily :: D.Free (Node l) Bool s
  }
  deriving (Family l s -> Family l s -> Bool
(Family l s -> Family l s -> Bool)
-> (Family l s -> Family l s -> Bool) -> Eq (Family l s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l s. Family l s -> Family l s -> Bool
/= :: Family l s -> Family l s -> Bool
$c/= :: forall l s. Family l s -> Family l s -> Bool
== :: Family l s -> Family l s -> Bool
$c== :: forall l s. Family l s -> Family l s -> Bool
Eq, Eq (Family l s)
Eq (Family l s) =>
(Family l s -> Family l s -> Ordering)
-> (Family l s -> Family l s -> Bool)
-> (Family l s -> Family l s -> Bool)
-> (Family l s -> Family l s -> Bool)
-> (Family l s -> Family l s -> Bool)
-> (Family l s -> Family l s -> Family l s)
-> (Family l s -> Family l s -> Family l s)
-> Ord (Family l s)
Family l s -> Family l s -> Bool
Family l s -> Family l s -> Ordering
Family l s -> Family l s -> Family l s
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 l s. Eq (Family l s)
forall l s. Family l s -> Family l s -> Bool
forall l s. Family l s -> Family l s -> Ordering
forall l s. Family l s -> Family l s -> Family l s
min :: Family l s -> Family l s -> Family l s
$cmin :: forall l s. Family l s -> Family l s -> Family l s
max :: Family l s -> Family l s -> Family l s
$cmax :: forall l s. Family l s -> Family l s -> Family l s
>= :: Family l s -> Family l s -> Bool
$c>= :: forall l s. Family l s -> Family l s -> Bool
> :: Family l s -> Family l s -> Bool
$c> :: forall l s. Family l s -> Family l s -> Bool
<= :: Family l s -> Family l s -> Bool
$c<= :: forall l s. Family l s -> Family l s -> Bool
< :: Family l s -> Family l s -> Bool
$c< :: forall l s. Family l s -> Family l s -> Bool
compare :: Family l s -> Family l s -> Ordering
$ccompare :: forall l s. Family l s -> Family l s -> Ordering
$cp1Ord :: forall l s. Eq (Family l s)
Ord)

-- | An internal node of the diagram
data Node l k = Node
  { Node l k -> l
label :: l,
    Node l k -> k
lo :: k,
    Node l k -> k
hi :: k
  }
  deriving (a -> Node l b -> Node l a
(a -> b) -> Node l a -> Node l b
(forall a b. (a -> b) -> Node l a -> Node l b)
-> (forall a b. a -> Node l b -> Node l a) -> Functor (Node l)
forall a b. a -> Node l b -> Node l a
forall a b. (a -> b) -> Node l a -> Node l b
forall l a b. a -> Node l b -> Node l a
forall l a b. (a -> b) -> Node l a -> Node l b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Node l b -> Node l a
$c<$ :: forall l a b. a -> Node l b -> Node l a
fmap :: (a -> b) -> Node l a -> Node l b
$cfmap :: forall l a b. (a -> b) -> Node l a -> Node l b
Functor, Node l a -> Bool
(a -> m) -> Node l a -> m
(a -> b -> b) -> b -> Node l a -> b
(forall m. Monoid m => Node l m -> m)
-> (forall m a. Monoid m => (a -> m) -> Node l a -> m)
-> (forall m a. Monoid m => (a -> m) -> Node l a -> m)
-> (forall a b. (a -> b -> b) -> b -> Node l a -> b)
-> (forall a b. (a -> b -> b) -> b -> Node l a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node l a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node l a -> b)
-> (forall a. (a -> a -> a) -> Node l a -> a)
-> (forall a. (a -> a -> a) -> Node l a -> a)
-> (forall a. Node l a -> [a])
-> (forall a. Node l a -> Bool)
-> (forall a. Node l a -> Int)
-> (forall a. Eq a => a -> Node l a -> Bool)
-> (forall a. Ord a => Node l a -> a)
-> (forall a. Ord a => Node l a -> a)
-> (forall a. Num a => Node l a -> a)
-> (forall a. Num a => Node l a -> a)
-> Foldable (Node l)
forall a. Eq a => a -> Node l a -> Bool
forall a. Num a => Node l a -> a
forall a. Ord a => Node l a -> a
forall m. Monoid m => Node l m -> m
forall a. Node l a -> Bool
forall a. Node l a -> Int
forall a. Node l a -> [a]
forall a. (a -> a -> a) -> Node l a -> a
forall l a. Eq a => a -> Node l a -> Bool
forall l a. Num a => Node l a -> a
forall l a. Ord a => Node l a -> a
forall m a. Monoid m => (a -> m) -> Node l a -> m
forall l m. Monoid m => Node l m -> m
forall l a. Node l a -> Bool
forall l a. Node l a -> Int
forall l a. Node l a -> [a]
forall b a. (b -> a -> b) -> b -> Node l a -> b
forall a b. (a -> b -> b) -> b -> Node l a -> b
forall l a. (a -> a -> a) -> Node l a -> a
forall l m a. Monoid m => (a -> m) -> Node l a -> m
forall l b a. (b -> a -> b) -> b -> Node l a -> b
forall l a b. (a -> b -> b) -> b -> Node l 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 :: Node l a -> a
$cproduct :: forall l a. Num a => Node l a -> a
sum :: Node l a -> a
$csum :: forall l a. Num a => Node l a -> a
minimum :: Node l a -> a
$cminimum :: forall l a. Ord a => Node l a -> a
maximum :: Node l a -> a
$cmaximum :: forall l a. Ord a => Node l a -> a
elem :: a -> Node l a -> Bool
$celem :: forall l a. Eq a => a -> Node l a -> Bool
length :: Node l a -> Int
$clength :: forall l a. Node l a -> Int
null :: Node l a -> Bool
$cnull :: forall l a. Node l a -> Bool
toList :: Node l a -> [a]
$ctoList :: forall l a. Node l a -> [a]
foldl1 :: (a -> a -> a) -> Node l a -> a
$cfoldl1 :: forall l a. (a -> a -> a) -> Node l a -> a
foldr1 :: (a -> a -> a) -> Node l a -> a
$cfoldr1 :: forall l a. (a -> a -> a) -> Node l a -> a
foldl' :: (b -> a -> b) -> b -> Node l a -> b
$cfoldl' :: forall l b a. (b -> a -> b) -> b -> Node l a -> b
foldl :: (b -> a -> b) -> b -> Node l a -> b
$cfoldl :: forall l b a. (b -> a -> b) -> b -> Node l a -> b
foldr' :: (a -> b -> b) -> b -> Node l a -> b
$cfoldr' :: forall l a b. (a -> b -> b) -> b -> Node l a -> b
foldr :: (a -> b -> b) -> b -> Node l a -> b
$cfoldr :: forall l a b. (a -> b -> b) -> b -> Node l a -> b
foldMap' :: (a -> m) -> Node l a -> m
$cfoldMap' :: forall l m a. Monoid m => (a -> m) -> Node l a -> m
foldMap :: (a -> m) -> Node l a -> m
$cfoldMap :: forall l m a. Monoid m => (a -> m) -> Node l a -> m
fold :: Node l m -> m
$cfold :: forall l m. Monoid m => Node l m -> m
Foldable, Functor (Node l)
Foldable (Node l)
(Functor (Node l), Foldable (Node l)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Node l a -> f (Node l b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Node l (f a) -> f (Node l a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Node l a -> m (Node l b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Node l (m a) -> m (Node l a))
-> Traversable (Node l)
(a -> f b) -> Node l a -> f (Node l b)
forall l. Functor (Node l)
forall l. Foldable (Node l)
forall l (m :: * -> *) a. Monad m => Node l (m a) -> m (Node l a)
forall l (f :: * -> *) a.
Applicative f =>
Node l (f a) -> f (Node l a)
forall l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node l a -> m (Node l b)
forall l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node l a -> f (Node l 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 => Node l (m a) -> m (Node l a)
forall (f :: * -> *) a.
Applicative f =>
Node l (f a) -> f (Node l a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node l a -> m (Node l b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node l a -> f (Node l b)
sequence :: Node l (m a) -> m (Node l a)
$csequence :: forall l (m :: * -> *) a. Monad m => Node l (m a) -> m (Node l a)
mapM :: (a -> m b) -> Node l a -> m (Node l b)
$cmapM :: forall l (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node l a -> m (Node l b)
sequenceA :: Node l (f a) -> f (Node l a)
$csequenceA :: forall l (f :: * -> *) a.
Applicative f =>
Node l (f a) -> f (Node l a)
traverse :: (a -> f b) -> Node l a -> f (Node l b)
$ctraverse :: forall l (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node l a -> f (Node l b)
$cp2Traversable :: forall l. Foldable (Node l)
$cp1Traversable :: forall l. Functor (Node l)
Traversable)

instance Eq l => Eq1 (Node l) where
  liftEq :: (a -> b -> Bool) -> Node l a -> Node l b -> Bool
liftEq eq :: a -> b -> Bool
eq n :: Node l a
n m :: Node l b
m = Node l a -> l
forall l k. Node l k -> l
label Node l a
n l -> l -> Bool
forall a. Eq a => a -> a -> Bool
== Node l b -> l
forall l k. Node l k -> l
label Node l b
m Bool -> Bool -> Bool
&& a -> b -> Bool
eq (Node l a -> a
forall l k. Node l k -> k
lo Node l a
n) (Node l b -> b
forall l k. Node l k -> k
lo Node l b
m) Bool -> Bool -> Bool
&& a -> b -> Bool
eq (Node l a -> a
forall l k. Node l k -> k
hi Node l a
n) (Node l b -> b
forall l k. Node l k -> k
hi Node l b
m)

instance Hashable l => Hashable1 (Node l) where
  liftHashWithSalt :: (Int -> a -> Int) -> Int -> Node l a -> Int
liftHashWithSalt l :: Int -> a -> Int
l s :: Int
s n :: Node l a
n = Int -> (l, Int, Int) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Node l a -> l
forall l k. Node l k -> l
label Node l a
n, Int -> a -> Int
l Int
s (Node l a -> a
forall l k. Node l k -> k
lo Node l a
n), Int -> a -> Int
l Int
s (Node l a -> a
forall l k. Node l k -> k
hi Node l a
n))

-- | Make a family (if not already present) from it's hi and lo cases
mkFamily :: (Eq l, Hashable l) => l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily :: l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily l :: l
l lo :: Family l s
lo hi :: Family l s
hi
  | Family l s
hi Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
base = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
lo
  | Bool
otherwise = Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Diagram
     (Node l)
     Bool
     s
     (State (Map (Memo l s) (Family l s)))
     (Free (Node l) Bool s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node l (Free (Node l) Bool s)
-> Diagram
     (Node l)
     Bool
     s
     (State (Map (Memo l s) (Family l s)))
     (Free (Node l) Bool s)
forall (m :: * -> *) (f :: * -> *) a s.
(Monad m, Hashable1 f, Hashable a, Eq1 f, Eq a) =>
f (Free f a s) -> Diagram f a s m (Free f a s)
D.free Node :: forall l k. l -> k -> k -> Node l k
Node {label :: l
label = l
l, lo :: Free (Node l) Bool s
lo = Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
lo, hi :: Free (Node l) Bool s
hi = Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
hi})

-- | Map elements in a family
mapAtom :: (Eq l, Hashable l) => (l -> l) -> Family l s -> Diagram l s (Family l s)
mapAtom :: (l -> l) -> Family l s -> Diagram l s (Family l s)
mapAtom f :: l -> l
f (Family p :: Free (Node l) Bool s
p) =
  Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$
    (Node l (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Free (Node l) Bool s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) b a s.
(Monad m, Traversable f) =>
(f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
D.fold
      ( \n :: Node l (Family l s)
n -> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$ do
          Family l s
lo' <- (l -> l) -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
(l -> l) -> Family l s -> Diagram l s (Family l s)
mapAtom l -> l
f (Node l (Family l s) -> Family l s
forall l k. Node l k -> k
lo Node l (Family l s)
n)
          Family l s
hi' <- (l -> l) -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
(l -> l) -> Family l s -> Diagram l s (Family l s)
mapAtom l -> l
f (Node l (Family l s) -> Family l s
forall l k. Node l k -> k
hi Node l (Family l s)
n)
          l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (l -> l
f (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$ Node l (Family l s) -> l
forall l k. Node l k -> l
label Node l (Family l s)
n) Family l s
lo' Family l s
hi'
      )
      (Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool -> Family l s)
-> Bool
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> (Bool -> Free (Node l) Bool s) -> Bool -> Family l s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure)
      Free (Node l) Bool s
p

-- | Replace an element with a family of sets
bindElem :: (Ord l, Hashable l) => Family l s -> (l -> Diagram l s (Family l s)) -> Diagram l s (Family l s)
bindElem :: Family l s
-> (l -> Diagram l s (Family l s)) -> Diagram l s (Family l s)
bindElem p :: Family l s
p f :: l -> Diagram l s (Family l s)
f =
  Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$
    (Node l (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Free (Node l) Bool s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) b a s.
(Monad m, Traversable f) =>
(f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
D.fold
      ( \n :: Node l (Family l s)
n -> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$ do
          Family l s
a <- l -> Diagram l s (Family l s)
f (Node l (Family l s) -> l
forall l k. Node l k -> l
label Node l (Family l s)
n)
          Family l s
b <- Family l s
a Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`intersect` Node l (Family l s) -> Family l s
forall l k. Node l k -> k
hi Node l (Family l s)
n
          Family l s
b Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`union` Node l (Family l s) -> Family l s
forall l k. Node l k -> k
lo Node l (Family l s)
n
      )
      (Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool -> Family l s)
-> Bool
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> (Bool -> Free (Node l) Bool s) -> Bool -> Family l s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure)
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)

-- | Simple families
empty, base :: Family l s
empty :: Family l s
empty = Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure Bool
True
base :: Family l s
base = Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure Bool
False

-- | Subsets that do or do not contain a particular element
subset :: (Ord l, Hashable l) => l -> Bool -> Family l s -> Diagram l s (Family l s)
subset :: l -> Bool -> Family l s -> Diagram l s (Family l s)
subset var :: l
var b :: Bool
b p :: Family l s
p =
  Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall l s.
Ord l =>
Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
memo (l -> Bool -> Family l s -> Memo l s
forall l s. l -> Bool -> Family l s -> Memo l s
Subset l
var Bool
b Family l s
p)
    (Diagram l s (Family l s) -> Diagram l s (Family l s))
-> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram
    (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      ( \n :: Node l (Free (Node l) Bool s)
n ->
          Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$
            case l -> l -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) l
var of
              LT -> Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
forall l s. Family l s
empty
              EQ -> Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s -> Diagram l s (Family l s))
-> Family l s -> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ if Bool
b then Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n else Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n
              GT -> do
                Family l s
lo' <- l -> Bool -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
l -> Bool -> Family l s -> Diagram l s (Family l s)
subset l
var Bool
b (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n)
                Family l s
hi' <- l -> Bool -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
l -> Bool -> Family l s -> Diagram l s (Family l s)
subset l
var Bool
b (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n)
                l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' Family l s
hi'
      )
      (Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool -> Family l s)
-> Bool
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> (Bool -> Free (Node l) Bool s) -> Bool -> Family l s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure)

-- | Flip an element in a family
change :: (Ord l, Hashable l) => l -> Family l s -> Diagram l s (Family l s)
change :: l -> Family l s -> Diagram l s (Family l s)
change var :: l
var p :: Family l s
p =
  Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall l s.
Ord l =>
Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
memo (l -> Family l s -> Memo l s
forall l s. l -> Family l s -> Memo l s
Change l
var Family l s
p)
    (Diagram l s (Family l s) -> Diagram l s (Family l s))
-> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram
    (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      ( \n :: Node l (Free (Node l) Bool s)
n ->
          Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$
            case l -> l -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) l
var of
              LT ->
                l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily l
var Family l s
forall l s. Family l s
empty Family l s
p
              EQ ->
                l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily l
var (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n) (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n)
              GT -> do
                Family l s
lo' <- l -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
l -> Family l s -> Diagram l s (Family l s)
change l
var (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n)
                Family l s
hi' <- l -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
l -> Family l s -> Diagram l s (Family l s)
change l
var (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n)
                l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' Family l s
hi'
      )
      (Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool -> Family l s)
-> Bool
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> (Bool -> Free (Node l) Bool s) -> Bool -> Family l s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure)

setLeftMost :: (Eq l, Hashable l) => Bool -> Family l s -> Diagram l s (Family l s)
setLeftMost :: Bool -> Family l s -> Diagram l s (Family l s)
setLeftMost b :: Bool
b p :: Family l s
p =
  Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$
    Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      ( \n :: Node l (Free (Node l) Bool s)
n -> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$ do
          Family l s
lo' <- Bool -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
Bool -> Family l s -> Diagram l s (Family l s)
setLeftMost Bool
b (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n)
          l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n)
      )
      (\_ -> Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$ Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure Bool
b)

flipLeftMost :: (Eq l, Hashable l) => Family l s -> Diagram l s (Family l s)
flipLeftMost :: Family l s -> Diagram l s (Family l s)
flipLeftMost p :: Family l s
p =
  Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$
    Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      ( \n :: Node l (Free (Node l) Bool s)
n -> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$ do
          Family l s
lo' <- Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
Family l s -> Diagram l s (Family l s)
flipLeftMost (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n)
          l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n)
      )
      (Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool -> Family l s)
-> Bool
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> (Bool -> Free (Node l) Bool s) -> Bool -> Family l s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure (Bool -> Free (Node l) Bool s)
-> (Bool -> Bool) -> Bool -> Free (Node l) Bool s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not)

getLeftMost :: Family l s -> Diagram l s (Family l s)
getLeftMost :: Family l s -> Diagram l s (Family l s)
getLeftMost p :: Family l s
p =
  Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$
    Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      (Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Node l (Free (Node l) Bool s) -> Diagram l s (Family l s))
-> Node l (Free (Node l) Bool s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Family l s -> Diagram l s (Family l s)
forall l s. Family l s -> Diagram l s (Family l s)
getLeftMost (Family l s -> Diagram l s (Family l s))
-> (Node l (Free (Node l) Bool s) -> Family l s)
-> Node l (Free (Node l) Bool s)
-> Diagram l s (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node l (Family l s) -> Family l s
forall l k. Node l k -> k
lo (Node l (Family l s) -> Family l s)
-> (Node l (Free (Node l) Bool s) -> Node l (Family l s))
-> Node l (Free (Node l) Bool s)
-> Family l s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Free (Node l) Bool s -> Family l s)
-> Node l (Free (Node l) Bool s) -> Node l (Family l s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family)
      (Family l s
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family l s
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool -> Family l s)
-> Bool
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> (Bool -> Free (Node l) Bool s) -> Bool -> Family l s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Free (Node l) Bool s
forall (f :: * -> *) a s. a -> Free f a s
D.Pure)

-- | The union of families
union :: (Ord l, Hashable l) => Family l s -> Family l s -> Diagram l s (Family l s)
union :: Family l s -> Family l s -> Diagram l s (Family l s)
union p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
q = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
p
union p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
empty = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
q
union p :: Family l s
p q :: Family l s
q | Family l s
q Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
empty = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
p
union p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
base = Bool -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
Bool -> Family l s -> Diagram l s (Family l s)
setLeftMost Bool
True Family l s
q
union p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
base = Bool -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
Bool -> Family l s -> Diagram l s (Family l s)
setLeftMost Bool
True Family l s
q
union p :: Family l s
p q :: Family l s
q =
  Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall l s.
Ord l =>
Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
memo (Family l s -> Family l s -> Memo l s
forall l s. Family l s -> Family l s -> Memo l s
Union Family l s
p Family l s
q)
    (Diagram l s (Family l s) -> Diagram l s (Family l s))
-> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram
    (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      ( \n :: Node l (Free (Node l) Bool s)
n ->
          Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
            (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
q)
            ( \m :: Node l (Free (Node l) Bool s)
m ->
                Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$
                  case l -> l -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
m) of
                    LT -> do
                      Family l s
lo' <- Family l s
p Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`union` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
m)
                      l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
m) Family l s
lo' (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
m)
                    EQ -> do
                      Family l s
lo' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`union` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
m)
                      Family l s
hi' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`union` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
m)
                      l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' Family l s
hi'
                    GT -> do
                      Family l s
lo' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`union` Family l s
p
                      l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n)
            )
            (\b :: Bool
b -> [Char]
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a. HasCallStack => [Char] -> a
error "Unreachable!")
      )
      (\b :: Bool
b -> [Char]
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a. HasCallStack => [Char] -> a
error "Unreachable!")

-- | The intersection of families
intersect :: (Ord l, Hashable l) => Family l s -> Family l s -> Diagram l s (Family l s)
intersect :: Family l s -> Family l s -> Diagram l s (Family l s)
intersect p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
q = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
p
intersect p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
empty = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
forall l s. Family l s
empty
intersect p :: Family l s
p q :: Family l s
q | Family l s
q Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
empty = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
forall l s. Family l s
empty
intersect p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
base = Family l s -> Diagram l s (Family l s)
forall l s. Family l s -> Diagram l s (Family l s)
getLeftMost Family l s
q
intersect p :: Family l s
p q :: Family l s
q | Family l s
q Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
base = Family l s -> Diagram l s (Family l s)
forall l s. Family l s -> Diagram l s (Family l s)
getLeftMost Family l s
p
intersect p :: Family l s
p q :: Family l s
q =
  Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall l s.
Ord l =>
Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
memo (Family l s -> Family l s -> Memo l s
forall l s. Family l s -> Family l s -> Memo l s
Intersect Family l s
p Family l s
q)
    (Diagram l s (Family l s) -> Diagram l s (Family l s))
-> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram
    (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      ( \n :: Node l (Free (Node l) Bool s)
n ->
          Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
            (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
q)
            ( \m :: Node l (Free (Node l) Bool s)
m ->
                Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$
                  case l -> l -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
m) of
                    LT ->
                      Family l s
p Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`intersect` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
m)
                    EQ -> do
                      Family l s
lo' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`intersect` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
m)
                      Family l s
hi' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`intersect` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
m)
                      l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' Family l s
hi'
                    GT ->
                      Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`intersect` Family l s
q
            )
            (\b :: Bool
b -> [Char]
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a. HasCallStack => [Char] -> a
error "Unreachable!")
      )
      (\b :: Bool
b -> [Char]
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a. HasCallStack => [Char] -> a
error "Unreachable!")

-- | The difference between families
difference :: (Ord l, Hashable l) => Family l s -> Family l s -> Diagram l s (Family l s)
difference :: Family l s -> Family l s -> Diagram l s (Family l s)
difference p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
q = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
forall l s. Family l s
empty
difference p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
empty = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
forall l s. Family l s
empty
difference p :: Family l s
p q :: Family l s
q | Family l s
q Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
empty = Family l s -> Diagram l s (Family l s)
forall (m :: * -> *) a. Monad m => a -> m a
return Family l s
p
difference p :: Family l s
p q :: Family l s
q | Family l s
p Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
base = Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
Family l s -> Diagram l s (Family l s)
flipLeftMost Family l s
q
difference p :: Family l s
p q :: Family l s
q | Family l s
q Family l s -> Family l s -> Bool
forall a. Eq a => a -> a -> Bool
== Family l s
forall l s. Family l s
base = Bool -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
Bool -> Family l s -> Diagram l s (Family l s)
setLeftMost Bool
False Family l s
p
difference p :: Family l s
p q :: Family l s
q =
  Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall l s.
Ord l =>
Memo l s -> Diagram l s (Family l s) -> Diagram l s (Family l s)
memo (Family l s -> Family l s -> Memo l s
forall l s. Family l s -> Family l s -> Memo l s
Difference Family l s
p Family l s
q)
    (Diagram l s (Family l s) -> Diagram l s (Family l s))
-> Diagram l s (Family l s) -> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Diagram
  (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram
    (Diagram
   (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
 -> Diagram l s (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
-> Diagram l s (Family l s)
forall a b. (a -> b) -> a -> b
$ Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
      (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
p)
      ( \n :: Node l (Free (Node l) Bool s)
n ->
          Free (Node l) Bool s
-> (Node l (Free (Node l) Bool s)
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> (Bool
    -> Diagram
         (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall (m :: * -> *) (f :: * -> *) a s b.
Monad m =>
Free f a s
-> (f (Free f a s) -> Diagram f a s m b)
-> (a -> Diagram f a s m b)
-> Diagram f a s m b
D.fromFree
            (Family l s -> Free (Node l) Bool s
forall l s. Family l s -> Free (Node l) Bool s
unFamily Family l s
q)
            ( \m :: Node l (Free (Node l) Bool s)
m ->
                Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s (Family l s)
 -> Diagram
      (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s))
-> Diagram l s (Family l s)
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a b. (a -> b) -> a -> b
$
                  case l -> l -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
m) of
                    LT ->
                      Family l s
p Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`difference` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
m)
                    EQ -> do
                      Family l s
lo' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`difference` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
m)
                      Family l s
hi' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`difference` Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
m)
                      l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' Family l s
hi'
                    GT -> do
                      Family l s
lo' <- Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
lo Node l (Free (Node l) Bool s)
n) Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Ord l, Hashable l) =>
Family l s -> Family l s -> Diagram l s (Family l s)
`difference` Family l s
q
                      l -> Family l s -> Family l s -> Diagram l s (Family l s)
forall l s.
(Eq l, Hashable l) =>
l -> Family l s -> Family l s -> Diagram l s (Family l s)
mkFamily (Node l (Free (Node l) Bool s) -> l
forall l k. Node l k -> l
label Node l (Free (Node l) Bool s)
n) Family l s
lo' (Free (Node l) Bool s -> Family l s
forall l s. Free (Node l) Bool s -> Family l s
Family (Free (Node l) Bool s -> Family l s)
-> Free (Node l) Bool s -> Family l s
forall a b. (a -> b) -> a -> b
$ Node l (Free (Node l) Bool s) -> Free (Node l) Bool s
forall l k. Node l k -> k
hi Node l (Free (Node l) Bool s)
n)
            )
            (\b :: Bool
b -> [Char]
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a. HasCallStack => [Char] -> a
error "Unreachable!")
      )
      (\b :: Bool
b -> [Char]
-> Diagram
     (Node l) Bool s (State (Map (Memo l s) (Family l s))) (Family l s)
forall a. HasCallStack => [Char] -> a
error "Unreachable!")

-- | Determine if the family is empty
--
--      >  anySat = fold (\_ p q -> p || q) id
anySat :: (Hashable l, Eq l) => Family l s -> Diagram l s Bool
anySat :: Family l s -> Diagram l s Bool
anySat = (l -> Bool -> Bool -> Diagram l s Bool)
-> (Bool -> Diagram l s Bool) -> Family l s -> Diagram l s Bool
forall l b s.
(Hashable l, Eq l) =>
(l -> b -> b -> Diagram l s b)
-> (Bool -> Diagram l s b) -> Family l s -> Diagram l s b
fold (\_ p :: Bool
p q :: Bool
q -> Bool -> Diagram l s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
p Bool -> Bool -> Bool
|| Bool
q)) Bool -> Diagram l s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Create a summary value of a family
fold :: (Hashable l, Eq l) => (l -> b -> b -> Diagram l s b) -> (Bool -> Diagram l s b) -> Family l s -> Diagram l s b
fold :: (l -> b -> b -> Diagram l s b)
-> (Bool -> Diagram l s b) -> Family l s -> Diagram l s b
fold f :: l -> b -> b -> Diagram l s b
f g :: Bool -> Diagram l s b
g (Family p :: Free (Node l) Bool s
p) = Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
-> Diagram l s b
forall l s a.
Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
-> Diagram l s a
Diagram (Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
 -> Diagram l s b)
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
-> Diagram l s b
forall a b. (a -> b) -> a -> b
$ (Node l b
 -> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b)
-> (Bool
    -> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b)
-> Free (Node l) Bool s
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
forall (m :: * -> *) (f :: * -> *) b a s.
(Monad m, Traversable f) =>
(f b -> Diagram f a s m b)
-> (a -> Diagram f a s m b) -> Free f a s -> Diagram f a s m b
D.fold (\n :: Node l b
n -> Diagram l s b
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s b
 -> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b)
-> Diagram l s b
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
forall a b. (a -> b) -> a -> b
$ l -> b -> b -> Diagram l s b
f (Node l b -> l
forall l k. Node l k -> l
label Node l b
n) (Node l b -> b
forall l k. Node l k -> k
lo Node l b
n) (Node l b -> b
forall l k. Node l k -> k
hi Node l b
n)) (Diagram l s b
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
forall l s a.
Diagram l s a
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) a
unDiag (Diagram l s b
 -> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b)
-> (Bool -> Diagram l s b)
-> Bool
-> Diagram (Node l) Bool s (State (Map (Memo l s) (Family l s))) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Diagram l s b
g) Free (Node l) Bool s
p