{-# 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.SElts
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 (Int -> OwlPFCmd -> ShowS
[OwlPFCmd] -> ShowS
OwlPFCmd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlPFCmd] -> ShowS
$cshowList :: [OwlPFCmd] -> ShowS
show :: OwlPFCmd -> String
$cshow :: OwlPFCmd -> String
showsPrec :: Int -> OwlPFCmd -> ShowS
$cshowsPrec :: Int -> OwlPFCmd -> ShowS
Show, 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
$cto :: forall x. Rep OwlPFCmd x -> OwlPFCmd
$cfrom :: forall x. OwlPFCmd -> Rep OwlPFCmd x
Generic)

instance NFData OwlPFCmd

doCmdState :: OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)
doCmdState :: OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)
doCmdState OwlPFCmd
cmd OwlPFState
s = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (OwlPFState -> Bool
owlPFState_isValid OwlPFState
newState) (OwlPFState
newState, SuperOwlChanges
changes) where
  (OwlPFState
newState, SuperOwlChanges
changes) = case OwlPFCmd
cmd of

    OwlPFCNewElts [(Int, OwlSpot, OwlItem)]
x      ->  [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newElts [(Int, OwlSpot, OwlItem)]
x OwlPFState
s
    OwlPFCDeleteElts [(Int, OwlSpot, OwlItem)]
x   ->  [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteElts [(Int, OwlSpot, OwlItem)]
x OwlPFState
s

    OwlPFCNewTree (MiniOwlTree, OwlSpot)
x      -> (MiniOwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newMiniOwlTree (MiniOwlTree, OwlSpot)
x OwlPFState
s
    OwlPFCDeleteTree (MiniOwlTree, OwlSpot)
x   -> (MiniOwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteMiniOwlTree (MiniOwlTree, OwlSpot)
x OwlPFState
s

    OwlPFCManipulate ControllersWithId
x   ->  ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_manipulate ControllersWithId
x OwlPFState
s

    OwlPFCMove (OwlSpot, SuperOwlParliament)
x         -> (OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_move (OwlSpot, SuperOwlParliament)
x OwlPFState
s
    OwlPFCResizeCanvas DeltaLBox
x -> (DeltaLBox -> OwlPFState -> OwlPFState
do_resizeCanvas DeltaLBox
x OwlPFState
s, forall a. IntMap a
IM.empty)

undoCmdState :: OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undoCmdState :: OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undoCmdState OwlPFCmd
cmd OwlPFState
s = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (OwlPFState -> Bool
owlPFState_isValid OwlPFState
newState) (OwlPFState
newState, SuperOwlChanges
changes) where
  (OwlPFState
newState, SuperOwlChanges
changes) =  case OwlPFCmd
cmd of

    OwlPFCNewElts [(Int, OwlSpot, OwlItem)]
x      ->  [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newElts [(Int, OwlSpot, OwlItem)]
x OwlPFState
s
    OwlPFCDeleteElts [(Int, OwlSpot, OwlItem)]
x   ->  [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteElts [(Int, OwlSpot, OwlItem)]
x OwlPFState
s

    OwlPFCNewTree (MiniOwlTree, OwlSpot)
x      -> (MiniOwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newMiniOwlTree (MiniOwlTree, OwlSpot)
x OwlPFState
s
    OwlPFCDeleteTree (MiniOwlTree, OwlSpot)
x   -> (MiniOwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteMiniOwlTree (MiniOwlTree, OwlSpot)
x OwlPFState
s

    OwlPFCManipulate ControllersWithId
x   ->  ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_manipulate ControllersWithId
x OwlPFState
s

    OwlPFCMove (OwlSpot, SuperOwlParliament)
x         -> (OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_move (OwlSpot, SuperOwlParliament)
x OwlPFState
s
    OwlPFCResizeCanvas DeltaLBox
x -> (DeltaLBox -> OwlPFState -> OwlPFState
undo_resizeCanvas DeltaLBox
x OwlPFState
s, forall a. IntMap a
IM.empty)



data SLlama =
  SLlama_Set [(REltId, SElt)]
  | SLlama_Rename (REltId, Text)
  | SLlama_Compose [SLlama]
  -- TODO OwlItem contains caches which we don't want to so serialize with Llama so ideally there should be a mirrored type to remove the cache, should be able to use SElt equivalents here instead?
  | SLlama_OwlPFCmd OwlPFCmd Bool
  deriving (Int -> SLlama -> ShowS
[SLlama] -> ShowS
SLlama -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SLlama] -> ShowS
$cshowList :: [SLlama] -> ShowS
show :: SLlama -> String
$cshow :: SLlama -> String
showsPrec :: Int -> SLlama -> ShowS
$cshowsPrec :: Int -> SLlama -> ShowS
Show, 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
$cto :: forall x. Rep SLlama x -> SLlama
$cfrom :: forall x. SLlama -> Rep SLlama x
Generic)

instance NFData SLlama

data ApplyLlamaError = ApplyLlamaError_Generic Text deriving (Int -> ApplyLlamaError -> ShowS
[ApplyLlamaError] -> ShowS
ApplyLlamaError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyLlamaError] -> ShowS
$cshowList :: [ApplyLlamaError] -> ShowS
show :: ApplyLlamaError -> String
$cshow :: ApplyLlamaError -> String
showsPrec :: Int -> ApplyLlamaError -> ShowS
$cshowsPrec :: Int -> 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. 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
$cto :: forall x. Rep Llama x -> Llama
$cfrom :: forall x. Llama -> Rep Llama x
Generic)

instance NFData Llama

instance Show Llama where
  show :: Llama -> String
show = forall b a. (Show a, IsString b) => a -> b
show 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 Int
_llamaStack_lastSaved :: Maybe Int -- size of do stacks on last save
} deriving (Int -> LlamaStack -> ShowS
[LlamaStack] -> ShowS
LlamaStack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LlamaStack] -> ShowS
$cshowList :: [LlamaStack] -> ShowS
show :: LlamaStack -> String
$cshow :: LlamaStack -> String
showsPrec :: Int -> LlamaStack -> ShowS
$cshowsPrec :: Int -> LlamaStack -> ShowS
Show, 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
$cto :: forall x. Rep LlamaStack x -> LlamaStack
$cfrom :: forall x. LlamaStack -> Rep LlamaStack x
Generic)

instance NFData LlamaStack

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


-- UNTESTED
llamaStack_hasUnsavedChanges :: LlamaStack -> Bool
llamaStack_hasUnsavedChanges :: LlamaStack -> Bool
llamaStack_hasUnsavedChanges 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]
..} = case Maybe Int
_llamaStack_lastSaved of
  Maybe Int
Nothing -> Bool
True
  Just Int
x  -> Int
x forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Llama]
_llamaStack_done

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

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


  serialize :: SLlama
serialize = (Int, Text) -> SLlama
SLlama_Rename (Int
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 " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
rid forall a. Semigroup a => a -> a -> a
<> Text
" to " forall a. Semigroup a => a -> a -> a
<> Text
newname
    }

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


  serialize :: SLlama
serialize = [(Int, SElt)] -> SLlama
SLlama_Set [(Int
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 " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
rid forall a. Semigroup a => a -> a -> a
<> Text
" to " forall a. Semigroup a => a -> a -> a
<> 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
      (OwlPFState
newState, SuperOwlChanges
changes) = if Bool
isDo then OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)
doCmdState OwlPFCmd
cmd OwlPFState
pfs else OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undoCmdState OwlPFCmd
cmd OwlPFState
pfs
    in forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (OwlPFState
newState, SuperOwlChanges
changes, Llama
unset)

  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 " forall a. Semigroup a => a -> a -> a
<> 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, forall a. IntMap a
IM.empty, []) where
    go :: [Llama]
-> (OwlPFState, SuperOwlChanges, [Llama])
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
go [] (OwlPFState
state, SuperOwlChanges
changes, [Llama]
undollamas) = 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 newoutput :: (OwlPFState, SuperOwlChanges, Llama)
newoutput@(OwlPFState
newstate, SuperOwlChanges
newchanges, Llama
newundollama) -> [Llama]
-> (OwlPFState, SuperOwlChanges, [Llama])
-> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)
go [Llama]
rest (OwlPFState
newstate, forall a. IntMap a -> IntMap a -> IntMap a
IM.union SuperOwlChanges
newchanges SuperOwlChanges
changes, Llama
newundollamaforall 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 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 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 [(Int, SElt)]
pairs -> [Llama] -> Llama
makeCompositionLlama (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, SElt) -> Llama
makeSetLlama [(Int, SElt)]
pairs)
  SLlama_Rename (Int, Text)
x -> (Int, Text) -> Llama
makeRenameLlama (Int, Text)
x
  SLlama_Compose [SLlama]
x -> [Llama] -> Llama
makeCompositionLlama 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