{-# 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.Math
import           Potato.Flow.Owl
import           Potato.Flow.OwlItem
import           Potato.Flow.OwlState
import           Potato.Flow.Serialization.Snake
import           Potato.Flow.Types
import Potato.Flow.Preview

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

-- TODO get rid of this, now needed
data OwlPFWorkspace = OwlPFWorkspace {
  OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState    :: OwlPFState

  -- TODO rename to localLlamaStack
  , OwlPFWorkspace -> LlamaStack
_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 -> Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview :: Maybe (Shepard, Shift, Llama) 
  , OwlPFWorkspace -> [(Shepard, Shift, Llama)]
_owlPFWorkspace_remotePreviews :: [(Shepard, Shift, Llama)]

} deriving (Int -> OwlPFWorkspace -> ShowS
[OwlPFWorkspace] -> ShowS
OwlPFWorkspace -> String
(Int -> OwlPFWorkspace -> ShowS)
-> (OwlPFWorkspace -> String)
-> ([OwlPFWorkspace] -> ShowS)
-> Show OwlPFWorkspace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlPFWorkspace -> ShowS
showsPrec :: Int -> OwlPFWorkspace -> ShowS
$cshow :: OwlPFWorkspace -> String
show :: OwlPFWorkspace -> String
$cshowList :: [OwlPFWorkspace] -> ShowS
showList :: [OwlPFWorkspace] -> ShowS
Show, (forall x. OwlPFWorkspace -> Rep OwlPFWorkspace x)
-> (forall x. Rep OwlPFWorkspace x -> OwlPFWorkspace)
-> Generic OwlPFWorkspace
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
$cfrom :: forall x. OwlPFWorkspace -> Rep OwlPFWorkspace x
from :: forall x. OwlPFWorkspace -> Rep OwlPFWorkspace x
$cto :: forall x. Rep OwlPFWorkspace x -> OwlPFWorkspace
to :: forall x. Rep OwlPFWorkspace x -> OwlPFWorkspace
Generic)

instance NFData OwlPFWorkspace

owlPFWorkspace_hasLocalPreview :: OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview :: OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview OwlPFWorkspace
pfw = Maybe (Shepard, Shift, Llama) -> Bool
forall a. Maybe a -> Bool
isJust (OwlPFWorkspace -> Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview OwlPFWorkspace
pfw)

-- NOTE this will reset all previews and the LlamaStack, be sure to synchronize with your ordering service!!!
loadOwlPFStateIntoWorkspace :: OwlPFState -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
loadOwlPFStateIntoWorkspace :: OwlPFState -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
loadOwlPFStateIntoWorkspace OwlPFState
pfs OwlPFWorkspace
ws = (OwlPFWorkspace
next_ws, SuperOwlChanges
changes) where
  removeOld :: SuperOwlChanges
removeOld = ((OwlItemMeta, OwlItem) -> Maybe SuperOwl)
-> IntMap (OwlItemMeta, OwlItem) -> SuperOwlChanges
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe SuperOwl -> (OwlItemMeta, OwlItem) -> Maybe SuperOwl
forall a b. a -> b -> a
const Maybe SuperOwl
forall a. Maybe a
Nothing) (OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping (OwlTree -> IntMap (OwlItemMeta, OwlItem))
-> (OwlPFWorkspace -> OwlTree)
-> OwlPFWorkspace
-> IntMap (OwlItemMeta, OwlItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> OwlTree)
-> (OwlPFWorkspace -> OwlPFState) -> OwlPFWorkspace -> OwlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState (OwlPFWorkspace -> IntMap (OwlItemMeta, OwlItem))
-> OwlPFWorkspace -> IntMap (OwlItemMeta, OwlItem)
forall a b. (a -> b) -> a -> b
$ OwlPFWorkspace
ws)
  addNew :: SuperOwlChanges
addNew = (Int -> (OwlItemMeta, OwlItem) -> Maybe SuperOwl)
-> IntMap (OwlItemMeta, OwlItem) -> SuperOwlChanges
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
rid (OwlItemMeta
oem,OwlItem
oe) -> SuperOwl -> Maybe SuperOwl
forall a. a -> Maybe a
Just (Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
rid OwlItemMeta
oem OwlItem
oe)) (OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping (OwlTree -> IntMap (OwlItemMeta, OwlItem))
-> (OwlPFState -> OwlTree)
-> OwlPFState
-> IntMap (OwlItemMeta, OwlItem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> IntMap (OwlItemMeta, OwlItem))
-> OwlPFState -> IntMap (OwlItemMeta, OwlItem)
forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs)
  changes :: SuperOwlChanges
changes = SuperOwlChanges -> SuperOwlChanges -> SuperOwlChanges
forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
addNew SuperOwlChanges
removeOld
  next_ws :: OwlPFWorkspace
next_ws = OwlPFWorkspace
emptyWorkspace {
      _owlPFWorkspace_owlPFState = pfs
      , _owlPFWorkspace_llamaStack = emptyLlamaStack
    }

emptyWorkspace :: OwlPFWorkspace
emptyWorkspace :: OwlPFWorkspace
emptyWorkspace =  OwlPFWorkspace {
    _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState    = OwlPFState
emptyOwlPFState
    , _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack  = LlamaStack
emptyLlamaStack
    , _owlPFWorkspace_localPreview :: Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview = Maybe (Shepard, Shift, Llama)
forall a. Maybe a
Nothing
    , _owlPFWorkspace_remotePreviews :: [(Shepard, Shift, Llama)]
_owlPFWorkspace_remotePreviews = []
  }

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

undoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoWorkspace OwlPFWorkspace
pfw =  (OwlPFWorkspace, SuperOwlChanges)
r where
  LlamaStack {[Llama]
Maybe Int
_llamaStack_done :: LlamaStack -> [Llama]
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_done :: [Llama]
_llamaStack_undone :: [Llama]
_llamaStack_lastSaved :: Maybe Int
..} = OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw
  r :: (OwlPFWorkspace, SuperOwlChanges)
r = case [Llama]
_llamaStack_done of
    Llama
c : [Llama]
cs -> (OwlPFWorkspace
next_ws , SuperOwlChanges
changes) 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  -> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (OwlPFState, SuperOwlChanges, Llama))
-> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ ApplyLlamaError -> Text
forall b a. (Show a, IsString b) => a -> b
show ApplyLlamaError
e
        Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
      next_ws :: OwlPFWorkspace
next_ws =  OwlPFWorkspace
pfw {
          _owlPFWorkspace_owlPFState = newpfs
          , _owlPFWorkspace_llamaStack = (LlamaStack cs (undollama:_llamaStack_undone) _llamaStack_lastSaved)
        }
    [Llama]
_ -> (OwlPFWorkspace
pfw, SuperOwlChanges
forall a. IntMap a
IM.empty)

redoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
redoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
redoWorkspace OwlPFWorkspace
pfw = (OwlPFWorkspace, SuperOwlChanges)
r where
  LlamaStack {[Llama]
Maybe Int
_llamaStack_done :: LlamaStack -> [Llama]
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_done :: [Llama]
_llamaStack_undone :: [Llama]
_llamaStack_lastSaved :: Maybe Int
..} = OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw
  r :: (OwlPFWorkspace, SuperOwlChanges)
r = case [Llama]
_llamaStack_undone of
    Llama
c : [Llama]
cs -> (OwlPFWorkspace
next_ws, SuperOwlChanges
changes) 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  -> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (OwlPFState, SuperOwlChanges, Llama))
-> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ ApplyLlamaError -> Text
forall b a. (Show a, IsString b) => a -> b
show ApplyLlamaError
e
        Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
      next_ws :: OwlPFWorkspace
next_ws = OwlPFWorkspace
pfw {
        _owlPFWorkspace_owlPFState = newpfs
        , _owlPFWorkspace_llamaStack = (LlamaStack (dollama:_llamaStack_done) cs _llamaStack_lastSaved)
      }
    [Llama]
_ -> (OwlPFWorkspace
pfw, SuperOwlChanges
forall a. IntMap a
IM.empty)

undoPermanentWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoPermanentWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoPermanentWorkspace OwlPFWorkspace
pfw =  (OwlPFWorkspace, SuperOwlChanges)
r where
  LlamaStack {[Llama]
Maybe Int
_llamaStack_done :: LlamaStack -> [Llama]
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_done :: [Llama]
_llamaStack_undone :: [Llama]
_llamaStack_lastSaved :: Maybe Int
..} = 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 Int
newLastSaved = case Maybe Int
_llamaStack_lastSaved of
    Maybe Int
Nothing -> Maybe Int
forall a. Maybe a
Nothing
    Just Int
x -> if [Llama] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Llama]
_llamaStack_done Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x
      -- we are undoing a change that came after last save
      then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
      -- we are permanently undoing a change from last saved
      else Maybe Int
forall a. Maybe a
Nothing
  r :: (OwlPFWorkspace, SuperOwlChanges)
r = case [Llama]
_llamaStack_done of
    Llama
c : [Llama]
cs -> (OwlPFWorkspace
next_ws, SuperOwlChanges
changes) 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  -> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (OwlPFState, SuperOwlChanges, Llama))
-> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ ApplyLlamaError -> Text
forall b a. (Show a, IsString b) => a -> b
show ApplyLlamaError
e
        Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
      next_ws :: OwlPFWorkspace
next_ws =  OwlPFWorkspace
pfw {
        _owlPFWorkspace_owlPFState = newpfs
        , _owlPFWorkspace_llamaStack = (LlamaStack cs _llamaStack_undone newLastSaved)
      }
    [Llama]
_ -> (OwlPFWorkspace
pfw, SuperOwlChanges
forall a. IntMap a
IM.empty)



moveLlamaStackDone :: Llama -> LlamaStack -> LlamaStack
moveLlamaStackDone :: Llama -> LlamaStack -> LlamaStack
moveLlamaStackDone Llama
undollama LlamaStack {[Llama]
Maybe Int
_llamaStack_done :: LlamaStack -> [Llama]
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_done :: [Llama]
_llamaStack_undone :: [Llama]
_llamaStack_lastSaved :: Maybe Int
..} = LlamaStack
r where
  newLastSaved :: Maybe Int
newLastSaved = case Maybe Int
_llamaStack_lastSaved of
    Maybe Int
Nothing -> Maybe Int
forall a. Maybe a
Nothing
    Just Int
x -> if [Llama] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Llama]
_llamaStack_done Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x
      -- we "did" something when last save is still on undo stack, so we can never recover to last saved
      then Maybe Int
forall a. Maybe a
Nothing
      -- we can still undo back to last save state
      else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
  r :: LlamaStack
r = LlamaStack {
      _llamaStack_done :: [Llama]
_llamaStack_done = Llama
undollama Llama -> [Llama] -> [Llama]
forall a. a -> [a] -> [a]
: [Llama]
_llamaStack_done
      , _llamaStack_undone :: [Llama]
_llamaStack_undone = [Llama]
_llamaStack_undone
      , _llamaStack_lastSaved :: Maybe Int
_llamaStack_lastSaved = Maybe Int
newLastSaved
    }

doLlamaWorkspace :: Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace :: Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace = Bool
-> Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace' Bool
True

doLlamaWorkspace' :: Bool -> Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace' :: Bool
-> Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace' Bool
updatestack Llama
llama OwlPFWorkspace
pfw = (OwlPFWorkspace, SuperOwlChanges)
r where
  oldpfs :: OwlPFState
oldpfs = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
pfw
  (OwlPFState
newpfs, SuperOwlChanges
changes, Maybe Llama
mundollama) = case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
llama OwlPFState
oldpfs of
    -- TODO would be nice to output error to user somehow?
    Left ApplyLlamaError
e  -> case ApplyLlamaError
e of
      ApplyLlamaError_Fatal Text
x -> Text -> (OwlPFState, SuperOwlChanges, Maybe Llama)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
      ApplyLLamaError_Soft Text
_  -> (OwlPFState
oldpfs, SuperOwlChanges
forall a. IntMap a
IM.empty, Maybe Llama
forall a. Maybe a
Nothing)
    Right (OwlPFState, SuperOwlChanges, Llama)
x -> case (OwlPFState, SuperOwlChanges, Llama)
x of
      (OwlPFState
newpfs', SuperOwlChanges
changes', Llama
undollama') -> (OwlPFState
newpfs', SuperOwlChanges
changes', Llama -> Maybe Llama
forall a. a -> Maybe a
Just Llama
undollama')
  llamastack :: LlamaStack
llamastack = (OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw)
  newstack :: LlamaStack
newstack = case Maybe Llama
mundollama of
    Maybe Llama
Nothing        -> LlamaStack
llamastack
    Just Llama
undollama -> Llama -> LlamaStack -> LlamaStack
moveLlamaStackDone Llama
undollama LlamaStack
llamastack

  r' :: OwlPFWorkspace
r' = OwlPFWorkspace
pfw {
      _owlPFWorkspace_owlPFState       = newpfs
      , _owlPFWorkspace_llamaStack  = if updatestack then newstack else _owlPFWorkspace_llamaStack pfw
    }
  r :: (OwlPFWorkspace, SuperOwlChanges)
r = (OwlPFWorkspace
r', SuperOwlChanges
changes)

doLlamaWorkspaceUndoPermanentFirst :: Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspaceUndoPermanentFirst :: Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspaceUndoPermanentFirst Llama
llama OwlPFWorkspace
ws = (OwlPFWorkspace, SuperOwlChanges)
r where
  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways
  (OwlPFWorkspace
undoedws, SuperOwlChanges
undochanges) = OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoPermanentWorkspace OwlPFWorkspace
ws
  (OwlPFWorkspace
newpfs, SuperOwlChanges
changes) = Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace Llama
llama OwlPFWorkspace
undoedws
  r :: (OwlPFWorkspace, SuperOwlChanges)
r = (OwlPFWorkspace
newpfs, SuperOwlChanges -> SuperOwlChanges -> SuperOwlChanges
forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
changes SuperOwlChanges
undochanges)

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

doCmdOwlPFWorkspaceUndoPermanentFirst :: (OwlPFState -> OwlPFCmd) -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doCmdOwlPFWorkspaceUndoPermanentFirst :: (OwlPFState -> OwlPFCmd)
-> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doCmdOwlPFWorkspaceUndoPermanentFirst OwlPFState -> OwlPFCmd
cmdFn OwlPFWorkspace
ws = (OwlPFWorkspace, SuperOwlChanges)
r where
  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways
  (OwlPFWorkspace
undoedws, SuperOwlChanges
undochanges) = OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoPermanentWorkspace OwlPFWorkspace
ws
  undoedpfs :: OwlPFState
undoedpfs = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
undoedws
  cmd :: OwlPFCmd
cmd = OwlPFState -> OwlPFCmd
cmdFn OwlPFState
undoedpfs
  (OwlPFWorkspace
newpfs, SuperOwlChanges
changes) = Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace (OwlPFCmd -> Llama
makePFCLlama OwlPFCmd
cmd) OwlPFWorkspace
undoedws
  r :: (OwlPFWorkspace, SuperOwlChanges)
r = (OwlPFWorkspace
newpfs, SuperOwlChanges -> SuperOwlChanges -> SuperOwlChanges
forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
changes SuperOwlChanges
undochanges)


------ 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 (Int -> WSEvent -> ShowS
[WSEvent] -> ShowS
WSEvent -> String
(Int -> WSEvent -> ShowS)
-> (WSEvent -> String) -> ([WSEvent] -> ShowS) -> Show WSEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WSEvent -> ShowS
showsPrec :: Int -> WSEvent -> ShowS
$cshow :: WSEvent -> String
show :: WSEvent -> String
$cshowList :: [WSEvent] -> ShowS
showList :: [WSEvent] -> ShowS
Show)
  

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


noChanges :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
noChanges :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
noChanges OwlPFWorkspace
ws = (OwlPFWorkspace
ws, SuperOwlChanges
forall a. IntMap a
IM.empty)

clearLocalPreview :: (OwlPFWorkspace, SuperOwlChanges) -> (OwlPFWorkspace, SuperOwlChanges)
clearLocalPreview :: (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
clearLocalPreview (OwlPFWorkspace
ws, SuperOwlChanges
changes) = (OwlPFWorkspace
ws { _owlPFWorkspace_localPreview = Nothing }, SuperOwlChanges
changes)

maybeCommitLocalPreviewToLlamaStackAndClear :: OwlPFWorkspace -> OwlPFWorkspace
maybeCommitLocalPreviewToLlamaStackAndClear :: OwlPFWorkspace -> OwlPFWorkspace
maybeCommitLocalPreviewToLlamaStackAndClear OwlPFWorkspace
ws = case OwlPFWorkspace -> Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview OwlPFWorkspace
ws of
  Maybe (Shepard, Shift, Llama)
Nothing -> OwlPFWorkspace
ws
  Just (Shepard
shep, Shift
shift, Llama
undollama) -> OwlPFWorkspace
r_1 where
    newstack :: LlamaStack
newstack = Llama -> LlamaStack -> LlamaStack
moveLlamaStackDone Llama
undollama (OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
ws)
    r_1 :: OwlPFWorkspace
r_1 = OwlPFWorkspace
ws { 
        _owlPFWorkspace_llamaStack = newstack 
        , _owlPFWorkspace_localPreview = Nothing
      }

mustUndoLocalPreview :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
mustUndoLocalPreview :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
mustUndoLocalPreview OwlPFWorkspace
ws = case OwlPFWorkspace -> Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview OwlPFWorkspace
ws of
  Maybe (Shepard, Shift, Llama)
Nothing -> Text -> (OwlPFWorkspace, SuperOwlChanges)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected local preview"
  Just (Shepard
_, Shift
_, Llama
undollama) -> case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
undollama (OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
ws) of
    Left ApplyLlamaError
e  -> case ApplyLlamaError
e of
      ApplyLlamaError_Fatal Text
x -> Text -> (OwlPFWorkspace, SuperOwlChanges)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
      ApplyLLamaError_Soft Text
x -> Text -> (OwlPFWorkspace, SuperOwlChanges)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
    Right (OwlPFState
newpfs, SuperOwlChanges
changes, Llama
_) -> (OwlPFWorkspace
ws {
        _owlPFWorkspace_owlPFState = newpfs
        , _owlPFWorkspace_localPreview = Nothing
      }, SuperOwlChanges
changes)
    

doLocalPreview :: Shepard -> Shift -> Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLocalPreview :: Shepard
-> Shift
-> Llama
-> OwlPFWorkspace
-> (OwlPFWorkspace, SuperOwlChanges)
doLocalPreview Shepard
shepard Shift
shift Llama
llama OwlPFWorkspace
ws = Bool
-> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
forall a. HasCallStack => Bool -> a -> a
assert (Maybe (Shepard, Shift, Llama) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Shepard, Shift, Llama) -> Bool)
-> Maybe (Shepard, Shift, Llama) -> Bool
forall a b. (a -> b) -> a -> b
$ OwlPFWorkspace -> Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview OwlPFWorkspace
ws) ((OwlPFWorkspace, SuperOwlChanges)
 -> (OwlPFWorkspace, SuperOwlChanges))
-> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (OwlPFWorkspace
next_ws, SuperOwlChanges
changes) where
  oldpfs :: OwlPFState
oldpfs = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
ws
  (OwlPFState
newpfs, SuperOwlChanges
changes, Llama
undollama) = case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
llama OwlPFState
oldpfs of
    Left ApplyLlamaError
e  -> case ApplyLlamaError
e of
      ApplyLlamaError_Fatal Text
x -> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
      ApplyLLamaError_Soft Text
x -> Text -> (OwlPFState, SuperOwlChanges, Llama)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
      -- TODO this is going to cause issues because it breaks assumptions about previews
      --ApplyLLamaError_Soft _ -> (oldpfs, IM.empty, Nothing)
    Right (OwlPFState, SuperOwlChanges, Llama)
x -> (OwlPFState, SuperOwlChanges, Llama)
x
  next_ws :: OwlPFWorkspace
next_ws = OwlPFWorkspace
ws {
      _owlPFWorkspace_owlPFState = newpfs
      , _owlPFWorkspace_localPreview = Just (shepard, shift, undollama)
    }


-- TODO take PotatoConfiguration here???
updateOwlPFWorkspace :: WSEvent -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
updateOwlPFWorkspace :: WSEvent -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
updateOwlPFWorkspace WSEvent
evt OwlPFWorkspace
ws = (OwlPFWorkspace, SuperOwlChanges)
r_0 where
  lastState :: OwlPFState
lastState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState OwlPFWorkspace
ws
  ws_afterCommit :: OwlPFWorkspace
ws_afterCommit = OwlPFWorkspace -> OwlPFWorkspace
maybeCommitLocalPreviewToLlamaStackAndClear OwlPFWorkspace
ws
  r_0' :: (OwlPFWorkspace, SuperOwlChanges)
r_0' = case WSEvent
evt of
    WSEApplyPreview Shepard
shepard Shift
shift Preview
preview -> case Preview
preview of
      Preview PreviewOperation
op Llama
llama -> case PreviewOperation
op of

        PreviewOperation
PO_Start -> Shepard
-> Shift
-> Llama
-> OwlPFWorkspace
-> (OwlPFWorkspace, SuperOwlChanges)
doLocalPreview Shepard
shepard Shift
shift Llama
llama OwlPFWorkspace
ws_afterCommit
        PreviewOperation
PO_CommitAndStart -> Bool
-> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
forall a. HasCallStack => Bool -> a -> a
assert (OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview OwlPFWorkspace
ws) ((OwlPFWorkspace, SuperOwlChanges)
 -> (OwlPFWorkspace, SuperOwlChanges))
-> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ Shepard
-> Shift
-> Llama
-> OwlPFWorkspace
-> (OwlPFWorkspace, SuperOwlChanges)
doLocalPreview Shepard
shepard Shift
shift Llama
llama OwlPFWorkspace
ws_afterCommit
        PreviewOperation
PO_StartAndCommit -> (OwlPFWorkspace, SuperOwlChanges)
r_1 where
          (OwlPFWorkspace
next_ws, SuperOwlChanges
changes) = Shepard
-> Shift
-> Llama
-> OwlPFWorkspace
-> (OwlPFWorkspace, SuperOwlChanges)
doLocalPreview Shepard
shepard Shift
shift Llama
llama OwlPFWorkspace
ws_afterCommit
          r_1 :: (OwlPFWorkspace, SuperOwlChanges)
r_1 = (OwlPFWorkspace -> OwlPFWorkspace
maybeCommitLocalPreviewToLlamaStackAndClear OwlPFWorkspace
next_ws, SuperOwlChanges
changes)

        PreviewOperation
PO_Continue -> (OwlPFWorkspace, SuperOwlChanges)
r_1 where
          (OwlPFWorkspace
next_ws', SuperOwlChanges
changes1) = OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
mustUndoLocalPreview OwlPFWorkspace
ws
          (OwlPFWorkspace
next_ws, SuperOwlChanges
changes2) = Shepard
-> Shift
-> Llama
-> OwlPFWorkspace
-> (OwlPFWorkspace, SuperOwlChanges)
doLocalPreview Shepard
shepard Shift
shift Llama
llama OwlPFWorkspace
next_ws'
          r_1 :: (OwlPFWorkspace, SuperOwlChanges)
r_1 = (OwlPFWorkspace
next_ws, SuperOwlChanges -> SuperOwlChanges -> SuperOwlChanges
forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
changes2 SuperOwlChanges
changes1)
        PreviewOperation
PO_ContinueAndCommit -> (OwlPFWorkspace, SuperOwlChanges)
r_1 where
          (OwlPFWorkspace
next_ws', SuperOwlChanges
changes1) = OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
mustUndoLocalPreview OwlPFWorkspace
ws
          (OwlPFWorkspace
next_ws, SuperOwlChanges
changes2) = Shepard
-> Shift
-> Llama
-> OwlPFWorkspace
-> (OwlPFWorkspace, SuperOwlChanges)
doLocalPreview Shepard
shepard Shift
shift Llama
llama OwlPFWorkspace
next_ws'
          r_1 :: (OwlPFWorkspace, SuperOwlChanges)
r_1 = (OwlPFWorkspace -> OwlPFWorkspace
maybeCommitLocalPreviewToLlamaStackAndClear OwlPFWorkspace
next_ws, SuperOwlChanges -> SuperOwlChanges -> SuperOwlChanges
forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
changes2 SuperOwlChanges
changes1)

        

      Preview
Preview_Commit -> Bool
-> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
forall a. HasCallStack => Bool -> a -> a
assert (OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview OwlPFWorkspace
ws) ((OwlPFWorkspace, SuperOwlChanges)
 -> (OwlPFWorkspace, SuperOwlChanges))
-> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (OwlPFWorkspace
ws_afterCommit, SuperOwlChanges
forall a. IntMap a
IM.empty)
      Preview
Preview_MaybeCommit -> (OwlPFWorkspace
ws_afterCommit, SuperOwlChanges
forall a. IntMap a
IM.empty)
      Preview
Preview_Cancel -> case OwlPFWorkspace -> Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview OwlPFWorkspace
ws of 
        Maybe (Shepard, Shift, Llama)
Nothing -> Text -> (OwlPFWorkspace, SuperOwlChanges)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected local preview"
        Just (Shepard
_, Shift
_, Llama
undollama) -> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
clearLocalPreview ((OwlPFWorkspace, SuperOwlChanges)
 -> (OwlPFWorkspace, SuperOwlChanges))
-> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ Bool
-> Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace' Bool
False Llama
undollama OwlPFWorkspace
ws

    WSEApplyLlama (Bool
undo, Llama
x) -> if Bool
undo
      then Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspaceUndoPermanentFirst Llama
x OwlPFWorkspace
ws
      else Llama -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
doLlamaWorkspace Llama
x OwlPFWorkspace
ws
    WSEvent
WSEUndo -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoWorkspace OwlPFWorkspace
ws_afterCommit
    WSEvent
WSERedo -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
redoWorkspace OwlPFWorkspace
ws_afterCommit
    WSELoad SPotatoFlow
x -> OwlPFState -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
loadOwlPFStateIntoWorkspace (SPotatoFlow -> OwlPFState
sPotatoFlow_to_owlPFState SPotatoFlow
x) OwlPFWorkspace
ws_afterCommit
  afterState :: OwlPFState
afterState = OwlPFWorkspace -> OwlPFState
_owlPFWorkspace_owlPFState ((OwlPFWorkspace, SuperOwlChanges) -> OwlPFWorkspace
forall a b. (a, b) -> a
fst (OwlPFWorkspace, SuperOwlChanges)
r_0')
  isValidAfter :: Bool
isValidAfter = OwlPFState -> Bool
owlPFState_isValid OwlPFState
afterState
  r_0 :: (OwlPFWorkspace, SuperOwlChanges)
r_0 = if Bool
isValidAfter
    then (OwlPFWorkspace, SuperOwlChanges)
r_0'
    else Text -> (OwlPFWorkspace, SuperOwlChanges)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text
"INVALID " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WSEvent -> Text
forall b a. (Show a, IsString b) => a -> b
show WSEvent
evt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OwlPFState -> OwlPFState -> Text
forall a. IsString a => OwlPFState -> OwlPFState -> a
debugPrintBeforeAfterState OwlPFState
lastState OwlPFState
afterState)