{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Util.VariableList(
newVariableListFromSet,
newVariableListFromList,
emptyVariableList,
singletonList,
VariableList,
ListDrawer(..),
attachListOp,
coMapListDrawer,
map2ListDrawer,
catVariableLists,
) 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
data ListDrawer a pos = ListDrawer {
ListDrawer a pos -> Maybe pos -> Maybe a -> IO pos
newPos :: Maybe pos -> Maybe a -> IO pos,
ListDrawer a pos -> pos -> Maybe a -> IO ()
setPos :: pos -> Maybe a -> IO (),
ListDrawer a pos -> pos -> IO ()
delPos :: pos -> IO (),
ListDrawer a pos -> IO ()
redraw :: IO ()
}
data VariableList a = VariableList {
VariableList a
-> forall pos. ParallelExec -> ListDrawer a pos -> IO (IO ())
attachListOp :: forall pos . ParallelExec -> ListDrawer a pos -> IO (IO ())
}
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
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
(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)]
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)]
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
)
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
)
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
)
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
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
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 []
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
([[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
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
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
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