{- |
Module      :./Interfaces/History.hs
Description : history management functions
Copyright   : uni-bremen and DFKI
License     : GPLv2 or higher, see LICENSE.txt
Maintainer  : r.pascanu@jacobs-university.de
Stability   : provisional
Portability : portable

Interfaces.History contains different functions that deal
with history

-}

module Interfaces.History
         ( undoOneStep
         , redoOneStep
         , undoOneStepWithUpdate
         , redoOneStepWithUpdate
         , add2history
         ) where

import Interfaces.DataTypes
import Interfaces.Command
import Common.LibName

import Proofs.AbstractState

import Static.DevGraph
import Static.History

import qualified Data.Map as Map

{- | Datatype used to differentiate between the two actions (so that code does
not get duplicated -}
data UndoOrRedo =
   DoUndo
 | DoRedo

add2history :: Command -> IntState -> [UndoRedoElem] -> IntState
add2history :: Command -> IntState -> [UndoRedoElem] -> IntState
add2history nm :: Command
nm st :: IntState
st descr :: [UndoRedoElem]
descr = let
  hst :: IntHistory
hst = IntState -> IntHistory
i_hist IntState
st
  ul :: [CmdHistory]
ul = IntHistory -> [CmdHistory]
undoList IntHistory
hst
  nwEl :: CmdHistory
nwEl = CmdHistory :: Command -> [UndoRedoElem] -> CmdHistory
CmdHistory
    { command :: Command
command = Command
nm
    , cmdHistory :: [UndoRedoElem]
cmdHistory = [UndoRedoElem]
descr }
  in IntState
st { i_hist :: IntHistory
i_hist = IntHistory
hst { undoList :: [CmdHistory]
undoList = CmdHistory
nwEl CmdHistory -> [CmdHistory] -> [CmdHistory]
forall a. a -> [a] -> [a]
: [CmdHistory]
ul } }

-- | Undo or redo a command that modified the development graph
undoRedoDgCmd :: UndoOrRedo -> IntState -> LibName
              -> ([DGChange] -> DGraph -> IO ()) -> IO IntState
undoRedoDgCmd :: UndoOrRedo
-> IntState
-> LibName
-> ([DGChange] -> DGraph -> IO ())
-> IO IntState
undoRedoDgCmd actionType :: UndoOrRedo
actionType state :: IntState
state ln :: LibName
ln update :: [DGChange] -> DGraph -> IO ()
update =
  case IntState -> Maybe IntIState
i_state IntState
state of
    -- should I return an error message??
   Nothing -> IntState -> IO IntState
forall (m :: * -> *) a. Monad m => a -> m a
return IntState
state
   Just dgS :: IntIState
dgS -> do
     let
         {- take ln from the history storage ??
         in contrast to GUI here you operate with only one ln at a time -}
         dg :: DGraph
dg = LibName -> LibEnv -> DGraph
lookupDGraph LibName
ln (IntIState -> LibEnv
i_libEnv IntIState
dgS)
         (dg' :: DGraph
dg', changes :: [DGChange]
changes) = ( case UndoOrRedo
actionType of
                       DoUndo -> DGraph -> (DGraph, [DGChange])
undoHistStep
                       DoRedo -> DGraph -> (DGraph, [DGChange])
redoHistStep) DGraph
dg
         newEnv :: LibEnv
newEnv = LibName -> DGraph -> LibEnv -> LibEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert LibName
ln DGraph
dg' (IntIState -> LibEnv
i_libEnv IntIState
dgS)
         newst :: IntState
newst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
dgS { i_libEnv :: LibEnv
i_libEnv = LibEnv
newEnv } }
     [DGChange] -> DGraph -> IO ()
update [DGChange]
changes DGraph
dg'
     IntState -> IO IntState
forall (m :: * -> *) a. Monad m => a -> m a
return IntState
newst

{- | Analyze changes to the selected nodes, return new nodes plus a list
of changes that would undo last changes -}
processList :: [ListChange] -> [Int_NodeInfo]
            -> [ListChange] -> ([Int_NodeInfo], [ListChange])
processList :: [ListChange]
-> [Int_NodeInfo] -> [ListChange] -> ([Int_NodeInfo], [ListChange])
processList ls :: [ListChange]
ls elems :: [Int_NodeInfo]
elems acc :: [ListChange]
acc
 = case [ListChange]
ls of
    -- if nothing to process return elements and changes
    [] -> ([Int_NodeInfo]
elems, [ListChange]
acc)
    x :: ListChange
x : l :: [ListChange]
l ->
      -- else check what type of change we are dealing with
      case ListChange
x of
       -- if it is a change in axioms
       AxiomsChange nwaxms :: [String]
nwaxms nb :: Int
nb ->
         -- apply change and store the undo action
         let nwls :: [(Int_NodeInfo, [ListChange])]
nwls = (Int_NodeInfo -> (Int_NodeInfo, [ListChange]))
-> [Int_NodeInfo] -> [(Int_NodeInfo, [ListChange])]
forall a b. (a -> b) -> [a] -> [b]
map (\ y :: Int_NodeInfo
y ->
                          case Int_NodeInfo
y of
                           Element ps :: ProofState
ps nb' :: Int
nb' ->
                            if Int
nb' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nb
                            then (ProofState -> Int -> Int_NodeInfo
Element ProofState
ps {includedAxioms :: [String]
includedAxioms = [String]
nwaxms} Int
nb
                                , [[String] -> Int -> ListChange
AxiomsChange (ProofState -> [String]
includedAxioms ProofState
ps) Int
nb])
                            else (Int_NodeInfo
y, []) ) [Int_NodeInfo]
elems
             nwelems :: [Int_NodeInfo]
nwelems = ((Int_NodeInfo, [ListChange]) -> Int_NodeInfo)
-> [(Int_NodeInfo, [ListChange])] -> [Int_NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Int_NodeInfo, [ListChange]) -> Int_NodeInfo
forall a b. (a, b) -> a
fst [(Int_NodeInfo, [ListChange])]
nwls
             changesLs :: [ListChange]
changesLs = ((Int_NodeInfo, [ListChange]) -> [ListChange])
-> [(Int_NodeInfo, [ListChange])] -> [ListChange]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int_NodeInfo, [ListChange]) -> [ListChange]
forall a b. (a, b) -> b
snd [(Int_NodeInfo, [ListChange])]
nwls
         in [ListChange]
-> [Int_NodeInfo] -> [ListChange] -> ([Int_NodeInfo], [ListChange])
processList [ListChange]
l [Int_NodeInfo]
nwelems ([ListChange]
changesLs [ListChange] -> [ListChange] -> [ListChange]
forall a. [a] -> [a] -> [a]
++ [ListChange]
acc)
       -- if it is a change in goals
       GoalsChange nwgls :: [String]
nwgls nb :: Int
nb ->
         -- apply change and store the undo action
         let nwls :: [(Int_NodeInfo, [ListChange])]
nwls = (Int_NodeInfo -> (Int_NodeInfo, [ListChange]))
-> [Int_NodeInfo] -> [(Int_NodeInfo, [ListChange])]
forall a b. (a -> b) -> [a] -> [b]
map (\ y :: Int_NodeInfo
y ->
                          case Int_NodeInfo
y of
                           Element ps :: ProofState
ps nb' :: Int
nb' ->
                            if Int
nb' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nb
                            then (ProofState -> Int -> Int_NodeInfo
Element ProofState
ps {selectedGoals :: [String]
selectedGoals = [String]
nwgls} Int
nb
                                , [[String] -> Int -> ListChange
GoalsChange (ProofState -> [String]
selectedGoals ProofState
ps) Int
nb])
                            else (Int_NodeInfo
y, [])) [Int_NodeInfo]
elems
             nwelems :: [Int_NodeInfo]
nwelems = ((Int_NodeInfo, [ListChange]) -> Int_NodeInfo)
-> [(Int_NodeInfo, [ListChange])] -> [Int_NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Int_NodeInfo, [ListChange]) -> Int_NodeInfo
forall a b. (a, b) -> a
fst [(Int_NodeInfo, [ListChange])]
nwls
             changeLs :: [ListChange]
changeLs = ((Int_NodeInfo, [ListChange]) -> [ListChange])
-> [(Int_NodeInfo, [ListChange])] -> [ListChange]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int_NodeInfo, [ListChange]) -> [ListChange]
forall a b. (a, b) -> b
snd [(Int_NodeInfo, [ListChange])]
nwls
         in [ListChange]
-> [Int_NodeInfo] -> [ListChange] -> ([Int_NodeInfo], [ListChange])
processList [ListChange]
l [Int_NodeInfo]
nwelems ([ListChange]
changeLs [ListChange] -> [ListChange] -> [ListChange]
forall a. [a] -> [a] -> [a]
++ [ListChange]
acc)
       -- if selected nodes change
       NodesChange nwelems :: [Int_NodeInfo]
nwelems ->
         [ListChange]
-> [Int_NodeInfo] -> [ListChange] -> ([Int_NodeInfo], [ListChange])
processList [ListChange]
l [Int_NodeInfo]
nwelems ([Int_NodeInfo] -> ListChange
NodesChange [Int_NodeInfo]
elems ListChange -> [ListChange] -> [ListChange]
forall a. a -> [a] -> [a]
: [ListChange]
acc)

-- | Process one step of undo or redo
processAny :: UndoOrRedo -> IntState
           -> (LibName -> [DGChange] -> DGraph -> IO ()) -> IO IntState
processAny :: UndoOrRedo
-> IntState
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO IntState
processAny actype :: UndoOrRedo
actype state :: IntState
state update :: LibName -> [DGChange] -> DGraph -> IO ()
update = do
  let hst :: [CmdHistory]
hst = case UndoOrRedo
actype of
              {- find out the list of actions according to the action
              (undo/redo) -}
              DoUndo -> IntHistory -> [CmdHistory]
undoList (IntHistory -> [CmdHistory]) -> IntHistory -> [CmdHistory]
forall a b. (a -> b) -> a -> b
$ IntState -> IntHistory
i_hist IntState
state
              DoRedo -> IntHistory -> [CmdHistory]
redoList (IntHistory -> [CmdHistory]) -> IntHistory -> [CmdHistory]
forall a b. (a -> b) -> a -> b
$ IntState -> IntHistory
i_hist IntState
state
  case [CmdHistory]
hst of
    [] -> IntState -> IO IntState
forall (m :: * -> *) a. Monad m => a -> m a
return IntState
state
    x :: CmdHistory
x : l :: [CmdHistory]
l -> do
       (nwst :: IntState
nwst, ch :: [UndoRedoElem]
ch) <- UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype (CmdHistory -> [UndoRedoElem]
cmdHistory CmdHistory
x) IntState
state [] LibName -> [DGChange] -> DGraph -> IO ()
update
       let
         x' :: CmdHistory
x' = CmdHistory
x { cmdHistory :: [UndoRedoElem]
cmdHistory = [UndoRedoElem]
ch }
         i_hist_state :: IntHistory
i_hist_state = IntState -> IntHistory
i_hist IntState
state
         nwstate :: IntState
nwstate = case UndoOrRedo
actype of
                    DoUndo -> IntState
nwst {
                              i_hist :: IntHistory
i_hist = IntHistory :: [CmdHistory] -> [CmdHistory] -> IntHistory
IntHistory {
                                        undoList :: [CmdHistory]
undoList = [CmdHistory]
l,
                                        redoList :: [CmdHistory]
redoList = CmdHistory
x' CmdHistory -> [CmdHistory] -> [CmdHistory]
forall a. a -> [a] -> [a]
: IntHistory -> [CmdHistory]
redoList IntHistory
i_hist_state
                                        }
                              }
                    DoRedo -> IntState
nwst {
                              i_hist :: IntHistory
i_hist = IntHistory :: [CmdHistory] -> [CmdHistory] -> IntHistory
IntHistory {
                                        redoList :: [CmdHistory]
redoList = [CmdHistory]
l,
                                        undoList :: [CmdHistory]
undoList = CmdHistory
x' CmdHistory -> [CmdHistory] -> [CmdHistory]
forall a. a -> [a] -> [a]
: IntHistory -> [CmdHistory]
undoList IntHistory
i_hist_state
                                        }
                              }
       IntState -> IO IntState
forall (m :: * -> *) a. Monad m => a -> m a
return IntState
nwstate

-- | Process a list of undo or redo changes
processUndoRedoElems :: UndoOrRedo -> [UndoRedoElem] -> IntState
                     -> [UndoRedoElem]
                     -> (LibName -> [DGChange] -> DGraph -> IO ())
                     -> IO (IntState, [UndoRedoElem])
processUndoRedoElems :: UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems actype :: UndoOrRedo
actype ls :: [UndoRedoElem]
ls state :: IntState
state acc :: [UndoRedoElem]
acc update :: LibName -> [DGChange] -> DGraph -> IO ()
update
 = case IntState -> Maybe IntIState
i_state IntState
state of
    Nothing -> (IntState, [UndoRedoElem]) -> IO (IntState, [UndoRedoElem])
forall (m :: * -> *) a. Monad m => a -> m a
return (IntState
state, [])
    Just ist :: IntIState
ist ->
     case [UndoRedoElem]
ls of
      [] -> (IntState, [UndoRedoElem]) -> IO (IntState, [UndoRedoElem])
forall (m :: * -> *) a. Monad m => a -> m a
return (IntState
state, [UndoRedoElem]
acc)
      ChShowOutput s :: Bool
s : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state {i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { showOutput :: Bool
showOutput = Bool
s}}
             ch :: UndoRedoElem
ch = Bool -> UndoRedoElem
ChShowOutput (Bool -> UndoRedoElem) -> Bool -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Bool
showOutput IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      UseThmChange sw :: Bool
sw : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { useTheorems :: Bool
useTheorems = Bool
sw } }
             ch :: UndoRedoElem
ch = Bool -> UndoRedoElem
UseThmChange (Bool -> UndoRedoElem) -> Bool -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Bool
useTheorems IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      Save2FileChange sw :: Bool
sw : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { save2file :: Bool
save2file = Bool
sw } }
             ch :: UndoRedoElem
ch = Bool -> UndoRedoElem
Save2FileChange (Bool -> UndoRedoElem) -> Bool -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Bool
save2file IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      ProverChange nwp :: Maybe G_prover
nwp : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { prover :: Maybe G_prover
prover = Maybe G_prover
nwp } }
             ch :: UndoRedoElem
ch = Maybe G_prover -> UndoRedoElem
ProverChange (Maybe G_prover -> UndoRedoElem) -> Maybe G_prover -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Maybe G_prover
prover IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      ConsCheckerChange nwc :: Maybe G_cons_checker
nwc : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { consChecker :: Maybe G_cons_checker
consChecker = Maybe G_cons_checker
nwc} }
             ch :: UndoRedoElem
ch = Maybe G_cons_checker -> UndoRedoElem
ConsCheckerChange (Maybe G_cons_checker -> UndoRedoElem)
-> Maybe G_cons_checker -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Maybe G_cons_checker
consChecker IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      ScriptChange nws :: ATPTacticScript
nws : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { script :: ATPTacticScript
script = ATPTacticScript
nws } }
             ch :: UndoRedoElem
ch = ATPTacticScript -> UndoRedoElem
ScriptChange (ATPTacticScript -> UndoRedoElem)
-> ATPTacticScript -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> ATPTacticScript
script IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      LoadScriptChange sw :: Bool
sw : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { loadScript :: Bool
loadScript = Bool
sw } }
             ch :: UndoRedoElem
ch = Bool -> UndoRedoElem
LoadScriptChange (Bool -> UndoRedoElem) -> Bool -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Bool
loadScript IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      CComorphismChange nwc :: Maybe AnyComorphism
nwc : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { cComorphism :: Maybe AnyComorphism
cComorphism = Maybe AnyComorphism
nwc} }
             ch :: UndoRedoElem
ch = Maybe AnyComorphism -> UndoRedoElem
CComorphismChange (Maybe AnyComorphism -> UndoRedoElem)
-> Maybe AnyComorphism -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Maybe AnyComorphism
cComorphism IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      DgCommandChange nln :: LibName
nln : l :: [UndoRedoElem]
l -> do
         IntState
nwst <- UndoOrRedo
-> IntState
-> LibName
-> ([DGChange] -> DGraph -> IO ())
-> IO IntState
undoRedoDgCmd UndoOrRedo
actype IntState
state LibName
nln (([DGChange] -> DGraph -> IO ()) -> IO IntState)
-> ([DGChange] -> DGraph -> IO ()) -> IO IntState
forall a b. (a -> b) -> a -> b
$ LibName -> [DGChange] -> DGraph -> IO ()
update LibName
nln
         let ch :: UndoRedoElem
ch = LibName -> UndoRedoElem
DgCommandChange LibName
nln
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      ListChange nls :: [ListChange]
nls : l :: [UndoRedoElem]
l -> do
         let (nwels :: [Int_NodeInfo]
nwels, lc :: [ListChange]
lc) = [ListChange]
-> [Int_NodeInfo] -> [ListChange] -> ([Int_NodeInfo], [ListChange])
processList [ListChange]
nls (IntIState -> [Int_NodeInfo]
elements IntIState
ist) []
             nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just (IntIState -> Maybe IntIState) -> IntIState -> Maybe IntIState
forall a b. (a -> b) -> a -> b
$ IntIState
ist { elements :: [Int_NodeInfo]
elements = [Int_NodeInfo]
nwels } }
             ch :: UndoRedoElem
ch = [ListChange] -> UndoRedoElem
ListChange [ListChange]
lc
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update
      IStateChange nist :: Maybe IntIState
nist : l :: [UndoRedoElem]
l -> do
         let nwst :: IntState
nwst = IntState
state { i_state :: Maybe IntIState
i_state = Maybe IntIState
nist }
             ch :: UndoRedoElem
ch = Maybe IntIState -> UndoRedoElem
IStateChange (Maybe IntIState -> UndoRedoElem)
-> Maybe IntIState -> UndoRedoElem
forall a b. (a -> b) -> a -> b
$ IntIState -> Maybe IntIState
forall a. a -> Maybe a
Just IntIState
ist
         UndoOrRedo
-> [UndoRedoElem]
-> IntState
-> [UndoRedoElem]
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO (IntState, [UndoRedoElem])
processUndoRedoElems UndoOrRedo
actype [UndoRedoElem]
l IntState
nwst (UndoRedoElem
ch UndoRedoElem -> [UndoRedoElem] -> [UndoRedoElem]
forall a. a -> [a] -> [a]
: [UndoRedoElem]
acc) LibName -> [DGChange] -> DGraph -> IO ()
update

undoOneStep :: IntState -> IO IntState
undoOneStep :: IntState -> IO IntState
undoOneStep ist :: IntState
ist = UndoOrRedo
-> IntState
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO IntState
processAny UndoOrRedo
DoUndo IntState
ist (\ _ _ _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

redoOneStep :: IntState -> IO IntState
redoOneStep :: IntState -> IO IntState
redoOneStep ist :: IntState
ist = UndoOrRedo
-> IntState
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO IntState
processAny UndoOrRedo
DoRedo IntState
ist (\ _ _ _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

undoOneStepWithUpdate :: IntState -> (LibName -> [DGChange] -> DGraph -> IO ())
                      -> IO IntState
undoOneStepWithUpdate :: IntState
-> (LibName -> [DGChange] -> DGraph -> IO ()) -> IO IntState
undoOneStepWithUpdate = UndoOrRedo
-> IntState
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO IntState
processAny UndoOrRedo
DoUndo

redoOneStepWithUpdate :: IntState -> (LibName -> [DGChange] -> DGraph -> IO ())
                      -> IO IntState
redoOneStepWithUpdate :: IntState
-> (LibName -> [DGChange] -> DGraph -> IO ()) -> IO IntState
redoOneStepWithUpdate = UndoOrRedo
-> IntState
-> (LibName -> [DGChange] -> DGraph -> IO ())
-> IO IntState
processAny UndoOrRedo
DoRedo