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

owlPFWorkspace_hasLocalPreview :: OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview :: OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview OwlPFWorkspace
pfw = 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 = 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. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
rid (OwlItemMeta
oem,OwlItem
oe) -> forall a. a -> Maybe a
Just (Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
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
  next_ws :: OwlPFWorkspace
next_ws = OwlPFWorkspace
emptyWorkspace {
      _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState = OwlPFState
pfs
      , _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack = 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 = 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_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
_llamaStack_lastSaved :: Maybe Int
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
..} = OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
pfw
  newas :: LlamaStack
newas = LlamaStack
as { _llamaStack_lastSaved :: Maybe Int
_llamaStack_lastSaved = forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Llama]
_llamaStack_done) }
  r :: OwlPFWorkspace
r = OwlPFWorkspace
pfw { _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack = LlamaStack
newas }

undoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoWorkspace :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)
undoWorkspace OwlPFWorkspace
pfw =  (OwlPFWorkspace, SuperOwlChanges)
r where
  LlamaStack {[Llama]
Maybe Int
_llamaStack_lastSaved :: Maybe Int
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
..} = 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  -> 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
      next_ws :: OwlPFWorkspace
next_ws =  OwlPFWorkspace
pfw {
          _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState = OwlPFState
newpfs
          , _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack = ([Llama] -> [Llama] -> Maybe Int -> LlamaStack
LlamaStack [Llama]
cs (Llama
undollamaforall a. a -> [a] -> [a]
:[Llama]
_llamaStack_undone) Maybe Int
_llamaStack_lastSaved)
        }
    [Llama]
_ -> (OwlPFWorkspace
pfw, 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_lastSaved :: Maybe Int
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
..} = 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  -> 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
      next_ws :: OwlPFWorkspace
next_ws = OwlPFWorkspace
pfw {
        _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState = OwlPFState
newpfs
        , _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack = ([Llama] -> [Llama] -> Maybe Int -> LlamaStack
LlamaStack (Llama
dollamaforall a. a -> [a] -> [a]
:[Llama]
_llamaStack_done) [Llama]
cs Maybe Int
_llamaStack_lastSaved)
      }
    [Llama]
_ -> (OwlPFWorkspace
pfw, 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_lastSaved :: Maybe Int
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_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 Int
newLastSaved = case Maybe Int
_llamaStack_lastSaved of
    Maybe Int
Nothing -> forall a. Maybe a
Nothing
    Just Int
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Llama]
_llamaStack_done forall a. Ord a => a -> a -> Bool
> Int
x
      -- we are undoing a change that came after last save
      then forall a. a -> Maybe a
Just Int
x
      -- we are permanently undoing a change from last saved
      else 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  -> 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
      next_ws :: OwlPFWorkspace
next_ws =  OwlPFWorkspace
pfw {
        _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState = OwlPFState
newpfs
        , _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack = ([Llama] -> [Llama] -> Maybe Int -> LlamaStack
LlamaStack [Llama]
cs [Llama]
_llamaStack_undone Maybe Int
newLastSaved)
      }
    [Llama]
_ -> (OwlPFWorkspace
pfw, forall a. IntMap a
IM.empty)



moveLlamaStackDone :: Llama -> LlamaStack -> LlamaStack
moveLlamaStackDone :: Llama -> LlamaStack -> LlamaStack
moveLlamaStackDone Llama
undollama LlamaStack {[Llama]
Maybe Int
_llamaStack_lastSaved :: Maybe Int
_llamaStack_undone :: [Llama]
_llamaStack_done :: [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe Int
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_done :: LlamaStack -> [Llama]
..} = LlamaStack
r where
  newLastSaved :: Maybe Int
newLastSaved = case Maybe Int
_llamaStack_lastSaved of
    Maybe Int
Nothing -> forall a. Maybe a
Nothing
    Just Int
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Llama]
_llamaStack_done 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 forall a. Maybe a
Nothing
      -- we can still undo back to last save state
      else forall a. a -> Maybe a
Just Int
x
  r :: LlamaStack
r = 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 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 -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
      ApplyLLamaError_Soft Text
_  -> (OwlPFState
oldpfs, forall a. IntMap a
IM.empty, 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', 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 :: OwlPFState
_owlPFWorkspace_owlPFState       = OwlPFState
newpfs
      , _owlPFWorkspace_llamaStack :: LlamaStack
_owlPFWorkspace_llamaStack  = if Bool
updatestack then LlamaStack
newstack else OwlPFWorkspace -> LlamaStack
_owlPFWorkspace_llamaStack OwlPFWorkspace
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, 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 = 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

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


clearLocalPreview :: (OwlPFWorkspace, SuperOwlChanges) -> (OwlPFWorkspace, SuperOwlChanges)
clearLocalPreview :: (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
clearLocalPreview (OwlPFWorkspace
ws, SuperOwlChanges
changes) = (OwlPFWorkspace
ws { _owlPFWorkspace_localPreview :: Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview = forall a. Maybe a
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
_, 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 :: LlamaStack
_owlPFWorkspace_llamaStack = LlamaStack
newstack 
        , _owlPFWorkspace_localPreview :: Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview = forall a. Maybe a
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 -> 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 -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
      ApplyLLamaError_Soft Text
x -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
    Right (OwlPFState
newpfs, SuperOwlChanges
changes, Llama
_) -> (OwlPFWorkspace
ws {
        _owlPFWorkspace_owlPFState :: OwlPFState
_owlPFWorkspace_owlPFState = OwlPFState
newpfs
        , _owlPFWorkspace_localPreview :: Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview = forall a. Maybe a
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 = forall a. HasCallStack => Bool -> a -> a
assert (forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ OwlPFWorkspace -> Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview OwlPFWorkspace
ws) 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 -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
x
      ApplyLLamaError_Soft Text
x -> 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 :: OwlPFState
_owlPFWorkspace_owlPFState = OwlPFState
newpfs
      , _owlPFWorkspace_localPreview :: Maybe (Shepard, Shift, Llama)
_owlPFWorkspace_localPreview = forall a. a -> Maybe a
Just (Shepard
shepard, Shift
shift, Llama
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 -> forall a. HasCallStack => Bool -> a -> a
assert (OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview OwlPFWorkspace
ws) 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, 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, forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
changes2 SuperOwlChanges
changes1)

        

      Preview
Preview_Commit -> forall a. HasCallStack => Bool -> a -> a
assert (OwlPFWorkspace -> Bool
owlPFWorkspace_hasLocalPreview OwlPFWorkspace
ws) forall a b. (a -> b) -> a -> b
$ (OwlPFWorkspace
ws_afterCommit, forall a. IntMap a
IM.empty)
      Preview
Preview_MaybeCommit -> (OwlPFWorkspace
ws_afterCommit, 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 -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected local preview"
        Just (Shepard
_, Shift
_, Llama
undollama) -> (OwlPFWorkspace, SuperOwlChanges)
-> (OwlPFWorkspace, SuperOwlChanges)
clearLocalPreview 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 (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 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)