{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE UndecidableInstances #-}

-- | VariableSet allow us to track changes to an unordered mutable set.
-- The elements of the set are keyed by instancing HasKey with some Ord
-- instance; this allows us to set up a special HasKey instance for this
-- module without committing us to that Ord instance everywhere.
module Util.VariableSet(
   HasKey(..),
   Keyed(..),
   VariableSetUpdate(..),
   VariableSet(..),

   newEmptyVariableSet,
   newVariableSet,
   updateSet,
   setVariableSet,

   VariableSetSource,
   emptyVariableSetSource,

   mapVariableSetSourceIO',
   concatVariableSetSource,

   mapVariableSetSource,
   singletonSetSource,
   listToSetSource,
   ) where

import Data.Maybe
import qualified Data.List as List

import qualified Data.Set as Set

import Util.Dynamics
import Util.Sources
import Util.Broadcaster

-- --------------------------------------------------------------------
-- The HasKey and Keyed types
-- --------------------------------------------------------------------

class Ord key => HasKey x key | x -> key where
   toKey :: x -> key


newtype Keyed x = Keyed x

unKey :: Keyed x -> x
unKey :: Keyed x -> x
unKey (Keyed x
x) = x
x

lift :: (HasKey x1 key1,HasKey x2 key2)
   => (key1 -> key2 -> a) -> (Keyed x1 -> Keyed x2 -> a)
lift :: (key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key1 -> key2 -> a
f Keyed x1
x1 Keyed x2
x2 = key1 -> key2 -> a
f (x1 -> key1
forall x key. HasKey x key => x -> key
toKey (x1 -> key1) -> (Keyed x1 -> x1) -> Keyed x1 -> key1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keyed x1 -> x1
forall x. Keyed x -> x
unKey (Keyed x1 -> key1) -> Keyed x1 -> key1
forall a b. (a -> b) -> a -> b
$ Keyed x1
x1) (x2 -> key2
forall x key. HasKey x key => x -> key
toKey (x2 -> key2) -> (Keyed x2 -> x2) -> Keyed x2 -> key2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keyed x2 -> x2
forall x. Keyed x -> x
unKey (Keyed x2 -> key2) -> Keyed x2 -> key2
forall a b. (a -> b) -> a -> b
$ Keyed x2
x2)


-- | HasKey specifies the ordering to use (without committing us to
-- a particular Ord instance elsewhere).
instance HasKey x key => Eq (Keyed x) where
   == :: Keyed x -> Keyed x -> Bool
(==) = (key -> key -> Bool) -> Keyed x -> Keyed x -> Bool
forall x1 key1 x2 key2 a.
(HasKey x1 key1, HasKey x2 key2) =>
(key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key -> key -> Bool
forall a. Eq a => a -> a -> Bool
(==)
   /= :: Keyed x -> Keyed x -> Bool
(/=) = (key -> key -> Bool) -> Keyed x -> Keyed x -> Bool
forall x1 key1 x2 key2 a.
(HasKey x1 key1, HasKey x2 key2) =>
(key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key -> key -> Bool
forall a. Eq a => a -> a -> Bool
(/=)

instance HasKey x key => Ord (Keyed x) where
   compare :: Keyed x -> Keyed x -> Ordering
compare = (key -> key -> Ordering) -> Keyed x -> Keyed x -> Ordering
forall x1 key1 x2 key2 a.
(HasKey x1 key1, HasKey x2 key2) =>
(key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key -> key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
   <= :: Keyed x -> Keyed x -> Bool
(<=) = (key -> key -> Bool) -> Keyed x -> Keyed x -> Bool
forall x1 key1 x2 key2 a.
(HasKey x1 key1, HasKey x2 key2) =>
(key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key -> key -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
   >= :: Keyed x -> Keyed x -> Bool
(>=) = (key -> key -> Bool) -> Keyed x -> Keyed x -> Bool
forall x1 key1 x2 key2 a.
(HasKey x1 key1, HasKey x2 key2) =>
(key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key -> key -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
   < :: Keyed x -> Keyed x -> Bool
(<) = (key -> key -> Bool) -> Keyed x -> Keyed x -> Bool
forall x1 key1 x2 key2 a.
(HasKey x1 key1, HasKey x2 key2) =>
(key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key -> key -> Bool
forall a. Ord a => a -> a -> Bool
(<)
   > :: Keyed x -> Keyed x -> Bool
(>) = (key -> key -> Bool) -> Keyed x -> Keyed x -> Bool
forall x1 key1 x2 key2 a.
(HasKey x1 key1, HasKey x2 key2) =>
(key1 -> key2 -> a) -> Keyed x1 -> Keyed x2 -> a
lift key -> key -> Bool
forall a. Ord a => a -> a -> Bool
(>)

-- --------------------------------------------------------------------
-- The datatype
-- --------------------------------------------------------------------

newtype VariableSetData x = VariableSetData (Set.Set (Keyed x))

-- | Encodes the updates to a variable set.
-- BeginGroup does not actually alter the set itself, but
-- indicate that a group of updates is about to begin, terminated by EndGroup.
-- This prevents the client from trying to recalculate the state after every single
-- update.
--
-- BeginGroup\/EndGroup may be nested (though I don\'t have any application for that
-- yet).
data VariableSetUpdate x =
      AddElement x
   |  DelElement x
   |  BeginGroup
   |  EndGroup

update :: HasKey x key
   => VariableSetUpdate x -> VariableSetData x
   -> (VariableSetData x,[VariableSetUpdate x])
update :: VariableSetUpdate x
-> VariableSetData x -> (VariableSetData x, [VariableSetUpdate x])
update VariableSetUpdate x
setUpdate (variableSet :: VariableSetData x
variableSet @ (VariableSetData Set (Keyed x)
set)) =
   let
      noop :: (VariableSetData x, [a])
noop = (VariableSetData x
variableSet,[])
      grouper :: (VariableSetData x, [VariableSetUpdate x])
grouper = (VariableSetData x
variableSet,[VariableSetUpdate x
setUpdate])
      oneop :: Set (Keyed x) -> (VariableSetData x, [VariableSetUpdate x])
oneop Set (Keyed x)
newSet = (Set (Keyed x) -> VariableSetData x
forall x. Set (Keyed x) -> VariableSetData x
VariableSetData Set (Keyed x)
newSet,[VariableSetUpdate x
setUpdate])
   in
      case VariableSetUpdate x
setUpdate of
         AddElement x
x ->
            let
               kx :: Keyed x
kx = x -> Keyed x
forall x. x -> Keyed x
Keyed x
x
               isElement :: Bool
isElement = Keyed x -> Set (Keyed x) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Keyed x
kx Set (Keyed x)
set
            in
               if Bool
isElement then (VariableSetData x, [VariableSetUpdate x])
forall a. (VariableSetData x, [a])
noop else Set (Keyed x) -> (VariableSetData x, [VariableSetUpdate x])
forall x.
Set (Keyed x) -> (VariableSetData x, [VariableSetUpdate x])
oneop (Keyed x -> Set (Keyed x) -> Set (Keyed x)
forall a. Ord a => a -> Set a -> Set a
Set.insert Keyed x
kx Set (Keyed x)
set)
         DelElement x
x ->
            let
               kx :: Keyed x
kx = x -> Keyed x
forall x. x -> Keyed x
Keyed x
x
               isElement :: Bool
isElement = Keyed x -> Set (Keyed x) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Keyed x
kx Set (Keyed x)
set
            in
               if Bool
isElement then Set (Keyed x) -> (VariableSetData x, [VariableSetUpdate x])
forall x.
Set (Keyed x) -> (VariableSetData x, [VariableSetUpdate x])
oneop (Keyed x -> Set (Keyed x) -> Set (Keyed x)
forall a. Ord a => a -> Set a -> Set a
Set.delete Keyed x
kx Set (Keyed x)
set)
                  else (VariableSetData x, [VariableSetUpdate x])
forall a. (VariableSetData x, [a])
noop
         VariableSetUpdate x
BeginGroup -> (VariableSetData x, [VariableSetUpdate x])
grouper
         VariableSetUpdate x
EndGroup -> (VariableSetData x, [VariableSetUpdate x])
grouper

newtype VariableSet x
   = VariableSet (Broadcaster (VariableSetData x) (VariableSetUpdate x))
   deriving (Typeable)

-- --------------------------------------------------------------------
-- The provider's interface
-- --------------------------------------------------------------------

-- | Create a new empty variable set.
newEmptyVariableSet :: HasKey x key => IO (VariableSet x)
newEmptyVariableSet :: IO (VariableSet x)
newEmptyVariableSet =
   do
      Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster <- VariableSetData x
-> IO (Broadcaster (VariableSetData x) (VariableSetUpdate x))
forall x d. x -> IO (Broadcaster x d)
newBroadcaster (Set (Keyed x) -> VariableSetData x
forall x. Set (Keyed x) -> VariableSetData x
VariableSetData Set (Keyed x)
forall a. Set a
Set.empty)
      VariableSet x -> IO (VariableSet x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Broadcaster (VariableSetData x) (VariableSetUpdate x)
-> VariableSet x
forall x.
Broadcaster (VariableSetData x) (VariableSetUpdate x)
-> VariableSet x
VariableSet Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster)

-- | Create a new variable set with given contents
newVariableSet :: HasKey x key => [x] -> IO (VariableSet x)
newVariableSet :: [x] -> IO (VariableSet x)
newVariableSet [x]
contents =
   do
      Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster
         <- VariableSetData x
-> IO (Broadcaster (VariableSetData x) (VariableSetUpdate x))
forall x d. x -> IO (Broadcaster x d)
newBroadcaster (Set (Keyed x) -> VariableSetData x
forall x. Set (Keyed x) -> VariableSetData x
VariableSetData ([Keyed x] -> Set (Keyed x)
forall a. Ord a => [a] -> Set a
Set.fromList ((x -> Keyed x) -> [x] -> [Keyed x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Keyed x
forall x. x -> Keyed x
Keyed [x]
contents)))
      VariableSet x -> IO (VariableSet x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Broadcaster (VariableSetData x) (VariableSetUpdate x)
-> VariableSet x
forall x.
Broadcaster (VariableSetData x) (VariableSetUpdate x)
-> VariableSet x
VariableSet Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster)

-- | Update a variable set in some way.
updateSet :: HasKey x key => VariableSet x -> VariableSetUpdate x -> IO ()
updateSet :: VariableSet x -> VariableSetUpdate x -> IO ()
updateSet (VariableSet Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster) VariableSetUpdate x
setUpdate
   = Broadcaster (VariableSetData x) (VariableSetUpdate x)
-> (VariableSetData x
    -> (VariableSetData x, [VariableSetUpdate x]))
-> IO ()
forall x d. Broadcaster x d -> (x -> (x, [d])) -> IO ()
applyUpdate Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster (VariableSetUpdate x
-> VariableSetData x -> (VariableSetData x, [VariableSetUpdate x])
forall x key.
HasKey x key =>
VariableSetUpdate x
-> VariableSetData x -> (VariableSetData x, [VariableSetUpdate x])
update VariableSetUpdate x
setUpdate)

-- | Set the elements of the variable set.
setVariableSet :: HasKey x key => VariableSet x -> [x] -> IO ()
setVariableSet :: VariableSet x -> [x] -> IO ()
setVariableSet (VariableSet Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster) [x]
newList =
   do
     let
        newSet :: Set (Keyed x)
newSet = [Keyed x] -> Set (Keyed x)
forall a. Ord a => [a] -> Set a
Set.fromList ((x -> Keyed x) -> [x] -> [Keyed x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Keyed x
forall x. x -> Keyed x
Keyed [x]
newList)

        updateFn :: VariableSetData x -> (VariableSetData x, [VariableSetUpdate x])
updateFn (VariableSetData Set (Keyed x)
oldSet) =
           let
              toAddList :: [x]
toAddList
                 = (x -> Bool) -> [x] -> [x]
forall a. (a -> Bool) -> [a] -> [a]
List.filter
                    (\ x
el -> Bool -> Bool
not (Keyed x -> Set (Keyed x) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (x -> Keyed x
forall x. x -> Keyed x
Keyed x
el) Set (Keyed x)
oldSet)) [x]
newList
              toDeleteList :: [x]
toDeleteList = (Keyed x -> x) -> [Keyed x] -> [x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Keyed x -> x
forall x. Keyed x -> x
unKey (Set (Keyed x) -> [Keyed x]
forall a. Set a -> [a]
Set.toList (Set (Keyed x) -> Set (Keyed x) -> Set (Keyed x)
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set (Keyed x)
oldSet Set (Keyed x)
newSet))
              updates :: [VariableSetUpdate x]
updates =
                 [VariableSetUpdate x
forall x. VariableSetUpdate x
BeginGroup] [VariableSetUpdate x]
-> [VariableSetUpdate x] -> [VariableSetUpdate x]
forall a. [a] -> [a] -> [a]
++ ((x -> VariableSetUpdate x) -> [x] -> [VariableSetUpdate x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> VariableSetUpdate x
forall x. x -> VariableSetUpdate x
AddElement [x]
toAddList)
                    [VariableSetUpdate x]
-> [VariableSetUpdate x] -> [VariableSetUpdate x]
forall a. [a] -> [a] -> [a]
++ ((x -> VariableSetUpdate x) -> [x] -> [VariableSetUpdate x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> VariableSetUpdate x
forall x. x -> VariableSetUpdate x
DelElement [x]
toDeleteList) [VariableSetUpdate x]
-> [VariableSetUpdate x] -> [VariableSetUpdate x]
forall a. [a] -> [a] -> [a]
++ [VariableSetUpdate x
forall x. VariableSetUpdate x
EndGroup]
           in
              (Set (Keyed x) -> VariableSetData x
forall x. Set (Keyed x) -> VariableSetData x
VariableSetData Set (Keyed x)
newSet,[VariableSetUpdate x]
updates)

     Broadcaster (VariableSetData x) (VariableSetUpdate x)
-> (VariableSetData x
    -> (VariableSetData x, [VariableSetUpdate x]))
-> IO ()
forall x d. Broadcaster x d -> (x -> (x, [d])) -> IO ()
applyUpdate Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster VariableSetData x -> (VariableSetData x, [VariableSetUpdate x])
forall key key.
(HasKey x key, HasKey x key) =>
VariableSetData x -> (VariableSetData x, [VariableSetUpdate x])
updateFn

-- --------------------------------------------------------------------
-- The client's interface
-- --------------------------------------------------------------------

instance HasKey x key => HasSource (VariableSet x) [x] (VariableSetUpdate x)
      where
   toSource :: VariableSet x -> Source [x] (VariableSetUpdate x)
toSource (VariableSet Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster) =
      (VariableSetData x -> [x])
-> Source (VariableSetData x) (VariableSetUpdate x)
-> Source [x] (VariableSetUpdate x)
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1
         (\ (VariableSetData Set (Keyed x)
set) -> (Keyed x -> x) -> [Keyed x] -> [x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Keyed x -> x
forall x. Keyed x -> x
unKey (Set (Keyed x) -> [Keyed x]
forall a. Set a -> [a]
Set.toList Set (Keyed x)
set))
         (Broadcaster (VariableSetData x) (VariableSetUpdate x)
-> Source (VariableSetData x) (VariableSetUpdate x)
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource Broadcaster (VariableSetData x) (VariableSetUpdate x)
broadcaster)

-- --------------------------------------------------------------------
-- Type with the clients interface to a variable set (but which may be
-- otherwise implemented)
-- --------------------------------------------------------------------

type VariableSetSource x = Source [x] (VariableSetUpdate x)

emptyVariableSetSource :: VariableSetSource x
emptyVariableSetSource :: VariableSetSource x
emptyVariableSetSource = [x] -> VariableSetSource x
forall x d. x -> Source x d
staticSource []

-- --------------------------------------------------------------------
-- Combinators for VariableSetSource
-- --------------------------------------------------------------------

mapVariableSetSourceIO' :: (x -> IO (Maybe y)) -> VariableSetSource x
   -> VariableSetSource y
mapVariableSetSourceIO' :: (x -> IO (Maybe y)) -> VariableSetSource x -> VariableSetSource y
mapVariableSetSourceIO' x -> IO (Maybe y)
mapFn=
   (([x] -> IO [y])
-> Source [x] (VariableSetUpdate y) -> VariableSetSource y
forall x1 x2 d. (x1 -> IO x2) -> Source x1 d -> Source x2 d
map1IO
      (\ [x]
currentEls ->
         do
            [Maybe y]
newEls <- (x -> IO (Maybe y)) -> [x] -> IO [Maybe y]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM x -> IO (Maybe y)
mapFn [x]
currentEls
            [y] -> IO [y]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe y] -> [y]
forall a. [Maybe a] -> [a]
catMaybes [Maybe y]
newEls)
         )
      )
   (Source [x] (VariableSetUpdate y) -> VariableSetSource y)
-> (VariableSetSource x -> Source [x] (VariableSetUpdate y))
-> VariableSetSource x
-> VariableSetSource y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((VariableSetUpdate x -> IO (Maybe (VariableSetUpdate y)))
-> VariableSetSource x -> Source [x] (VariableSetUpdate y)
forall d1 d2 x. (d1 -> IO (Maybe d2)) -> Source x d1 -> Source x d2
filter2IO
      (\ VariableSetUpdate x
change ->
         case VariableSetUpdate x
change of
            AddElement x
x ->
               do
                  Maybe y
yOpt <- x -> IO (Maybe y)
mapFn x
x
                  case Maybe y
yOpt of
                     Maybe y
Nothing -> Maybe (VariableSetUpdate y) -> IO (Maybe (VariableSetUpdate y))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (VariableSetUpdate y)
forall a. Maybe a
Nothing
                     Just y
y -> Maybe (VariableSetUpdate y) -> IO (Maybe (VariableSetUpdate y))
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableSetUpdate y -> Maybe (VariableSetUpdate y)
forall a. a -> Maybe a
Just (y -> VariableSetUpdate y
forall x. x -> VariableSetUpdate x
AddElement y
y))
            DelElement x
x ->
               do
                  Maybe y
yOpt <- x -> IO (Maybe y)
mapFn x
x
                  case Maybe y
yOpt of
                     Maybe y
Nothing -> Maybe (VariableSetUpdate y) -> IO (Maybe (VariableSetUpdate y))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (VariableSetUpdate y)
forall a. Maybe a
Nothing
                     Just y
y -> Maybe (VariableSetUpdate y) -> IO (Maybe (VariableSetUpdate y))
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableSetUpdate y -> Maybe (VariableSetUpdate y)
forall a. a -> Maybe a
Just (y -> VariableSetUpdate y
forall x. x -> VariableSetUpdate x
DelElement y
y))
            VariableSetUpdate x
BeginGroup -> Maybe (VariableSetUpdate y) -> IO (Maybe (VariableSetUpdate y))
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableSetUpdate y -> Maybe (VariableSetUpdate y)
forall a. a -> Maybe a
Just VariableSetUpdate y
forall x. VariableSetUpdate x
BeginGroup)
            VariableSetUpdate x
EndGroup -> Maybe (VariableSetUpdate y) -> IO (Maybe (VariableSetUpdate y))
forall (m :: * -> *) a. Monad m => a -> m a
return (VariableSetUpdate y -> Maybe (VariableSetUpdate y)
forall a. a -> Maybe a
Just VariableSetUpdate y
forall x. VariableSetUpdate x
EndGroup)
         )
      )

concatVariableSetSource :: VariableSetSource x -> VariableSetSource x
   -> VariableSetSource x
concatVariableSetSource :: VariableSetSource x -> VariableSetSource x -> VariableSetSource x
concatVariableSetSource (VariableSetSource x
source1 :: VariableSetSource x) VariableSetSource x
source2 =
   let
      pair :: Source ([x],[x])
         (Either (VariableSetUpdate x) (VariableSetUpdate x))
      pair :: Source
  ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
pair = VariableSetSource x
-> VariableSetSource x
-> Source
     ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
forall x1 d1 x2 d2.
Source x1 d1 -> Source x2 d2 -> Source (x1, x2) (Either d1 d2)
choose VariableSetSource x
source1 VariableSetSource x
source2

      res :: Source [x] (VariableSetUpdate x)
      res :: VariableSetSource x
res =
         ((([x], [x]) -> [x])
-> Source ([x], [x]) (VariableSetUpdate x) -> VariableSetSource x
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 (\ ([x]
x1,[x]
x2) -> [x]
x1 [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ [x]
x2))
         (Source ([x], [x]) (VariableSetUpdate x) -> VariableSetSource x)
-> (Source
      ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
    -> Source ([x], [x]) (VariableSetUpdate x))
-> Source
     ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
-> VariableSetSource x
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ((Either (VariableSetUpdate x) (VariableSetUpdate x)
 -> VariableSetUpdate x)
-> Source
     ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
-> Source ([x], [x]) (VariableSetUpdate x)
forall d1 d2 x. (d1 -> d2) -> Source x d1 -> Source x d2
map2
            (\ Either (VariableSetUpdate x) (VariableSetUpdate x)
xlr -> case Either (VariableSetUpdate x) (VariableSetUpdate x)
xlr of
               Left VariableSetUpdate x
x -> VariableSetUpdate x
x
               Right VariableSetUpdate x
x -> VariableSetUpdate x
x
               )
            )
         (Source
   ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
 -> VariableSetSource x)
-> Source
     ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
-> VariableSetSource x
forall a b. (a -> b) -> a -> b
$
         Source
  ([x], [x]) (Either (VariableSetUpdate x) (VariableSetUpdate x))
pair
   in
      VariableSetSource x
res

-- --------------------------------------------------------------------
-- VariableSetUpdate is an instance of Functor.
-- mapVariableSetSource is functor-like for VariableSetSource.
-- --------------------------------------------------------------------

instance Functor VariableSetUpdate where
   fmap :: (a -> b) -> VariableSetUpdate a -> VariableSetUpdate b
fmap a -> b
fn (AddElement a
x) = b -> VariableSetUpdate b
forall x. x -> VariableSetUpdate x
AddElement (a -> b
fn a
x)
   fmap a -> b
fn (DelElement a
x) = b -> VariableSetUpdate b
forall x. x -> VariableSetUpdate x
DelElement (a -> b
fn a
x)
   fmap a -> b
fn VariableSetUpdate a
BeginGroup = VariableSetUpdate b
forall x. VariableSetUpdate x
BeginGroup
   fmap a -> b
fn VariableSetUpdate a
EndGroup = VariableSetUpdate b
forall x. VariableSetUpdate x
EndGroup

mapVariableSetSource :: (x -> y) -> VariableSetSource x -> VariableSetSource y
mapVariableSetSource :: (x -> y) -> VariableSetSource x -> VariableSetSource y
mapVariableSetSource x -> y
fn VariableSetSource x
source =
   (([x] -> [y])
-> Source [x] (VariableSetUpdate y) -> VariableSetSource y
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 ((x -> y) -> [x] -> [y]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
fn)) (Source [x] (VariableSetUpdate y) -> VariableSetSource y)
-> (VariableSetSource x -> Source [x] (VariableSetUpdate y))
-> VariableSetSource x
-> VariableSetSource y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((VariableSetUpdate x -> VariableSetUpdate y)
-> VariableSetSource x -> Source [x] (VariableSetUpdate y)
forall d1 d2 x. (d1 -> d2) -> Source x d1 -> Source x d2
map2 ((x -> y) -> VariableSetUpdate x -> VariableSetUpdate y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
fn)) (VariableSetSource x -> VariableSetSource y)
-> VariableSetSource x -> VariableSetSource y
forall a b. (a -> b) -> a -> b
$
   VariableSetSource x
source

-- --------------------------------------------------------------------
-- singletonSetSource creates a VariableSet with a single element
-- --------------------------------------------------------------------

singletonSetSource :: SimpleSource x -> VariableSetSource x
singletonSetSource :: SimpleSource x -> VariableSetSource x
singletonSetSource (SimpleSource x
source0 :: SimpleSource x) =
   let
      (Source x x
source1 :: Source x x) = SimpleSource x -> Source x x
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource SimpleSource x
source0
      (Source x (x, x)
source2 :: Source x (x,x)) = (x -> x) -> Source x x -> Source x (x, x)
forall x d. (x -> d) -> Source x d -> Source x (d, d)
mkHistorySource x -> x
forall a. a -> a
id Source x x
source1
      (Source [x] [VariableSetUpdate x]
source3 :: Source [x] [VariableSetUpdate x]) =
         ((x -> [x])
-> Source x [VariableSetUpdate x]
-> Source [x] [VariableSetUpdate x]
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1
            (\ x
x -> [x
x])
            )
         (Source x [VariableSetUpdate x]
 -> Source [x] [VariableSetUpdate x])
-> (Source x (x, x) -> Source x [VariableSetUpdate x])
-> Source x (x, x)
-> Source [x] [VariableSetUpdate x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         (((x, x) -> [VariableSetUpdate x])
-> Source x (x, x) -> Source x [VariableSetUpdate x]
forall d1 d2 x. (d1 -> d2) -> Source x d1 -> Source x d2
map2
            (\ (x
x1,x
x2) -> [VariableSetUpdate x
forall x. VariableSetUpdate x
BeginGroup,x -> VariableSetUpdate x
forall x. x -> VariableSetUpdate x
AddElement x
x2,x -> VariableSetUpdate x
forall x. x -> VariableSetUpdate x
DelElement x
x1,VariableSetUpdate x
forall x. VariableSetUpdate x
EndGroup])
            )
         (Source x (x, x) -> Source [x] [VariableSetUpdate x])
-> Source x (x, x) -> Source [x] [VariableSetUpdate x]
forall a b. (a -> b) -> a -> b
$
         Source x (x, x)
source2
      (VariableSetSource x
source4 :: VariableSetSource x) = Source [x] [VariableSetUpdate x] -> VariableSetSource x
forall x d. Source x [d] -> Source x d
flattenSource Source [x] [VariableSetUpdate x]
source3
   in
      VariableSetSource x
source4

-- | Creates a VariableSetSource whose elements are the same as those of the
-- corresponding list.
listToSetSource :: Ord x => SimpleSource [x] -> VariableSetSource x
listToSetSource :: SimpleSource [x] -> VariableSetSource x
listToSetSource (SimpleSource [x]
simpleSource :: SimpleSource [x]) =
   let
      source1 :: Source [x] [x]
      source1 :: Source [x] [x]
source1 = SimpleSource [x] -> Source [x] [x]
forall hasSource x d.
HasSource hasSource x d =>
hasSource -> Source x d
toSource SimpleSource [x]
simpleSource

      source2 :: Source (Set.Set x,[x]) [VariableSetUpdate x]
      source2 :: Source (Set x, [x]) [VariableSetUpdate x]
source2 = ([x] -> Set x)
-> (Set x -> [x] -> (Set x, [VariableSetUpdate x]))
-> Source [x] [x]
-> Source (Set x, [x]) [VariableSetUpdate x]
forall x state d1 d2.
(x -> state)
-> (state -> d1 -> (state, d2))
-> Source x d1
-> Source (state, x) d2
foldSource
         (\ [x]
list -> [x] -> Set x
forall a. Ord a => [a] -> Set a
Set.fromList [x]
list)
         (\ Set x
oldSet [x]
newList ->
            let
               newSet :: Set x
newSet = [x] -> Set x
forall a. Ord a => [a] -> Set a
Set.fromList [x]
newList

               toAdd :: Set x
toAdd = Set x -> Set x -> Set x
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set x
newSet Set x
oldSet
               adds :: [VariableSetUpdate x]
adds = (x -> VariableSetUpdate x) -> [x] -> [VariableSetUpdate x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> VariableSetUpdate x
forall x. x -> VariableSetUpdate x
AddElement (Set x -> [x]
forall a. Set a -> [a]
Set.toList Set x
toAdd)

               toDelete :: Set x
toDelete = Set x -> Set x -> Set x
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set x
oldSet Set x
newSet
               deletes :: [VariableSetUpdate x]
deletes = (x -> VariableSetUpdate x) -> [x] -> [VariableSetUpdate x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> VariableSetUpdate x
forall x. x -> VariableSetUpdate x
DelElement (Set x -> [x]
forall a. Set a -> [a]
Set.toList Set x
toDelete)
            in
               (Set x
newSet,[VariableSetUpdate x]
adds [VariableSetUpdate x]
-> [VariableSetUpdate x] -> [VariableSetUpdate x]
forall a. [a] -> [a] -> [a]
++ [VariableSetUpdate x]
deletes)
            )
         Source [x] [x]
source1

      source3 :: Source [x] [VariableSetUpdate x]
      source3 :: Source [x] [VariableSetUpdate x]
source3 = ((Set x, [x]) -> [x])
-> Source (Set x, [x]) [VariableSetUpdate x]
-> Source [x] [VariableSetUpdate x]
forall x1 x2 d. (x1 -> x2) -> Source x1 d -> Source x2 d
map1 (Set x, [x]) -> [x]
forall a b. (a, b) -> b
snd Source (Set x, [x]) [VariableSetUpdate x]
source2

      source4 :: Source [x] (VariableSetUpdate x)
      source4 :: VariableSetSource x
source4 = Source [x] [VariableSetUpdate x] -> VariableSetSource x
forall x d. Source x [d] -> Source x d
flattenSource Source [x] [VariableSetUpdate x]
source3
   in
      VariableSetSource x
source4