{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Util.VariableList(
   newVariableListFromSet, -- :: Ord a => VariableSetSource a -> VariableList a
   newVariableListFromList, -- :: Ord a => SimpleSource [a] -> VariableList a
   emptyVariableList, -- :: VariableList a
   singletonList, -- :: a -> VariableList a
   VariableList,
   ListDrawer(..),
   attachListOp, -- :: VariableList a -> ListDrawer a -> IO (IO ())
   coMapListDrawer, -- :: (a -> b) -> ListDrawer b pos -> ListDrawer a pos
   map2ListDrawer, -- :: (pos1 -> pos2) -> (pos2 -> pos2) ->
      -- ListDrawer b pos1 -> ListDrawer b pos2

   catVariableLists, -- :: VariableList a -> VariableList a -> VariableList a

   ) where

import Data.Maybe

import Data.IORef

import Util.Computation
import Util.Registry
import Util.Sources
import Util.Sink
import Util.VariableSet
import Util.Delayer
import Util.Myers

-- -----------------------------------------------------------------------
-- The types
-- -----------------------------------------------------------------------

data ListDrawer a pos = ListDrawer {
   -- A drawn list consists of a list of positions of type "pos", each of
   -- which optionally has a value of type "a" attached to it.  The value
   -- of type "a" is mutable.

   ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos :: Maybe pos -> Maybe a -> IO pos,
      -- newPos posOpt aOpt creates a new position.  If posOpt is
      -- Nothing this is at the beginning of the list, otherwise it is
      -- after the given position. aOpt specifies the value.
   ListDrawer a pos -> pos -> Maybe a -> IO ()
setPos :: pos -> Maybe a -> IO (),
      -- Alter the value at pos.
   ListDrawer a pos -> pos -> IO ()
delPos :: pos -> IO (),
      -- Remove pos.  After this, pos should not be used.

   ListDrawer a pos -> IO ()
redraw :: IO ()
      -- This should be done after every group of updates, to ensure they
      -- physically happen.
   }

-- | Return the close action.
-- attachListOp :: ParallelExec -> VariableList a -> ListDrawer a -> IO (IO ())

data VariableList a = VariableList {
   VariableList a
-> forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp :: forall pos . ParallelExec -> ListDrawer a pos -> IO (IO ())
   }

-- -----------------------------------------------------------------------
-- The instances
-- -----------------------------------------------------------------------

instance Functor VariableList where
   fmap :: (a -> b) -> VariableList a -> VariableList b
fmap a -> b
fn (VariableList {attachListOp :: forall a.
VariableList a
-> forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp = forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp0}) =
      let
         attachListOp1 :: ParallelExec -> ListDrawer b pos -> IO (IO ())
attachListOp1 ParallelExec
parallelEx ListDrawer b pos
listDrawer =
            ParallelExec -> ListDrawer a pos -> IO (IO ())
forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp0 ParallelExec
parallelEx ((a -> b) -> ListDrawer b pos -> ListDrawer a pos
forall a b pos. (a -> b) -> ListDrawer b pos -> ListDrawer a pos
coMapListDrawer a -> b
fn ListDrawer b pos
listDrawer)
      in
         (forall pos. ParallelExec -> ListDrawer b pos -> IO (IO ()))
-> VariableList b
forall a.
(forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
VariableList forall pos. ParallelExec -> ListDrawer b pos -> IO (IO ())
attachListOp1

coMapListDrawer :: (a -> b) -> ListDrawer b pos -> ListDrawer a pos
coMapListDrawer :: (a -> b) -> ListDrawer b pos -> ListDrawer a pos
coMapListDrawer a -> b
fn (ListDrawer {
      newPos :: forall a pos. ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos = Maybe pos -> Maybe b -> IO pos
newPos0,setPos :: forall a pos. ListDrawer a pos -> pos -> Maybe a -> IO ()
setPos = pos -> Maybe b -> IO ()
setPos0,delPos :: forall a pos. ListDrawer a pos -> pos -> IO ()
delPos = pos -> IO ()
delPos0,redraw :: forall a pos. ListDrawer a pos -> IO ()
redraw = IO ()
redraw0}) =
   let
      newPos1 :: Maybe pos -> Maybe a -> IO pos
newPos1 Maybe pos
posOpt Maybe a
aOpt = Maybe pos -> Maybe b -> IO pos
newPos0 Maybe pos
posOpt ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn Maybe a
aOpt)
      setPos1 :: pos -> Maybe a -> IO ()
setPos1 pos
pos Maybe a
aOpt = pos -> Maybe b -> IO ()
setPos0 pos
pos ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn Maybe a
aOpt)
      delPos1 :: pos -> IO ()
delPos1 = pos -> IO ()
delPos0
      redraw1 :: IO ()
redraw1 = IO ()
redraw0
   in
      ListDrawer :: forall a pos.
(Maybe pos -> Maybe a -> IO pos)
-> (pos -> Maybe a -> IO ())
-> (pos -> IO ())
-> IO ()
-> ListDrawer a pos
ListDrawer {
         newPos :: Maybe pos -> Maybe a -> IO pos
newPos = Maybe pos -> Maybe a -> IO pos
newPos1,setPos :: pos -> Maybe a -> IO ()
setPos = pos -> Maybe a -> IO ()
setPos1,delPos :: pos -> IO ()
delPos = pos -> IO ()
delPos1,redraw :: IO ()
redraw = IO ()
redraw1}

map2ListDrawer :: (pos1 -> pos2) -> (pos2 -> pos1) ->
      ListDrawer b pos1 -> ListDrawer b pos2
map2ListDrawer :: (pos1 -> pos2)
-> (pos2 -> pos1) -> ListDrawer b pos1 -> ListDrawer b pos2
map2ListDrawer pos1 -> pos2
toPos2 pos2 -> pos1
toPos1 (ListDrawer {
      newPos :: forall a pos. ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos = Maybe pos1 -> Maybe b -> IO pos1
newPos1,setPos :: forall a pos. ListDrawer a pos -> pos -> Maybe a -> IO ()
setPos = pos1 -> Maybe b -> IO ()
setPos1,delPos :: forall a pos. ListDrawer a pos -> pos -> IO ()
delPos = pos1 -> IO ()
delPos1,redraw :: forall a pos. ListDrawer a pos -> IO ()
redraw = IO ()
redraw1}) =
   let
      newPos2 :: Maybe pos2 -> Maybe b -> IO pos2
newPos2 Maybe pos2
pos2Opt Maybe b
aOpt =
         do
            pos1
pos1 <- Maybe pos1 -> Maybe b -> IO pos1
newPos1 ((pos2 -> pos1) -> Maybe pos2 -> Maybe pos1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap pos2 -> pos1
toPos1 Maybe pos2
pos2Opt) Maybe b
aOpt
            pos2 -> IO pos2
forall (m :: * -> *) a. Monad m => a -> m a
return (pos1 -> pos2
toPos2 pos1
pos1)
      setPos2 :: pos2 -> Maybe b -> IO ()
setPos2 pos2
pos2 Maybe b
aOpt = pos1 -> Maybe b -> IO ()
setPos1 (pos2 -> pos1
toPos1 pos2
pos2) Maybe b
aOpt
      delPos2 :: pos2 -> IO ()
delPos2 pos2
pos2 = pos1 -> IO ()
delPos1 (pos2 -> pos1
toPos1 pos2
pos2)
      redraw2 :: IO ()
redraw2 = IO ()
redraw1
   in
      ListDrawer :: forall a pos.
(Maybe pos -> Maybe a -> IO pos)
-> (pos -> Maybe a -> IO ())
-> (pos -> IO ())
-> IO ()
-> ListDrawer a pos
ListDrawer {
         newPos :: Maybe pos2 -> Maybe b -> IO pos2
newPos = Maybe pos2 -> Maybe b -> IO pos2
newPos2,setPos :: pos2 -> Maybe b -> IO ()
setPos = pos2 -> Maybe b -> IO ()
setPos2,delPos :: pos2 -> IO ()
delPos = pos2 -> IO ()
delPos2,redraw :: IO ()
redraw = IO ()
redraw2}

instance HasAddDelayer (VariableList a) where
   addDelayer :: Delayer -> VariableList a -> VariableList a
addDelayer Delayer
delayer (VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp0) =
      let
         attachListOp1 :: ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp1 ParallelExec
parallelX ListDrawer a pos
listDrawer0 =
            do
               ListDrawer a pos
listDrawer1 <- Delayer -> ListDrawer a pos -> IO (ListDrawer a pos)
forall eventSource.
HasAddDelayerIO eventSource =>
Delayer -> eventSource -> IO eventSource
addDelayerIO Delayer
delayer ListDrawer a pos
listDrawer0
               ParallelExec -> ListDrawer a pos -> IO (IO ())
forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp0 ParallelExec
parallelX ListDrawer a pos
listDrawer1
      in
         (forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
forall a.
(forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp1

instance HasAddDelayerIO (ListDrawer a pos) where
   addDelayerIO :: Delayer -> ListDrawer a pos -> IO (ListDrawer a pos)
addDelayerIO Delayer
delayer ListDrawer a pos
listDrawer0 =
      do
         DelayedAction
delayedAction <- IO () -> IO DelayedAction
newDelayedAction (ListDrawer a pos -> IO ()
forall a pos. ListDrawer a pos -> IO ()
redraw ListDrawer a pos
listDrawer0)
         let
            redraw1 :: IO ()
redraw1 = Delayer -> DelayedAction -> IO ()
delayedAct Delayer
delayer DelayedAction
delayedAction

            listDrawer1 :: ListDrawer a pos
listDrawer1 = ListDrawer a pos
listDrawer0 {redraw :: IO ()
redraw = IO ()
redraw1}
         ListDrawer a pos -> IO (ListDrawer a pos)
forall (m :: * -> *) a. Monad m => a -> m a
return ListDrawer a pos
listDrawer1

-- -----------------------------------------------------------------------
-- Constructing VariableList's from other things.
-- -----------------------------------------------------------------------

emptyVariableList :: VariableList a
emptyVariableList :: VariableList a
emptyVariableList =
   let
      attachListOp :: p -> p -> m (m ())
attachListOp p
_ p
_ = m () -> m (m ())
forall (m :: * -> *) a. Monad m => a -> m a
return m ()
forall (m :: * -> *). Monad m => m ()
done
   in
      (forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
forall a.
(forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
forall (m :: * -> *) (m :: * -> *) p p.
(Monad m, Monad m) =>
p -> p -> m (m ())
attachListOp

singletonList :: forall a . a -> VariableList a
singletonList :: a -> VariableList a
singletonList a
a =
   let
      attachListOp :: forall pos . ParallelExec -> ListDrawer a pos
        -> IO (IO ())
      attachListOp :: ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp ParallelExec
parallelX ListDrawer a pos
listDrawer =
         do
            ParallelExec -> IO () -> IO ()
parallelExec ParallelExec
parallelX (
               do
                  ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
forall a pos. ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos ListDrawer a pos
listDrawer Maybe pos
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                  IO ()
forall (m :: * -> *). Monad m => m ()
done
               )
            IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
forall (m :: * -> *). Monad m => m ()
done
   in
      (forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
forall a.
(forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp

newVariableListFromSet :: forall a . Ord a => VariableSetSource a
    -> VariableList a
newVariableListFromSet :: VariableSetSource a -> VariableList a
newVariableListFromSet (VariableSetSource a
variableSetSource :: VariableSetSource a) =
   let
      attachListOp :: forall pos . ParallelExec -> ListDrawer a pos
        -> IO (IO ())
      attachListOp :: ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp ParallelExec
parallelX ListDrawer a pos
listDrawer =
         do
            (Registry a pos
posRegistry :: Registry a pos) <- IO (Registry a pos)
forall registry. NewRegistry registry => IO registry
newRegistry

            IORef Integer
groupingCount <- Integer -> IO (IORef Integer)
forall a. a -> IO (IORef a)
newIORef Integer
0

            let
               updateFn :: VariableSetUpdate a -> IO ()
               updateFn :: VariableSetUpdate a -> IO ()
updateFn (AddElement a
a) =
                  do
                     a -> IO ()
addElement a
a
                     Integer
groupCount <- IORef Integer -> IO Integer
forall a. IORef a -> IO a
readIORef IORef Integer
groupingCount
                     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
groupCount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (ListDrawer a pos -> IO ()
forall a pos. ListDrawer a pos -> IO ()
redraw ListDrawer a pos
listDrawer)
               updateFn (DelElement a
a) =
                  do
                     a -> IO ()
delElement a
a
                     Integer
groupCount <- IORef Integer -> IO Integer
forall a. IORef a -> IO a
readIORef IORef Integer
groupingCount
                     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
groupCount Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (ListDrawer a pos -> IO ()
forall a pos. ListDrawer a pos -> IO ()
redraw ListDrawer a pos
listDrawer)
               updateFn VariableSetUpdate a
BeginGroup = IORef Integer -> (Integer -> Integer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Integer
groupingCount (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
               updateFn VariableSetUpdate a
EndGroup =
                  do
                     Integer
groupCount0 <- IORef Integer -> IO Integer
forall a. IORef a -> IO a
readIORef IORef Integer
groupingCount
                     let
                        groupCount1 :: Integer
groupCount1 = Integer
groupCount0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
                     IORef Integer -> Integer -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Integer
groupingCount Integer
groupCount1
                     Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
groupCount1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (ListDrawer a pos -> IO ()
forall a pos. ListDrawer a pos -> IO ()
redraw ListDrawer a pos
listDrawer)

               initialElements :: [a] -> IO ()
               initialElements :: [a] -> IO ()
initialElements [a]
as =
                  do
                     (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
addElement [a]
as
                     ListDrawer a pos -> IO ()
forall a pos. ListDrawer a pos -> IO ()
redraw ListDrawer a pos
listDrawer

               addElement :: a -> IO ()
               addElement :: a -> IO ()
addElement a
a =
                  do
                     pos
pos <- ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
forall a pos. ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos ListDrawer a pos
listDrawer Maybe pos
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                     Registry a pos -> a -> pos -> IO ()
forall registry from to.
GetSetRegistry registry from to =>
registry -> from -> to -> IO ()
setValue Registry a pos
posRegistry a
a pos
pos

               delElement :: a -> IO ()
               delElement :: a -> IO ()
delElement a
a =
                  Registry a pos -> a -> (Maybe pos -> IO (Maybe pos, ())) -> IO ()
forall registry from to extra.
GetSetRegistry registry from to =>
registry -> from -> (Maybe to -> IO (Maybe to, extra)) -> IO extra
transformValue Registry a pos
posRegistry a
a (\ Maybe pos
posOpt -> case Maybe pos
posOpt of
                     Just pos
pos ->
                        do
                           ListDrawer a pos -> pos -> IO ()
forall a pos. ListDrawer a pos -> pos -> IO ()
delPos ListDrawer a pos
listDrawer pos
pos
                           (Maybe pos, ()) -> IO (Maybe pos, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe pos
forall a. Maybe a
Nothing,())
                     )

            SinkID
sinkID <- IO SinkID
newSinkID

            ([a]
x,Sink (VariableSetUpdate a)
sink) <- VariableSetSource a
-> ([a] -> IO ())
-> (VariableSetUpdate a -> IO ())
-> SinkID
-> ParallelExec
-> IO ([a], Sink (VariableSetUpdate a))
forall sinkSource x delta.
CanAddSinks sinkSource x delta =>
sinkSource
-> (x -> IO ())
-> (delta -> IO ())
-> SinkID
-> ParallelExec
-> IO (x, Sink delta)
addNewSinkWithInitial VariableSetSource a
variableSetSource
               [a] -> IO ()
initialElements VariableSetUpdate a -> IO ()
updateFn SinkID
sinkID ParallelExec
parallelX

            IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (SinkID -> IO ()
forall source. HasInvalidate source => source -> IO ()
invalidate SinkID
sinkID)
   in
      (forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
forall a.
(forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp

newVariableListFromList :: forall a . Ord a => SimpleSource [a]
    -> VariableList a
newVariableListFromList :: SimpleSource [a] -> VariableList a
newVariableListFromList (SimpleSource [a]
simpleSource :: SimpleSource [a]) =
   let
      attachListOp :: forall pos . ParallelExec -> ListDrawer a pos
        -> IO (IO ())
      attachListOp :: ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp ParallelExec
parallelX ListDrawer a pos
listDrawer =
         do
            -- state stores the current a values and a list of the same length
            -- containing their pos values.
            (IORef ([a], [pos])
state :: IORef ([a],[pos])) <- ([a], [pos]) -> IO (IORef ([a], [pos]))
forall a. a -> IO (IORef a)
newIORef ([],[])

            let
               updateList :: [a] -> IO ()
               updateList :: [a] -> IO ()
updateList [a]
newAs =
                  do
                     ([a]
oldAs,[pos]
oldPos) <- IORef ([a], [pos]) -> IO ([a], [pos])
forall a. IORef a -> IO a
readIORef IORef ([a], [pos])
state
                     let
                        changes :: [DiffElement a]
changes = [a] -> [a] -> [DiffElement a]
forall v. Eq v => [v] -> [v] -> [DiffElement v]
diff2 [a]
oldAs [a]
newAs

                        oldAsPlus :: [(a,Bool)]
                           -- True means that it is in both lists
                        oldAsPlus :: [(a, Bool)]
oldAsPlus = [[(a, Bool)]] -> [(a, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((DiffElement a -> [(a, Bool)]) -> [DiffElement a] -> [[(a, Bool)]]
forall a b. (a -> b) -> [a] -> [b]
map
                           (\ DiffElement a
diffElement -> case DiffElement a
diffElement of
                              InSecond [a]
_ -> []
                              InFirst [a]
l -> (a -> (a, Bool)) -> [a] -> [(a, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\ a
a -> (a
a,Bool
False)) [a]
l
                              InBoth [a]
l -> (a -> (a, Bool)) -> [a] -> [(a, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\ a
a -> (a
a,Bool
True)) [a]
l
                              )
                           [DiffElement a]
changes
                           )

                        newAsPlus :: [(a,Bool)]
                           -- True means that it is in both lists
                        newAsPlus :: [(a, Bool)]
newAsPlus = [[(a, Bool)]] -> [(a, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((DiffElement a -> [(a, Bool)]) -> [DiffElement a] -> [[(a, Bool)]]
forall a b. (a -> b) -> [a] -> [b]
map
                           (\ DiffElement a
diffElement -> case DiffElement a
diffElement of
                              InFirst [a]
_ -> []
                              InSecond [a]
l -> (a -> (a, Bool)) -> [a] -> [(a, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\ a
a -> (a
a,Bool
False)) [a]
l
                              InBoth [a]
l -> (a -> (a, Bool)) -> [a] -> [(a, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\ a
a -> (a
a,Bool
True)) [a]
l
                              )
                           [DiffElement a]
changes
                           )

                        -- (1) compute the delete actions
                        deleteAct :: IO ()
deleteAct = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (((a, Bool) -> pos -> IO ()) -> [(a, Bool)] -> [pos] -> [IO ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                           (\ (a
oldA,Bool
isCommon) pos
oldPos ->
                              if Bool
isCommon then IO ()
forall (m :: * -> *). Monad m => m ()
done else
                                 ListDrawer a pos -> pos -> IO ()
forall a pos. ListDrawer a pos -> pos -> IO ()
delPos ListDrawer a pos
listDrawer pos
oldPos
                              )
                           [(a, Bool)]
oldAsPlus [pos]
oldPos
                           )

                        -- (2) compute the positions which are common
                        commonPos :: [pos]
commonPos = [Maybe pos] -> [pos]
forall a. [Maybe a] -> [a]
catMaybes
                           (((a, Bool) -> pos -> Maybe pos)
-> [(a, Bool)] -> [pos] -> [Maybe pos]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                              (\ (a
oldA,Bool
isCommon) pos
oldPos ->
                                 if Bool
isCommon
                                    then
                                       pos -> Maybe pos
forall a. a -> Maybe a
Just pos
oldPos
                                    else
                                       Maybe pos
forall a. Maybe a
Nothing
                                 )
                              [(a, Bool)]
oldAsPlus [pos]
oldPos
                              )

                        -- (3) compute pairs (Maybe pos,[a]) where (Maybe pos)
                        -- is the last position before an insertion, [a] is
                        -- the insertion.
                        mkPairs :: Maybe pos -> [pos] -> [(a,Bool)]
                           -> [(Maybe pos,[a])] -> [(Maybe pos,[a])]
                        mkPairs :: Maybe pos
-> [pos] -> [(a, Bool)] -> [(Maybe pos, [a])] -> [(Maybe pos, [a])]
mkPairs Maybe pos
lastPosOpt [] [] [(Maybe pos, [a])]
acc0 = [(Maybe pos, [a])]
acc0
                        mkPairs Maybe pos
lastPosOpt [pos]
poss0
                              (xs0 :: [(a, Bool)]
xs0@((a
a,Bool
isCommon):[(a, Bool)]
rest)) [(Maybe pos, [a])]
acc0 =
                           if Bool
isCommon
                              then
                                 case [pos]
poss0 of
                                    pos
pos:[pos]
poss1 ->
                                       Maybe pos
-> [pos] -> [(a, Bool)] -> [(Maybe pos, [a])] -> [(Maybe pos, [a])]
mkPairs (pos -> Maybe pos
forall a. a -> Maybe a
Just pos
pos) [pos]
poss1 [(a, Bool)]
rest [(Maybe pos, [a])]
acc0
                              else
                                 -- scan to next common element or end
                                 let
                                    getInsertion :: [(a,Bool)]
                                       -> ([a],[(a,Bool)])
                                    getInsertion :: [(a, Bool)] -> ([a], [(a, Bool)])
getInsertion [] = ([],[])
                                    getInsertion (xs :: [(a, Bool)]
xs@((a
_,Bool
True):[(a, Bool)]
_)) = ([],[(a, Bool)]
xs)
                                    getInsertion (((a
a,Bool
False):[(a, Bool)]
xs0)) =
                                       let
                                          ([a]
as,[(a, Bool)]
xs1) = [(a, Bool)] -> ([a], [(a, Bool)])
getInsertion [(a, Bool)]
xs0
                                       in
                                          (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as,[(a, Bool)]
xs1)

                                    ([a]
as,[(a, Bool)]
xs1) = [(a, Bool)] -> ([a], [(a, Bool)])
getInsertion [(a, Bool)]
xs0
                                    acc1 :: [(Maybe pos, [a])]
acc1 = (Maybe pos
lastPosOpt,[a]
as) (Maybe pos, [a]) -> [(Maybe pos, [a])] -> [(Maybe pos, [a])]
forall a. a -> [a] -> [a]
: [(Maybe pos, [a])]
acc0
                                in
                                    case ([pos]
poss0,[(a, Bool)]
xs1) of
                                       ([],[]) -> [(Maybe pos, [a])]
acc1
                                       (pos
pos:[pos]
pos1,((a
_,Bool
True):[(a, Bool)]
xs2)) ->
                                          Maybe pos
-> [pos] -> [(a, Bool)] -> [(Maybe pos, [a])] -> [(Maybe pos, [a])]
mkPairs (pos -> Maybe pos
forall a. a -> Maybe a
Just pos
pos) [pos]
pos1 [(a, Bool)]
xs2 [(Maybe pos, [a])]
acc1

                        -- NB.  pairs is in reverse order.
                        pairs :: [(Maybe pos,[a])]
                        pairs :: [(Maybe pos, [a])]
pairs = Maybe pos
-> [pos] -> [(a, Bool)] -> [(Maybe pos, [a])] -> [(Maybe pos, [a])]
mkPairs Maybe pos
forall a. Maybe a
Nothing [pos]
commonPos [(a, Bool)]
newAsPlus []

                        -- (4) The add action, which also the
                        -- new positions.  The lists are all in reverse order.
                        addAct :: IO [[pos]]
                        addAct :: IO [[pos]]
addAct = ((Maybe pos, [a]) -> IO [pos]) -> [(Maybe pos, [a])] -> IO [[pos]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                           (\ (Maybe pos
posOpt,[a]
as) ->
                              (a -> IO pos) -> [a] -> IO [pos]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                                 (\ a
a -> ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
forall a pos. ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos ListDrawer a pos
listDrawer Maybe pos
posOpt (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
                                 ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
as)
                              )
                           [(Maybe pos, [a])]
pairs

                     -- (5) Do the additions and deletions.
                     ([[pos]]
newPosss0 :: [[pos]]) <- IO [[pos]]
addAct
                     IO ()
deleteAct
                     ListDrawer a pos -> IO ()
forall a pos. ListDrawer a pos -> IO ()
redraw ListDrawer a pos
listDrawer

                     let
                        -- (6) Compute all the new positions given the new
                        -- list + old common and new positions.
                        mkNewPos :: [(a,Bool)] -> [pos] -> [pos] -> [pos]
                           -> [pos]
                        mkNewPos :: [(a, Bool)] -> [pos] -> [pos] -> [pos] -> [pos]
mkNewPos [] [] [] [pos]
posAcc = [pos]
posAcc
                        mkNewPos ((a
_,Bool
isCommon):[(a, Bool)]
xs0) [pos]
posOld [pos]
posNew [pos]
posAcc =
                           if Bool
isCommon
                              then
                                 case [pos]
posOld of
                                    pos
pos:[pos]
posOld1 ->
                                       [(a, Bool)] -> [pos] -> [pos] -> [pos] -> [pos]
mkNewPos [(a, Bool)]
xs0 [pos]
posOld1 [pos]
posNew (pos
pospos -> [pos] -> [pos]
forall a. a -> [a] -> [a]
:[pos]
posAcc)
                              else
                                 case [pos]
posNew of
                                    pos
pos:[pos]
posNew1 ->
                                       [(a, Bool)] -> [pos] -> [pos] -> [pos] -> [pos]
mkNewPos [(a, Bool)]
xs0 [pos]
posOld [pos]
posNew1 (pos
pospos -> [pos] -> [pos]
forall a. a -> [a] -> [a]
:[pos]
posAcc)

                        newPos :: [pos]
newPos =  [(a, Bool)] -> [pos] -> [pos] -> [pos] -> [pos]
mkNewPos [(a, Bool)]
newAsPlus [pos]
commonPos
                           ([pos] -> [pos]
forall a. [a] -> [a]
reverse ([[pos]] -> [pos]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[pos]]
newPosss0)) []

                     IORef ([a], [pos]) -> ([a], [pos]) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ([a], [pos])
state ([a]
newAs,[pos] -> [pos]
forall a. [a] -> [a]
reverse [pos]
newPos)

            SinkID
sinkID <- IO SinkID
newSinkID

            SimpleSource [a]
-> ([a] -> IO ())
-> ([a] -> IO ())
-> SinkID
-> ParallelExec
-> IO ([a], Sink [a])
forall sinkSource x delta.
CanAddSinks sinkSource x delta =>
sinkSource
-> (x -> IO ())
-> (delta -> IO ())
-> SinkID
-> ParallelExec
-> IO (x, Sink delta)
addNewSinkWithInitial SimpleSource [a]
simpleSource [a] -> IO ()
updateList [a] -> IO ()
updateList SinkID
sinkID
               ParallelExec
parallelX

            IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (SinkID -> IO ()
forall source. HasInvalidate source => source -> IO ()
invalidate SinkID
sinkID)
   in
      (forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
forall a.
(forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp

-- -----------------------------------------------------------------------
-- Combinators
-- -----------------------------------------------------------------------

catVariableLists :: VariableList a -> VariableList a -> VariableList a
catVariableLists :: VariableList a -> VariableList a -> VariableList a
catVariableLists (VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp1) (VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp2) =
   let
      attachListOp :: ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp ParallelExec
parallelX ListDrawer a pos
listDrawer =
         do
            -- Separate the two using an unused position in the middle.
            pos
middlePos <- ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
forall a pos. ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos ListDrawer a pos
listDrawer Maybe pos
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing
            let
               listDrawer1 :: ListDrawer a pos
listDrawer1 = ListDrawer a pos
listDrawer

               newPos2 :: Maybe pos -> Maybe a -> IO pos
newPos2 Maybe pos
posOpt Maybe a
aOpt =
                  let
                     pos :: pos
pos = pos -> Maybe pos -> pos
forall a. a -> Maybe a -> a
fromMaybe pos
middlePos Maybe pos
posOpt
                  in
                     ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
forall a pos. ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos ListDrawer a pos
listDrawer (pos -> Maybe pos
forall a. a -> Maybe a
Just pos
pos) Maybe a
aOpt

               listDrawer2 :: ListDrawer a pos
listDrawer2 = ListDrawer a pos
listDrawer {newPos :: Maybe pos -> Maybe a -> IO pos
newPos = Maybe pos -> Maybe a -> IO pos
newPos2}

            IO ()
destroy1 <- ParallelExec -> ListDrawer a pos -> IO (IO ())
forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp1 ParallelExec
parallelX ListDrawer a pos
listDrawer1
            IO ()
destroy2 <- ParallelExec -> ListDrawer a pos -> IO (IO ())
forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp2 ParallelExec
parallelX ListDrawer a pos
listDrawer2
            IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO ()
destroy1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
destroy2)
   in
      (forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
forall a.
(forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ()))
-> VariableList a
VariableList forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp