OwlWorkspace.hs

{-# 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)