{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Deprecated.Workspace (
  PFWorkspace(..)
  , emptyWorkspace
  , emptyActionStack
  , loadPFStateIntoWorkspace
  , undoWorkspace
  , redoWorkspace
  , undoPermanentWorkspace
  , doCmdWorkspace
  , pfc_addElt_to_newElts
  , pfc_addFolder_to_newElts
  , pfc_removeElt_to_deleteElts
  , pfc_paste_to_newElts
  , WSEvent(..)
  , updatePFWorkspace
) where

import           Relude

import           Potato.Flow.Cmd
import           Potato.Flow.Deprecated.Layers
import           Potato.Flow.Math
import           Potato.Flow.SElts
import           Potato.Flow.Deprecated.State
import           Potato.Flow.Types

import           Control.Exception  (assert)
import           Data.Dependent.Sum (DSum ((:=>)), (==>))
import qualified Data.IntMap.Strict as IM
import qualified Data.Sequence      as Seq

-- TODO move this into a diff file
data ActionStack = ActionStack {
  ActionStack -> [PFCmd]
doStack     :: [PFCmd] -- maybe just do something lke [PFCmd, Maybe PFState] here for state based undo
  , ActionStack -> [PFCmd]
undoStack :: [PFCmd]
} deriving (REltId -> ActionStack -> ShowS
[ActionStack] -> ShowS
ActionStack -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionStack] -> ShowS
$cshowList :: [ActionStack] -> ShowS
show :: ActionStack -> String
$cshow :: ActionStack -> String
showsPrec :: REltId -> ActionStack -> ShowS
$cshowsPrec :: REltId -> ActionStack -> ShowS
Show, ActionStack -> ActionStack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionStack -> ActionStack -> Bool
$c/= :: ActionStack -> ActionStack -> Bool
== :: ActionStack -> ActionStack -> Bool
$c== :: ActionStack -> ActionStack -> Bool
Eq, forall x. Rep ActionStack x -> ActionStack
forall x. ActionStack -> Rep ActionStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActionStack x -> ActionStack
$cfrom :: forall x. ActionStack -> Rep ActionStack x
Generic)

instance NFData ActionStack

emptyActionStack :: ActionStack
emptyActionStack :: ActionStack
emptyActionStack = [PFCmd] -> [PFCmd] -> ActionStack
ActionStack [] []

data PFWorkspace = PFWorkspace {
  PFWorkspace -> PFState
_pFWorkspace_pFState       :: PFState
  , PFWorkspace -> SEltLabelChanges
_pFWorkspace_lastChanges :: SEltLabelChanges
  , PFWorkspace -> ActionStack
_pFWorkspace_actionStack :: ActionStack
} deriving (REltId -> PFWorkspace -> ShowS
[PFWorkspace] -> ShowS
PFWorkspace -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFWorkspace] -> ShowS
$cshowList :: [PFWorkspace] -> ShowS
show :: PFWorkspace -> String
$cshow :: PFWorkspace -> String
showsPrec :: REltId -> PFWorkspace -> ShowS
$cshowsPrec :: REltId -> PFWorkspace -> ShowS
Show, PFWorkspace -> PFWorkspace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFWorkspace -> PFWorkspace -> Bool
$c/= :: PFWorkspace -> PFWorkspace -> Bool
== :: PFWorkspace -> PFWorkspace -> Bool
$c== :: PFWorkspace -> PFWorkspace -> Bool
Eq, forall x. Rep PFWorkspace x -> PFWorkspace
forall x. PFWorkspace -> Rep PFWorkspace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PFWorkspace x -> PFWorkspace
$cfrom :: forall x. PFWorkspace -> Rep PFWorkspace x
Generic)

instance NFData PFWorkspace

loadPFStateIntoWorkspace :: PFState -> PFWorkspace -> PFWorkspace
loadPFStateIntoWorkspace :: PFState -> PFWorkspace -> PFWorkspace
loadPFStateIntoWorkspace PFState
pfs PFWorkspace
ws = PFWorkspace
r where
  removeOld :: SEltLabelChanges
removeOld = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (PFState -> IntMap SEltLabel
_pFState_directory forall b c a. (b -> c) -> (a -> b) -> a -> c
. PFWorkspace -> PFState
_pFWorkspace_pFState forall a b. (a -> b) -> a -> b
$ PFWorkspace
ws)
  addNew :: SEltLabelChanges
addNew = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (PFState -> IntMap SEltLabel
_pFState_directory PFState
pfs)
  changes :: SEltLabelChanges
changes = forall a. IntMap a -> IntMap a -> IntMap a
IM.union SEltLabelChanges
addNew SEltLabelChanges
removeOld
  r :: PFWorkspace
r = PFState -> SEltLabelChanges -> ActionStack -> PFWorkspace
PFWorkspace PFState
pfs SEltLabelChanges
changes ActionStack
emptyActionStack

emptyWorkspace :: PFWorkspace
emptyWorkspace :: PFWorkspace
emptyWorkspace = PFState -> SEltLabelChanges -> ActionStack -> PFWorkspace
PFWorkspace PFState
emptyPFState forall a. IntMap a
IM.empty ActionStack
emptyActionStack

undoWorkspace :: PFWorkspace -> PFWorkspace
undoWorkspace :: PFWorkspace -> PFWorkspace
undoWorkspace PFWorkspace
pfw =  PFWorkspace
r where
  ActionStack {[PFCmd]
undoStack :: [PFCmd]
doStack :: [PFCmd]
undoStack :: ActionStack -> [PFCmd]
doStack :: ActionStack -> [PFCmd]
..} = PFWorkspace -> ActionStack
_pFWorkspace_actionStack PFWorkspace
pfw
  r :: PFWorkspace
r = case [PFCmd]
doStack of
    PFCmd
c : [PFCmd]
cs -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PFState -> SEltLabelChanges -> ActionStack -> PFWorkspace
PFWorkspace (PFCmd -> PFState -> (PFState, SEltLabelChanges)
undoCmdState PFCmd
c (PFWorkspace -> PFState
_pFWorkspace_pFState PFWorkspace
pfw)) ([PFCmd] -> [PFCmd] -> ActionStack
ActionStack [PFCmd]
cs (PFCmd
cforall a. a -> [a] -> [a]
:[PFCmd]
undoStack))
    [PFCmd]
_ -> PFWorkspace
pfw

redoWorkspace :: PFWorkspace -> PFWorkspace
redoWorkspace :: PFWorkspace -> PFWorkspace
redoWorkspace PFWorkspace
pfw = PFWorkspace
r where
  ActionStack {[PFCmd]
undoStack :: [PFCmd]
doStack :: [PFCmd]
undoStack :: ActionStack -> [PFCmd]
doStack :: ActionStack -> [PFCmd]
..} = PFWorkspace -> ActionStack
_pFWorkspace_actionStack PFWorkspace
pfw
  r :: PFWorkspace
r = case [PFCmd]
undoStack of
    PFCmd
c : [PFCmd]
cs -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PFState -> SEltLabelChanges -> ActionStack -> PFWorkspace
PFWorkspace (PFCmd -> PFState -> (PFState, SEltLabelChanges)
doCmdState PFCmd
c (PFWorkspace -> PFState
_pFWorkspace_pFState PFWorkspace
pfw)) ([PFCmd] -> [PFCmd] -> ActionStack
ActionStack (PFCmd
cforall a. a -> [a] -> [a]
:[PFCmd]
doStack) [PFCmd]
cs)
    [PFCmd]
_ -> PFWorkspace
pfw

undoPermanentWorkspace :: PFWorkspace -> PFWorkspace
undoPermanentWorkspace :: PFWorkspace -> PFWorkspace
undoPermanentWorkspace PFWorkspace
pfw =  PFWorkspace
r where
  ActionStack {[PFCmd]
undoStack :: [PFCmd]
doStack :: [PFCmd]
undoStack :: ActionStack -> [PFCmd]
doStack :: ActionStack -> [PFCmd]
..} = PFWorkspace -> ActionStack
_pFWorkspace_actionStack PFWorkspace
pfw
  r :: PFWorkspace
r = case [PFCmd]
doStack of
    PFCmd
c : [PFCmd]
cs -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PFState -> SEltLabelChanges -> ActionStack -> PFWorkspace
PFWorkspace (PFCmd -> PFState -> (PFState, SEltLabelChanges)
undoCmdState PFCmd
c (PFWorkspace -> PFState
_pFWorkspace_pFState PFWorkspace
pfw)) ([PFCmd] -> [PFCmd] -> ActionStack
ActionStack [PFCmd]
cs [PFCmd]
undoStack)
    [PFCmd]
_ -> PFWorkspace
pfw

doCmdWorkspace :: PFCmd -> PFWorkspace -> PFWorkspace
-- deepseq here to force evaluation of workspace and prevent leaks
doCmdWorkspace :: PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace PFCmd
cmd PFWorkspace
pfw = forall a. NFData a => a -> a
force PFWorkspace
r where
  newState :: (PFState, SEltLabelChanges)
newState = PFCmd -> PFState -> (PFState, SEltLabelChanges)
doCmdState PFCmd
cmd (PFWorkspace -> PFState
_pFWorkspace_pFState PFWorkspace
pfw)
  ActionStack {[PFCmd]
undoStack :: [PFCmd]
doStack :: [PFCmd]
undoStack :: ActionStack -> [PFCmd]
doStack :: ActionStack -> [PFCmd]
..} = (PFWorkspace -> ActionStack
_pFWorkspace_actionStack PFWorkspace
pfw)
  newStack :: ActionStack
newStack = [PFCmd] -> [PFCmd] -> ActionStack
ActionStack (PFCmd
cmdforall a. a -> [a] -> [a]
:[PFCmd]
doStack) []
  --newMaxId = pFState_maxID _pFWorkspace_pFState
  r :: PFWorkspace
r = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PFState -> SEltLabelChanges -> ActionStack -> PFWorkspace
PFWorkspace (PFState, SEltLabelChanges)
newState ActionStack
newStack

doCmdState :: PFCmd -> PFState -> (PFState, SEltLabelChanges)
doCmdState :: PFCmd -> PFState -> (PFState, SEltLabelChanges)
doCmdState PFCmd
cmd PFState
s = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PFState -> Bool
pFState_isValid PFState
newState) (PFState
newState, SEltLabelChanges
changes) where
  (PFState
newState, SEltLabelChanges
changes) = case PFCmd
cmd of
    (PFCmdTag a
PFCNewElts :=> Identity a
x)      ->  [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
do_newElts a
x PFState
s
    (PFCmdTag a
PFCDeleteElts :=> Identity a
x)   ->  [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
do_deleteElts a
x PFState
s
    (PFCmdTag a
PFCManipulate :=> Identity a
x)   ->  ControllersWithId -> PFState -> (PFState, SEltLabelChanges)
do_manipulate a
x PFState
s
    (PFCmdTag a
PFCMove :=> Identity a
x)         -> ([REltId], REltId) -> PFState -> (PFState, SEltLabelChanges)
do_move a
x PFState
s
    (PFCmdTag a
PFCResizeCanvas :=> Identity a
x) -> (DeltaLBox -> PFState -> PFState
do_resizeCanvas a
x PFState
s, forall a. IntMap a
IM.empty)

undoCmdState :: PFCmd -> PFState -> (PFState, SEltLabelChanges)
undoCmdState :: PFCmd -> PFState -> (PFState, SEltLabelChanges)
undoCmdState PFCmd
cmd PFState
s = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PFState -> Bool
pFState_isValid PFState
newState) (PFState
newState, SEltLabelChanges
changes) where
  (PFState
newState, SEltLabelChanges
changes) =  case PFCmd
cmd of
    (PFCmdTag a
PFCNewElts :=> Identity a
x)      ->  [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
undo_newElts a
x PFState
s
    (PFCmdTag a
PFCDeleteElts :=> Identity a
x)   ->  [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
undo_deleteElts a
x PFState
s
    (PFCmdTag a
PFCManipulate :=> Identity a
x)   ->  ControllersWithId -> PFState -> (PFState, SEltLabelChanges)
undo_manipulate a
x PFState
s
    (PFCmdTag a
PFCMove :=> Identity a
x)         -> ([REltId], REltId) -> PFState -> (PFState, SEltLabelChanges)
undo_move a
x PFState
s
    (PFCmdTag a
PFCResizeCanvas :=> Identity a
x) -> (DeltaLBox -> PFState -> PFState
undo_resizeCanvas a
x PFState
s, forall a. IntMap a
IM.empty)

------ helpers for converting events to cmds
-- TODO move these to a different file prob
pfc_addElt_to_newElts :: PFState -> (LayerPos, SEltLabel) -> PFCmd
pfc_addElt_to_newElts :: PFState -> (REltId, SEltLabel) -> PFCmd
pfc_addElt_to_newElts PFState
pfs (REltId
lp,SEltLabel
seltl) = PFCmd
r where
  rid :: REltId
rid = PFState -> REltId
pFState_maxID PFState
pfs forall a. Num a => a -> a -> a
+ REltId
1
  r :: PFCmd
r = PFCmdTag [SuperSEltLabel]
PFCNewElts forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> [(REltId
rid,REltId
lp,SEltLabel
seltl)]

pfc_addFolder_to_newElts :: PFState -> (LayerPos, Text) -> PFCmd
pfc_addFolder_to_newElts :: PFState -> (REltId, Text) -> PFCmd
pfc_addFolder_to_newElts PFState
pfs (REltId
lp, Text
name) = PFCmd
r where
  ridStart :: REltId
ridStart = PFState -> REltId
pFState_maxID PFState
pfs forall a. Num a => a -> a -> a
+ REltId
1
  ridEnd :: REltId
ridEnd = REltId
ridStart forall a. Num a => a -> a -> a
+ REltId
1
  seltlStart :: SEltLabel
seltlStart = Text -> SElt -> SEltLabel
SEltLabel Text
name SElt
SEltFolderStart
  seltlEnd :: SEltLabel
seltlEnd = Text -> SElt -> SEltLabel
SEltLabel (Text
name forall a. Semigroup a => a -> a -> a
<> Text
" (end)") SElt
SEltFolderEnd
  r :: PFCmd
r = PFCmdTag [SuperSEltLabel]
PFCNewElts forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> [(REltId
ridStart, REltId
lp, SEltLabel
seltlStart), (REltId
ridEnd, REltId
lpforall a. Num a => a -> a -> a
+REltId
1, SEltLabel
seltlEnd)]

debugPrintLayerPoss :: (IsString a) => PFState -> [LayerPos] -> a
debugPrintLayerPoss :: forall a. IsString a => PFState -> [REltId] -> a
debugPrintLayerPoss PFState {IntMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: PFState -> Seq REltId
_pFState_canvas :: SCanvas
_pFState_directory :: IntMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_directory :: PFState -> IntMap SEltLabel
..} [REltId]
lps = forall a. IsString a => String -> a
fromString String
msg where
  rids :: [REltId]
rids = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Seq a -> REltId -> a
Seq.index Seq REltId
_pFState_layers) [REltId]
lps
  seltls :: [SEltLabel]
seltls = forall a b. (a -> b) -> [a] -> [b]
map (forall a. IntMap a -> REltId -> a
(IM.!) IntMap SEltLabel
_pFState_directory) [REltId]
rids
  msg :: String
msg = forall b a. (Show a, IsString b) => a -> b
show forall a b. (a -> b) -> a -> b
$ (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [REltId]
rids [REltId]
lps (forall a b. (a -> b) -> [a] -> [b]
map SEltLabel -> SElt
_sEltLabel_sElt [SEltLabel]
seltls))

-- TODO consider including folder end to selecetion if not included
-- or at least assert to ensure it's correct
pfc_removeElt_to_deleteElts :: PFState -> [LayerPos] -> PFCmd
--pfc_removeElt_to_deleteElts pfs@PFState {..} lps = if length lps > 1 then trace (debugPrintLayerPoss pfs lps) r else r where
pfc_removeElt_to_deleteElts :: PFState -> [REltId] -> PFCmd
pfc_removeElt_to_deleteElts PFState {IntMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: IntMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: PFState -> Seq REltId
_pFState_directory :: PFState -> IntMap SEltLabel
..} [REltId]
lps = PFCmd
r where
  rids :: [REltId]
rids = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Seq a -> REltId -> a
Seq.index Seq REltId
_pFState_layers) [REltId]
lps
  seltls :: [SEltLabel]
seltls = forall a b. (a -> b) -> [a] -> [b]
map (forall a. IntMap a -> REltId -> a
(IM.!) IntMap SEltLabel
_pFState_directory) [REltId]
rids
  r :: PFCmd
r = PFCmdTag [SuperSEltLabel]
PFCDeleteElts forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [REltId]
rids [REltId]
lps [SEltLabel]
seltls)

-- TODO DELETE
pfc_paste_to_newElts :: PFState -> ([SEltLabel], LayerPos) -> PFCmd
pfc_paste_to_newElts :: PFState -> ([SEltLabel], REltId) -> PFCmd
pfc_paste_to_newElts PFState
pfs ([SEltLabel]
seltls, REltId
lp) = PFCmd
r where
  rid :: REltId
rid = PFState -> REltId
pFState_maxID PFState
pfs forall a. Num a => a -> a -> a
+ REltId
1
  r :: PFCmd
r = PFCmdTag [SuperSEltLabel]
PFCNewElts forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [REltId
rid..] [REltId
lp..] [SEltLabel]
seltls

pfc_addRelative_to_newElts :: PFState -> (LayerPos, SEltTree) -> PFCmd
pfc_addRelative_to_newElts :: PFState -> (REltId, SEltTree) -> PFCmd
pfc_addRelative_to_newElts PFState
pfs (REltId
lp, SEltTree
stree) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
validScope forall a b. (a -> b) -> a -> b
$ PFCmd
r where
  validScope :: Bool
validScope = forall a. (a -> Maybe Bool) -> Seq a -> [REltId] -> Bool
selectionHasScopingProperty forall {a}. (a, SEltLabel) -> Maybe Bool
scopeFn (forall a. [a] -> Seq a
Seq.fromList SEltTree
stree) [REltId
0..forall (t :: * -> *) a. Foldable t => t a -> REltId
length SEltTree
stree forall a. Num a => a -> a -> a
- REltId
1]
  scopeFn :: (a, SEltLabel) -> Maybe Bool
scopeFn (a
_,SEltLabel
seltl) = case SEltLabel
seltl of
    (SEltLabel Text
_ SElt
SEltFolderStart) -> forall a. a -> Maybe a
Just Bool
True
    (SEltLabel Text
_ SElt
SEltFolderEnd)   -> forall a. a -> Maybe a
Just Bool
False
    SEltLabel
_                             -> forall a. Maybe a
Nothing
  -- TODO reposition/offset (could just offset by 1? or maybe need to add new arg)
  -- TODO reindex SEltTree maintaing connections
  rid :: REltId
rid = PFState -> REltId
pFState_maxID PFState
pfs forall a. Num a => a -> a -> a
+ REltId
1
  r :: PFCmd
r = PFCmdTag [SuperSEltLabel]
PFCNewElts forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [REltId
rid..] [REltId
lp..] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd SEltTree
stree)

--pfc_duplicate_to_duplicate :: PFState -> [LayerPos] -> PFCmd
--pfc_duplicate_to_duplicate pfs lps = r where
--  rids = map (Seq.index _pFState_layers) lps
--  r = PFCFDuplicate ==> rids

------ update functions via commands
data WSEvent =
  -- CHANGE TODO FIGURE IT OUT
  --WSEAddElt (Bool, OwlSpot, OwlItem)
  -- | WSEAddRelative (OwlSpot, Seq OwlItem)
  -- | WSEAddFolder (OwlSpot, Text)
  -- | WSERemoveElt [REltId] -- removed kiddos get adopted by grandparents or w/e?
  -- | WSEMoveElt (OwlSpot, [REltId]) -- also moves kiddos?
  -- | WSEDuplicate [REltId] -- kiddos get duplicated??


  WSEAddElt (Bool, (LayerPos, SEltLabel))
  | WSEAddRelative (LayerPos, SEltTree)
  | WSEAddFolder (LayerPos, Text)
  | WSERemoveElt [LayerPos]
  | WSEMoveElt ([LayerPos], LayerPos)
  -- | WSEDuplicate [LayerPos]
  | WSEManipulate (Bool, ControllersWithId)
  | WSEResizeCanvas DeltaLBox
  | WSEUndo
  | WSERedo
  | WSELoad SPotatoFlow
  deriving (REltId -> WSEvent -> ShowS
[WSEvent] -> ShowS
WSEvent -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WSEvent] -> ShowS
$cshowList :: [WSEvent] -> ShowS
show :: WSEvent -> String
$cshow :: WSEvent -> String
showsPrec :: REltId -> WSEvent -> ShowS
$cshowsPrec :: REltId -> WSEvent -> ShowS
Show, WSEvent -> WSEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WSEvent -> WSEvent -> Bool
$c/= :: WSEvent -> WSEvent -> Bool
== :: WSEvent -> WSEvent -> Bool
$c== :: WSEvent -> WSEvent -> Bool
Eq)

debugPrintBeforeAfterState :: (IsString a) => PFState -> PFState -> a
debugPrintBeforeAfterState :: forall a. IsString a => PFState -> PFState -> a
debugPrintBeforeAfterState PFState
stateBefore PFState
stateAfter = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"BEFORE: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => PFState -> a
debugPrintPFState PFState
stateBefore forall a. Semigroup a => a -> a -> a
<> String
"\nAFTER: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => PFState -> a
debugPrintPFState PFState
stateAfter

doCmdPFWorkspaceUndoPermanentFirst :: (PFState -> PFCmd) -> PFWorkspace -> PFWorkspace
doCmdPFWorkspaceUndoPermanentFirst :: (PFState -> PFCmd) -> PFWorkspace -> PFWorkspace
doCmdPFWorkspaceUndoPermanentFirst PFState -> PFCmd
cmdFn PFWorkspace
ws = PFWorkspace
r where
  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways
  undoedws :: PFWorkspace
undoedws = PFWorkspace -> PFWorkspace
undoPermanentWorkspace PFWorkspace
ws
  undoedpfs :: PFState
undoedpfs = PFWorkspace -> PFState
_pFWorkspace_pFState PFWorkspace
undoedws
  cmd :: PFCmd
cmd = PFState -> PFCmd
cmdFn PFState
undoedpfs
  r :: PFWorkspace
r = PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace PFCmd
cmd PFWorkspace
undoedws

updatePFWorkspace :: WSEvent -> PFWorkspace -> PFWorkspace
updatePFWorkspace :: WSEvent -> PFWorkspace -> PFWorkspace
updatePFWorkspace WSEvent
evt PFWorkspace
ws = let
  lastState :: PFState
lastState = PFWorkspace -> PFState
_pFWorkspace_pFState PFWorkspace
ws
  r :: PFWorkspace
r = case WSEvent
evt of
    WSEAddElt (Bool
undo, (REltId, SEltLabel)
x) -> if Bool
undo
      then (PFState -> PFCmd) -> PFWorkspace -> PFWorkspace
doCmdPFWorkspaceUndoPermanentFirst (\PFState
pfs -> PFState -> (REltId, SEltLabel) -> PFCmd
pfc_addElt_to_newElts PFState
pfs (REltId, SEltLabel)
x) PFWorkspace
ws
      else PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace (PFState -> (REltId, SEltLabel) -> PFCmd
pfc_addElt_to_newElts PFState
lastState (REltId, SEltLabel)
x) PFWorkspace
ws
    WSEAddRelative (REltId, SEltTree)
x -> PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace (PFState -> (REltId, SEltTree) -> PFCmd
pfc_addRelative_to_newElts PFState
lastState (REltId, SEltTree)
x) PFWorkspace
ws
    WSEAddFolder (REltId, Text)
x -> PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace (PFState -> (REltId, Text) -> PFCmd
pfc_addFolder_to_newElts PFState
lastState (REltId, Text)
x) PFWorkspace
ws
    WSERemoveElt [REltId]
x -> PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace (PFState -> [REltId] -> PFCmd
pfc_removeElt_to_deleteElts PFState
lastState [REltId]
x) PFWorkspace
ws
    WSEManipulate (Bool
undo, ControllersWithId
x) -> if Bool
undo
      then (PFState -> PFCmd) -> PFWorkspace -> PFWorkspace
doCmdPFWorkspaceUndoPermanentFirst (forall a b. a -> b -> a
const (PFCmdTag ControllersWithId
PFCManipulate forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> ControllersWithId
x)) PFWorkspace
ws
      else PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace (PFCmdTag ControllersWithId
PFCManipulate forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> ControllersWithId
x) PFWorkspace
ws
    -- TODO add children to selection before moving
    WSEMoveElt ([REltId], REltId)
x -> PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace (PFCmdTag ([REltId], REltId)
PFCMove forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> ([REltId], REltId)
x) PFWorkspace
ws
    WSEResizeCanvas DeltaLBox
x -> PFCmd -> PFWorkspace -> PFWorkspace
doCmdWorkspace (PFCmdTag DeltaLBox
PFCResizeCanvas forall (f :: * -> *) (tag :: * -> *) a.
Applicative f =>
tag a -> a -> DSum tag f
==> DeltaLBox
x) PFWorkspace
ws
    WSEvent
WSEUndo -> PFWorkspace -> PFWorkspace
undoWorkspace PFWorkspace
ws
    WSEvent
WSERedo -> PFWorkspace -> PFWorkspace
redoWorkspace PFWorkspace
ws
    WSELoad SPotatoFlow
x -> PFState -> PFWorkspace -> PFWorkspace
loadPFStateIntoWorkspace (SPotatoFlow -> PFState
sPotatoFlow_to_pFState SPotatoFlow
x) PFWorkspace
ws
  afterState :: PFState
afterState = PFWorkspace -> PFState
_pFWorkspace_pFState PFWorkspace
r
  isValidAfter :: Bool
isValidAfter = PFState -> Bool
pFState_isValid PFState
afterState
  in
    if Bool
isValidAfter then PFWorkspace
r else
      forall a t. (?callStack::CallStack, IsText t) => t -> a
error (Text
"INVALID " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show WSEvent
evt forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => PFState -> PFState -> a
debugPrintBeforeAfterState PFState
lastState PFState
afterState)