{-# LANGUAGE RecordWildCards #-} module Potato.Flow.OwlWorkspace ( OwlPFWorkspace(..) , emptyWorkspace , markWorkspaceSaved , undoWorkspace , redoWorkspace , undoPermanentWorkspace , doCmdWorkspace , WSEvent(..) , updateOwlPFWorkspace , loadOwlPFStateIntoWorkspace , maybeCommitLocalPreviewToLlamaStackAndClear , owlPFWorkspace_hasLocalPreview ) where import Relude import Potato.Flow.Llama import Potato.Flow.Owl import Potato.Flow.OwlState import Potato.Flow.Types import Potato.Flow.Preview import Control.Exception (assert) import qualified Data.IntMap.Strict as IM -- TODO get rid of this, now needed data OwlPFWorkspace = OwlPFWorkspace { _owlPFWorkspace_owlPFState :: OwlPFState -- TODO rename to localLlamaStack , _owlPFWorkspace_llamaStack :: LlamaStack -- WIP preview stuff -- Llama is the undo Llama for the preview as the preview has already been applied to _owlPFWorkspace_owlPFState , _owlPFWorkspace_localPreview :: Maybe (Shepard, Shift, Llama) , _owlPFWorkspace_remotePreviews :: [(Shepard, Shift, Llama)] } deriving (Show, Generic) instance NFData OwlPFWorkspace owlPFWorkspace_hasLocalPreview :: OwlPFWorkspace -> Bool owlPFWorkspace_hasLocalPreview pfw = isJust (_owlPFWorkspace_localPreview pfw) -- NOTE this will reset all previews and the LlamaStack, be sure to synchronize with your ordering service!!! loadOwlPFStateIntoWorkspace :: OwlPFState -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) loadOwlPFStateIntoWorkspace pfs ws = (next_ws, changes) where removeOld = fmap (const Nothing) (_owlTree_mapping . _owlPFState_owlTree . _owlPFWorkspace_owlPFState $ ws) addNew = IM.mapWithKey (\rid (oem,oe) -> Just (SuperOwl rid oem oe)) (_owlTree_mapping . _owlPFState_owlTree $ pfs) changes = IM.union addNew removeOld next_ws = emptyWorkspace { _owlPFWorkspace_owlPFState = pfs , _owlPFWorkspace_llamaStack = emptyLlamaStack } emptyWorkspace :: OwlPFWorkspace emptyWorkspace = OwlPFWorkspace { _owlPFWorkspace_owlPFState = emptyOwlPFState , _owlPFWorkspace_llamaStack = emptyLlamaStack , _owlPFWorkspace_localPreview = Nothing , _owlPFWorkspace_remotePreviews = [] } -- UNTESTED markWorkspaceSaved :: OwlPFWorkspace -> OwlPFWorkspace markWorkspaceSaved pfw = r where as@LlamaStack {..} = _owlPFWorkspace_llamaStack pfw newas = as { _llamaStack_lastSaved = Just (length _llamaStack_done) } r = pfw { _owlPFWorkspace_llamaStack = newas } undoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) undoWorkspace pfw = r where LlamaStack {..} = _owlPFWorkspace_llamaStack pfw r = case _llamaStack_done of c : cs -> (next_ws , changes) where (newpfs, changes, undollama) = case _llama_apply c (_owlPFWorkspace_owlPFState pfw) of Left e -> error $ show e Right x -> x next_ws = pfw { _owlPFWorkspace_owlPFState = newpfs , _owlPFWorkspace_llamaStack = (LlamaStack cs (undollama:_llamaStack_undone) _llamaStack_lastSaved) } _ -> (pfw, IM.empty) redoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) redoWorkspace pfw = r where LlamaStack {..} = _owlPFWorkspace_llamaStack pfw r = case _llamaStack_undone of c : cs -> (next_ws, changes) where (newpfs, changes, dollama) = case _llama_apply c (_owlPFWorkspace_owlPFState pfw) of Left e -> error $ show e Right x -> x next_ws = pfw { _owlPFWorkspace_owlPFState = newpfs , _owlPFWorkspace_llamaStack = (LlamaStack (dollama:_llamaStack_done) cs _llamaStack_lastSaved) } _ -> (pfw, IM.empty) undoPermanentWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) undoPermanentWorkspace pfw = r where LlamaStack {..} = _owlPFWorkspace_llamaStack 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 = case _llamaStack_lastSaved of Nothing -> Nothing Just x -> if length _llamaStack_done > x -- we are undoing a change that came after last save then Just x -- we are permanently undoing a change from last saved else Nothing r = case _llamaStack_done of c : cs -> (next_ws, changes) where (newpfs, changes, _) = case _llama_apply c (_owlPFWorkspace_owlPFState pfw) of Left e -> error $ show e Right x -> x next_ws = pfw { _owlPFWorkspace_owlPFState = newpfs , _owlPFWorkspace_llamaStack = (LlamaStack cs _llamaStack_undone newLastSaved) } _ -> (pfw, IM.empty) moveLlamaStackDone :: Llama -> LlamaStack -> LlamaStack moveLlamaStackDone undollama LlamaStack {..} = r where newLastSaved = case _llamaStack_lastSaved of Nothing -> Nothing Just x -> if length _llamaStack_done < x -- we "did" something when last save is still on undo stack, so we can never recover to last saved then Nothing -- we can still undo back to last save state else Just x r = LlamaStack { _llamaStack_done = undollama : _llamaStack_done , _llamaStack_undone = _llamaStack_undone , _llamaStack_lastSaved = newLastSaved } doLlamaWorkspace :: Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) doLlamaWorkspace = doLlamaWorkspace' True doLlamaWorkspace' :: Bool -> Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) doLlamaWorkspace' updatestack llama pfw = r where oldpfs = _owlPFWorkspace_owlPFState pfw (newpfs, changes, mundollama) = case _llama_apply llama oldpfs of -- TODO would be nice to output error to user somehow? Left e -> case e of ApplyLlamaError_Fatal x -> error x ApplyLLamaError_Soft _ -> (oldpfs, IM.empty, Nothing) Right x -> case x of (newpfs', changes', undollama') -> (newpfs', changes', Just undollama') llamastack = (_owlPFWorkspace_llamaStack pfw) newstack = case mundollama of Nothing -> llamastack Just undollama -> moveLlamaStackDone undollama llamastack r' = pfw { _owlPFWorkspace_owlPFState = newpfs , _owlPFWorkspace_llamaStack = if updatestack then newstack else _owlPFWorkspace_llamaStack pfw } r = (r', changes) doLlamaWorkspaceUndoPermanentFirst :: Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) doLlamaWorkspaceUndoPermanentFirst llama ws = r where -- undoPermanent is actually not necessary as the next action clears the redo stack anyways (undoedws, undochanges) = undoPermanentWorkspace ws (newpfs, changes) = doLlamaWorkspace llama undoedws r = (newpfs, IM.union changes undochanges) doCmdWorkspace :: OwlPFCmd -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) doCmdWorkspace cmd pfw = force r where r = doLlamaWorkspace (makePFCLlama cmd) pfw ------ update functions via commands data WSEvent = -- TODO DELETE -- TODO get rid of undo first parameter WSEApplyLlama (Bool, Llama) | WSEApplyPreview Shepard Shift Preview | WSEUndo | WSERedo | WSELoad SPotatoFlow deriving (Show) debugPrintBeforeAfterState :: (IsString a) => OwlPFState -> OwlPFState -> a debugPrintBeforeAfterState stateBefore stateAfter = fromString $ "BEFORE: " <> debugPrintOwlPFState stateBefore <> "\nAFTER: " <> debugPrintOwlPFState stateAfter clearLocalPreview :: (OwlPFWorkspace, SuperOwlChanges) -> (OwlPFWorkspace, SuperOwlChanges) clearLocalPreview (ws, changes) = (ws { _owlPFWorkspace_localPreview = Nothing }, changes) maybeCommitLocalPreviewToLlamaStackAndClear :: OwlPFWorkspace -> OwlPFWorkspace maybeCommitLocalPreviewToLlamaStackAndClear ws = case _owlPFWorkspace_localPreview ws of Nothing -> ws Just (_, _, undollama) -> r_1 where newstack = moveLlamaStackDone undollama (_owlPFWorkspace_llamaStack ws) r_1 = ws { _owlPFWorkspace_llamaStack = newstack , _owlPFWorkspace_localPreview = Nothing } mustUndoLocalPreview :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) mustUndoLocalPreview ws = case _owlPFWorkspace_localPreview ws of Nothing -> error "expected local preview" Just (_, _, undollama) -> case _llama_apply undollama (_owlPFWorkspace_owlPFState ws) of Left e -> case e of ApplyLlamaError_Fatal x -> error x ApplyLLamaError_Soft x -> error x Right (newpfs, changes, _) -> (ws { _owlPFWorkspace_owlPFState = newpfs , _owlPFWorkspace_localPreview = Nothing }, changes) doLocalPreview :: Shepard -> Shift -> Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) doLocalPreview shepard shift llama ws = assert (isNothing $ _owlPFWorkspace_localPreview ws) $ (next_ws, changes) where oldpfs = _owlPFWorkspace_owlPFState ws (newpfs, changes, undollama) = case _llama_apply llama oldpfs of Left e -> case e of ApplyLlamaError_Fatal x -> error x ApplyLLamaError_Soft x -> error x -- TODO this is going to cause issues because it breaks assumptions about previews --ApplyLLamaError_Soft _ -> (oldpfs, IM.empty, Nothing) Right x -> x next_ws = ws { _owlPFWorkspace_owlPFState = newpfs , _owlPFWorkspace_localPreview = Just (shepard, shift, undollama) } -- TODO take PotatoConfiguration here??? updateOwlPFWorkspace :: WSEvent -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges) updateOwlPFWorkspace evt ws = r_0 where lastState = _owlPFWorkspace_owlPFState ws ws_afterCommit = maybeCommitLocalPreviewToLlamaStackAndClear ws r_0' = case evt of WSEApplyPreview shepard shift preview -> case preview of Preview op llama -> case op of PO_Start -> doLocalPreview shepard shift llama ws_afterCommit PO_CommitAndStart -> assert (owlPFWorkspace_hasLocalPreview ws) $ doLocalPreview shepard shift llama ws_afterCommit PO_StartAndCommit -> r_1 where (next_ws, changes) = doLocalPreview shepard shift llama ws_afterCommit r_1 = (maybeCommitLocalPreviewToLlamaStackAndClear next_ws, changes) PO_Continue -> r_1 where (next_ws', changes1) = mustUndoLocalPreview ws (next_ws, changes2) = doLocalPreview shepard shift llama next_ws' r_1 = (next_ws, IM.union changes2 changes1) PO_ContinueAndCommit -> r_1 where (next_ws', changes1) = mustUndoLocalPreview ws (next_ws, changes2) = doLocalPreview shepard shift llama next_ws' r_1 = (maybeCommitLocalPreviewToLlamaStackAndClear next_ws, IM.union changes2 changes1) Preview_Commit -> assert (owlPFWorkspace_hasLocalPreview ws) $ (ws_afterCommit, IM.empty) Preview_MaybeCommit -> (ws_afterCommit, IM.empty) Preview_Cancel -> case _owlPFWorkspace_localPreview ws of Nothing -> error "expected local preview" Just (_, _, undollama) -> clearLocalPreview $ doLlamaWorkspace' False undollama ws WSEApplyLlama (undo, x) -> if undo then doLlamaWorkspaceUndoPermanentFirst x ws else doLlamaWorkspace x ws WSEUndo -> undoWorkspace ws_afterCommit WSERedo -> redoWorkspace ws_afterCommit WSELoad x -> loadOwlPFStateIntoWorkspace (sPotatoFlow_to_owlPFState x) ws_afterCommit afterState = _owlPFWorkspace_owlPFState (fst r_0') isValidAfter = owlPFState_isValid afterState r_0 = if isValidAfter then r_0' else error ("INVALID " <> show evt <> "\n" <> debugPrintBeforeAfterState lastState afterState)