{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Owl where

import Relude
import qualified Relude.Unsafe as Unsafe

import Control.Exception (assert)
import Data.Foldable (foldl)
import qualified Data.IntMap as IM
import qualified Data.List as L
import Data.Maybe (fromJust)
import Data.Sequence ((><), (|>), (<|))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.IntSet as IS
import qualified Data.Text as T
import Potato.Flow.OwlItem
import Potato.Flow.SElts
import Potato.Flow.Types
import Potato.Flow.DebugHelpers

errorMsg_owlTree_lookupFail :: OwlTree -> REltId -> Text
errorMsg_owlTree_lookupFail :: OwlTree -> REltId -> Text
errorMsg_owlTree_lookupFail OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
..} REltId
rid = OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail OwlMapping
_owlTree_mapping REltId
rid

errorMsg_owlMapping_lookupFail :: OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail :: OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail OwlMapping
_ REltId
rid = Text
"expected to find REltId " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
rid forall a. Semigroup a => a -> a -> a
<> Text
" in OwlMapping"

type OwlMapping = REltIdMap (OwlItemMeta, OwlItem)

-- | update attachments based on remap
owlItem_updateAttachments :: Bool -> REltIdMap REltId -> OwlItem -> OwlItem
owlItem_updateAttachments :: Bool -> REltIdMap REltId -> OwlItem -> OwlItem
owlItem_updateAttachments Bool
breakNonExistng REltIdMap REltId
ridremap OwlItem
oitem = case OwlItem
oitem of
  OwlItem OwlInfo
oinfo (OwlSubItemLine SAutoLine
sline) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo forall a b. (a -> b) -> a -> b
$ SAutoLine -> OwlSubItem
OwlSubItemLine (SAutoLine
sline {
      _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = Maybe Attachment -> Maybe Attachment
remapAttachment forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline
      , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = Maybe Attachment -> Maybe Attachment
remapAttachment forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline
    })
    where
      remapAttachment :: Maybe Attachment -> Maybe Attachment
remapAttachment Maybe Attachment
ma = case Maybe Attachment
ma of
        Maybe Attachment
Nothing -> forall a. Maybe a
Nothing
        Just Attachment
a -> case forall a. REltId -> IntMap a -> Maybe a
IM.lookup (Attachment -> REltId
_attachment_target Attachment
a) REltIdMap REltId
ridremap of
          -- could not find attachment, break it
          Maybe REltId
Nothing -> if Bool
breakNonExistng then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Attachment
a
          Just REltId
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Attachment
a { _attachment_target :: REltId
_attachment_target = REltId
t }
  OwlItem
x -> OwlItem
x



-- this is just position index in children
type SiblingPosition = Int

-- TODO remove OwlMapping arg not needed
locateLeftSiblingIdFromSiblingPosition :: OwlMapping -> Seq REltId -> SiblingPosition -> Maybe REltId
locateLeftSiblingIdFromSiblingPosition :: OwlMapping -> Seq REltId -> REltId -> Maybe REltId
locateLeftSiblingIdFromSiblingPosition OwlMapping
_ Seq REltId
s REltId
sp = case REltId
sp of
  REltId
0 -> forall a. Maybe a
Nothing
  REltId
x -> case forall a. REltId -> Seq a -> Maybe a
Seq.lookup (REltId
x forall a. Num a => a -> a -> a
- REltId
1) Seq REltId
s of
    Maybe REltId
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected to find index " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (REltId
x forall a. Num a => a -> a -> a
- REltId
1) forall a. Semigroup a => a -> a -> a
<> Text
" in seq"
    Just REltId
r -> forall a. a -> Maybe a
Just REltId
r

 
-- TODO
--isAncestorOf

isDescendentOf :: (HasCallStack) => OwlMapping -> REltId -> REltId -> Bool
isDescendentOf :: HasCallStack => OwlMapping -> REltId -> REltId -> Bool
isDescendentOf OwlMapping
om REltId
parent REltId
child
  | REltId
child forall a. Eq a => a -> a -> Bool
== REltId
noOwl = Bool
False
  | Bool
otherwise = Bool
r
  where
    parent' :: REltId
parent' = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
child OwlMapping
om of
      Just (OwlItemMeta
oem, OwlItem
_) -> OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
oem
      Maybe (OwlItemMeta, OwlItem)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail OwlMapping
om REltId
child
    r :: Bool
r = case REltId
parent' of
      REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> Bool
False
      REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
parent -> Bool
True
      REltId
x -> HasCallStack => OwlMapping -> REltId -> REltId -> Bool
isDescendentOf OwlMapping
om REltId
parent REltId
x

data OwlItemMeta = OwlItemMeta
  { OwlItemMeta -> REltId
_owlItemMeta_parent :: REltId
    , OwlItemMeta -> REltId
_owlItemMeta_depth :: Int
    , OwlItemMeta -> REltId
_owlItemMeta_position :: SiblingPosition
  }
  deriving (OwlItemMeta -> OwlItemMeta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OwlItemMeta -> OwlItemMeta -> Bool
$c/= :: OwlItemMeta -> OwlItemMeta -> Bool
== :: OwlItemMeta -> OwlItemMeta -> Bool
$c== :: OwlItemMeta -> OwlItemMeta -> Bool
Eq, REltId -> OwlItemMeta -> ShowS
[OwlItemMeta] -> ShowS
OwlItemMeta -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlItemMeta] -> ShowS
$cshowList :: [OwlItemMeta] -> ShowS
show :: OwlItemMeta -> String
$cshow :: OwlItemMeta -> String
showsPrec :: REltId -> OwlItemMeta -> ShowS
$cshowsPrec :: REltId -> OwlItemMeta -> ShowS
Show, forall x. Rep OwlItemMeta x -> OwlItemMeta
forall x. OwlItemMeta -> Rep OwlItemMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwlItemMeta x -> OwlItemMeta
$cfrom :: forall x. OwlItemMeta -> Rep OwlItemMeta x
Generic)

instance NFData OwlItemMeta

instance PotatoShow OwlItemMeta where
  potatoShow :: OwlItemMeta -> Text
potatoShow OwlItemMeta {REltId
_owlItemMeta_position :: REltId
_owlItemMeta_depth :: REltId
_owlItemMeta_parent :: REltId
_owlItemMeta_position :: OwlItemMeta -> REltId
_owlItemMeta_depth :: OwlItemMeta -> REltId
_owlItemMeta_parent :: OwlItemMeta -> REltId
..} = Text
"(meta: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
_owlItemMeta_parent forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
_owlItemMeta_depth forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
_owlItemMeta_position forall a. Semigroup a => a -> a -> a
<> Text
")"

-- a simpler version of OwlItemMeta used for inserting new Owls
data OwlSpot = OwlSpot {
    -- NOTE _owlSpot_parent is redundant if _owlSpot_leftSibling is not Nothing
    OwlSpot -> REltId
_owlSpot_parent :: REltId,
    OwlSpot -> Maybe REltId
_owlSpot_leftSibling :: Maybe REltId
  }
  deriving (REltId -> OwlSpot -> ShowS
[OwlSpot] -> ShowS
OwlSpot -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlSpot] -> ShowS
$cshowList :: [OwlSpot] -> ShowS
show :: OwlSpot -> String
$cshow :: OwlSpot -> String
showsPrec :: REltId -> OwlSpot -> ShowS
$cshowsPrec :: REltId -> OwlSpot -> ShowS
Show, forall x. Rep OwlSpot x -> OwlSpot
forall x. OwlSpot -> Rep OwlSpot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwlSpot x -> OwlSpot
$cfrom :: forall x. OwlSpot -> Rep OwlSpot x
Generic)

instance NFData OwlSpot

topSpot :: OwlSpot
topSpot :: OwlSpot
topSpot = REltId -> Maybe REltId -> OwlSpot
OwlSpot REltId
noOwl forall a. Maybe a
Nothing

-- TODO try and get rid of deriving Eq
data SuperOwl = SuperOwl
  { SuperOwl -> REltId
_superOwl_id :: REltId,
    SuperOwl -> OwlItemMeta
_superOwl_meta :: OwlItemMeta,
    SuperOwl -> OwlItem
_superOwl_elt :: OwlItem
  }
  deriving (SuperOwl -> SuperOwl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuperOwl -> SuperOwl -> Bool
$c/= :: SuperOwl -> SuperOwl -> Bool
== :: SuperOwl -> SuperOwl -> Bool
$c== :: SuperOwl -> SuperOwl -> Bool
Eq, REltId -> SuperOwl -> ShowS
[SuperOwl] -> ShowS
SuperOwl -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuperOwl] -> ShowS
$cshowList :: [SuperOwl] -> ShowS
show :: SuperOwl -> String
$cshow :: SuperOwl -> String
showsPrec :: REltId -> SuperOwl -> ShowS
$cshowsPrec :: REltId -> SuperOwl -> ShowS
Show, forall x. Rep SuperOwl x -> SuperOwl
forall x. SuperOwl -> Rep SuperOwl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SuperOwl x -> SuperOwl
$cfrom :: forall x. SuperOwl -> Rep SuperOwl x
Generic)

-- TODO something like
--type SuperDuperOwl = (SuperOwl, OwlTree)
-- or even data Duper a = Duper OwlTree a

instance NFData SuperOwl

instance MommyOwl SuperOwl where
  mommyOwl_kiddos :: SuperOwl -> Maybe (Seq REltId)
mommyOwl_kiddos SuperOwl
sowl = forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl)

instance HasOwlItem SuperOwl where
  hasOwlItem_owlItem :: SuperOwl -> OwlItem
hasOwlItem_owlItem = SuperOwl -> OwlItem
_superOwl_elt


type SuperOwlChanges = REltIdMap (Maybe SuperOwl)

-- updates AttachmeentMap with a list of SuperOwls (that may be attached to stuff)
attachmentMap_addSuperOwls' :: (Foldable f) => (Attachment -> Bool) -> f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls' :: forall (f :: * -> *).
Foldable f =>
(Attachment -> Bool)
-> f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls' Attachment -> Bool
filterfn f SuperOwl
sowls AttachmentMap
am = AttachmentMap
r where
  foldrfn :: SuperOwl -> AttachmentMap -> AttachmentMap
foldrfn SuperOwl
sowl AttachmentMap
m = AttachmentMap
newmap where
    --find all targets we are attached to
    attachedstuff :: [Attachment]
attachedstuff = forall a. (a -> Bool) -> [a] -> [a]
filter Attachment -> Bool
filterfn (forall o. HasOwlItem o => o -> [Attachment]
hasOwlItem_attachments SuperOwl
sowl)
    alterfn :: REltId -> Maybe IntSet -> Maybe IntSet
alterfn REltId
stuff Maybe IntSet
ms = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Maybe IntSet
ms of
      Maybe IntSet
Nothing -> (REltId -> IntSet
IS.singleton REltId
stuff)
      Just IntSet
s -> REltId -> IntSet -> IntSet
IS.insert REltId
stuff IntSet
s
    innerfoldrfn :: REltId -> AttachmentMap -> AttachmentMap
innerfoldrfn REltId
target AttachmentMap
m' = forall a. (Maybe a -> Maybe a) -> REltId -> IntMap a -> IntMap a
IM.alter (REltId -> Maybe IntSet -> Maybe IntSet
alterfn (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl)) REltId
target AttachmentMap
m'
    newmap :: AttachmentMap
newmap = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr REltId -> AttachmentMap -> AttachmentMap
innerfoldrfn AttachmentMap
m (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> REltId
_attachment_target [Attachment]
attachedstuff)
  r :: AttachmentMap
r = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SuperOwl -> AttachmentMap -> AttachmentMap
foldrfn AttachmentMap
am f SuperOwl
sowls

attachmentMap_addSuperOwls :: (Foldable f) => f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls :: forall (f :: * -> *).
Foldable f =>
f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls = forall (f :: * -> *).
Foldable f =>
(Attachment -> Bool)
-> f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls' (forall a b. a -> b -> a
const Bool
True)

-- TODO test I have no idea if I did this right...
-- | update AttachmentMap from SuperOwlChanges (call on SuperOwlChanges produced by updateOwlPFWorkspace)
updateAttachmentMapFromSuperOwlChanges :: SuperOwlChanges -> AttachmentMap -> AttachmentMap
updateAttachmentMapFromSuperOwlChanges :: SuperOwlChanges -> AttachmentMap -> AttachmentMap
updateAttachmentMapFromSuperOwlChanges SuperOwlChanges
changes AttachmentMap
am = AttachmentMap
newam_4 where

  -- remove deleted stuff from keys
  --newam_1 = foldr (\k acc -> IM.delete k acc) am $ IM.keys (IM.filter isNothing changes)
  -- actually don't bother
  newam_1 :: AttachmentMap
newam_1 = AttachmentMap
am

  -- remove changed elems from all value sets (this could be done more efficiently if we know the previous things they were attached to, but oh well)
  setToRemove :: IntSet
setToRemove = forall a. IntMap a -> IntSet
IM.keysSet SuperOwlChanges
changes
  newam_2 :: AttachmentMap
newam_2 = forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Bool
IS.null) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IntSet
s -> IntSet -> IntSet -> IntSet
IS.difference IntSet
s IntSet
setToRemove) AttachmentMap
newam_1

  -- add attachment targets of changed elems to value sets of those targets
  justChanges :: [SuperOwl]
justChanges = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [a]
IM.elems forall a b. (a -> b) -> a -> b
$ SuperOwlChanges
changes
  newam_3 :: AttachmentMap
newam_3 = forall (f :: * -> *).
Foldable f =>
f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls [SuperOwl]
justChanges AttachmentMap
newam_2

  -- needing to iterate through everything when there are newly created elts is kind of unfortunate :(. Especially when this is only meeaningful in undo cases. probably not worth trying to optimize away. I guess we could keep deleted elts around in AttachmentMap for some time?
  --sowls = owliterateall ot
  --newam_4 = if IS.null newstuff then newam_3 else attachmentMap_addSuperOwls' (\x -> IS.member (_attachment_target x) newstuff) sowls newam_3
  -- similarly, since we skip computing newam_1, we can skip computing newam_4
  newam_4 :: AttachmentMap
newam_4 = AttachmentMap
newam_3

-- | update SuperOwlChanges to include stuff attached to stuff that changed (call before rendering)
getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges
getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges
getChangesFromAttachmentMap owltreeafterchanges :: OwlTree
owltreeafterchanges@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} AttachmentMap
am SuperOwlChanges
changes = SuperOwlChanges
r where
  -- collect all stuff attaching to changed stuff
  changeset :: IntSet
changeset = forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\REltId
k [Maybe IntSet]
acc -> forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
k AttachmentMap
am forall a. a -> [a] -> [a]
: [Maybe IntSet]
acc) [] (forall a. IntMap a -> [REltId]
IM.keys SuperOwlChanges
changes)

  -- create SuperOwlChanges from changeset
  -- currently nothing can be attached to something that is attaching to thing sso you don't need to make this operation recursive
  r :: SuperOwlChanges
r = forall a. [(REltId, a)] -> IntMap a
IM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(REltId
_,Maybe SuperOwl
x) -> forall a. Maybe a -> Bool
isJust Maybe SuperOwl
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\REltId
rid -> (REltId
rid, OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
owltreeafterchanges REltId
rid)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  IntSet -> [REltId]
IS.toList forall a b. (a -> b) -> a -> b
$ IntSet
changeset

instance PotatoShow SuperOwl where
  potatoShow :: SuperOwl -> Text
potatoShow SuperOwl {REltId
OwlItem
OwlItemMeta
_superOwl_elt :: OwlItem
_superOwl_meta :: OwlItemMeta
_superOwl_id :: REltId
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_id :: SuperOwl -> REltId
..} = forall b a. (Show a, IsString b) => a -> b
show REltId
_superOwl_id forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. PotatoShow a => a -> Text
potatoShow OwlItemMeta
_superOwl_meta forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
elt
    where
      elt :: Text
elt = forall a. PotatoShow a => a -> Text
potatoShow OwlItem
_superOwl_elt

        --case _superOwl_elt of
          --OwlItem oinfo (OwlSubItemFolder kiddos) -> "folder: " <> (_owlInfo_name oinfo) <> ": " <> show kiddos
          --OwlItem oinfo _ -> "elt: " <> (_owlInfo_name oinfo) -- TODO elt type

--superOwl_id :: Lens' SuperOwl REltId
superOwl_id :: Functor f => (REltId -> f REltId) -> SuperOwl -> f SuperOwl
superOwl_id :: forall (f :: * -> *).
Functor f =>
(REltId -> f REltId) -> SuperOwl -> f SuperOwl
superOwl_id REltId -> f REltId
f SuperOwl
sowl = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\REltId
rid -> SuperOwl
sowl {_superOwl_id :: REltId
_superOwl_id = REltId
rid}) (REltId -> f REltId
f (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl))

-- TODO rest of lenses

superOwl_isTopOwl :: SuperOwl -> Bool
superOwl_isTopOwl :: SuperOwl -> Bool
superOwl_isTopOwl SuperOwl {REltId
OwlItem
OwlItemMeta
_superOwl_elt :: OwlItem
_superOwl_meta :: OwlItemMeta
_superOwl_id :: REltId
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_id :: SuperOwl -> REltId
..} = OwlItemMeta -> REltId
_owlItemMeta_depth OwlItemMeta
_superOwl_meta forall a. Eq a => a -> a -> Bool
== REltId
0

-- | same as superOwl_isTopOwl except checks all conditions, intended to be used in asserts
superOwl_isTopOwlSurely :: SuperOwl -> Bool
superOwl_isTopOwlSurely :: SuperOwl -> Bool
superOwl_isTopOwlSurely SuperOwl {REltId
OwlItem
OwlItemMeta
_superOwl_elt :: OwlItem
_superOwl_meta :: OwlItemMeta
_superOwl_id :: REltId
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_id :: SuperOwl -> REltId
..} = OwlItemMeta -> REltId
_owlItemMeta_depth OwlItemMeta
_superOwl_meta forall a. Eq a => a -> a -> Bool
== REltId
0 Bool -> Bool -> Bool
&& OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
_superOwl_meta forall a. Eq a => a -> a -> Bool
== REltId
noOwl

noOwl :: REltId
noOwl :: REltId
noOwl = -REltId
1

superOwl_parentId :: SuperOwl -> REltId
superOwl_parentId :: SuperOwl -> REltId
superOwl_parentId SuperOwl {REltId
OwlItem
OwlItemMeta
_superOwl_elt :: OwlItem
_superOwl_meta :: OwlItemMeta
_superOwl_id :: REltId
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_id :: SuperOwl -> REltId
..} = OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
_superOwl_meta

superOwl_depth :: SuperOwl -> Int
superOwl_depth :: SuperOwl -> REltId
superOwl_depth SuperOwl {REltId
OwlItem
OwlItemMeta
_superOwl_elt :: OwlItem
_superOwl_meta :: OwlItemMeta
_superOwl_id :: REltId
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_id :: SuperOwl -> REltId
..} = OwlItemMeta -> REltId
_owlItemMeta_depth OwlItemMeta
_superOwl_meta

superOwl_owlSubItem :: SuperOwl -> OwlSubItem
superOwl_owlSubItem :: SuperOwl -> OwlSubItem
superOwl_owlSubItem SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
  OwlItem OwlInfo
_ OwlSubItem
x -> OwlSubItem
x


owlTree_superOwlNthParentId :: OwlTree -> SuperOwl -> Int -> REltId
owlTree_superOwlNthParentId :: OwlTree -> SuperOwl -> REltId -> REltId
owlTree_superOwlNthParentId OwlTree
_ SuperOwl
sowl REltId
0 = SuperOwl -> REltId
_superOwl_id SuperOwl
sowl
owlTree_superOwlNthParentId OwlTree
od SuperOwl
sowl REltId
n
  | SuperOwl -> REltId
superOwl_parentId SuperOwl
sowl forall a. Eq a => a -> a -> Bool
== REltId
noOwl = REltId
noOwl
  | Bool
otherwise = OwlTree -> SuperOwl -> REltId -> REltId
owlTree_superOwlNthParentId OwlTree
od (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od (SuperOwl -> REltId
superOwl_parentId SuperOwl
sowl)) (REltId
nforall a. Num a => a -> a -> a
-REltId
1)

-- if parent is selected, then kiddos must not be directly included in the parliament
newtype OwlParliament = OwlParliament {OwlParliament -> Seq REltId
unOwlParliament :: Seq REltId} deriving (REltId -> OwlParliament -> ShowS
[OwlParliament] -> ShowS
OwlParliament -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlParliament] -> ShowS
$cshowList :: [OwlParliament] -> ShowS
show :: OwlParliament -> String
$cshow :: OwlParliament -> String
showsPrec :: REltId -> OwlParliament -> ShowS
$cshowsPrec :: REltId -> OwlParliament -> ShowS
Show, forall x. Rep OwlParliament x -> OwlParliament
forall x. OwlParliament -> Rep OwlParliament x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwlParliament x -> OwlParliament
$cfrom :: forall x. OwlParliament -> Rep OwlParliament x
Generic)

instance NFData OwlParliament

-- same as OwlParialment but contains more information
-- TODO consider adding OwlTree reference to this type and rename to SuperDuperOwlParliament or something like that
newtype SuperOwlParliament = SuperOwlParliament {SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament :: Seq SuperOwl} deriving (SuperOwlParliament -> SuperOwlParliament -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuperOwlParliament -> SuperOwlParliament -> Bool
$c/= :: SuperOwlParliament -> SuperOwlParliament -> Bool
== :: SuperOwlParliament -> SuperOwlParliament -> Bool
$c== :: SuperOwlParliament -> SuperOwlParliament -> Bool
Eq, REltId -> SuperOwlParliament -> ShowS
[SuperOwlParliament] -> ShowS
SuperOwlParliament -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuperOwlParliament] -> ShowS
$cshowList :: [SuperOwlParliament] -> ShowS
show :: SuperOwlParliament -> String
$cshow :: SuperOwlParliament -> String
showsPrec :: REltId -> SuperOwlParliament -> ShowS
$cshowsPrec :: REltId -> SuperOwlParliament -> ShowS
Show, forall x. Rep SuperOwlParliament x -> SuperOwlParliament
forall x. SuperOwlParliament -> Rep SuperOwlParliament x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SuperOwlParliament x -> SuperOwlParliament
$cfrom :: forall x. SuperOwlParliament -> Rep SuperOwlParliament x
Generic)

instance NFData SuperOwlParliament

instance PotatoShow SuperOwlParliament where
  potatoShow :: SuperOwlParliament -> Text
potatoShow (SuperOwlParliament Seq SuperOwl
sowls) = Text -> [Text] -> Text
T.intercalate Text
"\n" 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. PotatoShow a => a -> Text
potatoShow Seq SuperOwl
sowls

class IsParliament a where
  isParliament_disjointUnion :: a -> a -> a
  isParliament_null :: a -> Bool
  isParliament_empty :: a
  isParliament_length :: a -> Int

--  isParliament_isValid :: OwlMapping -> a -> Bool

disjointUnion :: (Eq a) => [a] -> [a] -> [a]
disjointUnion :: forall a. Eq a => [a] -> [a] -> [a]
disjointUnion [a]
a [a]
b = forall a. Eq a => [a] -> [a] -> [a]
L.union [a]
a [a]
b forall a. Eq a => [a] -> [a] -> [a]
L.\\ forall a. Eq a => [a] -> [a] -> [a]
L.intersect [a]
a [a]
b

instance IsParliament OwlParliament where
  isParliament_disjointUnion :: OwlParliament -> OwlParliament -> OwlParliament
isParliament_disjointUnion (OwlParliament Seq REltId
s1) (OwlParliament Seq REltId
s2) = Seq REltId -> OwlParliament
OwlParliament forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
disjointUnion (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REltId
s1) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REltId
s2)
  isParliament_null :: OwlParliament -> Bool
isParliament_null = forall a. Seq a -> Bool
Seq.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlParliament -> Seq REltId
unOwlParliament
  isParliament_empty :: OwlParliament
isParliament_empty = Seq REltId -> OwlParliament
OwlParliament forall a. Seq a
Seq.empty
  isParliament_length :: OwlParliament -> REltId
isParliament_length (OwlParliament Seq REltId
x) = forall a. Seq a -> REltId
Seq.length Seq REltId
x


instance IsParliament SuperOwlParliament where
  isParliament_disjointUnion :: SuperOwlParliament -> SuperOwlParliament -> SuperOwlParliament
isParliament_disjointUnion (SuperOwlParliament Seq SuperOwl
s1) (SuperOwlParliament Seq SuperOwl
s2) = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
disjointUnion (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SuperOwl
s1) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SuperOwl
s2)
  isParliament_null :: SuperOwlParliament -> Bool
isParliament_null = forall a. Seq a -> Bool
Seq.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament
  isParliament_empty :: SuperOwlParliament
isParliament_empty = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament forall a. Seq a
Seq.empty
  isParliament_length :: SuperOwlParliament -> REltId
isParliament_length (SuperOwlParliament Seq SuperOwl
x) = forall a. Seq a -> REltId
Seq.length Seq SuperOwl
x

owlParliament_toSuperOwlParliament :: OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament :: OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} OwlParliament
op = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap REltId -> SuperOwl
f (OwlParliament -> Seq REltId
unOwlParliament OwlParliament
op)
  where
    f :: REltId -> SuperOwl
f REltId
rid = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid OwlMapping
_owlTree_mapping of
      Maybe (OwlItemMeta, OwlItem)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ OwlTree -> REltId -> Text
errorMsg_owlTree_lookupFail OwlTree
od REltId
rid
      Just (OwlItemMeta
oem, OwlItem
oe) -> REltId -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl REltId
rid OwlItemMeta
oem OwlItem
oe

superOwlParliament_toOwlParliament :: SuperOwlParliament -> OwlParliament
superOwlParliament_toOwlParliament :: SuperOwlParliament -> OwlParliament
superOwlParliament_toOwlParliament = Seq REltId -> OwlParliament
OwlParliament forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> REltId
_superOwl_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament


-- | partition a list into groups based on int pairings
partitionN :: (a -> Int) -> Seq a -> IM.IntMap (Seq a)
partitionN :: forall a. (a -> REltId) -> Seq a -> IntMap (Seq a)
partitionN a -> REltId
f Seq a
as = IntMap (Seq a)
r where
  alterfn :: a -> Maybe (Seq a) -> Maybe (Seq a)
alterfn a
x Maybe (Seq a)
ml = case Maybe (Seq a)
ml of
    Maybe (Seq a)
Nothing -> forall a. a -> Maybe a
Just (forall a. a -> Seq a
Seq.singleton a
x)
    Just Seq a
xs -> forall a. a -> Maybe a
Just (a
xforall a. a -> Seq a -> Seq a
<|Seq a
xs)
  foldfn :: a -> IntMap (Seq a) -> IntMap (Seq a)
foldfn a
a IntMap (Seq a)
acc = forall a. (Maybe a -> Maybe a) -> REltId -> IntMap a -> IntMap a
IM.alter (forall {a}. a -> Maybe (Seq a) -> Maybe (Seq a)
alterfn a
a) (a -> REltId
f a
a) IntMap (Seq a)
acc
  r :: IntMap (Seq a)
r = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> IntMap (Seq a) -> IntMap (Seq a)
foldfn forall a. IntMap a
IM.empty Seq a
as

-- TODO how is this different than `\od sowls -> Seq.sortBy (owlTree_superOwl_comparePosition od) sowls`
  -- if it's not, than you can use them to UT against each other
-- TODO rename, SuperOwlParliament is always sorted so the name is redundant!
-- input type is not SuperOwlParliament type because it is not ordered
makeSortedSuperOwlParliament :: OwlTree -> Seq SuperOwl -> SuperOwlParliament
makeSortedSuperOwlParliament :: OwlTree -> Seq SuperOwl -> SuperOwlParliament
makeSortedSuperOwlParliament OwlTree
od Seq SuperOwl
sowls = SuperOwlParliament
r where

  -- attach parents (at front of list, last elt is child and actuall part of original selection)
  makeParentChain :: SuperOwl -> [SuperOwl]
  makeParentChain :: SuperOwl -> [SuperOwl]
makeParentChain SuperOwl
sowl = [SuperOwl]
done where
    makeParentChain' :: SuperOwl -> [SuperOwl] -> [SuperOwl]
makeParentChain' SuperOwl
sowl' [SuperOwl]
acc = case SuperOwl -> REltId
superOwl_parentId SuperOwl
sowl' of
      REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> [SuperOwl]
acc
      REltId
x -> SuperOwl -> [SuperOwl] -> [SuperOwl]
makeParentChain' SuperOwl
parentsowl (SuperOwl
parentsowlforall a. a -> [a] -> [a]
:[SuperOwl]
acc) where
        parentsowl :: SuperOwl
parentsowl = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
x
    done :: [SuperOwl]
done = SuperOwl -> [SuperOwl] -> [SuperOwl]
makeParentChain' SuperOwl
sowl (SuperOwl
sowlforall a. a -> [a] -> [a]
:[])

  parentChains :: Seq [SuperOwl]
parentChains = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> [SuperOwl]
makeParentChain Seq SuperOwl
sowls

  -- this function is sketch af D:
  sortrec :: Seq [SuperOwl] -> Seq SuperOwl
  sortrec :: Seq [SuperOwl] -> Seq SuperOwl
sortrec Seq [SuperOwl]
chains = Seq SuperOwl
done where
    frontid :: [SuperOwl] -> REltId
frontid (SuperOwl
x:[SuperOwl]
_) = SuperOwl -> REltId
_superOwl_id SuperOwl
x
    frontid [SuperOwl]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should never happen"

    groupedParentChains :: IntMap (Seq [SuperOwl])
groupedParentChains = forall a. (a -> REltId) -> Seq a -> IntMap (Seq a)
partitionN [SuperOwl] -> REltId
frontid Seq [SuperOwl]
chains

    removeFront :: [a] -> [a]
removeFront (a
_:[a]
xs) = [a]
xs
    removeFront [] = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should never happen"

    -- it's not necessary to look up rid as it will be the first element in each Seq elt in the value but whatever this is easier (to fix, you should rewrite partitionN)
    groupedParentChains2 :: Seq (SuperOwl, Seq [SuperOwl])
groupedParentChains2 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(REltId
rid,Seq [SuperOwl]
x) -> (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid, Seq [SuperOwl]
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(REltId, a)]
IM.toList forall a b. (a -> b) -> a -> b
$ IntMap (Seq [SuperOwl])
groupedParentChains
    cfn :: (SuperOwl, b) -> REltId
cfn = OwlItemMeta -> REltId
_owlItemMeta_position forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
    sortedPairs :: Seq (SuperOwl, Seq [SuperOwl])
sortedPairs = forall b a. Ord b => (a -> b) -> Seq a -> Seq a
Seq.sortOn forall {b}. (SuperOwl, b) -> REltId
cfn forall a b. (a -> b) -> a -> b
$ Seq (SuperOwl, Seq [SuperOwl])
groupedParentChains2

    -- sketchy logic here reliant on assumptions carried over from previous iteration... TODO rewrite this so it's not so weird
    fmapfn :: (a, Seq [SuperOwl]) -> Seq SuperOwl
fmapfn (a
_, Seq [SuperOwl]
chains') = if forall a. Seq a -> REltId
Seq.length Seq [SuperOwl]
chains' forall a. Eq a => a -> a -> Bool
== REltId
1
      -- this is unititive, but if the group has only 1 chain in it, that means it's already sorted and hence are leaf node case
      then forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Seq a
Seq.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
Unsafe.last) Seq [SuperOwl]
chains'
      -- otherwise, we have more children to process, note that if assumptions are correct, then each chain in the sequence has at least 2 elts (otherwise it would have been caught by the above condition in the previous iteration)
      else Seq [SuperOwl] -> Seq SuperOwl
sortrec (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. [a] -> [a]
removeFront Seq [SuperOwl]
chains')


    done :: Seq SuperOwl
done = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (a, Seq [SuperOwl]) -> Seq SuperOwl
fmapfn  forall a b. (a -> b) -> a -> b
$ Seq (SuperOwl, Seq [SuperOwl])
sortedPairs

  r :: SuperOwlParliament
r = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament forall a b. (a -> b) -> a -> b
$ Seq [SuperOwl] -> Seq SuperOwl
sortrec Seq [SuperOwl]
parentChains

-- TODO test
-- assumes s1 is and s2 are valid
superOwlParliament_disjointUnionAndCorrect :: OwlTree -> SuperOwlParliament -> SuperOwlParliament -> SuperOwlParliament
superOwlParliament_disjointUnionAndCorrect :: OwlTree
-> SuperOwlParliament -> SuperOwlParliament -> SuperOwlParliament
superOwlParliament_disjointUnionAndCorrect OwlTree
od (SuperOwlParliament Seq SuperOwl
s1) (SuperOwlParliament Seq SuperOwl
s2) = SuperOwlParliament
r where

  -- first convert s1 into a map
  mapsop0 :: IM.IntMap SuperOwl
  mapsop0 :: IntMap SuperOwl
mapsop0 = forall a. [(REltId, a)] -> IntMap a
IM.fromList 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
. 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
$ Seq SuperOwl
s1

  addToSelection :: SuperOwl -> IM.IntMap SuperOwl -> IM.IntMap SuperOwl
  addToSelection :: SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
addToSelection SuperOwl
sowl IntMap SuperOwl
mapsop = IntMap SuperOwl
rslt where
    rid :: REltId
rid = SuperOwl -> REltId
_superOwl_id SuperOwl
sowl

    -- add self to map
    rslt' :: IntMap SuperOwl
rslt' = forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid SuperOwl
sowl IntMap SuperOwl
mapsop

    -- check if any children are selected and remove them from selection
    children :: Seq SuperOwl
children = OwlTree -> REltId -> Seq SuperOwl
owliteratechildrenat OwlTree
od REltId
rid
    rslt :: IntMap SuperOwl
rslt = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SuperOwl
x IntMap SuperOwl
acc -> forall a. REltId -> IntMap a -> IntMap a
IM.delete (SuperOwl -> REltId
_superOwl_id SuperOwl
x) IntMap SuperOwl
acc) IntMap SuperOwl
rslt' Seq SuperOwl
children

  -- assumes sowl is NOT in mapsop and that one of its ancestors is
  -- removes sowl from mapsop and adds its siblings and recurses on its parent until it reaches a selected parent
  removeFromInheritSelection :: SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection SuperOwl
sowl IntMap SuperOwl
mapsop = IntMap SuperOwl
rslt where
    prid :: REltId
prid = SuperOwl -> REltId
superOwl_parentId SuperOwl
sowl
    -- the parent is guaranteed to exist because we only call this on elements who inheritSelected
    mommy :: SuperOwl
mommy = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
prid
    newkiddos :: Seq REltId
newkiddos = forall a. REltId -> Seq a -> Seq a
Seq.deleteAt (OwlItemMeta -> REltId
_owlItemMeta_position forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos SuperOwl
mommy)
    -- add siblings to selection (guaranteed that none of their children are selected by assumption)
    mapsop' :: IntMap SuperOwl
mapsop' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\REltId
rid IntMap SuperOwl
acc -> forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid) IntMap SuperOwl
acc) IntMap SuperOwl
mapsop Seq REltId
newkiddos
    rslt :: IntMap SuperOwl
rslt = if forall a. REltId -> IntMap a -> Bool
IM.member REltId
prid IntMap SuperOwl
mapsop'
      -- we've reached the selected parent, deselect it and return our new selection
      then forall a. REltId -> IntMap a -> IntMap a
IM.delete REltId
prid IntMap SuperOwl
mapsop'
      -- recursively deselect the parent
      else SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
prid) IntMap SuperOwl
mapsop'

  isDescendentOfOwlMap :: REltId -> IM.IntMap SuperOwl -> Bool
  isDescendentOfOwlMap :: REltId -> IntMap SuperOwl -> Bool
isDescendentOfOwlMap REltId
rid IntMap SuperOwl
mapsop = if forall a. REltId -> IntMap a -> Bool
IM.member REltId
rid IntMap SuperOwl
mapsop
    then Bool
True
    else case OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od REltId
rid of
      Maybe SuperOwl
Nothing -> Bool
False
      Just SuperOwl
x -> REltId -> IntMap SuperOwl -> Bool
isDescendentOfOwlMap (SuperOwl -> REltId
superOwl_parentId SuperOwl
x) IntMap SuperOwl
mapsop

  foldfn :: SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
foldfn SuperOwl
sowl IntMap SuperOwl
acc = if forall a. REltId -> IntMap a -> Bool
IM.member REltId
rid IntMap SuperOwl
acc
    -- we are selected, remove self from selection
    then forall a. REltId -> IntMap a -> IntMap a
IM.delete REltId
rid IntMap SuperOwl
acc
    -- we are not selected
    else if REltId -> IntMap SuperOwl -> Bool
isDescendentOfOwlMap REltId
rid IntMap SuperOwl
acc
      -- parent selected
      then SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection SuperOwl
sowl IntMap SuperOwl
acc
      -- parent not selected, add self to selection
      else SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
addToSelection SuperOwl
sowl IntMap SuperOwl
acc
    where
      rid :: REltId
rid = SuperOwl -> REltId
_superOwl_id SuperOwl
sowl

  mapsop1 :: IntMap SuperOwl
mapsop1 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
foldfn IntMap SuperOwl
mapsop0 Seq SuperOwl
s2
  unsortedSeq :: Seq SuperOwl
unsortedSeq = forall a. [a] -> Seq a
Seq.fromList (forall a. IntMap a -> [a]
IM.elems IntMap SuperOwl
mapsop1)

  r :: SuperOwlParliament
r = OwlTree -> Seq SuperOwl -> SuperOwlParliament
makeSortedSuperOwlParliament OwlTree
od Seq SuperOwl
unsortedSeq

superOwlParliament_isValid :: OwlTree -> SuperOwlParliament -> Bool
superOwlParliament_isValid :: OwlTree -> SuperOwlParliament -> Bool
superOwlParliament_isValid OwlTree
od sop :: SuperOwlParliament
sop@(SuperOwlParliament Seq SuperOwl
owls) = Bool
r
  where
    om :: OwlMapping
om = OwlTree -> OwlMapping
_owlTree_mapping OwlTree
od

    -- check if a mommy owl is selected, that no descendant of that mommy owl is selected
    kiddosFirst :: Seq SuperOwl
kiddosFirst = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (\SuperOwl
a SuperOwl
b -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare (OwlItemMeta -> REltId
_owlItemMeta_depth (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
a)) (OwlItemMeta -> REltId
_owlItemMeta_depth (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
b))) Seq SuperOwl
owls
    acc0 :: (Set REltId, Set REltId, Bool)
acc0 = (forall a. Set a
Set.empty, forall a. Ord a => [a] -> Set a
Set.fromList 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
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> REltId
_superOwl_id forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
owls, Bool
True)
    foldlfn :: (Set REltId, Set REltId, Bool)
-> SuperOwl -> (Set REltId, Set REltId, Bool)
foldlfn (Set REltId
visited, Set REltId
mommies', Bool
passing) SuperOwl
sowl = (Set REltId
nextVisited, Set REltId
mommies, Bool
passMommyCheck Bool -> Bool -> Bool
&& Bool
passing)
      where
        -- remove self from list of mommies
        -- TODO you  don't actually need to check two elts at the same level, you can be smarter about removing mommies at each level
        mommies :: Set REltId
mommies = forall a. Ord a => a -> Set a -> Set a
Set.delete (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl) Set REltId
mommies'

        checkMommyRec :: REltId -> Set REltId -> (Set REltId, Bool)
checkMommyRec REltId
rid Set REltId
toVisit = case REltId
rid of
          -- made it to the top
          REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> (Set REltId
toVisit, Bool
True)
          REltId
_ -> case forall a. Ord a => a -> Set a -> Bool
Set.member REltId
rid Set REltId
visited of
            -- we've been here before, must be OK
            Bool
True -> (Set REltId
toVisit, Bool
True)
            Bool
False -> case forall a. Ord a => a -> Set a -> Bool
Set.member REltId
rid Set REltId
mommies of
              -- one of our mommies, not OK
              Bool
True -> (Set REltId
toVisit, Bool
False)
              Bool
False -> case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid OwlMapping
om of
                Maybe (OwlItemMeta, OwlItem)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail OwlMapping
om REltId
rid
                -- add self to list of mommies to visit and recurse
                Just (OwlItemMeta
oem, OwlItem
_) -> REltId -> Set REltId -> (Set REltId, Bool)
checkMommyRec (OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
oem) (forall a. Ord a => a -> Set a -> Set a
Set.insert REltId
rid Set REltId
toVisit)
        (Set REltId
visitedMommies, Bool
passMommyCheck) = REltId -> Set REltId -> (Set REltId, Bool)
checkMommyRec (OwlItemMeta -> REltId
_owlItemMeta_parent (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl)) forall a. Set a
Set.empty
        nextVisited :: Set REltId
nextVisited =
          if Bool
passMommyCheck
            then forall a. Ord a => Set a -> Set a -> Set a
Set.union Set REltId
visited Set REltId
visitedMommies
            else Set REltId
visited

    (Set REltId
_, Set REltId
_, Bool
r1) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Set REltId, Set REltId, Bool)
-> SuperOwl -> (Set REltId, Set REltId, Bool)
foldlfn (Set REltId, Set REltId, Bool)
acc0 Seq SuperOwl
kiddosFirst

    -- check that parliament is in fact ordered correctly (inefficiently 😭)
    r2 :: Bool
r2 = OwlTree -> Seq SuperOwl -> SuperOwlParliament
makeSortedSuperOwlParliament OwlTree
od Seq SuperOwl
owls forall a. Eq a => a -> a -> Bool
== SuperOwlParliament
sop

    r :: Bool
r = Bool
r1 Bool -> Bool -> Bool
&& Bool
r2

superOwlParliament_toSEltTree :: OwlTree -> SuperOwlParliament -> SEltTree
superOwlParliament_toSEltTree :: OwlTree -> SuperOwlParliament -> SEltTree
superOwlParliament_toSEltTree od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} (SuperOwlParliament Seq SuperOwl
sowls) = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Seq (Seq (REltId, SEltLabel))
r
  where
    makeSElt :: REltId -> SuperOwl -> (REltId, Seq (REltId, SEltLabel))
    makeSElt :: REltId -> SuperOwl -> (REltId, Seq (REltId, SEltLabel))
makeSElt REltId
maxid SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
      OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq REltId
kiddos) -> (REltId
newmaxid,
          forall a. a -> Seq a
Seq.singleton (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl, Text -> SElt -> SEltLabel
SEltLabel (OwlInfo -> Text
_owlInfo_name OwlInfo
oinfo) SElt
SEltFolderStart)
            forall a. Seq a -> Seq a -> Seq a
>< (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Seq (Seq (REltId, SEltLabel))
childSElts)
            forall a. Seq a -> Seq a -> Seq a
>< forall a. a -> Seq a
Seq.singleton (REltId
maxid forall a. Num a => a -> a -> a
+ REltId
1, Text -> SElt -> SEltLabel
SEltLabel (OwlInfo -> Text
_owlInfo_name OwlInfo
oinfo forall a. Semigroup a => a -> a -> a
<> Text
"(end)") SElt
SEltFolderEnd)
        )
        where
          kiddoS :: Seq SuperOwl
kiddoS = (SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq REltId -> OwlParliament
OwlParliament forall a b. (a -> b) -> a -> b
$ Seq REltId
kiddos)
          (REltId
newmaxid, Seq (Seq (REltId, SEltLabel))
childSElts) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL REltId -> SuperOwl -> (REltId, Seq (REltId, SEltLabel))
makeSElt (REltId
maxid forall a. Num a => a -> a -> a
+ REltId
1) Seq SuperOwl
kiddoS
      OwlItem
_ -> (REltId
maxid, forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl, forall o. HasOwlItem o => o -> SEltLabel
hasOwlItem_toSEltLabel_hack (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl)))
    (REltId
_, Seq (Seq (REltId, SEltLabel))
r) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL REltId -> SuperOwl -> (REltId, Seq (REltId, SEltLabel))
makeSElt (OwlTree -> REltId
owlTree_maxId OwlTree
od) Seq SuperOwl
sowls


newtype CanvasSelection = CanvasSelection { CanvasSelection -> Seq SuperOwl
unCanvasSelection :: Seq SuperOwl } deriving (REltId -> CanvasSelection -> ShowS
[CanvasSelection] -> ShowS
CanvasSelection -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CanvasSelection] -> ShowS
$cshowList :: [CanvasSelection] -> ShowS
show :: CanvasSelection -> String
$cshow :: CanvasSelection -> String
showsPrec :: REltId -> CanvasSelection -> ShowS
$cshowsPrec :: REltId -> CanvasSelection -> ShowS
Show, CanvasSelection -> CanvasSelection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CanvasSelection -> CanvasSelection -> Bool
$c/= :: CanvasSelection -> CanvasSelection -> Bool
== :: CanvasSelection -> CanvasSelection -> Bool
$c== :: CanvasSelection -> CanvasSelection -> Bool
Eq)

-- | convert SuperOwlParliament to CanvasSelection (includes children and no folders)
-- does not omits locked/hidden elts since Owl should not depend on Layers, you should do this using filterfn I guess??
superOwlParliament_convertToCanvasSelection :: OwlTree -> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection :: OwlTree
-> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} SuperOwl -> Bool
filterfn (SuperOwlParliament Seq SuperOwl
sowls) = CanvasSelection
r where
  filtered :: Seq SuperOwl
filtered = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter SuperOwl -> Bool
filterfn Seq SuperOwl
sowls
  sopify :: Seq REltId -> SuperOwlParliament
sopify Seq REltId
children = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od (Seq REltId -> OwlParliament
OwlParliament Seq REltId
children)
  -- if folder then recursively include children otherwise include self
  mapfn :: SuperOwl -> Seq SuperOwl
mapfn SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
    OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
kiddos) -> CanvasSelection -> Seq SuperOwl
unCanvasSelection forall a b. (a -> b) -> a -> b
$ OwlTree
-> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection OwlTree
od SuperOwl -> Bool
filterfn (Seq REltId -> SuperOwlParliament
sopify Seq REltId
kiddos)
    OwlItem
_ -> forall a. a -> Seq a
Seq.singleton SuperOwl
sowl
  r :: CanvasSelection
r = Seq SuperOwl -> CanvasSelection
CanvasSelection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Seq SuperOwl
mapfn forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
filtered

-- converts a SuperOwlParliament to its ordered Seq of SuperOwls including its children
superOwlParliament_convertToSeqWithChildren :: OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren :: OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} (SuperOwlParliament Seq SuperOwl
sowls) = Seq SuperOwl
r where
  sopify :: Seq REltId -> SuperOwlParliament
sopify Seq REltId
children = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od (Seq REltId -> OwlParliament
OwlParliament Seq REltId
children)
  -- if folder then recursively include children otherwise include self
  mapfn :: SuperOwl -> Seq SuperOwl
mapfn SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
    OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
kiddos) -> SuperOwl
sowl forall a. a -> Seq a -> Seq a
<| (OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren OwlTree
od (Seq REltId -> SuperOwlParliament
sopify Seq REltId
kiddos))
    OwlItem
_ -> forall a. a -> Seq a
Seq.singleton SuperOwl
sowl
  r :: Seq SuperOwl
r = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Seq SuperOwl
mapfn forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
sowls

-- | intended for use in OwlWorkspace to create PFCmd
-- generate MiniOwlTree will be reindexed so as not to conflict with OwlTree
-- relies on OwlParliament being correctly ordered
owlParliament_convertToMiniOwltree :: OwlTree -> OwlParliament -> MiniOwlTree
owlParliament_convertToMiniOwltree :: OwlTree -> OwlParliament -> OwlTree
owlParliament_convertToMiniOwltree od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} op :: OwlParliament
op@(OwlParliament Seq REltId
owls) = forall a. HasCallStack => Bool -> a -> a
assert Bool
valid OwlTree
r where
  valid :: Bool
valid = OwlTree -> SuperOwlParliament -> Bool
superOwlParliament_isValid OwlTree
od forall a b. (a -> b) -> a -> b
$ OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od OwlParliament
op

  addOwl :: REltId -> REltId -> Seq REltId -> (OwlMapping, IM.IntMap REltId, REltId, SiblingPosition) -> (OwlMapping, IM.IntMap REltId, REltId)
  addOwl :: REltId
-> REltId
-> Seq REltId
-> (OwlMapping, REltIdMap REltId, REltId, REltId)
-> (OwlMapping, REltIdMap REltId, REltId)
addOwl REltId
newprid REltId
rid Seq REltId
newchildrids (OwlMapping
om, REltIdMap REltId
ridremap, REltId
nrid, REltId
pos) = (OwlMapping
newom, REltIdMap REltId
newridremap, REltId
nridforall a. Num a => a -> a -> a
+REltId
1) where
    sowl :: SuperOwl
sowl = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid
    newoem :: OwlItemMeta
newoem = OwlItemMeta {
        _owlItemMeta_parent :: REltId
_owlItemMeta_parent = REltId
newprid
        , _owlItemMeta_depth :: REltId
_owlItemMeta_depth = REltId
0
        , _owlItemMeta_position :: REltId
_owlItemMeta_position = REltId
pos -- relies on OwlParliament being correctly ordered
      }
    newoe :: OwlItem
newoe = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
      OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq REltId
_) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq REltId -> OwlSubItem
OwlSubItemFolder Seq REltId
newchildrids)
      OwlItem
x -> OwlItem
x
    newom :: OwlMapping
newom = forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
nrid (OwlItemMeta
newoem, OwlItem
newoe) OwlMapping
om
    newridremap :: REltIdMap REltId
newridremap = forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid REltId
nrid REltIdMap REltId
ridremap

  -- TODO this needs to return remapped rids (use mapAccumL)
  addOwlRecursive :: Int -> REltId -> REltId -> (OwlMapping, IM.IntMap REltId, REltId, SiblingPosition) -> ((OwlMapping, IM.IntMap REltId, REltId, SiblingPosition), REltId)
  addOwlRecursive :: REltId
-> REltId
-> REltId
-> (OwlMapping, REltIdMap REltId, REltId, REltId)
-> ((OwlMapping, REltIdMap REltId, REltId, REltId), REltId)
addOwlRecursive REltId
depth REltId
prid REltId
rid (OwlMapping
om, REltIdMap REltId
ridremap, REltId
nrid, REltId
pos) = ((OwlMapping, REltIdMap REltId, REltId, REltId), REltId)
rslt where

    newprid :: REltId
newprid = if REltId
prid forall a. Eq a => a -> a -> Bool
== REltId
noOwl then REltId
noOwl else REltIdMap REltId
ridremap forall a. IntMap a -> REltId -> a
IM.! REltId
prid

    -- add self (note that nrid is the new rid of the owl we just added)
    (OwlMapping
newom', REltIdMap REltId
newridremap', REltId
newnrid') = REltId
-> REltId
-> Seq REltId
-> (OwlMapping, REltIdMap REltId, REltId, REltId)
-> (OwlMapping, REltIdMap REltId, REltId)
addOwl REltId
newprid REltId
rid (Seq REltId
newchildrids) (OwlMapping
om, REltIdMap REltId
ridremap, REltId
nrid, REltId
pos)

    children :: Seq REltId
children = forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Seq.empty forall a b. (a -> b) -> a -> b
$ forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos forall a b. (a -> b) -> a -> b
$ HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid

    -- recursively add children
    ((OwlMapping
newom, REltIdMap REltId
newridremap, REltId
newnrid, REltId
_), Seq REltId
newchildrids) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\(OwlMapping, REltIdMap REltId, REltId, REltId)
acc REltId
crid -> REltId
-> REltId
-> REltId
-> (OwlMapping, REltIdMap REltId, REltId, REltId)
-> ((OwlMapping, REltIdMap REltId, REltId, REltId), REltId)
addOwlRecursive (REltId
depthforall a. Num a => a -> a -> a
+REltId
1) REltId
rid REltId
crid (OwlMapping, REltIdMap REltId, REltId, REltId)
acc) (OwlMapping
newom', REltIdMap REltId
newridremap', REltId
newnrid', REltId
0) Seq REltId
children

    rslt :: ((OwlMapping, REltIdMap REltId, REltId, REltId), REltId)
rslt = ((OwlMapping
newom, REltIdMap REltId
newridremap, REltId
newnrid, REltId
posforall a. Num a => a -> a -> a
+REltId
1), REltId
nrid)


  -- recursively add all children to owltree and reindex
  ((OwlMapping
om1, REltIdMap REltId
_, REltId
_, REltId
_), Seq REltId
newtopowls) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\(OwlMapping, REltIdMap REltId, REltId, REltId)
acc REltId
rid -> REltId
-> REltId
-> REltId
-> (OwlMapping, REltIdMap REltId, REltId, REltId)
-> ((OwlMapping, REltIdMap REltId, REltId, REltId), REltId)
addOwlRecursive REltId
0 REltId
noOwl REltId
rid (OwlMapping, REltIdMap REltId, REltId, REltId)
acc) (forall a. IntMap a
IM.empty, forall a. IntMap a
IM.empty, OwlTree -> REltId
owlTree_maxId OwlTree
od forall a. Num a => a -> a -> a
+ REltId
1, REltId
0) Seq REltId
owls

  r :: OwlTree
r = OwlTree {
      _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
om1
      , _owlTree_topOwls :: Seq REltId
_owlTree_topOwls = Seq REltId
newtopowls
    }


type OwlParliamentSet = IS.IntSet

superOwlParliament_toOwlParliamentSet :: SuperOwlParliament -> OwlParliamentSet
superOwlParliament_toOwlParliamentSet :: SuperOwlParliament -> IntSet
superOwlParliament_toOwlParliamentSet (SuperOwlParliament Seq SuperOwl
sowls) = [REltId] -> IntSet
IS.fromList 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
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> REltId
_superOwl_id forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
sowls

owlParliamentSet_member :: REltId -> OwlParliamentSet -> Bool
owlParliamentSet_member :: REltId -> IntSet -> Bool
owlParliamentSet_member = REltId -> IntSet -> Bool
IS.member

-- | returns true if rid is a contained in the OwlParliamentSet or is a descendent of sset
owlParliamentSet_descendent :: OwlTree -> REltId -> OwlParliamentSet -> Bool
owlParliamentSet_descendent :: OwlTree -> REltId -> IntSet -> Bool
owlParliamentSet_descendent OwlTree
ot REltId
rid IntSet
sset = if REltId -> IntSet -> Bool
owlParliamentSet_member REltId
rid IntSet
sset
  then Bool
True
  else case OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
ot REltId
rid of
    Maybe SuperOwl
Nothing -> Bool
False
    Just SuperOwl
x -> OwlTree -> REltId -> IntSet -> Bool
owlParliamentSet_descendent OwlTree
ot (SuperOwl -> REltId
superOwl_parentId SuperOwl
x) IntSet
sset

-- UNTESTED
owlParliamentSet_findParents :: OwlTree -> OwlParliamentSet -> OwlParliamentSet
owlParliamentSet_findParents :: OwlTree -> IntSet -> IntSet
owlParliamentSet_findParents OwlTree
od IntSet
ops = IntSet
r where
  foldrfn :: REltId -> IntSet -> IntSet
foldrfn REltId
rid IntSet
acc = case OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od REltId
rid of
    Maybe SuperOwl
Nothing -> IntSet
acc
    Just SuperOwl
sowl -> let
        prid :: REltId
prid = OwlItemMeta -> REltId
_owlItemMeta_parent (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl)
      in if REltId
prid forall a. Eq a => a -> a -> Bool
== REltId
noOwl
        then IntSet
acc
        else REltId -> IntSet -> IntSet
IS.insert REltId
prid IntSet
acc
  parents :: IntSet
parents = forall b. (REltId -> b -> b) -> b -> IntSet -> b
IS.foldr REltId -> IntSet -> IntSet
foldrfn IntSet
IS.empty IntSet
ops
  superparents :: IntSet
superparents = if IntSet -> Bool
IS.null IntSet
parents then IntSet
IS.empty else OwlTree -> IntSet -> IntSet
owlParliamentSet_findParents OwlTree
od IntSet
parents
  r :: IntSet
r = IntSet -> IntSet -> IntSet
IS.union IntSet
parents IntSet
superparents




-- |
data OwlTree = OwlTree
  { OwlTree -> OwlMapping
_owlTree_mapping :: OwlMapping,
    OwlTree -> Seq REltId
_owlTree_topOwls :: Seq REltId
  }
  deriving (REltId -> OwlTree -> ShowS
[OwlTree] -> ShowS
OwlTree -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlTree] -> ShowS
$cshowList :: [OwlTree] -> ShowS
show :: OwlTree -> String
$cshow :: OwlTree -> String
showsPrec :: REltId -> OwlTree -> ShowS
$cshowsPrec :: REltId -> OwlTree -> ShowS
Show, OwlTree -> OwlTree -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OwlTree -> OwlTree -> Bool
$c/= :: OwlTree -> OwlTree -> Bool
== :: OwlTree -> OwlTree -> Bool
$c== :: OwlTree -> OwlTree -> Bool
Eq, forall x. Rep OwlTree x -> OwlTree
forall x. OwlTree -> Rep OwlTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwlTree x -> OwlTree
$cfrom :: forall x. OwlTree -> Rep OwlTree x
Generic)

instance NFData OwlTree

instance MommyOwl OwlTree where
  mommyOwl_kiddos :: OwlTree -> Maybe (Seq REltId)
mommyOwl_kiddos OwlTree
o = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq REltId
_owlTree_topOwls OwlTree
o

type MiniOwlTree = OwlTree

-- | check if two OwlTree's are equivalent
-- checks if structure is the same, REltIds can differ
owlTree_equivalent :: OwlTree -> OwlTree -> Bool
owlTree_equivalent :: OwlTree -> OwlTree -> Bool
owlTree_equivalent OwlTree
ota OwlTree
otb = Bool
r
  where
    mustFind :: REltId -> OwlTree -> (OwlItemMeta, OwlItem)
mustFind REltId
rid OwlTree
ot = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
ot) of
      Maybe (OwlItemMeta, OwlItem)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ OwlTree -> REltId -> Text
errorMsg_owlTree_lookupFail OwlTree
ot REltId
rid
      Just (OwlItemMeta, OwlItem)
x -> (OwlItemMeta, OwlItem)
x

    kiddos_equivalent :: Seq REltId -> Seq REltId -> Bool
kiddos_equivalent Seq REltId
kiddosa Seq REltId
kiddosb =
      forall a. Seq a -> REltId
Seq.length Seq REltId
kiddosa forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> REltId
Seq.length Seq REltId
kiddosb
        Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. a -> a
id (forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (REltId -> REltId -> Bool
owl_equivalent') Seq REltId
kiddosa Seq REltId
kiddosb)

    owl_equivalent' :: REltId -> REltId -> Bool
owl_equivalent' REltId
rida REltId
ridb = OwlItem -> OwlItem -> Bool
owl_equivalent OwlItem
a' OwlItem
b'
      where
        (OwlItemMeta
_, OwlItem
a') = REltId -> OwlTree -> (OwlItemMeta, OwlItem)
mustFind REltId
rida OwlTree
ota
        (OwlItemMeta
_, OwlItem
b') = REltId -> OwlTree -> (OwlItemMeta, OwlItem)
mustFind REltId
ridb OwlTree
otb

    owl_equivalent :: OwlItem -> OwlItem -> Bool
owl_equivalent (OwlItem OwlInfo
oia (OwlSubItemFolder Seq REltId
kiddosa)) (OwlItem OwlInfo
oib (OwlSubItemFolder Seq REltId
kiddosb)) = OwlInfo
oia forall a. Eq a => a -> a -> Bool
== OwlInfo
oib Bool -> Bool -> Bool
&& Seq REltId -> Seq REltId -> Bool
kiddos_equivalent Seq REltId
kiddosa Seq REltId
kiddosb
    owl_equivalent (OwlItem OwlInfo
oia OwlSubItem
osia) (OwlItem OwlInfo
oib OwlSubItem
osib) = OwlInfo
oia forall a. Eq a => a -> a -> Bool
== OwlInfo
oib Bool -> Bool -> Bool
&& OwlSubItem -> OwlSubItem -> Bool
owlSubItem_equivalent OwlSubItem
osia OwlSubItem
osib

    r :: Bool
r = Seq REltId -> Seq REltId -> Bool
kiddos_equivalent (OwlTree -> Seq REltId
_owlTree_topOwls OwlTree
ota) (OwlTree -> Seq REltId
_owlTree_topOwls OwlTree
otb)

instance PotatoShow OwlTree where
  potatoShow :: OwlTree -> Text
potatoShow od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} = Text
r where
    foldlfn :: Text -> REltId -> Text
foldlfn Text
acc REltId
rid =
      let sowl :: SuperOwl
sowl = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid
          selfEntry' :: Text
selfEntry' = REltId -> Text -> Text
T.replicate (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
sowl) Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. PotatoShow a => a -> Text
potatoShow SuperOwl
sowl
          selfEntry :: Text
selfEntry = Text
selfEntry' forall a. Semigroup a => a -> a -> a
<> Text
"\n"
       in Text
acc forall a. Semigroup a => a -> a -> a
<> case forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos SuperOwl
sowl of
            Maybe (Seq REltId)
Nothing -> Text
selfEntry
            Just Seq REltId
kiddos -> Text
selfEntry forall a. Semigroup a => a -> a -> a
<> Seq REltId -> Text
printKiddos Seq REltId
kiddos
    printKiddos :: Seq REltId -> Text
    printKiddos :: Seq REltId -> Text
printKiddos Seq REltId
kiddos = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> REltId -> Text
foldlfn Text
"" Seq REltId
kiddos
    r :: Text
r = Seq REltId -> Text
printKiddos (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos OwlTree
od)

owlTree_validate :: OwlTree -> (Bool, Text)
owlTree_validate :: OwlTree -> (Bool, Text)
owlTree_validate OwlTree
od = Text -> REltId -> REltId -> Seq REltId -> (Bool, Text)
checkRecursive Text
"" REltId
noOwl REltId
0 (OwlTree -> Seq REltId
_owlTree_topOwls OwlTree
od)
  where
    checkRecursive :: Text -> REltId -> REltId -> Seq REltId -> (Bool, Text)
checkRecursive Text
msg0 REltId
parentrid REltId
depth Seq REltId
kiddos = (Bool, Text)
r
      where
        foldfn :: (Bool, Text) -> REltId -> REltId -> (Bool, Text)
foldfn (Bool
pass', Text
msg') REltId
i REltId
rid = case OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od REltId
rid of
          Maybe SuperOwl
Nothing -> (Bool
False, Text
msg' forall a. Semigroup a => a -> a -> a
<> Text
"\nmissing REltId " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
rid)
          Just SuperOwl
x -> (Bool
rpass, Text
rmsg)
            where
              expected :: OwlItemMeta
expected =
                OwlItemMeta
                  { _owlItemMeta_parent :: REltId
_owlItemMeta_parent = REltId
parentrid,
                    _owlItemMeta_depth :: REltId
_owlItemMeta_depth = REltId
depth,
                    _owlItemMeta_position :: REltId
_owlItemMeta_position = REltId
i
                  }
              rpass1 :: Bool
rpass1 = Bool
pass' Bool -> Bool -> Bool
&& OwlItemMeta
expected forall a. Eq a => a -> a -> Bool
== SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
x
              rmsg1 :: Text
rmsg1 = if Bool
rpass1 then Text
msg' else Text
msg' forall a. Semigroup a => a -> a -> a
<> Text
"\nbad meta at " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
rid forall a. Semigroup a => a -> a -> a
<> Text
" got " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
x) forall a. Semigroup a => a -> a -> a
<> Text
" expected " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show OwlItemMeta
expected
              (Bool
rpass2, Text
rmsg2) = case (forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos SuperOwl
x) of
                Maybe (Seq REltId)
Nothing -> (Bool
rpass1, Text
rmsg1)
                Just Seq REltId
kiddos' -> Text -> REltId -> REltId -> Seq REltId -> (Bool, Text)
checkRecursive Text
msg0 (SuperOwl -> REltId
_superOwl_id SuperOwl
x) (REltId
depth forall a. Num a => a -> a -> a
+ REltId
1) Seq REltId
kiddos'
              (Bool
rpass, Text
rmsg) = (Bool
rpass1 Bool -> Bool -> Bool
&& Bool
rpass2, Text
rmsg2)
        r :: (Bool, Text)
r = forall b a. (b -> REltId -> a -> b) -> b -> Seq a -> b
Seq.foldlWithIndex (Bool, Text) -> REltId -> REltId -> (Bool, Text)
foldfn (Bool
True, Text
msg0) Seq REltId
kiddos

owlTree_maxId :: OwlTree -> REltId
owlTree_maxId :: OwlTree -> REltId
owlTree_maxId OwlTree
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe REltId
0 forall a b. (a, b) -> a
fst (forall a. IntMap a -> Maybe (REltId, a)
IM.lookupMax (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
s))

-- reorganize the children of the given parent
-- i.e. update their position in the directory
internal_owlTree_reorgKiddos :: OwlTree -> REltId -> OwlTree
internal_owlTree_reorgKiddos :: OwlTree -> REltId -> OwlTree
internal_owlTree_reorgKiddos OwlTree
od REltId
prid = OwlTree
od {_owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
om}
  where
    childrenToUpdate :: Seq REltId
childrenToUpdate = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ OwlTree -> REltId -> Maybe (Seq REltId)
owlTree_findKiddos OwlTree
od REltId
prid
    setRelPos :: REltId -> (OwlItemMeta, b) -> (OwlItemMeta, b)
setRelPos REltId
i (OwlItemMeta
oem, b
oe) = (OwlItemMeta
oem {_owlItemMeta_position :: REltId
_owlItemMeta_position = REltId
i}, b
oe)
    om :: OwlMapping
om = forall b a. (b -> REltId -> a -> b) -> b -> Seq a -> b
Seq.foldlWithIndex (\OwlMapping
om' REltId
i REltId
x -> forall a. (a -> a) -> REltId -> IntMap a -> IntMap a
IM.adjust (forall {b}. REltId -> (OwlItemMeta, b) -> (OwlItemMeta, b)
setRelPos REltId
i) REltId
x OwlMapping
om') (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
od) Seq REltId
childrenToUpdate

emptyOwlTree :: OwlTree
emptyOwlTree :: OwlTree
emptyOwlTree =
  OwlTree
    { _owlTree_mapping :: OwlMapping
_owlTree_mapping = forall a. IntMap a
IM.empty,
      _owlTree_topOwls :: Seq REltId
_owlTree_topOwls = forall a. Seq a
Seq.empty
    }

owlTree_exists :: OwlTree -> REltId -> Bool
owlTree_exists :: OwlTree -> REltId -> Bool
owlTree_exists OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} REltId
rid = forall a. REltId -> IntMap a -> Bool
IM.member REltId
rid OwlMapping
_owlTree_mapping

owlTree_findSuperOwl :: OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl :: OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} REltId
rid = do
  (OwlItemMeta
meta, OwlItem
elt) <- forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid OwlMapping
_owlTree_mapping
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ REltId -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl REltId
rid OwlItemMeta
meta OwlItem
elt

owlTree_mustFindSuperOwl :: HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl :: HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid = case OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od REltId
rid of
  Maybe SuperOwl
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ OwlTree -> REltId -> Text
errorMsg_owlTree_lookupFail OwlTree
od REltId
rid
  Just SuperOwl
x -> SuperOwl
x

owlTree_findKiddos :: OwlTree -> REltId -> Maybe (Seq REltId)
owlTree_findKiddos :: OwlTree -> REltId -> Maybe (Seq REltId)
owlTree_findKiddos OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} REltId
rid = case REltId
rid of
  REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> forall (m :: * -> *) a. Monad m => a -> m a
return Seq REltId
_owlTree_topOwls
  REltId
x -> do
    (OwlItemMeta
_, OwlItem
oelt) <- forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
x OwlMapping
_owlTree_mapping
    forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos OwlItem
oelt

owlTree_findSuperOwlAtOwlSpot :: OwlTree -> OwlSpot -> Maybe SuperOwl
owlTree_findSuperOwlAtOwlSpot :: OwlTree -> OwlSpot -> Maybe SuperOwl
owlTree_findSuperOwlAtOwlSpot od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} OwlSpot {REltId
Maybe REltId
_owlSpot_leftSibling :: Maybe REltId
_owlSpot_parent :: REltId
_owlSpot_leftSibling :: OwlSpot -> Maybe REltId
_owlSpot_parent :: OwlSpot -> REltId
..} = do
  Seq REltId
kiddos <- OwlTree -> REltId -> Maybe (Seq REltId)
owlTree_findKiddos OwlTree
od REltId
_owlSpot_parent
  REltId
kid <- case Maybe REltId
_owlSpot_leftSibling of
    Maybe REltId
Nothing -> forall a. REltId -> Seq a -> Maybe a
Seq.lookup REltId
0 Seq REltId
kiddos
    -- take until we reach the point and return one to the right
    Just REltId
rid -> forall a. REltId -> Seq a -> Maybe a
Seq.lookup REltId
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. REltId -> Seq a -> Seq a
Seq.drop REltId
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL (\REltId
rid' -> REltId
rid' forall a. Eq a => a -> a -> Bool
/= REltId
rid) forall a b. (a -> b) -> a -> b
$ Seq REltId
kiddos
  OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od REltId
kid

-- move one spot to the left, returns Nothing if not possible
owlTree_goRightFromOwlSpot :: OwlTree -> OwlSpot -> Maybe OwlSpot
owlTree_goRightFromOwlSpot :: OwlTree -> OwlSpot -> Maybe OwlSpot
owlTree_goRightFromOwlSpot od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} OwlSpot
ospot = do
  SuperOwl
sowl <- OwlTree -> OwlSpot -> Maybe SuperOwl
owlTree_findSuperOwlAtOwlSpot OwlTree
od OwlSpot
ospot
  return $ OwlSpot
ospot {_owlSpot_leftSibling :: Maybe REltId
_owlSpot_leftSibling = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SuperOwl -> REltId
_superOwl_id SuperOwl
sowl}

-- |
-- throws if OwlItemMeta is invalid in OwlTree
-- TODO make naming consistent in this file...
owlTree_owlItemMeta_toOwlSpot :: OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot :: OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} OwlItemMeta {REltId
_owlItemMeta_position :: REltId
_owlItemMeta_depth :: REltId
_owlItemMeta_parent :: REltId
_owlItemMeta_position :: OwlItemMeta -> REltId
_owlItemMeta_depth :: OwlItemMeta -> REltId
_owlItemMeta_parent :: OwlItemMeta -> REltId
..} = OwlSpot
r
  where
    msiblings :: Maybe (Seq REltId)
msiblings = case REltId
_owlItemMeta_parent of
      REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> forall (m :: * -> *) a. Monad m => a -> m a
return Seq REltId
_owlTree_topOwls
      REltId
x -> do
        (OwlItemMeta
_, OwlItem
oelt) <- forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
x OwlMapping
_owlTree_mapping
        forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos OwlItem
oelt

    siblings :: Seq REltId
siblings = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq REltId)
msiblings
    r :: OwlSpot
r =
      OwlSpot
        { _owlSpot_parent :: REltId
_owlSpot_parent = REltId
_owlItemMeta_parent,
          _owlSpot_leftSibling :: Maybe REltId
_owlSpot_leftSibling = OwlMapping -> Seq REltId -> REltId -> Maybe REltId
locateLeftSiblingIdFromSiblingPosition OwlMapping
_owlTree_mapping Seq REltId
siblings REltId
_owlItemMeta_position
        }


-- |
-- throws if REltId is invalid in OwlTree
owlTree_rEltId_toOwlSpot :: (HasCallStack) => OwlTree -> REltId -> OwlSpot
owlTree_rEltId_toOwlSpot :: HasCallStack => OwlTree -> REltId -> OwlSpot
owlTree_rEltId_toOwlSpot od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} REltId
rid = OwlSpot
r
  where
    (OwlItemMeta
oem, OwlItem
_) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid OwlMapping
_owlTree_mapping
    r :: OwlSpot
r = OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
od OwlItemMeta
oem

-- |
-- super inefficient implementation for testing only
owlTree_rEltId_toFlattenedIndex_debug :: OwlTree -> REltId -> Int
owlTree_rEltId_toFlattenedIndex_debug :: OwlTree -> REltId -> REltId
owlTree_rEltId_toFlattenedIndex_debug od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} REltId
rid = REltId
r
  where
    sowls :: Seq SuperOwl
sowls = OwlTree -> Seq SuperOwl
owliterateall OwlTree
od
    r :: REltId
r = forall a. a -> Maybe a -> a
fromMaybe (-REltId
1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Maybe REltId
Seq.findIndexL (\SuperOwl
sowl -> SuperOwl -> REltId
_superOwl_id SuperOwl
sowl forall a. Eq a => a -> a -> Bool
== REltId
rid) Seq SuperOwl
sowls

-- |
-- NOTE this will return an AttachmentMap containing targets that have since been deleted
owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap
owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap
owlTree_makeAttachmentMap OwlTree
od = forall (f :: * -> *).
Foldable f =>
f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls (OwlTree -> Seq SuperOwl
owliterateall OwlTree
od) forall a. IntMap a
IM.empty

-- | return fales if any attachments are dangling (i.e. they are attached to a target that does not exist in the tree)
owlTree_hasDanglingAttachments :: OwlTree -> Bool
owlTree_hasDanglingAttachments :: OwlTree -> Bool
owlTree_hasDanglingAttachments od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\SuperOwl
sowl -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\REltId
x -> forall a. REltId -> IntMap a -> Bool
IM.member REltId
x (OwlMapping
_owlTree_mapping)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> REltId
_attachment_target forall a b. (a -> b) -> a -> b
$ forall o. HasOwlItem o => o -> [Attachment]
hasOwlItem_attachments SuperOwl
sowl)) (OwlTree -> Seq SuperOwl
owliterateall OwlTree
od)

owlTree_topSuperOwls :: OwlTree -> Seq SuperOwl
owlTree_topSuperOwls :: OwlTree -> Seq SuperOwl
owlTree_topSuperOwls OwlTree
od = Seq SuperOwl
r
  where
    sowls :: Seq SuperOwl
sowls = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od) (OwlTree -> Seq REltId
_owlTree_topOwls OwlTree
od)
    areOwlsInFactSuper :: Bool
areOwlsInFactSuper = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SuperOwl -> Bool
superOwl_isTopOwl Seq SuperOwl
sowls
    r :: Seq SuperOwl
r = forall a. HasCallStack => Bool -> a -> a
assert Bool
areOwlsInFactSuper Seq SuperOwl
sowls

owlTree_foldAt' :: (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' a -> SuperOwl -> a
f a
acc OwlTree
od SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
  OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
kiddos) -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc' REltId
rid' -> forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' a -> SuperOwl -> a
f a
acc' OwlTree
od (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid')) (a -> SuperOwl -> a
f a
acc SuperOwl
sowl) Seq REltId
kiddos
  OwlItem
_ -> a -> SuperOwl -> a
f a
acc SuperOwl
sowl

-- | fold over an element in the tree and all its children
owlTree_foldAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldAt :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldAt a -> SuperOwl -> a
f a
acc OwlTree
od REltId
rid = forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' a -> SuperOwl -> a
f a
acc OwlTree
od (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid)

owlTree_foldChildrenAt' :: (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldChildrenAt' :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldChildrenAt' a -> SuperOwl -> a
f a
acc OwlTree
od SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
  OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
kiddos) -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc' REltId
rid' -> forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' a -> SuperOwl -> a
f a
acc' OwlTree
od (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid')) a
acc Seq REltId
kiddos
  OwlItem
_ -> a
acc

-- | same as owlTree_foldAt but excludes parent
owlTree_foldChildrenAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldChildrenAt :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldChildrenAt a -> SuperOwl -> a
f a
acc OwlTree
od REltId
rid = forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldChildrenAt' a -> SuperOwl -> a
f a
acc OwlTree
od (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid)

owlTree_fold :: (a -> SuperOwl -> a) -> a -> OwlTree -> a
owlTree_fold :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> a
owlTree_fold a -> SuperOwl -> a
f a
acc0 OwlTree
od = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc REltId
rid -> forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldAt a -> SuperOwl -> a
f a
acc OwlTree
od REltId
rid) a
acc0 forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq REltId
_owlTree_topOwls OwlTree
od

owlTree_owlCount :: OwlTree -> Int
owlTree_owlCount :: OwlTree -> REltId
owlTree_owlCount OwlTree
od = forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> a
owlTree_fold (\REltId
acc SuperOwl
_ -> REltId
acc forall a. Num a => a -> a -> a
+ REltId
1) REltId
0 OwlTree
od

-- | iterates an element and all its children
owliterateat :: OwlTree -> REltId -> Seq SuperOwl
owliterateat :: OwlTree -> REltId -> Seq SuperOwl
owliterateat OwlTree
od REltId
rid = forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldAt forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Seq.empty OwlTree
od REltId
rid where

-- | iterates an element's children (excluding self)
owliteratechildrenat :: OwlTree -> REltId -> Seq SuperOwl
owliteratechildrenat :: OwlTree -> REltId -> Seq SuperOwl
owliteratechildrenat OwlTree
od REltId
rid = forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldChildrenAt forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Seq.empty OwlTree
od REltId
rid where

-- | iterates everything in the directory
owliterateall :: OwlTree -> Seq SuperOwl
owliterateall :: OwlTree -> Seq SuperOwl
owliterateall OwlTree
od = forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> a
owlTree_fold forall a. Seq a -> a -> Seq a
(|>) forall a. Seq a
Seq.empty OwlTree
od

class HasOwlTree o where
  hasOwlTree_owlTree :: o -> OwlTree
  hasOwlTree_exists :: o -> REltId -> Bool
  hasOwlTree_exists o
o REltId
rid = forall o. HasOwlTree o => o -> REltId -> Bool
hasOwlTree_exists (forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree o
o) REltId
rid
  hasOwlTree_findSuperOwl :: o -> REltId -> Maybe SuperOwl
  hasOwlTree_findSuperOwl o
o REltId
rid = forall o. HasOwlTree o => o -> REltId -> Maybe SuperOwl
hasOwlTree_findSuperOwl (forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree o
o) REltId
rid
  hasOwlTree_mustFindSuperOwl :: HasCallStack => o -> REltId -> SuperOwl
  hasOwlTree_mustFindSuperOwl o
o REltId
rid = forall o. (HasOwlTree o, HasCallStack) => o -> REltId -> SuperOwl
hasOwlTree_mustFindSuperOwl (forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree o
o) REltId
rid

  -- only intended for use in tests
  hasOwlTree_test_findFirstSuperOwlByName :: o -> Text -> Maybe SuperOwl
  hasOwlTree_test_findFirstSuperOwlByName o
o Text
t = forall o. HasOwlTree o => o -> Text -> Maybe SuperOwl
hasOwlTree_test_findFirstSuperOwlByName (forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree o
o) Text
t
  hasOwlTree_test_mustFindFirstSuperOwlByName :: o -> Text -> SuperOwl
  hasOwlTree_test_mustFindFirstSuperOwlByName o
o Text
t = forall a. HasCallStack => Maybe a -> a
fromJust (forall o. HasOwlTree o => o -> Text -> Maybe SuperOwl
hasOwlTree_test_findFirstSuperOwlByName o
o Text
t)

instance HasOwlTree OwlTree where
  hasOwlTree_owlTree :: OwlTree -> OwlTree
hasOwlTree_owlTree = forall a. a -> a
id
  hasOwlTree_exists :: OwlTree -> REltId -> Bool
hasOwlTree_exists = OwlTree -> REltId -> Bool
owlTree_exists
  hasOwlTree_findSuperOwl :: OwlTree -> REltId -> Maybe SuperOwl
hasOwlTree_findSuperOwl = OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl
  hasOwlTree_mustFindSuperOwl :: HasCallStack => OwlTree -> REltId -> SuperOwl
hasOwlTree_mustFindSuperOwl = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl
  hasOwlTree_test_findFirstSuperOwlByName :: OwlTree -> Text -> Maybe SuperOwl
hasOwlTree_test_findFirstSuperOwlByName OwlTree
ot Text
label = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SuperOwl
sowl -> forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
sowl forall a. Eq a => a -> a -> Bool
== Text
label) 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
$ OwlTree -> Seq SuperOwl
owliterateall OwlTree
ot

-- | select everything in the OwlTree
owlTree_toSuperOwlParliament :: OwlTree -> SuperOwlParliament
owlTree_toSuperOwlParliament :: OwlTree -> SuperOwlParliament
owlTree_toSuperOwlParliament od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} = SuperOwlParliament
r
  where
    r :: SuperOwlParliament
r = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq REltId -> OwlParliament
OwlParliament forall a b. (a -> b) -> a -> b
$ Seq REltId
_owlTree_topOwls

owlTree_removeREltId :: REltId -> OwlTree -> OwlTree
owlTree_removeREltId :: REltId -> OwlTree -> OwlTree
owlTree_removeREltId REltId
rid OwlTree
od = SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl (HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
rid) OwlTree
od

owlTree_removeSuperOwl :: SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl :: SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl SuperOwl
sowl OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} = OwlTree
r
  where
    -- remove the element itself
    newMapping'' :: OwlMapping
newMapping'' = forall a. REltId -> IntMap a -> IntMap a
IM.delete (SuperOwl -> REltId
_superOwl_id SuperOwl
sowl) OwlMapping
_owlTree_mapping

    -- remove all children recursively
    removeEltWithoutAdjustMommyFn :: REltId -> OwlMapping -> OwlMapping
removeEltWithoutAdjustMommyFn REltId
rid OwlMapping
mapping = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid OwlMapping
mapping of
      Maybe (OwlItemMeta, OwlItem)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail OwlMapping
mapping REltId
rid
      Just (OwlItemMeta
_, OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
kiddos)) -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr REltId -> OwlMapping -> OwlMapping
removeEltWithoutAdjustMommyFn (forall a. REltId -> IntMap a -> IntMap a
IM.delete REltId
rid OwlMapping
mapping) Seq REltId
kiddos
      Just (OwlItemMeta, OwlItem)
_ -> forall a. REltId -> IntMap a -> IntMap a
IM.delete REltId
rid OwlMapping
mapping
    newMapping' :: OwlMapping
newMapping' = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
      OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
kiddos) -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr REltId -> OwlMapping -> OwlMapping
removeEltWithoutAdjustMommyFn OwlMapping
newMapping'' Seq REltId
kiddos
      OwlItem
_ -> OwlMapping
newMapping''

    removeSuperOwlFromSeq :: Seq REltId -> SuperOwl -> Seq REltId
    removeSuperOwlFromSeq :: Seq REltId -> SuperOwl -> Seq REltId
removeSuperOwlFromSeq Seq REltId
s SuperOwl
so = forall a. HasCallStack => Bool -> a -> a
assert (forall a. Seq a -> REltId
Seq.length Seq REltId
s forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> REltId
Seq.length Seq REltId
deletedSeq forall a. Num a => a -> a -> a
+ REltId
1) Seq REltId
deletedSeq
      where
        -- sowl meta may be incorrect at this point so we do linear search to remove the elt
        deletedSeq :: Seq REltId
deletedSeq = forall a. REltId -> Seq a -> Seq a
Seq.deleteAt (forall a. HasCallStack => Maybe a -> a
fromJust (forall a. Eq a => a -> Seq a -> Maybe REltId
Seq.elemIndexL (SuperOwl -> REltId
_superOwl_id SuperOwl
so) Seq REltId
s)) Seq REltId
s
        -- TODO switch to this version once you fix issue in owlTree_moveOwlParliament (see comments there)
        --sp = _owlItemMeta_position . _superOwl_meta $ so
        --deletedSeq = Seq.deleteAt sp s

    -- remove from children of the element's mommy if needed
    removeChildFn :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
removeChildFn (OwlItemMeta, OwlItem)
parent = case (OwlItemMeta, OwlItem)
parent of
      (OwlItemMeta
oem, OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq REltId
kiddos)) -> (OwlItemMeta
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq REltId -> OwlSubItem
OwlSubItemFolder (Seq REltId -> SuperOwl -> Seq REltId
removeSuperOwlFromSeq Seq REltId
kiddos SuperOwl
sowl)))
      (OwlItemMeta, OwlItem)
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected parent to be a folder"
    newMapping :: OwlMapping
newMapping = case OwlItemMeta -> REltId
_owlItemMeta_parent (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl) of
      REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> OwlMapping
newMapping'
      REltId
rid -> forall a. (a -> a) -> REltId -> IntMap a -> IntMap a
IM.adjust (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
removeChildFn REltId
rid OwlMapping
newMapping'

    -- remove from top owls if needed
    newTopOwls :: Seq REltId
newTopOwls =
      if SuperOwl -> Bool
superOwl_isTopOwl SuperOwl
sowl
        then Seq REltId -> SuperOwl -> Seq REltId
removeSuperOwlFromSeq Seq REltId
_owlTree_topOwls SuperOwl
sowl
        else Seq REltId
_owlTree_topOwls

    r' :: OwlTree
r' =
      OwlTree
        { _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
newMapping,
          _owlTree_topOwls :: Seq REltId
_owlTree_topOwls = Seq REltId
newTopOwls
        }

    r :: OwlTree
r = OwlTree -> REltId -> OwlTree
internal_owlTree_reorgKiddos OwlTree
r' (OwlItemMeta -> REltId
_owlItemMeta_parent (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl))

owlTree_moveOwlParliament :: OwlParliament -> OwlSpot -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_moveOwlParliament :: OwlParliament -> OwlSpot -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_moveOwlParliament OwlParliament
op spot :: OwlSpot
spot@OwlSpot {REltId
Maybe REltId
_owlSpot_leftSibling :: Maybe REltId
_owlSpot_parent :: REltId
_owlSpot_leftSibling :: OwlSpot -> Maybe REltId
_owlSpot_parent :: OwlSpot -> REltId
..} od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
isValid (OwlTree, [SuperOwl])
r
  where
    sop :: SuperOwlParliament
sop@(SuperOwlParliament Seq SuperOwl
sowls) = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od OwlParliament
op

    -- check that we aren't doing circular parenting 😱
    isValid :: Bool
isValid = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\REltId
x -> HasCallStack => OwlMapping -> REltId -> REltId -> Bool
isDescendentOf OwlMapping
_owlTree_mapping REltId
x REltId
_owlSpot_parent) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> REltId
_superOwl_id Seq SuperOwl
sowls)

    -- NOTE, that _owlItemMeta_position in sowls may be incorrect in the middle of this fold
    -- this forces us to do linear search in the owlTree_removeSuperOwl call rather than use sibling position as index into children D:
    -- TODO fix by always sort from right to left to avoid this
    removedOd :: OwlTree
removedOd = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\OwlTree
acc SuperOwl
sowl -> SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl SuperOwl
sowl OwlTree
acc) OwlTree
od Seq SuperOwl
sowls

    -- WIP start
    -- ??? I can't remember what this is anymore, did I aready fix this or no? Pretty sure I can just delet all of this
    -- TODO now that we've removed owls, this might invalidate our target position, so we need to reconstruct it
{-
    -- first find the first position to the left (inclusive) of where we our original drop position is that isn't a removed element
    -- ()
    --removed =  sort . fmap (_owlItemMeta_position . _superOwl_owlItemMeta) . filter ((== _owlSpot_parent) . _owlItemMeta_parent . _superOwl_owlItemMeta) $ sowls
    findPos [] pos = pos
    findPos (x:xs) pos = if x == pos
      then go xs (pos-1)
      else pos
    leftSiblingPos = case _owlSpot_leftSibling of
      Nothing -> noOwl
      Just rid -> _owlItemMeta_position . _superOwl_owlItemMeta . owlTree_mustFindSuperOwl od $ rid
    newSpotPos = findPos removed leftSiblingPos

    newSpotLeftSibling = if newSpotPos == noOwl
      then Nothing
      else if _owlSpot_parent == noOwl
        then
        else owlTree_mustFindSuperOwl od _owlSpot_parent
    -}

    -- list of removed element sorted in order
    removed :: [REltId]
removed = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> REltId
_superOwl_id
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (OwlItemMeta -> REltId
_owlItemMeta_position forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== REltId
_owlSpot_parent) forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlItemMeta -> REltId
_owlItemMeta_parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta)
      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
$ Seq SuperOwl
sowls
    -- list of all siblings on the spot we are dragging to
    origSiblings :: Seq REltId
origSiblings = forall a. a -> Maybe a -> a
fromMaybe (forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected siblings") forall a b. (a -> b) -> a -> b
$ if REltId
_owlSpot_parent forall a. Eq a => a -> a -> Bool
== REltId
noOwl
      then forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos forall a b. (a -> b) -> a -> b
$ OwlTree
od
      else forall o. MommyOwl o => o -> Maybe (Seq REltId)
mommyOwl_kiddos forall a b. (a -> b) -> a -> b
$ HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od REltId
_owlSpot_parent
    -- now we will walk from right to left picking out the first elt that is on or after the target spot we are dragging to (_owlSpot_leftSibling) and isn't in the removed list
    findPos ::
      REltId -- ^ original _owlSpot_leftSibling
      -> [REltId] -- ^ list of removed elements
      -> [REltId] -- ^ list of siblings
      -> Bool -- ^ whether we've gone past our target or not
      -> Maybe REltId -- ^ new non-removed leftSibling
    findPos :: REltId -> [REltId] -> [REltId] -> Bool -> Maybe REltId
findPos REltId
_ [REltId]
_ [] Bool
_ = forall a. Maybe a
Nothing
    findPos REltId
targetrid [] (REltId
y:[REltId]
ys) Bool
past = if Bool
past
      then forall a. a -> Maybe a
Just REltId
y
      else if REltId
y forall a. Eq a => a -> a -> Bool
== REltId
targetrid
        then forall a. a -> Maybe a
Just REltId
y
        else REltId -> [REltId] -> [REltId] -> Bool -> Maybe REltId
findPos REltId
targetrid [] [REltId]
ys Bool
past
    findPos REltId
targetrid (REltId
x:[REltId]
xs) (REltId
y:[REltId]
ys) Bool
past = if Bool
past Bool -> Bool -> Bool
|| (REltId
y forall a. Eq a => a -> a -> Bool
== REltId
targetrid)
      then if REltId
x forall a. Eq a => a -> a -> Bool
== REltId
y
        then REltId -> [REltId] -> [REltId] -> Bool -> Maybe REltId
findPos REltId
targetrid [REltId]
xs [REltId]
ys Bool
True
        else forall a. a -> Maybe a
Just REltId
y
      else if REltId
x forall a. Eq a => a -> a -> Bool
== REltId
y
        then REltId -> [REltId] -> [REltId] -> Bool -> Maybe REltId
findPos REltId
targetrid [REltId]
xs [REltId]
ys Bool
past
        else REltId -> [REltId] -> [REltId] -> Bool -> Maybe REltId
findPos REltId
targetrid (REltId
xforall a. a -> [a] -> [a]
:[REltId]
xs) [REltId]
ys Bool
past
    newLeftSibling :: Maybe REltId
newLeftSibling = case Maybe REltId
_owlSpot_leftSibling of
      Maybe REltId
Nothing -> forall a. Maybe a
Nothing
      Just REltId
target -> REltId -> [REltId] -> [REltId] -> Bool -> Maybe REltId
findPos REltId
target (forall {a}. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [REltId]
removed) (forall {a}. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq REltId
origSiblings) Bool
False
    correctedSpot :: OwlSpot
correctedSpot = OwlSpot
spot { _owlSpot_leftSibling :: Maybe REltId
_owlSpot_leftSibling = Maybe REltId
newLeftSibling}

    selttree :: SEltTree
selttree = OwlTree -> SuperOwlParliament -> SEltTree
superOwlParliament_toSEltTree OwlTree
od SuperOwlParliament
sop
    r :: (OwlTree, [SuperOwl])
r = OwlSpot -> SEltTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addSEltTree OwlSpot
correctedSpot SEltTree
selttree OwlTree
removedOd

-- |
-- assumes SEltTree REltIds do not collide with OwlTree
owlTree_addSEltTree :: OwlSpot -> SEltTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addSEltTree :: OwlSpot -> SEltTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addSEltTree OwlSpot
spot SEltTree
selttree OwlTree
od = (OwlTree, [SuperOwl])
r where
  -- convert to OwlDirectory
  otherod :: OwlTree
otherod = SEltTree -> OwlTree
owlTree_fromSEltTree SEltTree
selttree
  r :: (OwlTree, [SuperOwl])
r = OwlSpot -> OwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree OwlSpot
spot OwlTree
otherod OwlTree
od

owlTree_reindex :: Int -> OwlTree -> OwlTree
owlTree_reindex :: REltId -> OwlTree -> OwlTree
owlTree_reindex REltId
start OwlTree
ot = forall a. HasCallStack => Bool -> a -> a
assert Bool
valid OwlTree
r where
  valid :: Bool
valid = OwlTree -> REltId
owlTree_maxId OwlTree
ot forall a. Ord a => a -> a -> Bool
< REltId
start
  -- TODO someday, when we're actually worried about id space size (i.e. when we have multi user mode) we will need to do this more efficiently
  adjustkeyfn :: REltId -> REltId
adjustkeyfn REltId
k = if REltId
k forall a. Eq a => a -> a -> Bool
== REltId
noOwl then REltId
noOwl else REltId
k forall a. Num a => a -> a -> a
+ REltId
start
  -- adjust keys to their new ones
  oldmap :: OwlMapping
oldmap = OwlTree -> OwlMapping
_owlTree_mapping OwlTree
ot
  newMap' :: OwlMapping
newMap' = forall a. (REltId -> REltId) -> IntMap a -> IntMap a
IM.mapKeysMonotonic REltId -> REltId
adjustkeyfn OwlMapping
oldmap
  -- next adjust children and attachments to the new ids
  ridremap :: REltIdMap REltId
ridremap = forall a b. (REltId -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\REltId
rid (OwlItemMeta, OwlItem)
_ -> REltId -> REltId
adjustkeyfn REltId
rid) OwlMapping
oldmap
  mapoem :: OwlItemMeta -> OwlItemMeta
mapoem OwlItemMeta
oem = OwlItemMeta
oem { _owlItemMeta_parent :: REltId
_owlItemMeta_parent = REltId -> REltId
adjustkeyfn (OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
oem) }
  mapoe :: OwlItem -> OwlItem
mapoe OwlItem
oe =
    -- remap attachments
    Bool -> REltIdMap REltId -> OwlItem -> OwlItem
owlItem_updateAttachments Bool
True REltIdMap REltId
ridremap
    -- remap kiddos
    forall a b. (a -> b) -> a -> b
$ (case OwlItem
oe of
      OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq REltId
kiddos) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq REltId -> OwlSubItem
OwlSubItemFolder (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap REltId -> REltId
adjustkeyfn Seq REltId
kiddos))
      OwlItem
x -> OwlItem
x)
  mapowlfn :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
mapowlfn (OwlItemMeta
oem, OwlItem
oe) = (OwlItemMeta -> OwlItemMeta
mapoem OwlItemMeta
oem, OwlItem -> OwlItem
mapoe OwlItem
oe)
  newMap :: OwlMapping
newMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
mapowlfn OwlMapping
newMap'
  newTopOwls :: Seq REltId
newTopOwls = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap REltId -> REltId
adjustkeyfn (OwlTree -> Seq REltId
_owlTree_topOwls OwlTree
ot)
  r :: OwlTree
r = OwlMapping -> Seq REltId -> OwlTree
OwlTree OwlMapping
newMap Seq REltId
newTopOwls

-- TODO check that there are no dangling attachments in MiniOwlTree (attach to non existant element), this is expected to be cleaned up in a previous step, use owlTree_hasDanglingAttachments
-- ^ actually this might be OK... or at least we want to check against tree we are attaching to such that if we copy paste something that was attached it keeps those attachments (or maybe we don't!)
owlTree_addMiniOwlTree :: OwlSpot -> MiniOwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree :: OwlSpot -> OwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree OwlSpot
targetspot OwlTree
miniot OwlTree
od0 = forall a. HasCallStack => Bool -> a -> a
assert (REltId
collisions forall a. Eq a => a -> a -> Bool
== REltId
0) forall a b. (a -> b) -> a -> b
$ (OwlTree, [SuperOwl])
r where
  od1indices :: Set REltId
od1indices = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [REltId]
IM.keys (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
od0)
  od2indices :: Set REltId
od2indices = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [REltId]
IM.keys (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
miniot)
  collisions :: REltId
collisions = forall a. Set a -> REltId
Set.size forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set REltId
od1indices Set REltId
od2indices

  mapaccumlfn :: OwlTree -> (OwlSpot, SuperOwl) -> (OwlTree, SuperOwl)
mapaccumlfn OwlTree
od (OwlSpot
spot, SuperOwl
sowl) = OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem OwlSpot
ospot REltId
rid OwlItem
oeltmodded OwlTree
od where
    rid :: REltId
rid = SuperOwl -> REltId
_superOwl_id SuperOwl
sowl
    meta :: OwlItemMeta
meta = SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl
    ospot :: OwlSpot
ospot = if OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
meta forall a. Eq a => a -> a -> Bool
== REltId
noOwl Bool -> Bool -> Bool
&& OwlItemMeta -> REltId
_owlItemMeta_position OwlItemMeta
meta forall a. Eq a => a -> a -> Bool
== REltId
0
      -- first element goes to target spot
      then OwlSpot
targetspot
      else if OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
meta forall a. Eq a => a -> a -> Bool
== REltId
noOwl
        -- top level elements share the parent of the target spot
        then OwlSpot
spot { _owlSpot_parent :: REltId
_owlSpot_parent = OwlSpot -> REltId
_owlSpot_parent OwlSpot
targetspot}
        -- everything else has a valid spot from previous tree
        else OwlSpot
spot

    oeltmodded :: OwlItem
oeltmodded = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
      -- temp remove kiddos from parent as needed by internal_owlTree_addOwlItem
      OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq REltId
_) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq REltId -> OwlSubItem
OwlSubItemFolder forall a. Seq a
Seq.empty)
      OwlItem
x -> OwlItem
x

  -- go from left to right such that parents/left siblings are added first
  r :: (OwlTree, [SuperOwl])
r = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL OwlTree -> (OwlSpot, SuperOwl) -> (OwlTree, SuperOwl)
mapaccumlfn OwlTree
od0 forall a b. (a -> b) -> a -> b
$ 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 (\SuperOwl
sowl -> (OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
miniot (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl), SuperOwl
sowl)) (OwlTree -> Seq SuperOwl
owliterateall OwlTree
miniot)

-- parents NOT allowed :O
internal_owlTree_addOwlItem :: OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem :: OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem OwlSpot {REltId
Maybe REltId
_owlSpot_leftSibling :: Maybe REltId
_owlSpot_parent :: REltId
_owlSpot_leftSibling :: OwlSpot -> Maybe REltId
_owlSpot_parent :: OwlSpot -> REltId
..} REltId
rid OwlItem
oitem OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
nochildrenifaddingfolder (OwlTree, SuperOwl)
r
  where
    -- if we're adding a folder (in the normal case), ensure it has no children
    nochildrenifaddingfolder :: Bool
nochildrenifaddingfolder = case OwlItem
oitem of
      OwlItem OwlInfo
_ (OwlSubItemFolder Seq REltId
kiddos) -> forall a. Seq a -> Bool
Seq.null Seq REltId
kiddos
      OwlItem
_ -> Bool
True

    -- first add the OwlItem to the mapping
    meta :: OwlItemMeta
meta =
      OwlItemMeta
        { _owlItemMeta_parent :: REltId
_owlItemMeta_parent = REltId
_owlSpot_parent,
          _owlItemMeta_depth :: REltId
_owlItemMeta_depth = case REltId
_owlSpot_parent of
            REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> REltId
0
            REltId
_ -> case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
_owlSpot_parent OwlMapping
_owlTree_mapping of
              Maybe (OwlItemMeta, OwlItem)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail OwlMapping
_owlTree_mapping REltId
_owlSpot_parent
              Just (OwlItemMeta
x, OwlItem
_) -> OwlItemMeta -> REltId
_owlItemMeta_depth OwlItemMeta
x forall a. Num a => a -> a -> a
+ REltId
1,
          -- this will get set correctly when we call internal_owlTree_reorgKiddos later
          _owlItemMeta_position :: REltId
_owlItemMeta_position = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this thunk should never get evaluated"
        }

    newMapping' :: OwlMapping
newMapping' = forall a.
(REltId -> a -> a -> a) -> REltId -> a -> IntMap a -> IntMap a
IM.insertWithKey (\REltId
k (OwlItemMeta, OwlItem)
_ (OwlItemMeta, OwlItem)
ov -> forall a t. (HasCallStack, IsText t) => t -> a
error (Text
"key " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
k forall a. Semigroup a => a -> a -> a
<> Text
" already exists with value " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (OwlItemMeta, OwlItem)
ov)) REltId
rid (OwlItemMeta
meta, OwlItem
oitem) OwlMapping
_owlTree_mapping

    -- modify kiddos of the parent we are adding to
    modifyKiddos :: Seq REltId -> Seq REltId
modifyKiddos Seq REltId
kiddos = forall a. REltId -> a -> Seq a -> Seq a
Seq.insertAt REltId
position REltId
rid Seq REltId
kiddos
      where
        position :: REltId
position = case Maybe REltId
_owlSpot_leftSibling of
          Maybe REltId
Nothing -> REltId
0
          Just REltId
leftsibrid -> case forall a. Eq a => a -> Seq a -> Maybe REltId
Seq.elemIndexL REltId
leftsibrid Seq REltId
kiddos of
            Maybe REltId
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected to find leftmost sibling " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show REltId
leftsibrid forall a. Semigroup a => a -> a -> a
<> Text
" in " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Seq REltId
kiddos
            Just REltId
x -> REltId
x forall a. Num a => a -> a -> a
+ REltId
1
    adjustfn :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
adjustfn (OwlItemMeta
oem, OwlItem
oitem') = case OwlItem
oitem' of
      OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq REltId
kiddos) -> (OwlItemMeta
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq REltId -> OwlSubItem
OwlSubItemFolder (Seq REltId -> Seq REltId
modifyKiddos Seq REltId
kiddos)))
      OwlItem
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected OwlItemFolder"
    newMapping :: OwlMapping
newMapping = case REltId
_owlSpot_parent of
      REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> OwlMapping
newMapping'
      REltId
_ -> forall a. (a -> a) -> REltId -> IntMap a -> IntMap a
IM.adjust (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
adjustfn REltId
_owlSpot_parent OwlMapping
newMapping'
    -- or top owls if there is no parent
    newTopOwls :: Seq REltId
newTopOwls = case REltId
_owlSpot_parent of
      REltId
x | REltId
x forall a. Eq a => a -> a -> Bool
== REltId
noOwl -> Seq REltId -> Seq REltId
modifyKiddos Seq REltId
_owlTree_topOwls
      REltId
_ -> Seq REltId
_owlTree_topOwls

    r' :: OwlTree
r' =
      OwlTree
        { _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
newMapping,
          _owlTree_topOwls :: Seq REltId
_owlTree_topOwls = Seq REltId
newTopOwls
        }

    newtree :: OwlTree
newtree = OwlTree -> REltId -> OwlTree
internal_owlTree_reorgKiddos OwlTree
r' REltId
_owlSpot_parent

    newsowl :: SuperOwl
newsowl = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
newtree REltId
rid

    r :: (OwlTree, SuperOwl)
r = (OwlTree
newtree, SuperOwl
newsowl)

-- OwlItem must not be a parent
owlTree_addOwlItem :: OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
owlTree_addOwlItem :: OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
owlTree_addOwlItem = OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem

-- this method works for parents IF all children are included in the list and sorted from left to right
owlTree_addOwlItemList :: [(REltId, OwlSpot, OwlItem)] -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItemList :: [(REltId, OwlSpot, OwlItem)] -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItemList [(REltId, OwlSpot, OwlItem)]
seltls OwlTree
od0 = (OwlTree, [SuperOwl])
r where

  -- TODO test that seltls are valid... (easier said than done)

  mapaccumlfn :: OwlTree -> (REltId, OwlSpot, OwlItem) -> (OwlTree, SuperOwl)
mapaccumlfn OwlTree
od (REltId
rid,OwlSpot
ospot,OwlItem
oitem) = OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem OwlSpot
ospot REltId
rid OwlItem
oitemmodded OwlTree
od where
    osubitemmodded :: OwlSubItem
osubitemmodded = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
oitem of
      -- temp remove kiddos from parent as needed by internal_owlTree_addOwlItem
      OwlSubItemFolder Seq REltId
_ -> Seq REltId -> OwlSubItem
OwlSubItemFolder forall a. Seq a
Seq.empty
      OwlSubItem
x -> OwlSubItem
x
    oitemmodded :: OwlItem
oitemmodded = OwlInfo -> OwlSubItem -> OwlItem
OwlItem (OwlItem -> OwlInfo
_owlItem_info OwlItem
oitem) OwlSubItem
osubitemmodded

  -- go from left to right such that parents are added first
  (OwlTree
newot, [SuperOwl]
changes) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL OwlTree -> (REltId, OwlSpot, OwlItem) -> (OwlTree, SuperOwl)
mapaccumlfn OwlTree
od0 [(REltId, OwlSpot, OwlItem)]
seltls

  r :: (OwlTree, [SuperOwl])
r = (OwlTree
newot, [SuperOwl]
changes)


-- TODO TEST
owlTree_superOwl_comparePosition :: OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition :: OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
ot SuperOwl
sowl1 SuperOwl
sowl2 = Ordering
r where
  m1 :: OwlItemMeta
m1 = SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl1
  m2 :: OwlItemMeta
m2 = SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl2
  d1 :: REltId
d1 = OwlItemMeta -> REltId
_owlItemMeta_depth OwlItemMeta
m1
  d2 :: REltId
d2 = OwlItemMeta -> REltId
_owlItemMeta_depth OwlItemMeta
m2
  p1 :: REltId
p1 = OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
m1
  p2 :: REltId
p2 = OwlItemMeta -> REltId
_owlItemMeta_parent OwlItemMeta
m2
  s1 :: REltId
s1 = OwlItemMeta -> REltId
_owlItemMeta_position OwlItemMeta
m1
  s2 :: REltId
s2 = OwlItemMeta -> REltId
_owlItemMeta_position OwlItemMeta
m2
  psowl1 :: SuperOwl
psowl1 = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
ot REltId
p1
  psowl2 :: SuperOwl
psowl2 = HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
ot REltId
p2
  r :: Ordering
r = if REltId
d1 forall a. Eq a => a -> a -> Bool
== REltId
d2
    then if REltId
p1 forall a. Eq a => a -> a -> Bool
== REltId
p2
      then forall a. Ord a => a -> a -> Ordering
compare REltId
s1 REltId
s2
      else OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
ot SuperOwl
psowl1 SuperOwl
psowl2
    else if REltId
d1 forall a. Ord a => a -> a -> Bool
> REltId
d2
      then OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
ot SuperOwl
psowl1 SuperOwl
sowl2
      else OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
ot SuperOwl
sowl1 SuperOwl
psowl2

-- | use to convert old style layers to Owl
internal_addUntilFolderEndRecursive ::
  REltIdMap SEltLabel ->
  Seq REltId ->
  -- | current layer position we are adding
  Int ->
  -- | parent
  REltId ->
  -- | depth
  Int ->
  -- | accumulated directory
  REltIdMap (OwlItemMeta, OwlItem) ->
  -- | accumulated children at current level
  Seq REltId ->
  -- | (next lp, accumulated directory, children of current level)
  (Int, REltIdMap (OwlItemMeta, OwlItem), Seq REltId)
internal_addUntilFolderEndRecursive :: REltIdMap SEltLabel
-> Seq REltId
-> REltId
-> REltId
-> REltId
-> OwlMapping
-> Seq REltId
-> (REltId, OwlMapping, Seq REltId)
internal_addUntilFolderEndRecursive REltIdMap SEltLabel
oldDir Seq REltId
oldLayers REltId
lp REltId
parent REltId
depth OwlMapping
accDir Seq REltId
accSiblings =
  let recurfn :: REltId
-> REltId
-> REltId
-> OwlMapping
-> Seq REltId
-> (REltId, OwlMapping, Seq REltId)
recurfn = REltIdMap SEltLabel
-> Seq REltId
-> REltId
-> REltId
-> REltId
-> OwlMapping
-> Seq REltId
-> (REltId, OwlMapping, Seq REltId)
internal_addUntilFolderEndRecursive REltIdMap SEltLabel
oldDir Seq REltId
oldLayers
      -- the elt we want to add
      rid :: REltId
rid = forall a. Seq a -> REltId -> a
Seq.index Seq REltId
oldLayers REltId
lp
      SEltLabel Text
name SElt
selt = REltIdMap SEltLabel
oldDir forall a. IntMap a -> REltId -> a
IM.! REltId
rid
      selfMeta :: OwlItemMeta
selfMeta = REltId -> REltId -> REltId -> OwlItemMeta
OwlItemMeta REltId
parent REltId
depth (forall a. Seq a -> REltId
Seq.length Seq REltId
accSiblings)
      newSiblings :: Seq REltId
newSiblings = Seq REltId
accSiblings forall a. Seq a -> a -> Seq a
|> REltId
rid
   in if REltId
lp forall a. Ord a => a -> a -> Bool
>= forall a. Seq a -> REltId
Seq.length Seq REltId
oldLayers
        then -- this means we've reached the end of layers, nothing to do
          (REltId
lp forall a. Num a => a -> a -> a
+ REltId
1, OwlMapping
accDir, Seq REltId
accSiblings)
        else -- normal case
        case SElt
selt of
          SElt
SEltFolderStart -> (REltId, OwlMapping, Seq REltId)
r
            where
              (REltId
lp', OwlMapping
accDir', Seq REltId
accSiblings') = REltId
-> REltId
-> REltId
-> OwlMapping
-> Seq REltId
-> (REltId, OwlMapping, Seq REltId)
recurfn (REltId
lp forall a. Num a => a -> a -> a
+ REltId
1) REltId
rid (REltId
depth forall a. Num a => a -> a -> a
+ REltId
1) OwlMapping
accDir forall a. Seq a
Seq.empty
              selfOwl :: OwlItem
selfOwl = OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (Seq REltId -> OwlSubItem
OwlSubItemFolder Seq REltId
accSiblings')
              r :: (REltId, OwlMapping, Seq REltId)
r = REltId
-> REltId
-> REltId
-> OwlMapping
-> Seq REltId
-> (REltId, OwlMapping, Seq REltId)
recurfn REltId
lp' REltId
parent REltId
depth (forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid (OwlItemMeta
selfMeta, OwlItem
selfOwl) OwlMapping
accDir') Seq REltId
newSiblings
          -- we're done! throw out this elt
          SElt
SEltFolderEnd -> (REltId
lp forall a. Num a => a -> a -> a
+ REltId
1, OwlMapping
accDir, Seq REltId
accSiblings)
          -- nothing special, keep going
          SElt
_ -> REltId
-> REltId
-> REltId
-> OwlMapping
-> Seq REltId
-> (REltId, OwlMapping, Seq REltId)
recurfn (REltId
lp forall a. Num a => a -> a -> a
+ REltId
1) REltId
parent REltId
depth (forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid (OwlItemMeta
selfMeta, (OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (SElt -> OwlSubItem
sElt_to_owlSubItem SElt
selt))) OwlMapping
accDir) Seq REltId
newSiblings

owlTree_fromSEltTree :: SEltTree -> OwlTree
owlTree_fromSEltTree :: SEltTree -> OwlTree
owlTree_fromSEltTree SEltTree
selttree = OwlTree
r
  where
    seltmap :: REltIdMap SEltLabel
seltmap = forall a. [(REltId, a)] -> IntMap a
IM.fromList SEltTree
selttree
    layers :: [REltId]
layers = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst SEltTree
selttree
    r :: OwlTree
r = REltIdMap SEltLabel -> Seq REltId -> OwlTree
owlTree_fromOldState REltIdMap SEltLabel
seltmap (forall a. [a] -> Seq a
Seq.fromList [REltId]
layers)

owlTree_fromOldState :: REltIdMap SEltLabel -> Seq REltId -> OwlTree
owlTree_fromOldState :: REltIdMap SEltLabel -> Seq REltId -> OwlTree
owlTree_fromOldState REltIdMap SEltLabel
oldDir Seq REltId
oldLayers = OwlTree
r
  where
    (REltId
_, OwlMapping
newDir, Seq REltId
topOwls) = REltIdMap SEltLabel
-> Seq REltId
-> REltId
-> REltId
-> REltId
-> OwlMapping
-> Seq REltId
-> (REltId, OwlMapping, Seq REltId)
internal_addUntilFolderEndRecursive REltIdMap SEltLabel
oldDir Seq REltId
oldLayers REltId
0 REltId
noOwl REltId
0 forall a. IntMap a
IM.empty forall a. Seq a
Seq.empty
    r :: OwlTree
r =
      OwlTree
        { _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
newDir,
          _owlTree_topOwls :: Seq REltId
_owlTree_topOwls = Seq REltId
topOwls
        }

owlTree_toSEltTree :: OwlTree -> SEltTree
owlTree_toSEltTree :: OwlTree -> SEltTree
owlTree_toSEltTree od :: OwlTree
od@OwlTree {OwlMapping
Seq REltId
_owlTree_topOwls :: Seq REltId
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: OwlTree -> Seq REltId
_owlTree_mapping :: OwlTree -> OwlMapping
..} = OwlTree -> SuperOwlParliament -> SEltTree
superOwlParliament_toSEltTree OwlTree
od (OwlTree -> SuperOwlParliament
owlTree_toSuperOwlParliament OwlTree
od)

-- DELETE use hasOwlElt variant
superOwl_toSElt_hack :: SuperOwl -> SElt
superOwl_toSElt_hack :: SuperOwl -> SElt
superOwl_toSElt_hack = forall o. HasOwlItem o => o -> SElt
hasOwlItem_toSElt_hack forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItem
_superOwl_elt

-- DELETE use hasOwlElt variant
superOwl_toSEltLabel_hack :: SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack :: SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack = forall o. HasOwlItem o => o -> SEltLabel
hasOwlItem_toSEltLabel_hack forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItem
_superOwl_elt