{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.OwlWorkspace (
  OwlPFWorkspace(..)
  , emptyWorkspace
  , markWorkspaceSaved
  , undoWorkspace
  , redoWorkspace
  , undoPermanentWorkspace
  , doCmdWorkspace
  , WSEvent(..)
  , updateOwlPFWorkspace
  , loadOwlPFStateIntoWorkspace
) where

import           Relude

import           Potato.Flow.Llama
import           Potato.Flow.Math
import           Potato.Flow.Owl
import           Potato.Flow.OwlItem
import           Potato.Flow.OwlState
import           Potato.Flow.SElts
import           Potato.Flow.Types

import           Control.Exception    (assert)
import qualified Data.IntMap.Strict   as IM
import qualified Data.IntSet          as IS
import qualified Data.Sequence        as Seq

-- TODO rename
data OwlPFWorkspace = OwlPFWorkspace {
  OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState    :: OwlPFState

  -- this is updated after each call to updateOwlPFWorkspace and is only guaranteed to be valid at that point
  -- TODO better to have methods return (OwlPFWorkspace, SuperOwlChanges) instead of embedding in OwlPFWorkspace
  , OwlPFWorkspace -> SuperOwlChanges
_owlPFWorkspace_lastChanges :: SuperOwlChanges

  , OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack  :: LlamaStack
} deriving (REltId -> OwlPFWorkspace -> ShowS
[OwlPFWorkspace] -> ShowS
OwlPFWorkspace -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlPFWorkspace] -> ShowS
$cshowList :: [OwlPFWorkspace] -> ShowS
show :: OwlPFWorkspace -> String
$cshow :: OwlPFWorkspace -> String
showsPrec :: REltId -> OwlPFWorkspace -> ShowS
$cshowsPrec :: REltId -> OwlPFWorkspace -> ShowS
Show, forall x. Rep OwlPFWorkspace x -> OwlPFWorkspace
forall x. OwlPFWorkspace -> Rep OwlPFWorkspace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwlPFWorkspace x -> OwlPFWorkspace
$cfrom :: forall x. OwlPFWorkspace -> Rep OwlPFWorkspace x
Generic)

instance NFData OwlPFWorkspace

loadOwlPFStateIntoWorkspace :: OwlPFState -> OwlPFWorkspace -> OwlPFWorkspace
loadOwlPFStateIntoWorkspace :: OwlPFState -> OwlPFWorkspace -> OwlPFWorkspace
loadOwlPFStateIntoWorkspace OwlPFState
pfs OwlPFWorkspace
ws = OwlPFWorkspace
r where
  removeOld :: SuperOwlChanges
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) (OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState forall a b. (a -> b) -> a -> b
$ OwlPFWorkspace
ws)
  addNew :: SuperOwlChanges
addNew = forall a b. (REltId -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\REltId
rid (OwlItemMeta
oem,OwlItem
oe) -> forall a. a -> Maybe a
Just (REltId -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl REltId
rid OwlItemMeta
oem OwlItem
oe)) (OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs)
  changes :: SuperOwlChanges
changes = forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
addNew SuperOwlChanges
removeOld
  r :: OwlPFWorkspace
r = OwlPFState -> SuperOwlChanges -> LlamaStack -> OwlPFWorkspace
OwlPFWorkspace OwlPFState
pfs SuperOwlChanges
changes LlamaStack
emptyLlamaStack

emptyWorkspace :: OwlPFWorkspace
emptyWorkspace :: OwlPFWorkspace
emptyWorkspace = OwlPFState -> SuperOwlChanges -> LlamaStack -> OwlPFWorkspace
OwlPFWorkspace OwlPFState
emptyOwlPFState forall a. IntMap a
IM.empty LlamaStack
emptyLlamaStack

-- UNTESTED
markWorkspaceSaved :: OwlPFWorkspace -> OwlPFWorkspace
markWorkspaceSaved :: OwlPFWorkspace -> OwlPFWorkspace
markWorkspaceSaved OwlPFWorkspace
pfw = OwlPFWorkspace
r where
  as :: LlamaStack
as@LlamaStack {[Llama]
Maybe REltId
_llamaStack_lastSaved :: LlamaStack -> Maybe REltId
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
_llamaStack_lastSaved :: Maybe REltId
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
..} = OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw
  newas :: LlamaStack
newas = LlamaStack
as { _llamaStack_lastSaved :: Maybe REltId
_llamaStack_lastSaved = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> REltId
length [Llama]
_llamaStack_done) }
  r :: OwlPFWorkspace
r = OwlPFWorkspace
pfw { _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack = LlamaStack
newas }

undoWorkspace :: OwlPFWorkspace -> OwlPFWorkspace
undoWorkspace :: OwlPFWorkspace -> OwlPFWorkspace
undoWorkspace OwlPFWorkspace
pfw =  OwlPFWorkspace
r where
  LlamaStack {[Llama]
Maybe REltId
_llamaStack_lastSaved :: Maybe REltId
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe REltId
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
..} = OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw
  r :: OwlPFWorkspace
r = case [Llama]
_llamaStack_done of
    Llama
c : [Llama]
cs -> OwlPFState -> SuperOwlChanges -> LlamaStack -> OwlPFWorkspace
OwlPFWorkspace OwlPFState
newpfs SuperOwlChanges
changes ([Llama] -> [Llama] -> Maybe REltId -> LlamaStack
LlamaStack [Llama]
cs (Llama
undollamaforall a. a -> [a] -> [a]
:[Llama]
_llamaStack_undone) Maybe REltId
_llamaStack_lastSaved) where
      (OwlPFState
newpfs, SuperOwlChanges
changes, Llama
undollama) = case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
c (OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
pfw) of
        Left ApplyLlamaError
e  -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show ApplyLlamaError
e
        Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
    [Llama]
_ -> OwlPFWorkspace
pfw

redoWorkspace :: OwlPFWorkspace -> OwlPFWorkspace
redoWorkspace :: OwlPFWorkspace -> OwlPFWorkspace
redoWorkspace OwlPFWorkspace
pfw = OwlPFWorkspace
r where
  LlamaStack {[Llama]
Maybe REltId
_llamaStack_lastSaved :: Maybe REltId
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe REltId
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
..} = OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw
  r :: OwlPFWorkspace
r = case [Llama]
_llamaStack_undone of
    Llama
c : [Llama]
cs -> OwlPFState -> SuperOwlChanges -> LlamaStack -> OwlPFWorkspace
OwlPFWorkspace OwlPFState
newpfs SuperOwlChanges
changes ([Llama] -> [Llama] -> Maybe REltId -> LlamaStack
LlamaStack (Llama
dollamaforall a. a -> [a] -> [a]
:[Llama]
_llamaStack_done) [Llama]
cs Maybe REltId
_llamaStack_lastSaved) where
      (OwlPFState
newpfs, SuperOwlChanges
changes, Llama
dollama) = case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
c (OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
pfw) of
        Left ApplyLlamaError
e  -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show ApplyLlamaError
e
        Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
    [Llama]
_ -> OwlPFWorkspace
pfw

undoPermanentWorkspace :: OwlPFWorkspace -> OwlPFWorkspace
undoPermanentWorkspace :: OwlPFWorkspace -> OwlPFWorkspace
undoPermanentWorkspace OwlPFWorkspace
pfw =  OwlPFWorkspace
r where
  LlamaStack {[Llama]
Maybe REltId
_llamaStack_lastSaved :: Maybe REltId
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe REltId
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
..} = OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw
  -- NOTE this step is rather unecessary as this is always followed by a doCmdWorkspace but it's best to keep the state correct in between in case anything changes in the future
  newLastSaved :: Maybe REltId
newLastSaved = case Maybe REltId
_llamaStack_lastSaved of
    Maybe REltId
Nothing -> forall a. Maybe a
Nothing
    Just REltId
x -> if forall (t :: * -> *) a. Foldable t => t a -> REltId
length [Llama]
_llamaStack_done forall a. Ord a => a -> a -> Bool
> REltId
x
      -- we are undoing a change that came after last save
      then forall a. a -> Maybe a
Just REltId
x
      -- we are permanently undoing a change from last saved
      else forall a. Maybe a
Nothing
  r :: OwlPFWorkspace
r = case [Llama]
_llamaStack_done of
    Llama
c : [Llama]
cs -> OwlPFState -> SuperOwlChanges -> LlamaStack -> OwlPFWorkspace
OwlPFWorkspace OwlPFState
newpfs SuperOwlChanges
changes ([Llama] -> [Llama] -> Maybe REltId -> LlamaStack
LlamaStack [Llama]
cs [Llama]
_llamaStack_undone Maybe REltId
newLastSaved) where
      (OwlPFState
newpfs, SuperOwlChanges
changes, Llama
_) = case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
c (OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
pfw) of
        Left ApplyLlamaError
e  -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show ApplyLlamaError
e
        Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
    [Llama]
_ -> OwlPFWorkspace
pfw

doLlamaWorkspace :: Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspace :: Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspace Llama
llama OwlPFWorkspace
pfw = OwlPFWorkspace
r where
  (OwlPFState
newpfs, SuperOwlChanges
changes, Llama
undollama) = case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
llama (OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
pfw) of
    Left ApplyLlamaError
e  -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show ApplyLlamaError
e
    Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
  LlamaStack {[Llama]
Maybe REltId
_llamaStack_lastSaved :: Maybe REltId
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe REltId
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
..} = (OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw)
  newLastSaved :: Maybe REltId
newLastSaved = case Maybe REltId
_llamaStack_lastSaved of
    Maybe REltId
Nothing -> forall a. Maybe a
Nothing
    Just REltId
x -> if forall (t :: * -> *) a. Foldable t => t a -> REltId
length [Llama]
_llamaStack_done forall a. Ord a => a -> a -> Bool
< REltId
x
      -- we "did" something when last save is still on undo stack, so we can never recover to last saved
      then forall a. Maybe a
Nothing
      -- we can still undo back to last save state
      else forall a. a -> Maybe a
Just REltId
x
  r :: OwlPFWorkspace
r = OwlPFWorkspace {
      _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState       = OwlPFState
newpfs
      , _owlPFWorkspace_lastChanges :: SuperOwlChanges
_owlPFWorkspace_lastChanges = SuperOwlChanges
changes
      , _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack  = LlamaStack {
          _llamaStack_done :: [Llama]
_llamaStack_done = Llama
undollama forall a. a -> [a] -> [a]
: [Llama]
_llamaStack_done
          , _llamaStack_undone :: [Llama]
_llamaStack_undone = [Llama]
_llamaStack_undone
          , _llamaStack_lastSaved :: Maybe REltId
_llamaStack_lastSaved = Maybe REltId
newLastSaved
        }
    }

doLlamaWorkspaceUndoPermanentFirst :: Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspaceUndoPermanentFirst :: Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspaceUndoPermanentFirst Llama
llama OwlPFWorkspace
ws = OwlPFWorkspace
r where
  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways
  undoedws :: OwlPFWorkspace
undoedws = OwlPFWorkspace -> OwlPFWorkspace
undoPermanentWorkspace OwlPFWorkspace
ws
  r :: OwlPFWorkspace
r = Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspace Llama
llama OwlPFWorkspace
undoedws

doCmdWorkspace :: OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace :: OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace OwlPFCmd
cmd OwlPFWorkspace
pfw = forall a. NFData a => a -> a
force OwlPFWorkspace
r where
  r :: OwlPFWorkspace
r = Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspace (OwlPFCmd -> Llama
makePFCLlama OwlPFCmd
cmd) OwlPFWorkspace
pfw

doCmdOwlPFWorkspaceUndoPermanentFirst :: (OwlPFState -> OwlPFCmd) -> OwlPFWorkspace -> OwlPFWorkspace
doCmdOwlPFWorkspaceUndoPermanentFirst :: (OwlPFState -> OwlPFCmd) -> OwlPFWorkspace -> OwlPFWorkspace
doCmdOwlPFWorkspaceUndoPermanentFirst OwlPFState -> OwlPFCmd
cmdFn OwlPFWorkspace
ws = OwlPFWorkspace
r where
  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways
  undoedws :: OwlPFWorkspace
undoedws = OwlPFWorkspace -> OwlPFWorkspace
undoPermanentWorkspace OwlPFWorkspace
ws
  undoedpfs :: OwlPFState
undoedpfs = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
undoedws
  cmd :: OwlPFCmd
cmd = OwlPFState -> OwlPFCmd
cmdFn OwlPFState
undoedpfs
  r :: OwlPFWorkspace
r = Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspace (OwlPFCmd -> Llama
makePFCLlama OwlPFCmd
cmd) OwlPFWorkspace
undoedws

------ update functions via commands
data WSEvent =
  WSEAddElt (Bool, OwlSpot, OwlItem)
  | WSEAddTree (OwlSpot, MiniOwlTree)
  | WSEAddFolder (OwlSpot, Text)

  -- DELETE
  | WSERemoveElt OwlParliament

  -- WIP
  | WSERemoveEltAndUpdateAttachments OwlParliament AttachmentMap


  | WSEMoveElt (OwlSpot, OwlParliament)
  -- | WSEDuplicate OwlParliament -- kiddos get duplicated??
  | WSEApplyLlama (Bool, Llama)
  | 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)

debugPrintBeforeAfterState :: (IsString a) => OwlPFState -> OwlPFState -> a
debugPrintBeforeAfterState :: forall a. IsString a => OwlPFState -> OwlPFState -> a
debugPrintBeforeAfterState OwlPFState
stateBefore OwlPFState
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 => OwlPFState -> a
debugPrintOwlPFState OwlPFState
stateBefore forall a. Semigroup a => a -> a -> a
<> String
"\nAFTER: " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => OwlPFState -> a
debugPrintOwlPFState OwlPFState
stateAfter


------ helpers for converting events to cmds
-- TODO assert elts are valid
pfc_addElt_to_newElts :: OwlPFState -> OwlSpot -> OwlItem -> OwlPFCmd
pfc_addElt_to_newElts :: OwlPFState -> OwlSpot -> OwlItem -> OwlPFCmd
pfc_addElt_to_newElts OwlPFState
pfs OwlSpot
spot OwlItem
oelt = [(REltId, OwlSpot, OwlItem)] -> OwlPFCmd
OwlPFCNewElts [(OwlPFState -> REltId
owlPFState_nextId OwlPFState
pfs, OwlSpot
spot, OwlItem
oelt)]

--TODO need to reorder so it becomes undo friendly here I think? (uhh, pretty sure it's ok to delete this TODO? should be ordered by assumption)
-- TODO assert elts are valid
pfc_moveElt_to_move :: OwlPFState -> (OwlSpot, OwlParliament) -> OwlPFCmd
pfc_moveElt_to_move :: OwlPFState -> (OwlSpot, OwlParliament) -> OwlPFCmd
pfc_moveElt_to_move OwlPFState
pfs (OwlSpot
ospot, OwlParliament
op) = (OwlSpot, SuperOwlParliament) -> OwlPFCmd
OwlPFCMove (OwlSpot
ospot, OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) OwlParliament
op)

pfc_removeElt_to_deleteElts :: OwlPFState -> OwlParliament -> OwlPFCmd
pfc_removeElt_to_deleteElts :: OwlPFState -> OwlParliament -> OwlPFCmd
pfc_removeElt_to_deleteElts OwlPFState
pfs OwlParliament
owlp = forall a. HasCallStack => Bool -> a -> a
assert Bool
valid OwlPFCmd
r where
  od :: OwlTree
od = OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs
  valid :: Bool
valid = OwlTree -> SuperOwlParliament -> Bool
superOwlParliament_isValid OwlTree
od forall a b. (a -> b) -> a -> b
$ OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od OwlParliament
owlp
  sop :: SuperOwlParliament
sop = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od OwlParliament
owlp
  sowlswithchildren :: Seq SuperOwl
sowlswithchildren = OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren OwlTree
od SuperOwlParliament
sop
  r :: OwlPFCmd
r = [(REltId, OwlSpot, OwlItem)] -> OwlPFCmd
OwlPFCDeleteElts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl {REltId
OwlItem
OwlItemMeta
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_id :: SuperOwl -> REltId
_superOwl_elt :: OwlItem
_superOwl_meta :: OwlItemMeta
_superOwl_id :: REltId
..} -> (REltId
_superOwl_id, OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
od OwlItemMeta
_superOwl_meta, OwlItem
_superOwl_elt)) Seq SuperOwl
sowlswithchildren)

pfc_addFolder_to_newElts :: OwlPFState -> (OwlSpot, Text) -> OwlPFCmd
pfc_addFolder_to_newElts :: OwlPFState -> (OwlSpot, Text) -> OwlPFCmd
pfc_addFolder_to_newElts OwlPFState
pfs (OwlSpot
spot, Text
name) = [(REltId, OwlSpot, OwlItem)] -> OwlPFCmd
OwlPFCNewElts [(OwlPFState -> REltId
owlPFState_nextId OwlPFState
pfs, OwlSpot
spot, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (Seq REltId -> OwlSubItem
OwlSubItemFolder forall a. Seq a
Seq.empty))]

-- UNTESTED
makeLlamaToSetAttachedLinesToCurrentPosition :: OwlPFState -> AttachmentMap -> REltId -> [Llama]
makeLlamaToSetAttachedLinesToCurrentPosition :: OwlPFState -> AttachmentMap -> REltId -> [Llama]
makeLlamaToSetAttachedLinesToCurrentPosition OwlPFState
pfs AttachmentMap
am REltId
target = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
target AttachmentMap
am of
    Maybe IntSet
Nothing       -> []
    Just IntSet
attached -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap REltId -> Llama
makeLlama forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [REltId]
IS.toList forall a b. (a -> b) -> a -> b
$ IntSet
attached
  where
    makeLlama :: REltId -> Llama
    makeLlama :: REltId -> Llama
makeLlama REltId
rid = case SuperOwl -> OwlItem
_superOwl_elt (forall o. (HasOwlTree o, HasCallStack) => o -> REltId -> SuperOwl
hasOwlTree_mustFindSuperOwl OwlPFState
pfs REltId
rid) of
        OwlItem OwlInfo
_ (OwlSubItemLine SAutoLine
sline) -> Llama
r where
          startAttachment :: Maybe Attachment
startAttachment = SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline
          endAttachment :: Maybe Attachment
endAttachment = SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline
          affectstart :: Bool
affectstart = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> REltId
_attachment_target Maybe Attachment
startAttachment forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just REltId
target
          affectend :: Bool
affectend = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> REltId
_attachment_target Maybe Attachment
endAttachment forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just REltId
target
          newstartpos :: XY
newstartpos = case HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
False OwlPFState
pfs Maybe Attachment
startAttachment of
            Maybe XY
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected to find attachment " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
startAttachment
            Just XY
x -> XY
x
          newendpos :: XY
newendpos = case HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
False OwlPFState
pfs Maybe Attachment
endAttachment of
            Maybe XY
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected to find attachment " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Maybe Attachment
endAttachment
            Just XY
x -> XY
x
          newsline :: SAutoLine
newsline = SAutoLine
sline {
              -- disconnect from target if it was deleted
              -- NOTE strictly speaking necessary! Not sure which way is better in multi-user mode
              _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = if Bool
affectstart then forall a. Maybe a
Nothing else SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline
              , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = if Bool
affectend  then forall a. Maybe a
Nothing else SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline

              -- place endpoints in new place
              , _sAutoLine_start :: XY
_sAutoLine_start = if Bool
affectstart then XY
newstartpos else SAutoLine -> XY
_sAutoLine_start SAutoLine
sline
              , _sAutoLine_end :: XY
_sAutoLine_end = if Bool
affectend then XY
newendpos else SAutoLine -> XY
_sAutoLine_end SAutoLine
sline

            }
          r :: Llama
r = (REltId, SElt) -> Llama
makeSetLlama (REltId
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)
        OwlItem
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"found non-line element in attachment list"

-- TODO rename to removeElts
removeEltAndUpdateAttachments_to_llama :: OwlPFState -> AttachmentMap -> OwlParliament -> Llama
removeEltAndUpdateAttachments_to_llama :: OwlPFState -> AttachmentMap -> OwlParliament -> Llama
removeEltAndUpdateAttachments_to_llama OwlPFState
pfs AttachmentMap
am op :: OwlParliament
op@(OwlParliament Seq REltId
rids) = Llama
r where
  removellama :: Llama
removellama = OwlPFCmd -> Llama
makePFCLlamaforall a b. (a -> b) -> a -> b
$  OwlPFState -> OwlParliament -> OwlPFCmd
pfc_removeElt_to_deleteElts OwlPFState
pfs OwlParliament
op
  resetattachllamas :: [Llama]
resetattachllamas = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlPFState -> AttachmentMap -> REltId -> [Llama]
makeLlamaToSetAttachedLinesToCurrentPosition OwlPFState
pfs AttachmentMap
am) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REltId
rids)
  -- seems more correct to detach lines first and then delete the target so that undo operation is more sensible
  r :: Llama
r = [Llama] -> Llama
makeCompositionLlama forall a b. (a -> b) -> a -> b
$ [Llama]
resetattachllamas forall a. Semigroup a => a -> a -> a
<> [Llama
removellama]

-- TODO take PotatoConfiguration here???
updateOwlPFWorkspace :: WSEvent -> OwlPFWorkspace -> OwlPFWorkspace
updateOwlPFWorkspace :: WSEvent -> OwlPFWorkspace -> OwlPFWorkspace
updateOwlPFWorkspace WSEvent
evt OwlPFWorkspace
ws = let
  lastState :: OwlPFState
lastState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
ws
  r :: OwlPFWorkspace
r = case WSEvent
evt of
    WSEAddElt (Bool
undo, OwlSpot
spot, OwlItem
oelt) -> if Bool
undo
      then (OwlPFState -> OwlPFCmd) -> OwlPFWorkspace -> OwlPFWorkspace
doCmdOwlPFWorkspaceUndoPermanentFirst (\OwlPFState
pfs -> OwlPFState -> OwlSpot -> OwlItem -> OwlPFCmd
pfc_addElt_to_newElts OwlPFState
pfs OwlSpot
spot OwlItem
oelt) OwlPFWorkspace
ws
      else OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace (OwlPFState -> OwlSpot -> OwlItem -> OwlPFCmd
pfc_addElt_to_newElts OwlPFState
lastState OwlSpot
spot OwlItem
oelt) OwlPFWorkspace
ws
    WSEAddTree (OwlSpot, OwlTree)
x -> OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace ((OwlTree, OwlSpot) -> OwlPFCmd
OwlPFCNewTree (forall a b. (a, b) -> (b, a)
swap (OwlSpot, OwlTree)
x)) OwlPFWorkspace
ws
    WSEAddFolder (OwlSpot, Text)
x -> OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace (OwlPFState -> (OwlSpot, Text) -> OwlPFCmd
pfc_addFolder_to_newElts OwlPFState
lastState (OwlSpot, Text)
x) OwlPFWorkspace
ws

    -- DELETE
    WSERemoveElt OwlParliament
x -> OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace (OwlPFState -> OwlParliament -> OwlPFCmd
pfc_removeElt_to_deleteElts OwlPFState
lastState OwlParliament
x) OwlPFWorkspace
ws

    WSERemoveEltAndUpdateAttachments OwlParliament
x AttachmentMap
am -> Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspace (OwlPFState -> AttachmentMap -> OwlParliament -> Llama
removeEltAndUpdateAttachments_to_llama OwlPFState
lastState AttachmentMap
am OwlParliament
x) OwlPFWorkspace
ws

    WSEApplyLlama (Bool
undo, Llama
x) -> if Bool
undo
      then Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspaceUndoPermanentFirst Llama
x OwlPFWorkspace
ws
      else Llama -> OwlPFWorkspace -> OwlPFWorkspace
doLlamaWorkspace Llama
x OwlPFWorkspace
ws
    WSEMoveElt (OwlSpot, OwlParliament)
x -> OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace (OwlPFState -> (OwlSpot, OwlParliament) -> OwlPFCmd
pfc_moveElt_to_move OwlPFState
lastState (OwlSpot, OwlParliament)
x) OwlPFWorkspace
ws
    -- ignore invalid canvas resize events
    WSEResizeCanvas DeltaLBox
x -> if DeltaLBox -> OwlPFWorkspace -> Bool
validateCanvasSizeOperation DeltaLBox
x OwlPFWorkspace
ws
      then OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace
doCmdWorkspace (DeltaLBox -> OwlPFCmd
OwlPFCResizeCanvas DeltaLBox
x) OwlPFWorkspace
ws
      else OwlPFWorkspace
ws
    WSEvent
WSEUndo -> OwlPFWorkspace -> OwlPFWorkspace
undoWorkspace OwlPFWorkspace
ws
    WSEvent
WSERedo -> OwlPFWorkspace -> OwlPFWorkspace
redoWorkspace OwlPFWorkspace
ws
    WSELoad SPotatoFlow
x -> OwlPFState -> OwlPFWorkspace -> OwlPFWorkspace
loadOwlPFStateIntoWorkspace (SPotatoFlow -> OwlPFState
sPotatoFlow_to_owlPFState SPotatoFlow
x) OwlPFWorkspace
ws
  afterState :: OwlPFState
afterState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
r
  isValidAfter :: Bool
isValidAfter = OwlPFState -> Bool
owlPFState_isValid OwlPFState
afterState
  in if Bool
isValidAfter
    then OwlPFWorkspace
r
    else forall a t. (HasCallStack, 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 => OwlPFState -> OwlPFState -> a
debugPrintBeforeAfterState OwlPFState
lastState OwlPFState
afterState)


-- | returns true if the applying `OwlPFCResizeCanvas lbox` results in a valid canvas size
validateCanvasSizeOperation :: DeltaLBox -> OwlPFWorkspace -> Bool
validateCanvasSizeOperation :: DeltaLBox -> OwlPFWorkspace -> Bool
validateCanvasSizeOperation DeltaLBox
lbox OwlPFWorkspace
ws = Bool
r where
  pfs :: OwlPFState
pfs = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
ws
  oldcanvas :: LBox
oldcanvas = SCanvas -> LBox
_sCanvas_box forall a b. (a -> b) -> a -> b
$ OwlPFState -> SCanvas
_owlPFState_canvas OwlPFState
pfs
  newcanvas :: LBox
newcanvas = forall x dx. Delta x dx => x -> dx -> x
plusDelta LBox
oldcanvas DeltaLBox
lbox
  r :: Bool
r = SCanvas -> Bool
isValidCanvas (LBox -> SCanvas
SCanvas LBox
newcanvas)