{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.OwlState where

import           Relude

import Potato.Flow.Owl
import Potato.Flow.Attachments
import Potato.Flow.OwlItem
import           Potato.Flow.Math
import           Potato.Flow.SElts
import           Potato.Flow.SEltMethods
import           Potato.Flow.Types
import Potato.Flow.DebugHelpers

import           Control.Exception       (assert)
import qualified Data.IntMap.Strict      as IM
import           Data.List.Ordered       (isSortedBy)
import           Data.Maybe
import qualified Data.Text as T



-- prob not the best place for these...
maybeGetAttachmentPosition :: (HasCallStack) => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition :: HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetBorder OwlPFState
pfs Attachment
a = do
  SuperOwl
target <- forall o. HasOwlTree o => o -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl OwlPFState
pfs (Attachment -> Int
_attachment_target Attachment
a)
  return $ case forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem SuperOwl
target of
    OwlItem OwlInfo
_ (OwlSubItemBox SBox
sbox) -> Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox Bool
offsetBorder (SBox -> LBox
_sBox_box SBox
sbox, Attachment -> AttachmentLocation
_attachment_location Attachment
a, Attachment -> AttachmentOffsetRatio
_attachment_offset_rel Attachment
a)
    OwlItem
x -> forall a t. (HasCallStack, IsText t) => t -> a
error (Text
"expecteed OwlSubItemBox, got: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show OwlItem
x)

maybeGetAttachmentBox :: Bool -> OwlPFState -> Attachment -> Maybe LBox
maybeGetAttachmentBox :: Bool -> OwlPFState -> Attachment -> Maybe LBox
maybeGetAttachmentBox Bool
offsetBorder OwlPFState
pfs Attachment
a = do
  SuperOwl
target <- forall o. HasOwlTree o => o -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl OwlPFState
pfs (Attachment -> Int
_attachment_target Attachment
a)
  return $ case forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem SuperOwl
target of
    OwlItem OwlInfo
_ (OwlSubItemBox SBox
sbox) -> if Bool
offsetBorder then LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand (SBox -> LBox
_sBox_box SBox
sbox) (Int
1,Int
1,Int
1,Int
1) else SBox -> LBox
_sBox_box SBox
sbox
    OwlItem
x -> forall a t. (HasCallStack, IsText t) => t -> a
error (Text
"expecteed OwlSubItemBox, got: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show OwlItem
x)

maybeLookupAttachment :: (HasCallStack) => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment :: HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
matt = HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetBorder OwlPFState
pfs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
matt



-- TODO rename
data OwlPFState = OwlPFState {
  OwlPFState -> OwlTree
_owlPFState_owlTree :: OwlTree
  , OwlPFState -> SCanvas
_owlPFState_canvas    :: SCanvas
} deriving (Int -> OwlPFState -> ShowS
[OwlPFState] -> ShowS
OwlPFState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlPFState] -> ShowS
$cshowList :: [OwlPFState] -> ShowS
show :: OwlPFState -> String
$cshow :: OwlPFState -> String
showsPrec :: Int -> OwlPFState -> ShowS
$cshowsPrec :: Int -> OwlPFState -> ShowS
Show, OwlPFState -> OwlPFState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OwlPFState -> OwlPFState -> Bool
$c/= :: OwlPFState -> OwlPFState -> Bool
== :: OwlPFState -> OwlPFState -> Bool
$c== :: OwlPFState -> OwlPFState -> Bool
Eq, forall x. Rep OwlPFState x -> OwlPFState
forall x. OwlPFState -> Rep OwlPFState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwlPFState x -> OwlPFState
$cfrom :: forall x. OwlPFState -> Rep OwlPFState x
Generic)

instance HasOwlTree OwlPFState where
  hasOwlTree_owlTree :: OwlPFState -> OwlTree
hasOwlTree_owlTree = OwlPFState -> OwlTree
_owlPFState_owlTree

-- TODO delete replace with PotatoShow
owlPFState_prettyPrintForDebugging :: OwlPFState -> Text
owlPFState_prettyPrintForDebugging :: OwlPFState -> Text
owlPFState_prettyPrintForDebugging OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. PotatoShow a => a -> Text
potatoShow OwlTree
_owlPFState_owlTree forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SCanvas
_owlPFState_canvas

instance PotatoShow OwlPFState where
  potatoShow :: OwlPFState -> Text
potatoShow = OwlPFState -> Text
owlPFState_prettyPrintForDebugging

instance NFData OwlPFState

owlPFState_nextId :: OwlPFState -> REltId
owlPFState_nextId :: OwlPFState -> Int
owlPFState_nextId OwlPFState
pfs = (forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> Int
owlTree_maxId forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs

owlPFState_lastId :: OwlPFState -> REltId
owlPFState_lastId :: OwlPFState -> Int
owlPFState_lastId OwlPFState
pfs = OwlTree -> Int
owlTree_maxId forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs

owlPFState_numElts :: OwlPFState -> Int
owlPFState_numElts :: OwlPFState -> Int
owlPFState_numElts OwlPFState
pfs = forall a. IntMap a -> Int
IM.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

-- TODO DELETE replace with potatoShow
debugPrintOwlPFState :: (IsString a) => OwlPFState -> a
debugPrintOwlPFState :: forall a. IsString a => OwlPFState -> a
debugPrintOwlPFState OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. PotatoShow a => a -> Text
potatoShow OwlTree
_owlPFState_owlTree

-- TODO owlPFState_selectionIsValid pfs OwlParliament $ Seq.fromList [0..Seq.length _owlPFState_layers - 1]
owlPFState_isValid :: OwlPFState -> Bool
owlPFState_isValid :: OwlPFState -> Bool
owlPFState_isValid OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = Bool
True

owlPFState_selectionIsValid :: OwlPFState -> OwlParliament -> Bool
owlPFState_selectionIsValid :: OwlPFState -> OwlParliament -> Bool
owlPFState_selectionIsValid OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} (OwlParliament Seq Int
op) = Bool
validElts where
  OwlTree {IntMap (OwlItemMeta, OwlItem)
Seq Int
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_topOwls :: Seq Int
_owlTree_mapping :: IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping :: OwlTree -> IntMap (OwlItemMeta, OwlItem)
..} = OwlTree
_owlPFState_owlTree
  validElts :: Bool
validElts = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IntMap a -> Int -> Maybe a
(IM.!?) IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping) Seq Int
op

-- TODO replace with superOwlParliament_toSEltTree
owlPFState_copyElts :: OwlPFState -> OwlParliament -> [SEltLabel]
owlPFState_copyElts :: OwlPFState -> OwlParliament -> [SEltLabel]
owlPFState_copyElts OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} OwlParliament
op = [SEltLabel]
r where
  sop :: SuperOwlParliament
sop = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
_owlPFState_owlTree OwlParliament
op
  r :: [SEltLabel]
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ OwlTree -> SuperOwlParliament -> SEltTree
superOwlParliament_toSEltTree OwlTree
_owlPFState_owlTree SuperOwlParliament
sop

-- TODO replace with owlTree_findSuperOwl
owlPFState_getSuperOwls :: OwlPFState -> [REltId] -> REltIdMap (Maybe SuperOwl)
owlPFState_getSuperOwls :: OwlPFState -> [Int] -> REltIdMap (Maybe SuperOwl)
owlPFState_getSuperOwls OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} [Int]
rids = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
rid REltIdMap (Maybe SuperOwl)
acc -> forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid (OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
_owlPFState_owlTree Int
rid) REltIdMap (Maybe SuperOwl)
acc) forall a. IntMap a
IM.empty [Int]
rids

emptyOwlPFState :: OwlPFState
emptyOwlPFState :: OwlPFState
emptyOwlPFState = OwlTree -> SCanvas -> OwlPFState
OwlPFState OwlTree
emptyOwlTree (LBox -> SCanvas
SCanvas (XY -> XY -> LBox
LBox XY
0 XY
1))

sPotatoFlow_to_owlPFState :: SPotatoFlow -> OwlPFState
sPotatoFlow_to_owlPFState :: SPotatoFlow -> OwlPFState
sPotatoFlow_to_owlPFState SPotatoFlow {SEltTree
SCanvas
_sPotatoFlow_sEltTree :: SPotatoFlow -> SEltTree
_sPotatoFlow_sCanvas :: SPotatoFlow -> SCanvas
_sPotatoFlow_sEltTree :: SEltTree
_sPotatoFlow_sCanvas :: SCanvas
..} = OwlPFState
r where
  r :: OwlPFState
r = OwlTree -> SCanvas -> OwlPFState
OwlPFState (SEltTree -> OwlTree
owlTree_fromSEltTree SEltTree
_sPotatoFlow_sEltTree) SCanvas
_sPotatoFlow_sCanvas

owlPFState_to_sPotatoFlow :: OwlPFState -> SPotatoFlow
owlPFState_to_sPotatoFlow :: OwlPFState -> SPotatoFlow
owlPFState_to_sPotatoFlow OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = SPotatoFlow
r where
  selttree :: SEltTree
selttree = OwlTree -> SEltTree
owlTree_toSEltTree OwlTree
_owlPFState_owlTree
  r :: SPotatoFlow
r = SCanvas -> SEltTree -> SPotatoFlow
SPotatoFlow SCanvas
_owlPFState_canvas SEltTree
selttree

owlPFState_toCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_toCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_toCanvasCoordinates OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} (V2 Int
x Int
y) = forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
-Int
sx) (Int
yforall a. Num a => a -> a -> a
-Int
sy) where
  LBox (V2 Int
sx Int
sy) XY
_ = SCanvas -> LBox
_sCanvas_box SCanvas
_owlPFState_canvas

owlPFState_fromCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_fromCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_fromCanvasCoordinates OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} (V2 Int
x Int
y) = forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
+Int
sx) (Int
yforall a. Num a => a -> a -> a
+Int
sy) where
  LBox (V2 Int
sx Int
sy) XY
_ = SCanvas -> LBox
_sCanvas_box SCanvas
_owlPFState_canvas

owlPFState_to_SuperOwlParliament :: OwlPFState -> SuperOwlParliament
owlPFState_to_SuperOwlParliament :: OwlPFState -> SuperOwlParliament
owlPFState_to_SuperOwlParliament OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ Seq Int -> OwlParliament
OwlParliament forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq Int
_owlTree_topOwls OwlTree
_owlPFState_owlTree

do_newElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newElts [(Int, OwlSpot, OwlItem)]
seltls pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where

  -- parents are allowed, but seltls must be sortefd from left -> right such that leftmost sibling/parent of OwlSpot exists (assuming elts are added to the tree from left to right)
  (OwlTree
newot, [SuperOwl]
changes') = [(Int, OwlSpot, OwlItem)] -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItemList [(Int, OwlSpot, OwlItem)]
seltls OwlTree
_owlPFState_owlTree

  changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) [SuperOwl]
changes'
  r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)

undo_newElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newElts [(Int, OwlSpot, OwlItem)]
seltls pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
  foldfn :: (Int, b, c) -> OwlTree -> OwlTree
foldfn (Int
rid,b
_,c
_) OwlTree
od = Int -> OwlTree -> OwlTree
owlTree_removeREltId Int
rid OwlTree
od
  -- assumes seltls sorted from left to right so that no parent is deleted before its child
  newot :: OwlTree
newot = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b} {c}. (Int, b, c) -> OwlTree -> OwlTree
foldfn OwlTree
_owlPFState_owlTree [(Int, OwlSpot, OwlItem)]
seltls
  changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
rid,OwlSpot
_,OwlItem
_) -> (Int
rid, forall a. Maybe a
Nothing)) [(Int, OwlSpot, OwlItem)]
seltls
  r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)

do_deleteElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_deleteElts = [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newElts

undo_deleteElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_deleteElts = [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newElts

do_newMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newMiniOwlTree (OwlTree
mot, OwlSpot
ospot) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
  (OwlTree
newot, [SuperOwl]
changes') = OwlSpot -> OwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree OwlSpot
ospot OwlTree
mot OwlTree
_owlPFState_owlTree
  changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) [SuperOwl]
changes'
  r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)

undo_newMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newMiniOwlTree (OwlTree
mot, OwlSpot
_) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
  foldfn :: Int -> OwlTree -> OwlTree
foldfn Int
rid OwlTree
od = Int -> OwlTree -> OwlTree
owlTree_removeREltId Int
rid OwlTree
od
  newot :: OwlTree
newot = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> OwlTree -> OwlTree
foldfn OwlTree
_owlPFState_owlTree (OwlTree -> Seq Int
_owlTree_topOwls OwlTree
mot)
  changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. Maybe a
Nothing)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq SuperOwl
owliterateall OwlTree
mot
  r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)

do_deleteMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_deleteMiniOwlTree = (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newMiniOwlTree

undo_deleteMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_deleteMiniOwlTree = (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newMiniOwlTree



isSuperOwlParliamentUndoFriendly :: SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly :: SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly SuperOwlParliament
sop = Bool
r where
  rp :: SuperOwl -> Int
rp = OwlItemMeta -> Int
_owlItemMeta_position forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta
  sameparent :: SuperOwl -> SuperOwl -> Bool
sameparent SuperOwl
sowl1 SuperOwl
sowl2 = OwlItemMeta -> Int
_owlItemMeta_parent ( SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl1) forall a. Eq a => a -> a -> Bool
== OwlItemMeta -> Int
_owlItemMeta_parent ( SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl2)
  -- this is a hack use of isSortedBy and assumes parliament is ordered correctly
  r :: Bool
r = forall a. (a -> a -> Bool) -> [a] -> Bool
isSortedBy (\SuperOwl
sowl1 SuperOwl
sowl2 -> if SuperOwl -> SuperOwl -> Bool
sameparent SuperOwl
sowl1 SuperOwl
sowl2 then (SuperOwl -> Int
rp SuperOwl
sowl1) forall a. Ord a => a -> a -> Bool
< (SuperOwl -> Int
rp SuperOwl
sowl2) else Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament forall a b. (a -> b) -> a -> b
$ SuperOwlParliament
sop

do_move :: (OwlSpot, SuperOwlParliament) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_move :: (OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_move (OwlSpot
os, SuperOwlParliament
sop) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
isUndoFriendly (OwlPFState, REltIdMap (Maybe SuperOwl))
r where

  -- make sure SuperOwlParliament is ordered in an undo-friendly way
  isUndoFriendly :: Bool
isUndoFriendly = SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly SuperOwlParliament
sop

  op :: OwlParliament
op = SuperOwlParliament -> OwlParliament
superOwlParliament_toOwlParliament SuperOwlParliament
sop
  (OwlTree
newot, [SuperOwl]
changes') = OwlParliament -> OwlSpot -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_moveOwlParliament OwlParliament
op OwlSpot
os OwlTree
_owlPFState_owlTree
  changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) [SuperOwl]
changes'
  r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)

undo_move :: (OwlSpot, SuperOwlParliament) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_move :: (OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_move (OwlSpot
_, SuperOwlParliament
sop) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
isUndoFriendly (OwlPFState, REltIdMap (Maybe SuperOwl))
r where

  -- NOTE that sop is likely invalid in pfs at this point

  -- make sure SuperOwlParliament is ordered in an undo-friendly way
  isUndoFriendly :: Bool
isUndoFriendly = SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly SuperOwlParliament
sop

  -- first remove all elements we moved
  removefoldfn :: OwlTree -> SuperOwl -> OwlTree
removefoldfn OwlTree
tree' SuperOwl
so = Int -> OwlTree -> OwlTree
owlTree_removeREltId (SuperOwl -> Int
_superOwl_id SuperOwl
so) OwlTree
tree'
  removedTree :: OwlTree
removedTree = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OwlTree -> SuperOwl -> OwlTree
removefoldfn OwlTree
_owlPFState_owlTree (SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament SuperOwlParliament
sop)

  -- then add them back in in order
  addmapaccumlfn :: OwlTree -> SuperOwl -> (OwlTree, SuperOwl)
addmapaccumlfn OwlTree
tree' SuperOwl
so = OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
owlTree_addOwlItem OwlSpot
ospot (SuperOwl -> Int
_superOwl_id SuperOwl
so) (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
so) OwlTree
tree' where
    -- NOTE that because we are ordered from left to right, _superOwl_meta so is valid in tree'
    ospot :: OwlSpot
ospot = OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
tree' forall a b. (a -> b) -> a -> b
$ SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
so
  (OwlTree
addedTree, Seq SuperOwl
changes') = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL OwlTree -> SuperOwl -> (OwlTree, SuperOwl)
addmapaccumlfn OwlTree
removedTree (SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament SuperOwlParliament
sop)

  changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SuperOwl
changes')
  r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
addedTree}, REltIdMap (Maybe SuperOwl)
changes)


-- OwlItem compatible variant of updateFnFromController
updateFnFromControllerOwl :: Bool -> Controller -> ((OwlItemMeta, OwlItem)->(OwlItemMeta, OwlItem))
updateFnFromControllerOwl :: Bool
-> Controller -> (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
updateFnFromControllerOwl Bool
isDo Controller
controller = (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
r where
  f :: SEltLabel -> SEltLabel
f = Bool -> Controller -> SEltLabel -> SEltLabel
updateFnFromController Bool
isDo Controller
controller
  -- 😱😱😱
  rewrap :: a -> Maybe (Seq Int) -> SEltLabel -> (a, OwlItem)
rewrap a
oem Maybe (Seq Int)
mkiddos (SEltLabel Text
name SElt
elt) = case SElt
elt of
    SElt
SEltFolderStart -> (a
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (Seq Int -> OwlSubItem
OwlSubItemFolder (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Int)
mkiddos)))
    SElt
s -> (a
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (SElt -> OwlSubItem
sElt_to_owlSubItem SElt
s))
  r :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
r (OwlItemMeta
oem, OwlItem
oitem) = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
oitem of
    OwlSubItemFolder Seq Int
kiddos -> forall {a}. a -> Maybe (Seq Int) -> SEltLabel -> (a, OwlItem)
rewrap OwlItemMeta
oem (forall a. a -> Maybe a
Just Seq Int
kiddos) forall a b. (a -> b) -> a -> b
$ SEltLabel -> SEltLabel
f (Text -> SElt -> SEltLabel
SEltLabel (OwlItem -> Text
owlItem_name OwlItem
oitem) SElt
SEltFolderStart)
    OwlSubItem
_ -> forall {a}. a -> Maybe (Seq Int) -> SEltLabel -> (a, OwlItem)
rewrap OwlItemMeta
oem forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ SEltLabel -> SEltLabel
f (forall o. HasOwlItem o => o -> SEltLabel
hasOwlItem_toSEltLabel_hack OwlItem
oitem)

manipulate :: Bool -> ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
manipulate :: Bool
-> ControllersWithId
-> OwlPFState
-> (OwlPFState, REltIdMap (Maybe SuperOwl))
manipulate Bool
isDo ControllersWithId
cs OwlPFState
pfs = (OwlPFState
r, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IntMap SuperOwl
changes) where
  mapping :: IntMap (OwlItemMeta, OwlItem)
mapping = 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' :: IntMap (OwlItemMeta, OwlItem)
changes' = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (Bool
-> Controller -> (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
updateFnFromControllerOwl Bool
isDo) ControllersWithId
cs IntMap (OwlItemMeta, OwlItem)
mapping
  newMapping :: IntMap (OwlItemMeta, OwlItem)
newMapping = forall a. IntMap a -> IntMap a -> IntMap a
IM.union IntMap (OwlItemMeta, OwlItem)
changes' IntMap (OwlItemMeta, OwlItem)
mapping
  changes :: IntMap SuperOwl
changes = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
k (OwlItemMeta
oem, OwlItem
oe) -> Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
k OwlItemMeta
oem OwlItem
oe) IntMap (OwlItemMeta, OwlItem)
changes'
  r :: OwlPFState
r = OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) { _owlTree_mapping :: IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping = IntMap (OwlItemMeta, OwlItem)
newMapping } }

do_manipulate :: ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_manipulate :: ControllersWithId
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_manipulate = Bool
-> ControllersWithId
-> OwlPFState
-> (OwlPFState, REltIdMap (Maybe SuperOwl))
manipulate Bool
True

undo_manipulate :: ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_manipulate :: ControllersWithId
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_manipulate = Bool
-> ControllersWithId
-> OwlPFState
-> (OwlPFState, REltIdMap (Maybe SuperOwl))
manipulate Bool
False

-- | check if the SCanvas is valid or not
-- for now, canvas offset must always be 0, I forget why it's even an option to offset the SCanvas, probably potatoes.
isValidCanvas :: SCanvas -> Bool
isValidCanvas :: SCanvas -> Bool
isValidCanvas (SCanvas (LBox XY
p (V2 Int
w Int
h))) = XY
p forall a. Eq a => a -> a -> Bool
== XY
0 Bool -> Bool -> Bool
&& Int
w forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
h forall a. Ord a => a -> a -> Bool
> Int
0

do_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
do_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
do_resizeCanvas DeltaLBox
d OwlPFState
pfs = forall a. HasCallStack => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs { _owlPFState_canvas :: SCanvas
_owlPFState_canvas = SCanvas
newCanvas } where
  newCanvas :: SCanvas
newCanvas = LBox -> SCanvas
SCanvas forall a b. (a -> b) -> a -> b
$ forall x dx. Delta x dx => x -> dx -> x
plusDelta (SCanvas -> LBox
_sCanvas_box (OwlPFState -> SCanvas
_owlPFState_canvas OwlPFState
pfs)) DeltaLBox
d

undo_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
undo_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
undo_resizeCanvas DeltaLBox
d OwlPFState
pfs = forall a. HasCallStack => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs { _owlPFState_canvas :: SCanvas
_owlPFState_canvas = SCanvas
newCanvas } where
  newCanvas :: SCanvas
newCanvas = LBox -> SCanvas
SCanvas forall a b. (a -> b) -> a -> b
$ forall x dx. Delta x dx => x -> dx -> x
minusDelta (SCanvas -> LBox
_sCanvas_box (OwlPFState -> SCanvas
_owlPFState_canvas OwlPFState
pfs)) DeltaLBox
d