{-# LANGUAGE RecordWildCards #-}


module Potato.Flow.Llama where

import           Relude                   hiding (state)

import           Potato.Flow.DebugHelpers
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           Control.Exception        (assert)
import qualified Data.IntMap              as IM
import qualified Data.Text                as T
import qualified Text.Show


-- TODO rename
-- TODO this is a carryover from a refactor, it would be good to combine this with SLlama but I won't bother.
data OwlPFCmd =
  OwlPFCNewElts [(REltId, OwlSpot, OwlItem)]
  | OwlPFCDeleteElts [(REltId, OwlSpot, OwlItem)]

  | OwlPFCNewTree (MiniOwlTree, OwlSpot)
  | OwlPFCDeleteTree (MiniOwlTree, OwlSpot)

  -- DEPRECATE
  | OwlPFCManipulate ControllersWithId

  -- we need SuperOwlParliament for undo
  | OwlPFCMove (OwlSpot, SuperOwlParliament)

  | OwlPFCResizeCanvas DeltaLBox
  --  | OwlPFCSnap (OwlPFState, OwlPFState) --(before, after)
  deriving (REltId -> OwlPFCmd -> ShowS
[OwlPFCmd] -> ShowS
OwlPFCmd -> String
(REltId -> OwlPFCmd -> ShowS)
-> (OwlPFCmd -> String) -> ([OwlPFCmd] -> ShowS) -> Show OwlPFCmd
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: REltId -> OwlPFCmd -> ShowS
showsPrec :: REltId -> OwlPFCmd -> ShowS
$cshow :: OwlPFCmd -> String
show :: OwlPFCmd -> String
$cshowList :: [OwlPFCmd] -> ShowS
showList :: [OwlPFCmd] -> ShowS
Show, (forall x. OwlPFCmd -> Rep OwlPFCmd x)
-> (forall x. Rep OwlPFCmd x -> OwlPFCmd) -> Generic OwlPFCmd
forall x. Rep OwlPFCmd x -> OwlPFCmd
forall x. OwlPFCmd -> Rep OwlPFCmd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OwlPFCmd -> Rep OwlPFCmd x
from :: forall x. OwlPFCmd -> Rep OwlPFCmd x
$cto :: forall x. Rep OwlPFCmd x -> OwlPFCmd
to :: forall x. Rep OwlPFCmd x -> OwlPFCmd
Generic)

instance NFData OwlPFCmd




-- | returns true if the applying DeltaLBox results in a valid canvas size
validateCanvasSizeOperation :: DeltaLBox -> OwlPFState -> Bool
validateCanvasSizeOperation :: DeltaLBox -> OwlPFState -> Bool
validateCanvasSizeOperation DeltaLBox
lbox OwlPFState
pfs = Bool
r where
  oldcanvas :: LBox
oldcanvas = SCanvas -> LBox
_sCanvas_box (SCanvas -> LBox) -> SCanvas -> LBox
forall a b. (a -> b) -> a -> b
$ OwlPFState -> SCanvas
_owlPFState_canvas OwlPFState
pfs
  newcanvas :: LBox
newcanvas = LBox -> DeltaLBox -> LBox
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)

doCmdState :: OwlPFCmd -> OwlPFState -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
doCmdState :: OwlPFCmd
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
doCmdState OwlPFCmd
cmd OwlPFState
s = Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r where
  r' :: Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r' = case OwlPFCmd
cmd of

    OwlPFCNewElts [(REltId, OwlSpot, OwlItem)]
x      ->  (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
[(REltId, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
[(REltId, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newElts [(REltId, OwlSpot, OwlItem)]
x OwlPFState
s
    OwlPFCDeleteElts [(REltId, OwlSpot, OwlItem)]
x   ->  (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ [(REltId, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteElts [(REltId, OwlSpot, OwlItem)]
x OwlPFState
s

    OwlPFCNewTree (OwlTree, OwlSpot)
x      -> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (OwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newMiniOwlTree (OwlTree, OwlSpot)
x OwlPFState
s
    OwlPFCDeleteTree (OwlTree, OwlSpot)
x   -> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (OwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteMiniOwlTree (OwlTree, OwlSpot)
x OwlPFState
s

    OwlPFCManipulate ControllersWithId
x   ->  (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_manipulate ControllersWithId
x OwlPFState
s

    OwlPFCMove (OwlSpot, SuperOwlParliament)
x         -> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_move (OwlSpot, SuperOwlParliament)
x OwlPFState
s
    OwlPFCResizeCanvas DeltaLBox
x -> if DeltaLBox -> OwlPFState -> Bool
validateCanvasSizeOperation DeltaLBox
x OwlPFState
s 
      then (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (DeltaLBox -> OwlPFState -> OwlPFState
do_resizeCanvas DeltaLBox
x OwlPFState
s, SuperOwlChanges
forall a. IntMap a
IM.empty)
      else ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. a -> Either a b
Left (ApplyLlamaError
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ Text -> ApplyLlamaError
ApplyLLamaError_Soft (Text -> ApplyLlamaError) -> Text -> ApplyLlamaError
forall a b. (a -> b) -> a -> b
$ Text
"Invalid canvas size operation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DeltaLBox -> Text
forall b a. (Show a, IsString b) => a -> b
show DeltaLBox
x

  r :: Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r = case Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r' of 
    Right (OwlPFState
newState, SuperOwlChanges
changes) -> Bool
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a. HasCallStack => Bool -> a -> a
assert (OwlPFState -> Bool
owlPFState_isValid OwlPFState
newState) Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r'
    Left ApplyLlamaError
e -> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. a -> Either a b
Left ApplyLlamaError
e

undoCmdState :: OwlPFCmd -> OwlPFState -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
undoCmdState :: OwlPFCmd
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
undoCmdState OwlPFCmd
cmd OwlPFState
s = Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r where
  r' :: Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r' =  case OwlPFCmd
cmd of

    OwlPFCNewElts [(REltId, OwlSpot, OwlItem)]
x      ->  (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ [(REltId, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newElts [(REltId, OwlSpot, OwlItem)]
x OwlPFState
s
    OwlPFCDeleteElts [(REltId, OwlSpot, OwlItem)]
x   ->  (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ [(REltId, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteElts [(REltId, OwlSpot, OwlItem)]
x OwlPFState
s

    OwlPFCNewTree (OwlTree, OwlSpot)
x      -> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (OwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newMiniOwlTree (OwlTree, OwlSpot)
x OwlPFState
s
    OwlPFCDeleteTree (OwlTree, OwlSpot)
x   -> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (OwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteMiniOwlTree (OwlTree, OwlSpot)
x OwlPFState
s

    OwlPFCManipulate ControllersWithId
x   -> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_manipulate ControllersWithId
x OwlPFState
s

    OwlPFCMove (OwlSpot, SuperOwlParliament)
x         -> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
(OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
(OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_move (OwlSpot, SuperOwlParliament)
x OwlPFState
s
    OwlPFCResizeCanvas DeltaLBox
x -> if DeltaLBox -> OwlPFState -> Bool
validateCanvasSizeOperation (DeltaLBox -> DeltaLBox
deltaLBox_invert DeltaLBox
x) OwlPFState
s 
      then (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ (DeltaLBox -> OwlPFState -> OwlPFState
undo_resizeCanvas DeltaLBox
x OwlPFState
s, SuperOwlChanges
forall a. IntMap a
IM.empty)
      else ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. a -> Either a b
Left (ApplyLlamaError
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges))
-> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. (a -> b) -> a -> b
$ Text -> ApplyLlamaError
ApplyLLamaError_Soft (Text -> ApplyLlamaError) -> Text -> ApplyLlamaError
forall a b. (a -> b) -> a -> b
$ Text
"Invalid canvas size operation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DeltaLBox -> Text
forall b a. (Show a, IsString b) => a -> b
show DeltaLBox
x

  r :: Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r = case Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r' of
    Right (OwlPFState
newState, SuperOwlChanges
changes) -> Bool
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a. HasCallStack => Bool -> a -> a
assert (OwlPFState -> Bool
owlPFState_isValid OwlPFState
newState) Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
r'
    Left ApplyLlamaError
e                    -> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
forall a b. a -> Either a b
Left ApplyLlamaError
e




data SLlama =
  SLlama_Set [(REltId, SElt)]
  | SLlama_Rename (REltId, Text)
  | SLlama_Compose [SLlama]
  | SLlama_OwlPFCmd OwlPFCmd Bool
  deriving (REltId -> SLlama -> ShowS
[SLlama] -> ShowS
SLlama -> String
(REltId -> SLlama -> ShowS)
-> (SLlama -> String) -> ([SLlama] -> ShowS) -> Show SLlama
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: REltId -> SLlama -> ShowS
showsPrec :: REltId -> SLlama -> ShowS
$cshow :: SLlama -> String
show :: SLlama -> String
$cshowList :: [SLlama] -> ShowS
showList :: [SLlama] -> ShowS
Show, (forall x. SLlama -> Rep SLlama x)
-> (forall x. Rep SLlama x -> SLlama) -> Generic SLlama
forall x. Rep SLlama x -> SLlama
forall x. SLlama -> Rep SLlama x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SLlama -> Rep SLlama x
from :: forall x. SLlama -> Rep SLlama x
$cto :: forall x. Rep SLlama x -> SLlama
to :: forall x. Rep SLlama x -> SLlama
Generic)

instance NFData SLlama

data ApplyLlamaError = ApplyLlamaError_Fatal Text | ApplyLLamaError_Soft Text deriving (REltId -> ApplyLlamaError -> ShowS
[ApplyLlamaError] -> ShowS
ApplyLlamaError -> String
(REltId -> ApplyLlamaError -> ShowS)
-> (ApplyLlamaError -> String)
-> ([ApplyLlamaError] -> ShowS)
-> Show ApplyLlamaError
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: REltId -> ApplyLlamaError -> ShowS
showsPrec :: REltId -> ApplyLlamaError -> ShowS
$cshow :: ApplyLlamaError -> String
show :: ApplyLlamaError -> String
$cshowList :: [ApplyLlamaError] -> ShowS
showList :: [ApplyLlamaError] -> ShowS
Show)

data Llama = Llama {
  Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply :: OwlPFState -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
  , Llama -> SLlama
_llama_serialize :: SLlama
  , Llama -> Text
_llama_describe :: Text
} deriving ((forall x. Llama -> Rep Llama x)
-> (forall x. Rep Llama x -> Llama) -> Generic Llama
forall x. Rep Llama x -> Llama
forall x. Llama -> Rep Llama x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Llama -> Rep Llama x
from :: forall x. Llama -> Rep Llama x
$cto :: forall x. Rep Llama x -> Llama
to :: forall x. Rep Llama x -> Llama
Generic)

instance NFData Llama

instance Show Llama where
  show :: Llama -> String
show = SLlama -> String
forall b a. (Show a, IsString b) => a -> b
show (SLlama -> String) -> (Llama -> SLlama) -> Llama -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Llama -> SLlama
_llama_serialize

data LlamaStack = LlamaStack {
  LlamaStack -> [Llama]
_llamaStack_done        :: [Llama] -- stuff we've done, applying these Llamas will *undo* the operation that put them on the stack!
  , LlamaStack -> [Llama]
_llamaStack_undone    :: [Llama] -- stuff we've undone, applying these Llamas will *redo* the operation that put them on the stack!
  , LlamaStack -> Maybe REltId
_llamaStack_lastSaved :: Maybe Int -- size of do stacks on last save
} deriving (REltId -> LlamaStack -> ShowS
[LlamaStack] -> ShowS
LlamaStack -> String
(REltId -> LlamaStack -> ShowS)
-> (LlamaStack -> String)
-> ([LlamaStack] -> ShowS)
-> Show LlamaStack
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: REltId -> LlamaStack -> ShowS
showsPrec :: REltId -> LlamaStack -> ShowS
$cshow :: LlamaStack -> String
show :: LlamaStack -> String
$cshowList :: [LlamaStack] -> ShowS
showList :: [LlamaStack] -> ShowS
Show, (forall x. LlamaStack -> Rep LlamaStack x)
-> (forall x. Rep LlamaStack x -> LlamaStack) -> Generic LlamaStack
forall x. Rep LlamaStack x -> LlamaStack
forall x. LlamaStack -> Rep LlamaStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LlamaStack -> Rep LlamaStack x
from :: forall x. LlamaStack -> Rep LlamaStack x
$cto :: forall x. Rep LlamaStack x -> LlamaStack
to :: forall x. Rep LlamaStack x -> LlamaStack
Generic)

instance NFData LlamaStack

emptyLlamaStack :: LlamaStack
emptyLlamaStack :: LlamaStack
emptyLlamaStack = [Llama] -> [Llama] -> Maybe REltId -> LlamaStack
LlamaStack [] [] (REltId -> Maybe REltId
forall a. a -> Maybe a
Just REltId
0)


-- UNTESTED
llamaStack_hasUnsavedChanges :: LlamaStack -> Bool
llamaStack_hasUnsavedChanges :: LlamaStack -> Bool
llamaStack_hasUnsavedChanges LlamaStack {[Llama]
Maybe REltId
_llamaStack_done :: LlamaStack -> [Llama]
_llamaStack_undone :: LlamaStack -> [Llama]
_llamaStack_lastSaved :: LlamaStack -> Maybe REltId
_llamaStack_done :: [Llama]
_llamaStack_undone :: [Llama]
_llamaStack_lastSaved :: Maybe REltId
..} = case Maybe REltId
_llamaStack_lastSaved of
  Maybe REltId
Nothing -> Bool
True
  Just REltId
x  -> REltId
x REltId -> REltId -> Bool
forall a. Eq a => a -> a -> Bool
/= [Llama] -> REltId
forall a. [a] -> REltId
forall (t :: * -> *) a. Foldable t => t a -> REltId
length [Llama]
_llamaStack_done

makeRenameLlama :: (REltId, Text) -> Llama
makeRenameLlama :: (REltId, Text) -> Llama
makeRenameLlama (REltId
rid, Text
newname) = Llama
r where

  apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply OwlPFState
pfs = let
      mapping :: OwlMapping
mapping = OwlTree -> OwlMapping
_owlTree_mapping (OwlTree -> OwlMapping)
-> (OwlPFState -> OwlTree) -> OwlPFState -> OwlMapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> OwlMapping) -> OwlPFState -> OwlMapping
forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs
    in case REltId -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid OwlMapping
mapping of
        Maybe (OwlItemMeta, OwlItem)
Nothing -> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. a -> Either a b
Left (ApplyLlamaError
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama))
-> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ Text -> ApplyLlamaError
ApplyLlamaError_Fatal (Text -> ApplyLlamaError) -> Text -> ApplyLlamaError
forall a b. (a -> b) -> a -> b
$ Text
"Element to rename does not exist " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> REltId -> Text
forall b a. (Show a, IsString b) => a -> b
show REltId
rid
        Just (OwlItemMeta
oldoem, OwlItem
oldoitem) -> let
            (OwlItem
newoitem, Text
oldname) = (OwlItem -> Text -> OwlItem
owlItem_setName OwlItem
oldoitem Text
newname, OwlItem -> Text
owlItem_name OwlItem
oldoitem)
            newsowl :: SuperOwl
newsowl = REltId -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl REltId
rid OwlItemMeta
oldoem OwlItem
newoitem
            newMapping :: OwlMapping
newMapping = REltId -> (OwlItemMeta, OwlItem) -> OwlMapping -> OwlMapping
forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid (OwlItemMeta
oldoem, OwlItem
newoitem) OwlMapping
mapping
            changes :: SuperOwlChanges
changes = REltId -> Maybe SuperOwl -> SuperOwlChanges
forall a. REltId -> a -> IntMap a
IM.singleton REltId
rid (SuperOwl -> Maybe SuperOwl
forall a. a -> Maybe a
Just SuperOwl
newsowl)
            unset :: Llama
unset = (REltId, Text) -> Llama
makeRenameLlama (REltId
rid, Text
oldname)
            newState :: OwlPFState
newState = OwlPFState
pfs { _owlPFState_owlTree = (_owlPFState_owlTree pfs) { _owlTree_mapping = newMapping } }
          in
            (OwlPFState, SuperOwlChanges, Llama)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges, Llama)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama))
-> (OwlPFState, SuperOwlChanges, Llama)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ (OwlPFState
newState, SuperOwlChanges
changes, Llama
unset)


  serialize :: SLlama
serialize = (REltId, Text) -> SLlama
SLlama_Rename (REltId
rid, Text
newname)
  r :: Llama
r = Llama {
      _llama_apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply = OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply
      , _llama_serialize :: SLlama
_llama_serialize = SLlama
serialize
      , _llama_describe :: Text
_llama_describe = Text
"rename " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> REltId -> Text
forall b a. (Show a, IsString b) => a -> b
show REltId
rid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newname
    }

makeSetLlama :: (REltId, SElt) -> Llama
makeSetLlama :: (REltId, SElt) -> Llama
makeSetLlama (REltId
rid, SElt
selt) = Llama
r where
  apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply OwlPFState
pfs = let
      mapping :: OwlMapping
mapping = OwlTree -> OwlMapping
_owlTree_mapping (OwlTree -> OwlMapping)
-> (OwlPFState -> OwlTree) -> OwlPFState -> OwlMapping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> OwlMapping) -> OwlPFState -> OwlMapping
forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs
    in case REltId -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid OwlMapping
mapping of
        Maybe (OwlItemMeta, OwlItem)
Nothing -> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. a -> Either a b
Left (ApplyLlamaError
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama))
-> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ Text -> ApplyLlamaError
ApplyLlamaError_Fatal (Text -> ApplyLlamaError) -> Text -> ApplyLlamaError
forall a b. (a -> b) -> a -> b
$ Text
"Element to modify does not exist " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> REltId -> Text
forall b a. (Show a, IsString b) => a -> b
show REltId
rid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OwlTree -> Text
forall a. PotatoShow a => a -> Text
potatoShow (OwlPFState -> OwlTree
_owlPFState_owlTree (OwlPFState -> OwlTree) -> OwlPFState -> OwlTree
forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs)
        Just (OwlItemMeta
_, OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
_)) -> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. a -> Either a b
Left (ApplyLlamaError
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama))
-> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ Text -> ApplyLlamaError
ApplyLlamaError_Fatal (Text -> ApplyLlamaError) -> Text -> ApplyLlamaError
forall a b. (a -> b) -> a -> b
$ Text
"Element to modify is a folder " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> REltId -> Text
forall b a. (Show a, IsString b) => a -> b
show REltId
rid
        Just (OwlItemMeta
oldoem, OwlItem OwlInfo
oinfo OwlSubItem
oldsubitem) -> let
            -- this will clear the cache in OwlItem
            newoitem :: OwlItem
newoitem = OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (OwlSubItem -> OwlItem) -> OwlSubItem -> OwlItem
forall a b. (a -> b) -> a -> b
$ SElt -> OwlSubItem
sElt_to_owlSubItem SElt
selt
            newsowl :: SuperOwl
newsowl = REltId -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl REltId
rid OwlItemMeta
oldoem OwlItem
newoitem
            newMapping :: OwlMapping
newMapping = REltId -> (OwlItemMeta, OwlItem) -> OwlMapping -> OwlMapping
forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid (OwlItemMeta
oldoem, OwlItem
newoitem) OwlMapping
mapping
            changes :: SuperOwlChanges
changes = REltId -> Maybe SuperOwl -> SuperOwlChanges
forall a. REltId -> a -> IntMap a
IM.singleton REltId
rid (SuperOwl -> Maybe SuperOwl
forall a. a -> Maybe a
Just SuperOwl
newsowl)
            unset :: Llama
unset = (REltId, SElt) -> Llama
makeSetLlama (REltId
rid, OwlSubItem -> SElt
owlSubItem_to_sElt_hack OwlSubItem
oldsubitem)
            newState :: OwlPFState
newState = OwlPFState
pfs { _owlPFState_owlTree = (_owlPFState_owlTree pfs) { _owlTree_mapping = newMapping } }
          in
            (OwlPFState, SuperOwlChanges, Llama)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges, Llama)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama))
-> (OwlPFState, SuperOwlChanges, Llama)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ (OwlPFState
newState, SuperOwlChanges
changes, Llama
unset)


  serialize :: SLlama
serialize = [(REltId, SElt)] -> SLlama
SLlama_Set [(REltId
rid, SElt
selt)]
  r :: Llama
r = Llama {
      _llama_apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply = OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply
      , _llama_serialize :: SLlama
_llama_serialize = SLlama
serialize
      , _llama_describe :: Text
_llama_describe = Text
"set " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> REltId -> Text
forall b a. (Show a, IsString b) => a -> b
show REltId
rid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SElt -> Text
forall b a. (Show a, IsString b) => a -> b
show SElt
selt
    }


makePFCLlama' :: Bool -> OwlPFCmd -> Llama
makePFCLlama' :: Bool -> OwlPFCmd -> Llama
makePFCLlama' Bool
isDo OwlPFCmd
cmd = Llama
r where
  apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply OwlPFState
pfs = let
      unset :: Llama
unset = Bool -> OwlPFCmd -> Llama
makePFCLlama' (Bool -> Bool
not Bool
isDo) OwlPFCmd
cmd
    in case (if Bool
isDo then OwlPFCmd
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
doCmdState OwlPFCmd
cmd OwlPFState
pfs else OwlPFCmd
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)
undoCmdState OwlPFCmd
cmd OwlPFState
pfs) of
      Right (OwlPFState
newState, SuperOwlChanges
changes) -> (OwlPFState, SuperOwlChanges, Llama)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. b -> Either a b
Right ((OwlPFState, SuperOwlChanges, Llama)
 -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama))
-> (OwlPFState, SuperOwlChanges, Llama)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. (a -> b) -> a -> b
$ (OwlPFState
newState, SuperOwlChanges
changes, Llama
unset)
      Left ApplyLlamaError
e -> ApplyLlamaError
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. a -> Either a b
Left ApplyLlamaError
e


        
  serialize :: SLlama
serialize = OwlPFCmd -> Bool -> SLlama
SLlama_OwlPFCmd OwlPFCmd
cmd Bool
isDo
  r :: Llama
r = Llama {
      _llama_apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply = OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply
      , _llama_serialize :: SLlama
_llama_serialize = SLlama
serialize
      , _llama_describe :: Text
_llama_describe = Text
"PFC " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OwlPFCmd -> Text
forall b a. (Show a, IsString b) => a -> b
show OwlPFCmd
cmd
    }

makePFCLlama :: OwlPFCmd -> Llama
makePFCLlama :: OwlPFCmd -> Llama
makePFCLlama = Bool -> OwlPFCmd -> Llama
makePFCLlama' Bool
True

-- UNTESTED
makeCompositionLlama :: [Llama] -> Llama
makeCompositionLlama :: [Llama] -> Llama
makeCompositionLlama [Llama]
llamas = Llama
r where

  apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply OwlPFState
pfs = [Llama]
-> (OwlPFState, SuperOwlChanges, [Llama])
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
go [Llama]
llamas (OwlPFState
pfs, SuperOwlChanges
forall a. IntMap a
IM.empty, []) where
    go :: [Llama]
-> (OwlPFState, SuperOwlChanges, [Llama])
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
go [] (OwlPFState
state, SuperOwlChanges
changes, [Llama]
undollamas) = (OwlPFState, SuperOwlChanges, Llama)
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
forall a b. b -> Either a b
Right (OwlPFState
state, SuperOwlChanges
changes, [Llama] -> Llama
makeCompositionLlama [Llama]
undollamas)
    go (Llama
llama:[Llama]
rest) (OwlPFState
state, SuperOwlChanges
changes, [Llama]
undollamas) = case Llama
-> OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply Llama
llama OwlPFState
state of
      Right (OwlPFState
newstate, SuperOwlChanges
newchanges, Llama
newundollama) -> [Llama]
-> (OwlPFState, SuperOwlChanges, [Llama])
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
go [Llama]
rest (OwlPFState
newstate, SuperOwlChanges -> SuperOwlChanges -> SuperOwlChanges
forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
newchanges SuperOwlChanges
changes, Llama
newundollamaLlama -> [Llama] -> [Llama]
forall a. a -> [a] -> [a]
:[Llama]
undollamas)
      Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
e -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
e


  serialize :: SLlama
serialize = [SLlama] -> SLlama
SLlama_Compose ([SLlama] -> SLlama) -> [SLlama] -> SLlama
forall a b. (a -> b) -> a -> b
$ (Llama -> SLlama) -> [Llama] -> [SLlama]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Llama -> SLlama
_llama_serialize [Llama]
llamas
  r :: Llama
r = Llama {
      _llama_apply :: OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
_llama_apply = OwlPFState
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
apply
      , _llama_serialize :: SLlama
_llama_serialize = SLlama
serialize
      , _llama_describe :: Text
_llama_describe = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Llama -> Text) -> [Llama] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Llama -> Text
_llama_describe [Llama]
llamas
    }


sLlama_deserialize :: OwlPFState -> SLlama -> Llama
sLlama_deserialize :: OwlPFState -> SLlama -> Llama
sLlama_deserialize OwlPFState
pfs SLlama
sllama = case SLlama
sllama of
  SLlama_Set [(REltId, SElt)]
pairs -> [Llama] -> Llama
makeCompositionLlama (((REltId, SElt) -> Llama) -> [(REltId, SElt)] -> [Llama]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (REltId, SElt) -> Llama
makeSetLlama [(REltId, SElt)]
pairs)
  SLlama_Rename (REltId, Text)
x -> (REltId, Text) -> Llama
makeRenameLlama (REltId, Text)
x
  SLlama_Compose [SLlama]
x -> [Llama] -> Llama
makeCompositionLlama ([Llama] -> Llama) -> [Llama] -> Llama
forall a b. (a -> b) -> a -> b
$ (SLlama -> Llama) -> [SLlama] -> [Llama]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlPFState -> SLlama -> Llama
sLlama_deserialize OwlPFState
pfs) [SLlama]
x
  SLlama_OwlPFCmd OwlPFCmd
pfc Bool
isDo -> Bool -> OwlPFCmd -> Llama
makePFCLlama' Bool
isDo OwlPFCmd
pfc