{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

-- TODO move to Potato.Flow.Controller
module Potato.Flow.Controller.OwlLayers where

import           Relude

import           Potato.Flow.Controller.Types
import           Potato.Flow.Types
import Potato.Flow.SElts
import           Potato.Flow.OwlItem
import Potato.Flow.Owl
import Potato.Flow.OwlState
import Potato.Flow.DebugHelpers

import           Control.Lens                 (over, _2)
import Data.Foldable (foldl)
import           Data.Default
import qualified Data.IntMap                  as IM
import qualified Data.IntSet as IS
import           Data.Sequence                ((><), (|>))
import qualified Data.Sequence                as Seq
import qualified Data.Text as T
import qualified Text.Show

data LockHiddenState = LHS_True | LHS_False | LHS_True_InheritTrue | LHS_False_InheritTrue deriving (LockHiddenState -> LockHiddenState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockHiddenState -> LockHiddenState -> Bool
$c/= :: LockHiddenState -> LockHiddenState -> Bool
== :: LockHiddenState -> LockHiddenState -> Bool
$c== :: LockHiddenState -> LockHiddenState -> Bool
Eq, REltId -> LockHiddenState -> ShowS
[LockHiddenState] -> ShowS
LockHiddenState -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockHiddenState] -> ShowS
$cshowList :: [LockHiddenState] -> ShowS
show :: LockHiddenState -> String
$cshow :: LockHiddenState -> String
showsPrec :: REltId -> LockHiddenState -> ShowS
$cshowsPrec :: REltId -> LockHiddenState -> ShowS
Show)

lockHiddenStateToBool :: LockHiddenState -> Bool
lockHiddenStateToBool :: LockHiddenState -> Bool
lockHiddenStateToBool = \case
  LockHiddenState
LHS_False -> Bool
False
  LockHiddenState
_ -> Bool
True

toggleLockHiddenState :: LockHiddenState -> LockHiddenState
toggleLockHiddenState :: LockHiddenState -> LockHiddenState
toggleLockHiddenState = \case
  LockHiddenState
LHS_True -> LockHiddenState
LHS_False
  LockHiddenState
LHS_False -> LockHiddenState
LHS_True
  LockHiddenState
LHS_True_InheritTrue -> LockHiddenState
LHS_False_InheritTrue
  LockHiddenState
LHS_False_InheritTrue -> LockHiddenState
LHS_True_InheritTrue

setLockHiddenStateInChildren :: LockHiddenState -> Bool -> LockHiddenState
setLockHiddenStateInChildren :: LockHiddenState -> Bool -> LockHiddenState
setLockHiddenStateInChildren LockHiddenState
parentstate = \case
  Bool
False -> case LockHiddenState
parentstate of
    LockHiddenState
LHS_False -> LockHiddenState
LHS_False
    LockHiddenState
_         -> LockHiddenState
LHS_False_InheritTrue
  Bool
True -> case LockHiddenState
parentstate of
    LockHiddenState
LHS_False -> LockHiddenState
LHS_True
    LockHiddenState
_         -> LockHiddenState
LHS_True_InheritTrue

-- ancestor state got set, update the child
updateLockHiddenStateInChildren :: LockHiddenState -> LockHiddenState -> LockHiddenState
updateLockHiddenStateInChildren :: LockHiddenState -> LockHiddenState -> LockHiddenState
updateLockHiddenStateInChildren LockHiddenState
parentstate = \case
  LockHiddenState
LHS_False -> case LockHiddenState
parentstate of
    LockHiddenState
LHS_True  -> LockHiddenState
LHS_False_InheritTrue
    LockHiddenState
LHS_False -> LockHiddenState
LHS_False
    LockHiddenState
_         -> forall {a}. a
invalid
  LockHiddenState
LHS_True -> case LockHiddenState
parentstate of
    LockHiddenState
LHS_True  -> LockHiddenState
LHS_True_InheritTrue
    LockHiddenState
LHS_False -> LockHiddenState
LHS_True
    LockHiddenState
_         -> forall {a}. a
invalid
  LockHiddenState
LHS_True_InheritTrue -> case LockHiddenState
parentstate of
    LockHiddenState
LHS_False -> LockHiddenState
LHS_True
    LockHiddenState
LHS_True  -> LockHiddenState
LHS_True_InheritTrue
    LockHiddenState
_         -> forall {a}. a
invalid
  LockHiddenState
LHS_False_InheritTrue -> case LockHiddenState
parentstate of
    LockHiddenState
LHS_False -> LockHiddenState
LHS_False
    LockHiddenState
LHS_True  -> LockHiddenState
LHS_False_InheritTrue
    LockHiddenState
_         -> forall {a}. a
invalid
  where
    invalid :: a
invalid = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"toggling of LHS_XXX_InheritTrue elements disallowed"

-- TODO be careful with hidden cost of Eq SuperOwl
-- this stores info just for what is displayed, Seq LayerEntry is uniquely generated from LayerMetaMap and PFState
data LayerEntry = LayerEntry {
  LayerEntry -> LockHiddenState
_layerEntry_lockState      :: LockHiddenState
  , LayerEntry -> LockHiddenState
_layerEntry_hideState      :: LockHiddenState
  , LayerEntry -> Bool
_layerEntry_isCollapsed    :: Bool -- this parameter is ignored if not a folder, Maybe Bool instead?
  , LayerEntry -> SuperOwl
_layerEntry_superOwl :: SuperOwl
} deriving (LayerEntry -> LayerEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerEntry -> LayerEntry -> Bool
$c/= :: LayerEntry -> LayerEntry -> Bool
== :: LayerEntry -> LayerEntry -> Bool
$c== :: LayerEntry -> LayerEntry -> Bool
Eq)

instance Show LayerEntry where
  show :: LayerEntry -> String
show LayerEntry {Bool
SuperOwl
LockHiddenState
_layerEntry_superOwl :: SuperOwl
_layerEntry_isCollapsed :: Bool
_layerEntry_hideState :: LockHiddenState
_layerEntry_lockState :: LockHiddenState
_layerEntry_superOwl :: LayerEntry -> SuperOwl
_layerEntry_isCollapsed :: LayerEntry -> Bool
_layerEntry_hideState :: LayerEntry -> LockHiddenState
_layerEntry_lockState :: LayerEntry -> LockHiddenState
..} = String
"LayerEntry (lhc: "
    forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show LockHiddenState
_layerEntry_lockState
    forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show LockHiddenState
_layerEntry_hideState
    forall a. Semigroup a => a -> a -> a
<> String
"," forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Bool
_layerEntry_isCollapsed
    forall a. Semigroup a => a -> a -> a
<> String
"):\n" forall a. Semigroup a => a -> a -> a
<> (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. PotatoShow a => a -> Text
potatoShow SuperOwl
_layerEntry_superOwl)

layerEntry_depth :: LayerEntry -> Int
layerEntry_depth :: LayerEntry -> REltId
layerEntry_depth LayerEntry {Bool
SuperOwl
LockHiddenState
_layerEntry_superOwl :: SuperOwl
_layerEntry_isCollapsed :: Bool
_layerEntry_hideState :: LockHiddenState
_layerEntry_lockState :: LockHiddenState
_layerEntry_superOwl :: LayerEntry -> SuperOwl
_layerEntry_isCollapsed :: LayerEntry -> Bool
_layerEntry_hideState :: LayerEntry -> LockHiddenState
_layerEntry_lockState :: LayerEntry -> LockHiddenState
..} = OwlItemMeta -> REltId
_owlItemMeta_depth forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta forall a b. (a -> b) -> a -> b
$ SuperOwl
_layerEntry_superOwl

layerEntry_display :: LayerEntry -> Text
layerEntry_display :: LayerEntry -> Text
layerEntry_display LayerEntry {Bool
SuperOwl
LockHiddenState
_layerEntry_superOwl :: SuperOwl
_layerEntry_isCollapsed :: Bool
_layerEntry_hideState :: LockHiddenState
_layerEntry_lockState :: LockHiddenState
_layerEntry_superOwl :: LayerEntry -> SuperOwl
_layerEntry_isCollapsed :: LayerEntry -> Bool
_layerEntry_hideState :: LayerEntry -> LockHiddenState
_layerEntry_lockState :: LayerEntry -> LockHiddenState
..} = forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
_layerEntry_superOwl

layerEntry_isFolder :: LayerEntry -> Bool
layerEntry_isFolder :: LayerEntry -> Bool
layerEntry_isFolder LayerEntry {Bool
SuperOwl
LockHiddenState
_layerEntry_superOwl :: SuperOwl
_layerEntry_isCollapsed :: Bool
_layerEntry_hideState :: LockHiddenState
_layerEntry_lockState :: LockHiddenState
_layerEntry_superOwl :: LayerEntry -> SuperOwl
_layerEntry_isCollapsed :: LayerEntry -> Bool
_layerEntry_hideState :: LayerEntry -> LockHiddenState
_layerEntry_lockState :: LayerEntry -> LockHiddenState
..} = forall o. MommyOwl o => o -> Bool
mommyOwl_hasKiddos SuperOwl
_layerEntry_superOwl

layerEntry_rEltId :: LayerEntry -> REltId
layerEntry_rEltId :: LayerEntry -> REltId
layerEntry_rEltId LayerEntry {Bool
SuperOwl
LockHiddenState
_layerEntry_superOwl :: SuperOwl
_layerEntry_isCollapsed :: Bool
_layerEntry_hideState :: LockHiddenState
_layerEntry_lockState :: LockHiddenState
_layerEntry_superOwl :: LayerEntry -> SuperOwl
_layerEntry_isCollapsed :: LayerEntry -> Bool
_layerEntry_hideState :: LayerEntry -> LockHiddenState
_layerEntry_lockState :: LayerEntry -> LockHiddenState
..} = SuperOwl -> REltId
_superOwl_id SuperOwl
_layerEntry_superOwl

-- index type into Seq LayerEntry
type LayerEntryPos = Int
type LayerEntries = Seq LayerEntry

layerEntriesToPrettyText :: LayerEntries -> Text
layerEntriesToPrettyText :: LayerEntries -> Text
layerEntriesToPrettyText LayerEntries
lentries = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LayerEntry -> Text -> Text
foldrfn Text
"" LayerEntries
lentries where
  foldrfn :: LayerEntry -> Text -> Text
foldrfn le :: LayerEntry
le@LayerEntry {Bool
SuperOwl
LockHiddenState
_layerEntry_superOwl :: SuperOwl
_layerEntry_isCollapsed :: Bool
_layerEntry_hideState :: LockHiddenState
_layerEntry_lockState :: LockHiddenState
_layerEntry_superOwl :: LayerEntry -> SuperOwl
_layerEntry_isCollapsed :: LayerEntry -> Bool
_layerEntry_hideState :: LayerEntry -> LockHiddenState
_layerEntry_lockState :: LayerEntry -> LockHiddenState
..} Text
acc = Text
r where
    collapseText :: Text
collapseText = if LayerEntry -> Bool
layerEntry_isFolder LayerEntry
le
      then if Bool
_layerEntry_isCollapsed
        then Text
">"
        else Text
"v"
      else Text
" "
    hideText :: Text
hideText = case LockHiddenState
_layerEntry_hideState of
      LockHiddenState
LHS_True              -> Text
"▓"
      LockHiddenState
LHS_False             -> Text
" "
      LockHiddenState
LHS_True_InheritTrue  -> Text
"▓"
      LockHiddenState
LHS_False_InheritTrue -> Text
"▒"
    lockText :: Text
lockText = case LockHiddenState
_layerEntry_lockState of
      LockHiddenState
LHS_True              -> Text
"▓"
      LockHiddenState
LHS_False             -> Text
" "
      LockHiddenState
LHS_True_InheritTrue  -> Text
"▓"
      LockHiddenState
LHS_False_InheritTrue -> Text
"▒"
    sowl :: SuperOwl
sowl = SuperOwl
_layerEntry_superOwl
    r :: Text
r = REltId -> Text -> Text
T.replicate (LayerEntry -> REltId
layerEntry_depth LayerEntry
le) Text
" " forall a. Semigroup a => a -> a -> a
<> Text
collapseText forall a. Semigroup a => a -> a -> a
<> Text
hideText forall a. Semigroup a => a -> a -> a
<> Text
lockText forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
sowl forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
acc

data LayersState = LayersState {
    -- mapping from REltId to element meta data
    LayersState -> LayerMetaMap
_layersState_meta :: LayerMetaMap
    -- sequence of visible folders
    , LayersState -> LayerEntries
_layersState_entries :: LayerEntries
    , LayersState -> REltId
_layersState_scrollPos :: Int
  } deriving (REltId -> LayersState -> ShowS
[LayersState] -> ShowS
LayersState -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayersState] -> ShowS
$cshowList :: [LayersState] -> ShowS
show :: LayersState -> String
$cshow :: LayersState -> String
showsPrec :: REltId -> LayersState -> ShowS
$cshowsPrec :: REltId -> LayersState -> ShowS
Show, LayersState -> LayersState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayersState -> LayersState -> Bool
$c/= :: LayersState -> LayersState -> Bool
== :: LayersState -> LayersState -> Bool
$c== :: LayersState -> LayersState -> Bool
Eq)

instance PotatoShow LayersState where
  potatoShow :: LayersState -> Text
potatoShow LayersState{REltId
LayerMetaMap
LayerEntries
_layersState_scrollPos :: REltId
_layersState_entries :: LayerEntries
_layersState_meta :: LayerMetaMap
_layersState_scrollPos :: LayersState -> REltId
_layersState_entries :: LayersState -> LayerEntries
_layersState_meta :: LayersState -> LayerMetaMap
..} = Text
r where
    r :: Text
r = Text
"LayersState: "
      forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show LayerMetaMap
_layersState_meta
      forall a. Semigroup a => a -> a -> a
<> Text
"\nLayerEntries:\n"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. (Foldable f, Show a) => f a -> Text
showFoldable LayerEntries
_layersState_entries

data LockHideCollapseOp = LHCO_ToggleLock | LHCO_ToggleHide | LHCO_ToggleCollapse deriving (REltId -> LockHideCollapseOp -> ShowS
[LockHideCollapseOp] -> ShowS
LockHideCollapseOp -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockHideCollapseOp] -> ShowS
$cshowList :: [LockHideCollapseOp] -> ShowS
show :: LockHideCollapseOp -> String
$cshow :: LockHideCollapseOp -> String
showsPrec :: REltId -> LockHideCollapseOp -> ShowS
$cshowsPrec :: REltId -> LockHideCollapseOp -> ShowS
Show)

alterWithDefault :: (Eq a, Default a) => (a -> a) -> REltId -> REltIdMap a -> REltIdMap a
alterWithDefault :: forall a.
(Eq a, Default a) =>
(a -> a) -> REltId -> REltIdMap a -> REltIdMap a
alterWithDefault a -> a
f REltId
k REltIdMap a
m = forall a. (Maybe a -> Maybe a) -> REltId -> IntMap a -> IntMap a
IM.alter Maybe a -> Maybe a
f' REltId
k REltIdMap a
m where
  apply :: a -> Maybe a
apply a
x = if a
fx forall a. Eq a => a -> a -> Bool
== forall a. Default a => a
def then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
fx where
    fx :: a
fx = a -> a
f a
x
  f' :: Maybe a -> Maybe a
f' = \case
    Maybe a
Nothing -> a -> Maybe a
apply forall a. Default a => a
def
    Just a
x -> a -> Maybe a
apply a
x

lookupWithDefault :: (Default a) => REltId -> REltIdMap a -> a
lookupWithDefault :: forall a. Default a => REltId -> REltIdMap a -> a
lookupWithDefault REltId
rid REltIdMap a
ridm = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid REltIdMap a
ridm of
  Maybe a
Nothing -> forall a. Default a => a
def
  Just a
x  -> a
x





-- TODO test
-- | assumes LayersState is after hide state of given lepos has just been toggled
changesFromToggleHide :: OwlPFState -> LayersState -> LayerEntryPos -> SuperOwlChanges
changesFromToggleHide :: OwlPFState -> LayersState -> REltId -> SuperOwlChanges
changesFromToggleHide OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
..} LayersState {REltId
LayerMetaMap
LayerEntries
_layersState_scrollPos :: REltId
_layersState_entries :: LayerEntries
_layersState_meta :: LayerMetaMap
_layersState_scrollPos :: LayersState -> REltId
_layersState_entries :: LayersState -> LayerEntries
_layersState_meta :: LayersState -> LayerMetaMap
..} REltId
lepos = SuperOwlChanges
r where
  le :: LayerEntry
le = forall a. Seq a -> REltId -> a
Seq.index LayerEntries
_layersState_entries REltId
lepos
  sowl :: SuperOwl
sowl = LayerEntry -> SuperOwl
_layerEntry_superOwl LayerEntry
le
  lerid :: REltId
lerid = SuperOwl -> REltId
_superOwl_id SuperOwl
sowl
  lm :: LayerMeta
lm = forall a. Default a => REltId -> REltIdMap a -> a
lookupWithDefault REltId
lerid LayerMetaMap
_layersState_meta
  isHidden :: Bool
isHidden = LayerMeta -> Bool
_layerMeta_isHidden LayerMeta
lm

  -- find all children that weren't already hidden
  children :: Seq SuperOwl
children = OwlTree -> REltId -> Seq SuperOwl
owliteratechildrenat OwlTree
_owlPFState_owlTree REltId
lerid
  isunhidden :: SuperOwl -> Bool
isunhidden SuperOwl
sowl' = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayerMeta -> Bool
_layerMeta_isHidden forall a b. (a -> b) -> a -> b
$ forall a. Default a => REltId -> REltIdMap a -> a
lookupWithDefault (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl') LayerMetaMap
_layersState_meta
  unhiddenChildren :: [(REltId, SuperOwl)]
unhiddenChildren = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl' -> (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl', SuperOwl
sowl')) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter SuperOwl -> Bool
isunhidden Seq SuperOwl
children

  r :: SuperOwlChanges
r = if Bool
isHidden
    then forall a. [(REltId, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ (REltId
lerid, forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field2 s t a b => Lens s t a b
_2 (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)) [(REltId, SuperOwl)]
unhiddenChildren)
    else forall a. [(REltId, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ (REltId
lerid,forall a. a -> Maybe a
Just SuperOwl
sowl) forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field2 s t a b => Lens s t a b
_2 forall a. a -> Maybe a
Just) [(REltId, SuperOwl)]
unhiddenChildren)

-- iterates over LayerEntryPos, skipping all children of entries where skipfn evaluates to true
doChildrenRecursive :: (LayerEntry -> Bool) -> (LayerEntry -> LayerEntry) -> Seq LayerEntry -> Seq LayerEntry
doChildrenRecursive :: (LayerEntry -> Bool)
-> (LayerEntry -> LayerEntry) -> LayerEntries -> LayerEntries
doChildrenRecursive LayerEntry -> Bool
skipfn LayerEntry -> LayerEntry
entryfn = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL REltId -> LayerEntry -> (REltId, LayerEntry)
mapaccumlfn forall a. Bounded a => a
maxBound where
  mapaccumlfn :: REltId -> LayerEntry -> (REltId, LayerEntry)
mapaccumlfn REltId
skipdepth LayerEntry
le = (REltId
newskipdepth, LayerEntry
newle) where
    depth :: REltId
depth = LayerEntry -> REltId
layerEntry_depth LayerEntry
le
    newskipdepth :: REltId
newskipdepth
      -- skip, so keep skipping
      | REltId
depth forall a. Ord a => a -> a -> Bool
>= REltId
skipdepth = REltId
skipdepth
      -- skip all children
      -- note, no need to check for collapsed state because we are iterating over LayerEntry which do not include children of collapsed entries
      | LayerEntry -> Bool
skipfn LayerEntry
le = REltId
depth forall a. Num a => a -> a -> a
+ REltId
1
      -- either we exited a skipped folder or aren't skipping, reset skip counter (since we skip subfolders of skipped entries, maximal skip stack depth is 1 so reset is OK)
      | Bool
otherwise = forall a. Bounded a => a
maxBound
    newle :: LayerEntry
newle = if REltId
depth forall a. Ord a => a -> a -> Bool
>= REltId
skipdepth
      then LayerEntry
le -- no changes to skipped elts
      else LayerEntry -> LayerEntry
entryfn LayerEntry
le


toggleLayerEntry :: OwlPFState -> LayersState -> LayerEntryPos -> LockHideCollapseOp -> LayersState
toggleLayerEntry :: OwlPFState
-> LayersState -> REltId -> LockHideCollapseOp -> LayersState
toggleLayerEntry OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} LayersState {REltId
LayerMetaMap
LayerEntries
_layersState_scrollPos :: REltId
_layersState_entries :: LayerEntries
_layersState_meta :: LayerMetaMap
_layersState_scrollPos :: LayersState -> REltId
_layersState_entries :: LayersState -> LayerEntries
_layersState_meta :: LayersState -> LayerMetaMap
..} REltId
lepos LockHideCollapseOp
op = LayersState
r where
  le :: LayerEntry
le = forall a. Seq a -> REltId -> a
Seq.index LayerEntries
_layersState_entries REltId
lepos
  lerid :: REltId
lerid = LayerEntry -> REltId
layerEntry_rEltId LayerEntry
le
  ledepth :: REltId
ledepth = LayerEntry -> REltId
layerEntry_depth LayerEntry
le
  childFrom :: LayerEntry -> Bool
childFrom LayerEntry
nextLayerEntry = LayerEntry -> REltId
layerEntry_depth LayerEntry
nextLayerEntry forall a. Eq a => a -> a -> Bool
/= REltId
ledepth
  -- visible children of le
  childles :: LayerEntries
childles = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileL LayerEntry -> Bool
childFrom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. REltId -> Seq a -> Seq a
Seq.drop (REltId
leposforall a. Num a => a -> a -> a
+REltId
1) forall a b. (a -> b) -> a -> b
$ LayerEntries
_layersState_entries
  -- everything before le
  frontOfLe :: LayerEntries
frontOfLe = forall a. REltId -> Seq a -> Seq a
Seq.take REltId
lepos LayerEntries
_layersState_entries
  -- everything after childles
  backOfChildles :: LayerEntries
backOfChildles = forall a. REltId -> Seq a -> Seq a
Seq.drop (REltId
lepos forall a. Num a => a -> a -> a
+ REltId
1 forall a. Num a => a -> a -> a
+ forall a. Seq a -> REltId
Seq.length LayerEntries
childles) LayerEntries
_layersState_entries

  -- simple helper function for setting lock/hidden state
  togglefn :: (LayerEntry -> LockHiddenState)
-> (LayerMeta -> Bool -> LayerMeta)
-> (LayerEntry -> LockHiddenState -> LayerEntry)
-> LayersState
togglefn LayerEntry -> LockHiddenState
fn LayerMeta -> Bool -> LayerMeta
setlmfn LayerEntry -> LockHiddenState -> LayerEntry
setlefn = (LayerMetaMap -> LayerEntries -> REltId -> LayersState
LayersState LayerMetaMap
newlmm LayerEntries
newlentries REltId
0) where
    newlhsstate :: LockHiddenState
newlhsstate = LockHiddenState -> LockHiddenState
toggleLockHiddenState forall a b. (a -> b) -> a -> b
$ LayerEntry -> LockHiddenState
fn LayerEntry
le
    newlmm :: LayerMetaMap
newlmm = forall a.
(Eq a, Default a) =>
(a -> a) -> REltId -> REltIdMap a -> REltIdMap a
alterWithDefault (\LayerMeta
lm' -> LayerMeta -> Bool -> LayerMeta
setlmfn LayerMeta
lm' (LockHiddenState -> Bool
lockHiddenStateToBool LockHiddenState
newlhsstate)) REltId
lerid LayerMetaMap
_layersState_meta
    entryfn :: LayerEntry -> LayerEntry
entryfn LayerEntry
childle = LayerEntry -> LockHiddenState -> LayerEntry
setlefn LayerEntry
childle forall a b. (a -> b) -> a -> b
$ LockHiddenState -> LockHiddenState -> LockHiddenState
updateLockHiddenStateInChildren LockHiddenState
newlhsstate (LayerEntry -> LockHiddenState
fn LayerEntry
childle)
    newchildles :: LayerEntries
newchildles = (LayerEntry -> Bool)
-> (LayerEntry -> LayerEntry) -> LayerEntries -> LayerEntries
doChildrenRecursive (LockHiddenState -> Bool
lockHiddenStateToBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayerEntry -> LockHiddenState
fn) LayerEntry -> LayerEntry
entryfn LayerEntries
childles
    newle :: LayerEntry
newle = LayerEntry -> LockHiddenState -> LayerEntry
setlefn LayerEntry
le LockHiddenState
newlhsstate
    newlentries :: LayerEntries
newlentries = (LayerEntries
frontOfLe forall a. Seq a -> a -> Seq a
|> LayerEntry
newle) forall a. Seq a -> Seq a -> Seq a
>< LayerEntries
newchildles forall a. Seq a -> Seq a -> Seq a
>< LayerEntries
backOfChildles

  r :: LayersState
r = case LockHideCollapseOp
op of
    LockHideCollapseOp
LHCO_ToggleCollapse -> (LayerMetaMap -> LayerEntries -> REltId -> LayersState
LayersState LayerMetaMap
newlmm LayerEntries
newlentries REltId
0) where
      newcollapse :: Bool
newcollapse = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ LayerEntry -> Bool
_layerEntry_isCollapsed LayerEntry
le
      newlmm :: LayerMetaMap
newlmm = forall a.
(Eq a, Default a) =>
(a -> a) -> REltId -> REltIdMap a -> REltIdMap a
alterWithDefault (\LayerMeta
le' -> LayerMeta
le' { _layerMeta_isCollapsed :: Bool
_layerMeta_isCollapsed = Bool
newcollapse }) REltId
lerid LayerMetaMap
_layersState_meta
      newle :: LayerEntry
newle = LayerEntry
le { _layerEntry_isCollapsed :: Bool
_layerEntry_isCollapsed = Bool
newcollapse }
      newchildles :: LayerEntries
newchildles = OwlTree
-> LayerMetaMap -> LayerEntries -> Maybe LayerEntry -> LayerEntries
buildLayerEntriesRecursive OwlTree
_owlPFState_owlTree LayerMetaMap
_layersState_meta forall a. Seq a
Seq.empty (forall a. a -> Maybe a
Just LayerEntry
newle)
      newlentries :: LayerEntries
newlentries = if Bool
newcollapse
        then (LayerEntries
frontOfLe forall a. Seq a -> a -> Seq a
|> LayerEntry
newle) forall a. Seq a -> Seq a -> Seq a
>< LayerEntries
backOfChildles
        else (LayerEntries
frontOfLe forall a. Seq a -> a -> Seq a
|> LayerEntry
newle) forall a. Seq a -> Seq a -> Seq a
>< LayerEntries
newchildles forall a. Seq a -> Seq a -> Seq a
>< LayerEntries
backOfChildles

    LockHideCollapseOp
LHCO_ToggleLock -> (LayerEntry -> LockHiddenState)
-> (LayerMeta -> Bool -> LayerMeta)
-> (LayerEntry -> LockHiddenState -> LayerEntry)
-> LayersState
togglefn LayerEntry -> LockHiddenState
_layerEntry_lockState (\LayerMeta
lm' Bool
x -> LayerMeta
lm' { _layerMeta_isLocked :: Bool
_layerMeta_isLocked = Bool
x }) (\LayerEntry
le' LockHiddenState
x -> LayerEntry
le' { _layerEntry_lockState :: LockHiddenState
_layerEntry_lockState = LockHiddenState
x })
    LockHideCollapseOp
LHCO_ToggleHide -> (LayerEntry -> LockHiddenState)
-> (LayerMeta -> Bool -> LayerMeta)
-> (LayerEntry -> LockHiddenState -> LayerEntry)
-> LayersState
togglefn LayerEntry -> LockHiddenState
_layerEntry_hideState (\LayerMeta
lm' Bool
x -> LayerMeta
lm' { _layerMeta_isHidden :: Bool
_layerMeta_isHidden = Bool
x }) (\LayerEntry
le' LockHiddenState
x -> LayerEntry
le' { _layerEntry_hideState :: LockHiddenState
_layerEntry_hideState = LockHiddenState
x })

expandAllCollapsedParents :: Selection -> OwlPFState -> LayersState -> LayersState
expandAllCollapsedParents :: Selection -> OwlPFState -> LayersState -> LayersState
expandAllCollapsedParents Selection
selection OwlPFState
pfs LayersState
ls = LayersState
r where
  ops :: OwlParliamentSet
ops = OwlTree -> OwlParliamentSet -> OwlParliamentSet
owlParliamentSet_findParents (forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree OwlPFState
pfs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> OwlParliamentSet
superOwlParliament_toOwlParliamentSet forall a b. (a -> b) -> a -> b
$  Selection
selection
  oldlmm :: LayerMetaMap
oldlmm = LayersState -> LayerMetaMap
_layersState_meta LayersState
ls
  iscollapsedfilterfn :: REltId -> Bool
iscollapsedfilterfn REltId
rid = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid LayerMetaMap
oldlmm of
    Just LayerMeta
lm -> LayerMeta -> Bool
_layerMeta_isCollapsed LayerMeta
lm
    Maybe LayerMeta
Nothing -> Bool
defaultFolderCollapseState
  collapsedParents :: OwlParliamentSet
collapsedParents = (REltId -> Bool) -> OwlParliamentSet -> OwlParliamentSet
IS.filter REltId -> Bool
iscollapsedfilterfn OwlParliamentSet
ops
  alterfn :: Maybe LayerMeta -> Maybe LayerMeta
alterfn Maybe LayerMeta
mlm = case Maybe LayerMeta
mlm of
    Maybe LayerMeta
Nothing -> forall a. a -> Maybe a
Just (forall a. Default a => a
def { _layerMeta_isCollapsed :: Bool
_layerMeta_isCollapsed = Bool
False })
    Just LayerMeta
x -> forall a. a -> Maybe a
Just (LayerMeta
x { _layerMeta_isCollapsed :: Bool
_layerMeta_isCollapsed = Bool
False })
  newlmm :: LayerMetaMap
newlmm = forall b. (REltId -> b -> b) -> b -> OwlParliamentSet -> b
IS.foldr (forall a. (Maybe a -> Maybe a) -> REltId -> IntMap a -> IntMap a
IM.alter Maybe LayerMeta -> Maybe LayerMeta
alterfn) LayerMetaMap
oldlmm OwlParliamentSet
collapsedParents
  r :: LayersState
r = if OwlParliamentSet -> Bool
IS.null OwlParliamentSet
collapsedParents
    then LayersState
ls
    -- can we do this more efficiently?
    else (OwlPFState -> LayerMetaMap -> LayersState
makeLayersStateFromOwlPFState OwlPFState
pfs LayerMetaMap
newlmm) { _layersState_scrollPos :: REltId
_layersState_scrollPos = LayersState -> REltId
_layersState_scrollPos LayersState
ls }

makeLayersStateFromOwlPFState :: OwlPFState -> LayerMetaMap -> LayersState
makeLayersStateFromOwlPFState :: OwlPFState -> LayerMetaMap -> LayersState
makeLayersStateFromOwlPFState OwlPFState
pfs LayerMetaMap
lmm = LayersState {
    _layersState_meta :: LayerMetaMap
_layersState_meta = LayerMetaMap
lmm
    , _layersState_entries :: LayerEntries
_layersState_entries = OwlTree -> LayerMetaMap -> LayerEntries
generateLayersNew (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) LayerMetaMap
lmm
    , _layersState_scrollPos :: REltId
_layersState_scrollPos = REltId
0
  }

updateLayers :: OwlPFState -> SuperOwlChanges -> LayersState -> LayersState
updateLayers :: OwlPFState -> SuperOwlChanges -> LayersState -> LayersState
updateLayers OwlPFState
pfs SuperOwlChanges
changes LayersState {REltId
LayerMetaMap
LayerEntries
_layersState_scrollPos :: REltId
_layersState_entries :: LayerEntries
_layersState_meta :: LayerMetaMap
_layersState_scrollPos :: LayersState -> REltId
_layersState_entries :: LayersState -> LayerEntries
_layersState_meta :: LayersState -> LayerMetaMap
..} = LayersState
r where
  -- update _layersState_meta
  (SuperOwlChanges
deletestuff, SuperOwlChanges
maybenewstuff) = forall a. (a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
IM.partition forall a. Maybe a -> Bool
isNothing SuperOwlChanges
changes

  maybenewstuffcollapsed :: LayerMetaMap
maybenewstuffcollapsed = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (forall a. Default a => a
def {_layerMeta_isCollapsed :: Bool
_layerMeta_isCollapsed = Bool
True})) SuperOwlChanges
maybenewstuff)

  newlmm :: LayerMetaMap
newlmm = forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference (forall a. IntMap a -> IntMap a -> IntMap a
IM.union LayerMetaMap
_layersState_meta LayerMetaMap
maybenewstuffcollapsed) SuperOwlChanges
deletestuff


  -- keep deleted elts so that folder state is preserved after undos/redos
  --newlmm = IM.union _layersState_meta (fmap (const def) maybenewstuff)

  -- TODO incremental rather than regenerate...
  newlentries :: LayerEntries
newlentries = OwlTree -> LayerMetaMap -> LayerEntries
generateLayersNew (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) LayerMetaMap
newlmm

  r :: LayersState
r = LayerMetaMap -> LayerEntries -> REltId -> LayersState
LayersState LayerMetaMap
newlmm LayerEntries
newlentries REltId
_layersState_scrollPos

buildLayerEntriesRecursive :: OwlTree -> LayerMetaMap -> Seq LayerEntry -> Maybe LayerEntry -> Seq LayerEntry
buildLayerEntriesRecursive :: OwlTree
-> LayerMetaMap -> LayerEntries -> Maybe LayerEntry -> LayerEntries
buildLayerEntriesRecursive OwlTree
ot LayerMetaMap
lmm LayerEntries
acc Maybe LayerEntry
mparent = LayerEntries
r where
  foldlfn :: LayerEntries -> REltId -> LayerEntries
foldlfn LayerEntries
acclentries REltId
rid = LayerEntries
newacclentries where
    sowl :: SuperOwl
sowl = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
ot REltId
rid
    lm :: LayerMeta
lm = forall a. Default a => REltId -> REltIdMap a -> a
lookupWithDefault REltId
rid LayerMetaMap
lmm
    -- add self
    lentry :: LayerEntry
lentry = case Maybe LayerEntry
mparent of
      Maybe LayerEntry
Nothing -> LayerEntry {
        _layerEntry_lockState :: LockHiddenState
_layerEntry_lockState =  if LayerMeta -> Bool
_layerMeta_isLocked LayerMeta
lm then LockHiddenState
LHS_True else LockHiddenState
LHS_False
        , _layerEntry_hideState :: LockHiddenState
_layerEntry_hideState = if LayerMeta -> Bool
_layerMeta_isHidden LayerMeta
lm then LockHiddenState
LHS_True else LockHiddenState
LHS_False
        , _layerEntry_isCollapsed :: Bool
_layerEntry_isCollapsed = LayerMeta -> Bool
_layerMeta_isCollapsed LayerMeta
lm
        , _layerEntry_superOwl :: SuperOwl
_layerEntry_superOwl = SuperOwl
sowl
      }
      Just LayerEntry
parent -> LayerEntry {
        _layerEntry_lockState :: LockHiddenState
_layerEntry_lockState = LockHiddenState -> Bool -> LockHiddenState
setLockHiddenStateInChildren (LayerEntry -> LockHiddenState
_layerEntry_lockState LayerEntry
parent) forall a b. (a -> b) -> a -> b
$ LayerMeta -> Bool
_layerMeta_isLocked LayerMeta
lm
        , _layerEntry_hideState :: LockHiddenState
_layerEntry_hideState = LockHiddenState -> Bool -> LockHiddenState
setLockHiddenStateInChildren (LayerEntry -> LockHiddenState
_layerEntry_hideState LayerEntry
parent) forall a b. (a -> b) -> a -> b
$ LayerMeta -> Bool
_layerMeta_isHidden LayerMeta
lm
        , _layerEntry_isCollapsed :: Bool
_layerEntry_isCollapsed = LayerMeta -> Bool
_layerMeta_isCollapsed LayerMeta
lm
        , _layerEntry_superOwl :: SuperOwl
_layerEntry_superOwl = SuperOwl
sowl
      }
    newacclentries' :: LayerEntries
newacclentries' = LayerEntries
acclentries forall a. Seq a -> a -> Seq a
|> LayerEntry
lentry
    -- recursively add children
    newacclentries :: LayerEntries
newacclentries = if LayerMeta -> Bool
_layerMeta_isCollapsed LayerMeta
lm
      then LayerEntries
newacclentries'
      else OwlTree
-> LayerMetaMap -> LayerEntries -> Maybe LayerEntry -> LayerEntries
buildLayerEntriesRecursive OwlTree
ot LayerMetaMap
lmm LayerEntries
newacclentries' (forall a. a -> Maybe a
Just LayerEntry
lentry)
  r :: LayerEntries
r = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl LayerEntries -> REltId -> LayerEntries
foldlfn LayerEntries
acc forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ case Maybe LayerEntry
mparent of
    Maybe LayerEntry
Nothing -> forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos OwlTree
ot
    Just LayerEntry
lentry -> forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos (LayerEntry -> SuperOwl
_layerEntry_superOwl LayerEntry
lentry)

generateLayersNew :: OwlTree -> LayerMetaMap -> Seq LayerEntry
generateLayersNew :: OwlTree -> LayerMetaMap -> LayerEntries
generateLayersNew OwlTree
ot LayerMetaMap
lmm = OwlTree
-> LayerMetaMap -> LayerEntries -> Maybe LayerEntry -> LayerEntries
buildLayerEntriesRecursive OwlTree
ot LayerMetaMap
lmm forall a. Seq a
Seq.empty forall a. Maybe a
Nothing


layerMetaMap_isInheritHiddenOrLocked :: OwlTree -> REltId -> LayerMetaMap -> Bool
layerMetaMap_isInheritHiddenOrLocked :: OwlTree -> REltId -> LayerMetaMap -> Bool
layerMetaMap_isInheritHiddenOrLocked OwlTree
ot REltId
rid LayerMetaMap
lmm = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid LayerMetaMap
lmm of
  -- these may both be false, but it may inherit from a parent where these are true therefore we still need to walk up the tree if these are both false
  Just LayerMeta
lm | LayerMeta -> Bool
_layerMeta_isLocked LayerMeta
lm Bool -> Bool -> Bool
|| LayerMeta -> Bool
_layerMeta_isHidden LayerMeta
lm -> Bool
True
  Maybe LayerMeta
_ -> case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
ot) of
    Maybe (OwlItemMeta, OwlItem)
Nothing -> Bool
False
    Just (OwlItemMeta
oem,OwlItem
_) -> OwlTree -> REltId -> LayerMetaMap -> Bool
layerMetaMap_isInheritHiddenOrLocked OwlTree
ot (OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
oem) LayerMetaMap
lmm

layerMetaMap_isInheritHidden :: OwlTree -> REltId -> LayerMetaMap -> Bool
layerMetaMap_isInheritHidden :: OwlTree -> REltId -> LayerMetaMap -> Bool
layerMetaMap_isInheritHidden OwlTree
ot REltId
rid LayerMetaMap
lmm = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid LayerMetaMap
lmm of
  Just LayerMeta
lm | LayerMeta -> Bool
_layerMeta_isHidden LayerMeta
lm -> Bool
True
  Maybe LayerMeta
_ -> case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
ot) of
    Maybe (OwlItemMeta, OwlItem)
Nothing -> Bool
False
    Just (OwlItemMeta
oem,OwlItem
_) -> OwlTree -> REltId -> LayerMetaMap -> Bool
layerMetaMap_isInheritHidden OwlTree
ot (OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
oem) LayerMetaMap
lmm