{-# 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.Serialization.Snake
import Potato.Flow.Types
import Potato.Flow.DebugHelpers
errorMsg_owlTree_lookupFail :: OwlTree -> REltId -> Text
errorMsg_owlTree_lookupFail :: OwlTree -> Int -> Text
errorMsg_owlTree_lookupFail OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
..} Int
rid = OwlMapping -> Int -> Text
errorMsg_owlMapping_lookupFail OwlMapping
_owlTree_mapping Int
rid
errorMsg_owlMapping_lookupFail :: OwlMapping -> REltId -> Text
errorMsg_owlMapping_lookupFail :: OwlMapping -> Int -> Text
errorMsg_owlMapping_lookupFail OwlMapping
_ Int
rid = Text
"expected to find REltId " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
rid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in OwlMapping"
type OwlMapping = REltIdMap (OwlItemMeta, OwlItem)
owlItem_updateAttachments :: Bool -> REltIdMap REltId -> OwlItem -> OwlItem
owlItem_updateAttachments :: Bool -> REltIdMap Int -> OwlItem -> OwlItem
owlItem_updateAttachments Bool
breakNonExistng REltIdMap Int
ridremap OwlItem
oitem = case OwlItem
oitem of
OwlItem OwlInfo
oinfo (OwlSubItemLine SAutoLine
sline) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (OwlSubItem -> OwlItem) -> OwlSubItem -> OwlItem
forall a b. (a -> b) -> a -> b
$ SAutoLine -> OwlSubItem
OwlSubItemLine (SAutoLine
sline {
_sAutoLine_attachStart = remapAttachment $ _sAutoLine_attachStart sline
, _sAutoLine_attachEnd = remapAttachment $ _sAutoLine_attachEnd sline
})
where
remapAttachment :: Maybe Attachment -> Maybe Attachment
remapAttachment Maybe Attachment
ma = case Maybe Attachment
ma of
Maybe Attachment
Nothing -> Maybe Attachment
forall a. Maybe a
Nothing
Just Attachment
a -> case Int -> REltIdMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Attachment -> Int
_attachment_target Attachment
a) REltIdMap Int
ridremap of
Maybe Int
Nothing -> if Bool
breakNonExistng then Maybe Attachment
forall a. Maybe a
Nothing else Attachment -> Maybe Attachment
forall a. a -> Maybe a
Just Attachment
a
Just Int
t -> Attachment -> Maybe Attachment
forall a. a -> Maybe a
Just (Attachment -> Maybe Attachment) -> Attachment -> Maybe Attachment
forall a b. (a -> b) -> a -> b
$ Attachment
a { _attachment_target = t }
OwlItem
x -> OwlItem
x
type SiblingPosition = Int
locateLeftSiblingIdFromSiblingPosition :: OwlMapping -> Seq REltId -> SiblingPosition -> Maybe REltId
locateLeftSiblingIdFromSiblingPosition :: OwlMapping -> Seq Int -> Int -> Maybe Int
locateLeftSiblingIdFromSiblingPosition OwlMapping
_ Seq Int
s Int
sp = case Int
sp of
Int
0 -> Maybe Int
forall a. Maybe a
Nothing
Int
x -> case Int -> Seq Int -> Maybe Int
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq Int
s of
Maybe Int
Nothing -> Text -> Maybe Int
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text
"expected to find index " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in seq"
Just Int
r -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
r
isDescendentOf :: (HasCallStack) => OwlMapping -> REltId -> REltId -> Bool
isDescendentOf :: HasCallStack => OwlMapping -> Int -> Int -> Bool
isDescendentOf OwlMapping
om Int
parent Int
child
| Int
child Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl = Bool
False
| Bool
otherwise = Bool
r
where
parent' :: Int
parent' = case Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
child OwlMapping
om of
Just (OwlItemMeta
oem, OwlItem
_) -> OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
oem
Maybe (OwlItemMeta, OwlItem)
Nothing -> Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ OwlMapping -> Int -> Text
errorMsg_owlMapping_lookupFail OwlMapping
om Int
child
r :: Bool
r = case Int
parent' of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> Bool
False
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
parent -> Bool
True
Int
x -> HasCallStack => OwlMapping -> Int -> Int -> Bool
OwlMapping -> Int -> Int -> Bool
isDescendentOf OwlMapping
om Int
parent Int
x
data OwlItemMeta = OwlItemMeta
{ OwlItemMeta -> Int
_owlItemMeta_parent :: REltId
, OwlItemMeta -> Int
_owlItemMeta_depth :: Int
, OwlItemMeta -> Int
_owlItemMeta_position :: SiblingPosition
}
deriving (OwlItemMeta -> OwlItemMeta -> Bool
(OwlItemMeta -> OwlItemMeta -> Bool)
-> (OwlItemMeta -> OwlItemMeta -> Bool) -> Eq OwlItemMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OwlItemMeta -> OwlItemMeta -> Bool
== :: OwlItemMeta -> OwlItemMeta -> Bool
$c/= :: OwlItemMeta -> OwlItemMeta -> Bool
/= :: OwlItemMeta -> OwlItemMeta -> Bool
Eq, Int -> OwlItemMeta -> ShowS
[OwlItemMeta] -> ShowS
OwlItemMeta -> String
(Int -> OwlItemMeta -> ShowS)
-> (OwlItemMeta -> String)
-> ([OwlItemMeta] -> ShowS)
-> Show OwlItemMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlItemMeta -> ShowS
showsPrec :: Int -> OwlItemMeta -> ShowS
$cshow :: OwlItemMeta -> String
show :: OwlItemMeta -> String
$cshowList :: [OwlItemMeta] -> ShowS
showList :: [OwlItemMeta] -> ShowS
Show, (forall x. OwlItemMeta -> Rep OwlItemMeta x)
-> (forall x. Rep OwlItemMeta x -> OwlItemMeta)
-> Generic OwlItemMeta
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
$cfrom :: forall x. OwlItemMeta -> Rep OwlItemMeta x
from :: forall x. OwlItemMeta -> Rep OwlItemMeta x
$cto :: forall x. Rep OwlItemMeta x -> OwlItemMeta
to :: forall x. Rep OwlItemMeta x -> OwlItemMeta
Generic)
instance NFData OwlItemMeta
instance PotatoShow OwlItemMeta where
potatoShow :: OwlItemMeta -> Text
potatoShow OwlItemMeta {Int
_owlItemMeta_parent :: OwlItemMeta -> Int
_owlItemMeta_depth :: OwlItemMeta -> Int
_owlItemMeta_position :: OwlItemMeta -> Int
_owlItemMeta_parent :: Int
_owlItemMeta_depth :: Int
_owlItemMeta_position :: Int
..} = Text
"(meta: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
_owlItemMeta_parent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
_owlItemMeta_depth Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
_owlItemMeta_position Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
data OwlSpot = OwlSpot {
OwlSpot -> Int
_owlSpot_parent :: REltId,
OwlSpot -> Maybe Int
_owlSpot_leftSibling :: Maybe REltId
}
deriving (Int -> OwlSpot -> ShowS
[OwlSpot] -> ShowS
OwlSpot -> String
(Int -> OwlSpot -> ShowS)
-> (OwlSpot -> String) -> ([OwlSpot] -> ShowS) -> Show OwlSpot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlSpot -> ShowS
showsPrec :: Int -> OwlSpot -> ShowS
$cshow :: OwlSpot -> String
show :: OwlSpot -> String
$cshowList :: [OwlSpot] -> ShowS
showList :: [OwlSpot] -> ShowS
Show, (forall x. OwlSpot -> Rep OwlSpot x)
-> (forall x. Rep OwlSpot x -> OwlSpot) -> Generic OwlSpot
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
$cfrom :: forall x. OwlSpot -> Rep OwlSpot x
from :: forall x. OwlSpot -> Rep OwlSpot x
$cto :: forall x. Rep OwlSpot x -> OwlSpot
to :: forall x. Rep OwlSpot x -> OwlSpot
Generic)
instance NFData OwlSpot
topSpot :: OwlSpot
topSpot :: OwlSpot
topSpot = Int -> Maybe Int -> OwlSpot
OwlSpot Int
noOwl Maybe Int
forall a. Maybe a
Nothing
data SuperOwl = SuperOwl
{ SuperOwl -> Int
_superOwl_id :: REltId,
SuperOwl -> OwlItemMeta
_superOwl_meta :: OwlItemMeta,
SuperOwl -> OwlItem
_superOwl_elt :: OwlItem
}
deriving (SuperOwl -> SuperOwl -> Bool
(SuperOwl -> SuperOwl -> Bool)
-> (SuperOwl -> SuperOwl -> Bool) -> Eq SuperOwl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SuperOwl -> SuperOwl -> Bool
== :: SuperOwl -> SuperOwl -> Bool
$c/= :: SuperOwl -> SuperOwl -> Bool
/= :: SuperOwl -> SuperOwl -> Bool
Eq, Int -> SuperOwl -> ShowS
[SuperOwl] -> ShowS
SuperOwl -> String
(Int -> SuperOwl -> ShowS)
-> (SuperOwl -> String) -> ([SuperOwl] -> ShowS) -> Show SuperOwl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SuperOwl -> ShowS
showsPrec :: Int -> SuperOwl -> ShowS
$cshow :: SuperOwl -> String
show :: SuperOwl -> String
$cshowList :: [SuperOwl] -> ShowS
showList :: [SuperOwl] -> ShowS
Show, (forall x. SuperOwl -> Rep SuperOwl x)
-> (forall x. Rep SuperOwl x -> SuperOwl) -> Generic SuperOwl
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
$cfrom :: forall x. SuperOwl -> Rep SuperOwl x
from :: forall x. SuperOwl -> Rep SuperOwl x
$cto :: forall x. Rep SuperOwl x -> SuperOwl
to :: forall x. Rep SuperOwl x -> SuperOwl
Generic)
instance NFData SuperOwl
instance MommyOwl SuperOwl where
mommyOwl_kiddos :: SuperOwl -> Maybe (Seq Int)
mommyOwl_kiddos SuperOwl
sowl = OwlItem -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
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)
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
attachedstuff :: [Attachment]
attachedstuff = (Attachment -> Bool) -> [Attachment] -> [Attachment]
forall a. (a -> Bool) -> [a] -> [a]
filter Attachment -> Bool
filterfn (SuperOwl -> [Attachment]
forall o. HasOwlItem o => o -> [Attachment]
hasOwlItem_attachments SuperOwl
sowl)
alterfn :: Int -> Maybe IntSet -> Maybe IntSet
alterfn Int
stuff Maybe IntSet
ms = IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$ case Maybe IntSet
ms of
Maybe IntSet
Nothing -> (Int -> IntSet
IS.singleton Int
stuff)
Just IntSet
s -> Int -> IntSet -> IntSet
IS.insert Int
stuff IntSet
s
innerfoldrfn :: Int -> AttachmentMap -> AttachmentMap
innerfoldrfn Int
target AttachmentMap
m' = (Maybe IntSet -> Maybe IntSet)
-> Int -> AttachmentMap -> AttachmentMap
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter (Int -> Maybe IntSet -> Maybe IntSet
alterfn (SuperOwl -> Int
_superOwl_id SuperOwl
sowl)) Int
target AttachmentMap
m'
newmap :: AttachmentMap
newmap = (Int -> AttachmentMap -> AttachmentMap)
-> AttachmentMap -> [Int] -> AttachmentMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> AttachmentMap -> AttachmentMap
innerfoldrfn AttachmentMap
m ((Attachment -> Int) -> [Attachment] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> Int
_attachment_target [Attachment]
attachedstuff)
r :: AttachmentMap
r = (SuperOwl -> AttachmentMap -> AttachmentMap)
-> AttachmentMap -> f SuperOwl -> AttachmentMap
forall a b. (a -> b -> b) -> b -> f a -> b
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 = (Attachment -> Bool)
-> f SuperOwl -> AttachmentMap -> AttachmentMap
forall (f :: * -> *).
Foldable f =>
(Attachment -> Bool)
-> f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls' (Bool -> Attachment -> Bool
forall a b. a -> b -> a
const Bool
True)
updateAttachmentMapFromSuperOwlChanges :: SuperOwlChanges -> AttachmentMap -> AttachmentMap
updateAttachmentMapFromSuperOwlChanges :: SuperOwlChanges -> AttachmentMap -> AttachmentMap
updateAttachmentMapFromSuperOwlChanges SuperOwlChanges
changes AttachmentMap
am = AttachmentMap
newam_4 where
newam_1 :: AttachmentMap
newam_1 = AttachmentMap
am
setToRemove :: IntSet
setToRemove = SuperOwlChanges -> IntSet
forall a. IntMap a -> IntSet
IM.keysSet SuperOwlChanges
changes
newam_2 :: AttachmentMap
newam_2 = (IntSet -> Bool) -> AttachmentMap -> AttachmentMap
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter (Bool -> Bool
not (Bool -> Bool) -> (IntSet -> Bool) -> IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Bool
IS.null) (AttachmentMap -> AttachmentMap) -> AttachmentMap -> AttachmentMap
forall a b. (a -> b) -> a -> b
$ (IntSet -> IntSet) -> AttachmentMap -> AttachmentMap
forall a b. (a -> b) -> IntMap a -> IntMap 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
justChanges :: [SuperOwl]
justChanges = [Maybe SuperOwl] -> [SuperOwl]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe SuperOwl] -> [SuperOwl])
-> (SuperOwlChanges -> [Maybe SuperOwl])
-> SuperOwlChanges
-> [SuperOwl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwlChanges -> [Maybe SuperOwl]
forall a. IntMap a -> [a]
IM.elems (SuperOwlChanges -> [SuperOwl]) -> SuperOwlChanges -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ SuperOwlChanges
changes
newam_3 :: AttachmentMap
newam_3 = [SuperOwl] -> AttachmentMap -> AttachmentMap
forall (f :: * -> *).
Foldable f =>
f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls [SuperOwl]
justChanges AttachmentMap
newam_2
newam_4 :: AttachmentMap
newam_4 = AttachmentMap
newam_3
getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges
getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges
getChangesFromAttachmentMap OwlTree
owltreeafterchanges AttachmentMap
am SuperOwlChanges
changes = SuperOwlChanges
r where
changeset :: IntSet
changeset = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IS.unions ([IntSet] -> IntSet)
-> ([Maybe IntSet] -> [IntSet]) -> [Maybe IntSet] -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe IntSet] -> [IntSet]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe IntSet] -> IntSet) -> [Maybe IntSet] -> IntSet
forall a b. (a -> b) -> a -> b
$ (Int -> [Maybe IntSet] -> [Maybe IntSet])
-> [Maybe IntSet] -> [Int] -> [Maybe IntSet]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
k [Maybe IntSet]
acc -> Int -> AttachmentMap -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k AttachmentMap
am Maybe IntSet -> [Maybe IntSet] -> [Maybe IntSet]
forall a. a -> [a] -> [a]
: [Maybe IntSet]
acc) [] (SuperOwlChanges -> [Int]
forall a. IntMap a -> [Int]
IM.keys SuperOwlChanges
changes)
r :: SuperOwlChanges
r = [(Int, Maybe SuperOwl)] -> SuperOwlChanges
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Maybe SuperOwl)] -> SuperOwlChanges)
-> (IntSet -> [(Int, Maybe SuperOwl)]) -> IntSet -> SuperOwlChanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe SuperOwl) -> Bool)
-> [(Int, Maybe SuperOwl)] -> [(Int, Maybe SuperOwl)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,Maybe SuperOwl
x) -> Maybe SuperOwl -> Bool
forall a. Maybe a -> Bool
isJust Maybe SuperOwl
x) ([(Int, Maybe SuperOwl)] -> [(Int, Maybe SuperOwl)])
-> (IntSet -> [(Int, Maybe SuperOwl)])
-> IntSet
-> [(Int, Maybe SuperOwl)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Int, Maybe SuperOwl)) -> [Int] -> [(Int, Maybe SuperOwl)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
rid -> (Int
rid, OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
owltreeafterchanges Int
rid)) ([Int] -> [(Int, Maybe SuperOwl)])
-> (IntSet -> [Int]) -> IntSet -> [(Int, Maybe SuperOwl)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toList (IntSet -> SuperOwlChanges) -> IntSet -> SuperOwlChanges
forall a b. (a -> b) -> a -> b
$ IntSet
changeset
instance PotatoShow SuperOwl where
potatoShow :: SuperOwl -> Text
potatoShow SuperOwl {Int
OwlItem
OwlItemMeta
_superOwl_id :: SuperOwl -> Int
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_id :: Int
_superOwl_meta :: OwlItemMeta
_superOwl_elt :: OwlItem
..} = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
_superOwl_id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OwlItemMeta -> Text
forall a. PotatoShow a => a -> Text
potatoShow OwlItemMeta
_superOwl_meta Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elt
where
elt :: Text
elt = OwlItem -> Text
forall a. PotatoShow a => a -> Text
potatoShow OwlItem
_superOwl_elt
superOwl_id :: Functor f => (REltId -> f REltId) -> SuperOwl -> f SuperOwl
superOwl_id :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> SuperOwl -> f SuperOwl
superOwl_id Int -> f Int
f SuperOwl
sowl = (Int -> SuperOwl) -> f Int -> f SuperOwl
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
rid -> SuperOwl
sowl {_superOwl_id = rid}) (Int -> f Int
f (SuperOwl -> Int
_superOwl_id SuperOwl
sowl))
superOwl_isTopOwl :: SuperOwl -> Bool
superOwl_isTopOwl :: SuperOwl -> Bool
superOwl_isTopOwl SuperOwl {Int
OwlItem
OwlItemMeta
_superOwl_id :: SuperOwl -> Int
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_id :: Int
_superOwl_meta :: OwlItemMeta
_superOwl_elt :: OwlItem
..} = OwlItemMeta -> Int
_owlItemMeta_depth OwlItemMeta
_superOwl_meta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
superOwl_isTopOwlSurely :: SuperOwl -> Bool
superOwl_isTopOwlSurely :: SuperOwl -> Bool
superOwl_isTopOwlSurely SuperOwl {Int
OwlItem
OwlItemMeta
_superOwl_id :: SuperOwl -> Int
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_id :: Int
_superOwl_meta :: OwlItemMeta
_superOwl_elt :: OwlItem
..} = OwlItemMeta -> Int
_owlItemMeta_depth OwlItemMeta
_superOwl_meta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
_superOwl_meta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl
noOwl :: REltId
noOwl :: Int
noOwl = -Int
1
superOwl_parentId :: SuperOwl -> REltId
superOwl_parentId :: SuperOwl -> Int
superOwl_parentId SuperOwl {Int
OwlItem
OwlItemMeta
_superOwl_id :: SuperOwl -> Int
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_id :: Int
_superOwl_meta :: OwlItemMeta
_superOwl_elt :: OwlItem
..} = OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
_superOwl_meta
superOwl_depth :: SuperOwl -> Int
superOwl_depth :: SuperOwl -> Int
superOwl_depth SuperOwl {Int
OwlItem
OwlItemMeta
_superOwl_id :: SuperOwl -> Int
_superOwl_meta :: SuperOwl -> OwlItemMeta
_superOwl_elt :: SuperOwl -> OwlItem
_superOwl_id :: Int
_superOwl_meta :: OwlItemMeta
_superOwl_elt :: OwlItem
..} = OwlItemMeta -> Int
_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 -> Int -> Int
owlTree_superOwlNthParentId OwlTree
_ SuperOwl
sowl Int
0 = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
owlTree_superOwlNthParentId OwlTree
od SuperOwl
sowl Int
n
| SuperOwl -> Int
superOwl_parentId SuperOwl
sowl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl = Int
noOwl
| Bool
otherwise = OwlTree -> SuperOwl -> Int -> Int
owlTree_superOwlNthParentId OwlTree
od (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od (SuperOwl -> Int
superOwl_parentId SuperOwl
sowl)) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
newtype OwlParliament = OwlParliament {OwlParliament -> Seq Int
unOwlParliament :: Seq REltId} deriving (Int -> OwlParliament -> ShowS
[OwlParliament] -> ShowS
OwlParliament -> String
(Int -> OwlParliament -> ShowS)
-> (OwlParliament -> String)
-> ([OwlParliament] -> ShowS)
-> Show OwlParliament
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlParliament -> ShowS
showsPrec :: Int -> OwlParliament -> ShowS
$cshow :: OwlParliament -> String
show :: OwlParliament -> String
$cshowList :: [OwlParliament] -> ShowS
showList :: [OwlParliament] -> ShowS
Show, (forall x. OwlParliament -> Rep OwlParliament x)
-> (forall x. Rep OwlParliament x -> OwlParliament)
-> Generic OwlParliament
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
$cfrom :: forall x. OwlParliament -> Rep OwlParliament x
from :: forall x. OwlParliament -> Rep OwlParliament x
$cto :: forall x. Rep OwlParliament x -> OwlParliament
to :: forall x. Rep OwlParliament x -> OwlParliament
Generic)
instance NFData OwlParliament
newtype SuperOwlParliament = SuperOwlParliament {SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament :: Seq SuperOwl} deriving (SuperOwlParliament -> SuperOwlParliament -> Bool
(SuperOwlParliament -> SuperOwlParliament -> Bool)
-> (SuperOwlParliament -> SuperOwlParliament -> Bool)
-> Eq SuperOwlParliament
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SuperOwlParliament -> SuperOwlParliament -> Bool
== :: SuperOwlParliament -> SuperOwlParliament -> Bool
$c/= :: SuperOwlParliament -> SuperOwlParliament -> Bool
/= :: SuperOwlParliament -> SuperOwlParliament -> Bool
Eq, Int -> SuperOwlParliament -> ShowS
[SuperOwlParliament] -> ShowS
SuperOwlParliament -> String
(Int -> SuperOwlParliament -> ShowS)
-> (SuperOwlParliament -> String)
-> ([SuperOwlParliament] -> ShowS)
-> Show SuperOwlParliament
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SuperOwlParliament -> ShowS
showsPrec :: Int -> SuperOwlParliament -> ShowS
$cshow :: SuperOwlParliament -> String
show :: SuperOwlParliament -> String
$cshowList :: [SuperOwlParliament] -> ShowS
showList :: [SuperOwlParliament] -> ShowS
Show, (forall x. SuperOwlParliament -> Rep SuperOwlParliament x)
-> (forall x. Rep SuperOwlParliament x -> SuperOwlParliament)
-> Generic SuperOwlParliament
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
$cfrom :: forall x. SuperOwlParliament -> Rep SuperOwlParliament x
from :: forall x. SuperOwlParliament -> Rep SuperOwlParliament x
$cto :: forall x. Rep SuperOwlParliament x -> SuperOwlParliament
to :: forall x. Rep SuperOwlParliament x -> SuperOwlParliament
Generic)
instance NFData SuperOwlParliament
instance PotatoShow SuperOwlParliament where
potatoShow :: SuperOwlParliament -> Text
potatoShow (SuperOwlParliament Seq SuperOwl
sowls) = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> (Seq Text -> [Text]) -> Seq Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Text -> Text) -> Seq Text -> Text
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> Text) -> Seq SuperOwl -> Seq Text
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Text
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
disjointUnion :: (Eq a) => [a] -> [a] -> [a]
disjointUnion :: forall a. Eq a => [a] -> [a] -> [a]
disjointUnion [a]
a [a]
b = [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
L.union [a]
a [a]
b [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [a] -> [a] -> [a]
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 Int
s1) (OwlParliament Seq Int
s2) = Seq Int -> OwlParliament
OwlParliament (Seq Int -> OwlParliament) -> Seq Int -> OwlParliament
forall a b. (a -> b) -> a -> b
$ [Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList ([Int] -> Seq Int) -> [Int] -> Seq Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
disjointUnion (Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
s1) (Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
s2)
isParliament_null :: OwlParliament -> Bool
isParliament_null = Seq Int -> Bool
forall a. Seq a -> Bool
Seq.null (Seq Int -> Bool)
-> (OwlParliament -> Seq Int) -> OwlParliament -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlParliament -> Seq Int
unOwlParliament
isParliament_empty :: OwlParliament
isParliament_empty = Seq Int -> OwlParliament
OwlParliament Seq Int
forall a. Seq a
Seq.empty
isParliament_length :: OwlParliament -> Int
isParliament_length (OwlParliament Seq Int
x) = Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
x
instance IsParliament SuperOwlParliament where
isParliament_disjointUnion :: SuperOwlParliament -> SuperOwlParliament -> SuperOwlParliament
isParliament_disjointUnion (SuperOwlParliament Seq SuperOwl
s1) (SuperOwlParliament Seq SuperOwl
s2) = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament (Seq SuperOwl -> SuperOwlParliament)
-> Seq SuperOwl -> SuperOwlParliament
forall a b. (a -> b) -> a -> b
$ [SuperOwl] -> Seq SuperOwl
forall a. [a] -> Seq a
Seq.fromList ([SuperOwl] -> Seq SuperOwl) -> [SuperOwl] -> Seq SuperOwl
forall a b. (a -> b) -> a -> b
$ [SuperOwl] -> [SuperOwl] -> [SuperOwl]
forall a. Eq a => [a] -> [a] -> [a]
disjointUnion (Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SuperOwl
s1) (Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SuperOwl
s2)
isParliament_null :: SuperOwlParliament -> Bool
isParliament_null = Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null (Seq SuperOwl -> Bool)
-> (SuperOwlParliament -> Seq SuperOwl)
-> SuperOwlParliament
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament
isParliament_empty :: SuperOwlParliament
isParliament_empty = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament Seq SuperOwl
forall a. Seq a
Seq.empty
isParliament_length :: SuperOwlParliament -> Int
isParliament_length (SuperOwlParliament Seq SuperOwl
x) = Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length Seq SuperOwl
x
owlParliament_toSuperOwlParliament :: OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament :: OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament od :: OwlTree
od@OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} OwlParliament
op = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament (Seq SuperOwl -> SuperOwlParliament)
-> Seq SuperOwl -> SuperOwlParliament
forall a b. (a -> b) -> a -> b
$ (Int -> SuperOwl) -> Seq Int -> Seq SuperOwl
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> SuperOwl
f (OwlParliament -> Seq Int
unOwlParliament OwlParliament
op)
where
f :: Int -> SuperOwl
f Int
rid = case Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid OwlMapping
_owlTree_mapping of
Maybe (OwlItemMeta, OwlItem)
Nothing -> Text -> SuperOwl
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> SuperOwl) -> Text -> SuperOwl
forall a b. (a -> b) -> a -> b
$ OwlTree -> Int -> Text
errorMsg_owlTree_lookupFail OwlTree
od Int
rid
Just (OwlItemMeta
oem, OwlItem
oe) -> Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
rid OwlItemMeta
oem OwlItem
oe
superOwlParliament_toOwlParliament :: SuperOwlParliament -> OwlParliament
superOwlParliament_toOwlParliament :: SuperOwlParliament -> OwlParliament
superOwlParliament_toOwlParliament = Seq Int -> OwlParliament
OwlParliament (Seq Int -> OwlParliament)
-> (SuperOwlParliament -> Seq Int)
-> SuperOwlParliament
-> OwlParliament
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Int) -> Seq SuperOwl -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Int
_superOwl_id (Seq SuperOwl -> Seq Int)
-> (SuperOwlParliament -> Seq SuperOwl)
-> SuperOwlParliament
-> Seq Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament
partitionN :: (a -> Int) -> Seq a -> IM.IntMap (Seq a)
partitionN :: forall a. (a -> Int) -> Seq a -> IntMap (Seq a)
partitionN a -> Int
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 -> Seq a -> Maybe (Seq a)
forall a. a -> Maybe a
Just (a -> Seq a
forall a. a -> Seq a
Seq.singleton a
x)
Just Seq a
xs -> Seq a -> Maybe (Seq a)
forall a. a -> Maybe a
Just (a
xa -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<|Seq a
xs)
foldfn :: a -> IntMap (Seq a) -> IntMap (Seq a)
foldfn a
a IntMap (Seq a)
acc = (Maybe (Seq a) -> Maybe (Seq a))
-> Int -> IntMap (Seq a) -> IntMap (Seq a)
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter (a -> Maybe (Seq a) -> Maybe (Seq a)
forall {a}. a -> Maybe (Seq a) -> Maybe (Seq a)
alterfn a
a) (a -> Int
f a
a) IntMap (Seq a)
acc
r :: IntMap (Seq a)
r = (a -> IntMap (Seq a) -> IntMap (Seq a))
-> IntMap (Seq a) -> Seq a -> IntMap (Seq a)
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> IntMap (Seq a) -> IntMap (Seq a)
foldfn IntMap (Seq a)
forall a. IntMap a
IM.empty Seq a
as
makeSortedSuperOwlParliament :: OwlTree -> Seq SuperOwl -> SuperOwlParliament
makeSortedSuperOwlParliament :: OwlTree -> Seq SuperOwl -> SuperOwlParliament
makeSortedSuperOwlParliament OwlTree
od Seq SuperOwl
sowls = SuperOwlParliament
r where
makeParentChain :: SuperOwl -> [SuperOwl]
makeParentChain :: SuperOwl -> [SuperOwl]
makeParentChain SuperOwl
sowl = [SuperOwl]
done where
makeParentChain' :: SuperOwl -> [SuperOwl] -> [SuperOwl]
makeParentChain' SuperOwl
sowl' [SuperOwl]
acc = case SuperOwl -> Int
superOwl_parentId SuperOwl
sowl' of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> [SuperOwl]
acc
Int
x -> SuperOwl -> [SuperOwl] -> [SuperOwl]
makeParentChain' SuperOwl
parentsowl (SuperOwl
parentsowlSuperOwl -> [SuperOwl] -> [SuperOwl]
forall a. a -> [a] -> [a]
:[SuperOwl]
acc) where
parentsowl :: SuperOwl
parentsowl = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
x
done :: [SuperOwl]
done = SuperOwl -> [SuperOwl] -> [SuperOwl]
makeParentChain' SuperOwl
sowl (SuperOwl
sowlSuperOwl -> [SuperOwl] -> [SuperOwl]
forall a. a -> [a] -> [a]
:[])
parentChains :: Seq [SuperOwl]
parentChains = (SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> Seq [SuperOwl]
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> [SuperOwl]
makeParentChain Seq SuperOwl
sowls
sortrec :: Seq [SuperOwl] -> Seq SuperOwl
sortrec :: Seq [SuperOwl] -> Seq SuperOwl
sortrec Seq [SuperOwl]
chains = Seq SuperOwl
done where
frontid :: [SuperOwl] -> Int
frontid (SuperOwl
x:[SuperOwl]
_) = SuperOwl -> Int
_superOwl_id SuperOwl
x
frontid [SuperOwl]
_ = Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should never happen"
groupedParentChains :: IntMap (Seq [SuperOwl])
groupedParentChains = ([SuperOwl] -> Int) -> Seq [SuperOwl] -> IntMap (Seq [SuperOwl])
forall a. (a -> Int) -> Seq a -> IntMap (Seq a)
partitionN [SuperOwl] -> Int
frontid Seq [SuperOwl]
chains
removeFront :: [a] -> [a]
removeFront (a
_:[a]
xs) = [a]
xs
removeFront [] = Text -> [a]
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should never happen"
groupedParentChains2 :: Seq (SuperOwl, Seq [SuperOwl])
groupedParentChains2 = ((Int, Seq [SuperOwl]) -> (SuperOwl, Seq [SuperOwl]))
-> Seq (Int, Seq [SuperOwl]) -> Seq (SuperOwl, Seq [SuperOwl])
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
rid,Seq [SuperOwl]
x) -> (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid, Seq [SuperOwl]
x)) (Seq (Int, Seq [SuperOwl]) -> Seq (SuperOwl, Seq [SuperOwl]))
-> (IntMap (Seq [SuperOwl]) -> Seq (Int, Seq [SuperOwl]))
-> IntMap (Seq [SuperOwl])
-> Seq (SuperOwl, Seq [SuperOwl])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Seq [SuperOwl])] -> Seq (Int, Seq [SuperOwl])
forall a. [a] -> Seq a
Seq.fromList ([(Int, Seq [SuperOwl])] -> Seq (Int, Seq [SuperOwl]))
-> (IntMap (Seq [SuperOwl]) -> [(Int, Seq [SuperOwl])])
-> IntMap (Seq [SuperOwl])
-> Seq (Int, Seq [SuperOwl])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (Seq [SuperOwl]) -> [(Int, Seq [SuperOwl])]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap (Seq [SuperOwl]) -> Seq (SuperOwl, Seq [SuperOwl]))
-> IntMap (Seq [SuperOwl]) -> Seq (SuperOwl, Seq [SuperOwl])
forall a b. (a -> b) -> a -> b
$ IntMap (Seq [SuperOwl])
groupedParentChains
cfn :: (SuperOwl, b) -> Int
cfn = OwlItemMeta -> Int
_owlItemMeta_position (OwlItemMeta -> Int)
-> ((SuperOwl, b) -> OwlItemMeta) -> (SuperOwl, b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta (SuperOwl -> OwlItemMeta)
-> ((SuperOwl, b) -> SuperOwl) -> (SuperOwl, b) -> OwlItemMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl, b) -> SuperOwl
forall a b. (a, b) -> a
fst
sortedPairs :: Seq (SuperOwl, Seq [SuperOwl])
sortedPairs = ((SuperOwl, Seq [SuperOwl]) -> Int)
-> Seq (SuperOwl, Seq [SuperOwl]) -> Seq (SuperOwl, Seq [SuperOwl])
forall b a. Ord b => (a -> b) -> Seq a -> Seq a
Seq.sortOn (SuperOwl, Seq [SuperOwl]) -> Int
forall {b}. (SuperOwl, b) -> Int
cfn (Seq (SuperOwl, Seq [SuperOwl]) -> Seq (SuperOwl, Seq [SuperOwl]))
-> Seq (SuperOwl, Seq [SuperOwl]) -> Seq (SuperOwl, Seq [SuperOwl])
forall a b. (a -> b) -> a -> b
$ Seq (SuperOwl, Seq [SuperOwl])
groupedParentChains2
fmapfn :: (a, Seq [SuperOwl]) -> Seq SuperOwl
fmapfn (a
_, Seq [SuperOwl]
chains') = if Seq [SuperOwl] -> Int
forall a. Seq a -> Int
Seq.length Seq [SuperOwl]
chains' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then Seq (Seq SuperOwl) -> Seq SuperOwl
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Seq (Seq SuperOwl) -> Seq SuperOwl)
-> Seq (Seq SuperOwl) -> Seq SuperOwl
forall a b. (a -> b) -> a -> b
$ ([SuperOwl] -> Seq SuperOwl)
-> Seq [SuperOwl] -> Seq (Seq SuperOwl)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SuperOwl -> Seq SuperOwl
forall a. a -> Seq a
Seq.singleton (SuperOwl -> Seq SuperOwl)
-> ([SuperOwl] -> SuperOwl) -> [SuperOwl] -> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SuperOwl] -> SuperOwl
forall a. HasCallStack => [a] -> a
Unsafe.last) Seq [SuperOwl]
chains'
else Seq [SuperOwl] -> Seq SuperOwl
sortrec (([SuperOwl] -> [SuperOwl]) -> Seq [SuperOwl] -> Seq [SuperOwl]
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [SuperOwl] -> [SuperOwl]
forall {a}. [a] -> [a]
removeFront Seq [SuperOwl]
chains')
done :: Seq SuperOwl
done = Seq (Seq SuperOwl) -> Seq SuperOwl
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Seq (Seq SuperOwl) -> Seq SuperOwl)
-> (Seq (SuperOwl, Seq [SuperOwl]) -> Seq (Seq SuperOwl))
-> Seq (SuperOwl, Seq [SuperOwl])
-> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SuperOwl, Seq [SuperOwl]) -> Seq SuperOwl)
-> Seq (SuperOwl, Seq [SuperOwl]) -> Seq (Seq SuperOwl)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SuperOwl, Seq [SuperOwl]) -> Seq SuperOwl
forall {a}. (a, Seq [SuperOwl]) -> Seq SuperOwl
fmapfn (Seq (SuperOwl, Seq [SuperOwl]) -> Seq SuperOwl)
-> Seq (SuperOwl, Seq [SuperOwl]) -> Seq SuperOwl
forall a b. (a -> b) -> a -> b
$ Seq (SuperOwl, Seq [SuperOwl])
sortedPairs
r :: SuperOwlParliament
r = Seq SuperOwl -> SuperOwlParliament
SuperOwlParliament (Seq SuperOwl -> SuperOwlParliament)
-> Seq SuperOwl -> SuperOwlParliament
forall a b. (a -> b) -> a -> b
$ Seq [SuperOwl] -> Seq SuperOwl
sortrec Seq [SuperOwl]
parentChains
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
mapsop0 :: IM.IntMap SuperOwl
mapsop0 :: IntMap SuperOwl
mapsop0 = [(Int, SuperOwl)] -> IntMap SuperOwl
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, SuperOwl)] -> IntMap SuperOwl)
-> (Seq SuperOwl -> [(Int, SuperOwl)])
-> Seq SuperOwl
-> IntMap SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Int, SuperOwl) -> [(Int, SuperOwl)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Int, SuperOwl) -> [(Int, SuperOwl)])
-> (Seq SuperOwl -> Seq (Int, SuperOwl))
-> Seq SuperOwl
-> [(Int, SuperOwl)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> (Int, SuperOwl))
-> Seq SuperOwl -> Seq (Int, SuperOwl)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, SuperOwl
sowl)) (Seq SuperOwl -> IntMap SuperOwl)
-> Seq SuperOwl -> IntMap SuperOwl
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 :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
rslt' :: IntMap SuperOwl
rslt' = Int -> SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid SuperOwl
sowl IntMap SuperOwl
mapsop
children :: Seq SuperOwl
children = OwlTree -> Int -> Seq SuperOwl
owliteratechildrenat OwlTree
od Int
rid
rslt :: IntMap SuperOwl
rslt = (SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl)
-> IntMap SuperOwl -> Seq SuperOwl -> IntMap SuperOwl
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SuperOwl
x IntMap SuperOwl
acc -> Int -> IntMap SuperOwl -> IntMap SuperOwl
forall a. Int -> IntMap a -> IntMap a
IM.delete (SuperOwl -> Int
_superOwl_id SuperOwl
x) IntMap SuperOwl
acc) IntMap SuperOwl
rslt' Seq SuperOwl
children
removeFromInheritSelection :: SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection SuperOwl
sowl IntMap SuperOwl
mapsop = IntMap SuperOwl
rslt where
prid :: Int
prid = SuperOwl -> Int
superOwl_parentId SuperOwl
sowl
mommy :: SuperOwl
mommy = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
prid
newkiddos :: Seq Int
newkiddos = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
Seq.deleteAt (OwlItemMeta -> Int
_owlItemMeta_position (OwlItemMeta -> Int)
-> (SuperOwl -> OwlItemMeta) -> SuperOwl -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta (SuperOwl -> Int) -> SuperOwl -> Int
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) (Maybe (Seq Int) -> Seq Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Seq Int) -> Seq Int) -> Maybe (Seq Int) -> Seq Int
forall a b. (a -> b) -> a -> b
$ SuperOwl -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos SuperOwl
mommy)
mapsop' :: IntMap SuperOwl
mapsop' = (Int -> IntMap SuperOwl -> IntMap SuperOwl)
-> IntMap SuperOwl -> Seq Int -> IntMap SuperOwl
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
rid IntMap SuperOwl
acc -> Int -> SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid) IntMap SuperOwl
acc) IntMap SuperOwl
mapsop Seq Int
newkiddos
rslt :: IntMap SuperOwl
rslt = if Int -> IntMap SuperOwl -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
prid IntMap SuperOwl
mapsop'
then Int -> IntMap SuperOwl -> IntMap SuperOwl
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
prid IntMap SuperOwl
mapsop'
else SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
prid) IntMap SuperOwl
mapsop'
isDescendentOfOwlMap :: REltId -> IM.IntMap SuperOwl -> Bool
isDescendentOfOwlMap :: Int -> IntMap SuperOwl -> Bool
isDescendentOfOwlMap Int
rid IntMap SuperOwl
mapsop = if Int -> IntMap SuperOwl -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
rid IntMap SuperOwl
mapsop
then Bool
True
else case OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od Int
rid of
Maybe SuperOwl
Nothing -> Bool
False
Just SuperOwl
x -> Int -> IntMap SuperOwl -> Bool
isDescendentOfOwlMap (SuperOwl -> Int
superOwl_parentId SuperOwl
x) IntMap SuperOwl
mapsop
foldfn :: SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
foldfn SuperOwl
sowl IntMap SuperOwl
acc = if Int -> IntMap SuperOwl -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
rid IntMap SuperOwl
acc
then Int -> IntMap SuperOwl -> IntMap SuperOwl
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
rid IntMap SuperOwl
acc
else if Int -> IntMap SuperOwl -> Bool
isDescendentOfOwlMap Int
rid IntMap SuperOwl
acc
then SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection SuperOwl
sowl IntMap SuperOwl
acc
else SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
addToSelection SuperOwl
sowl IntMap SuperOwl
acc
where
rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
mapsop1 :: IntMap SuperOwl
mapsop1 = (SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl)
-> IntMap SuperOwl -> Seq SuperOwl -> IntMap SuperOwl
forall a b. (a -> b -> b) -> b -> Seq a -> b
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 = [SuperOwl] -> Seq SuperOwl
forall a. [a] -> Seq a
Seq.fromList (IntMap SuperOwl -> [SuperOwl]
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
kiddosFirst :: Seq SuperOwl
kiddosFirst = (SuperOwl -> SuperOwl -> Ordering) -> Seq SuperOwl -> Seq SuperOwl
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy (\SuperOwl
a SuperOwl
b -> (Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OwlItemMeta -> Int
_owlItemMeta_depth (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
a)) (OwlItemMeta -> Int
_owlItemMeta_depth (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
b))) Seq SuperOwl
owls
acc0 :: (Set Int, Set Int, Bool)
acc0 = (Set Int
forall a. Set a
Set.empty, [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int)
-> (Seq SuperOwl -> [Int]) -> Seq SuperOwl -> Set Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Int -> [Int])
-> (Seq SuperOwl -> Seq Int) -> Seq SuperOwl -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Int) -> Seq SuperOwl -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Int
_superOwl_id (Seq SuperOwl -> Set Int) -> Seq SuperOwl -> Set Int
forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
owls, Bool
True)
foldlfn :: (Set Int, Set Int, Bool) -> SuperOwl -> (Set Int, Set Int, Bool)
foldlfn (Set Int
visited, Set Int
mommies', Bool
passing) SuperOwl
sowl = (Set Int
nextVisited, Set Int
mommies, Bool
passMommyCheck Bool -> Bool -> Bool
&& Bool
passing)
where
mommies :: Set Int
mommies = Int -> Set Int -> Set Int
forall a. Ord a => a -> Set a -> Set a
Set.delete (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) Set Int
mommies'
checkMommyRec :: Int -> Set Int -> (Set Int, Bool)
checkMommyRec Int
rid Set Int
toVisit = case Int
rid of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> (Set Int
toVisit, Bool
True)
Int
_ -> case Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Int
rid Set Int
visited of
Bool
True -> (Set Int
toVisit, Bool
True)
Bool
False -> case Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Int
rid Set Int
mommies of
Bool
True -> (Set Int
toVisit, Bool
False)
Bool
False -> case Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid OwlMapping
om of
Maybe (OwlItemMeta, OwlItem)
Nothing -> Text -> (Set Int, Bool)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (Set Int, Bool)) -> Text -> (Set Int, Bool)
forall a b. (a -> b) -> a -> b
$ OwlMapping -> Int -> Text
errorMsg_owlMapping_lookupFail OwlMapping
om Int
rid
Just (OwlItemMeta
oem, OwlItem
_) -> Int -> Set Int -> (Set Int, Bool)
checkMommyRec (OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
oem) (Int -> Set Int -> Set Int
forall a. Ord a => a -> Set a -> Set a
Set.insert Int
rid Set Int
toVisit)
(Set Int
visitedMommies, Bool
passMommyCheck) = Int -> Set Int -> (Set Int, Bool)
checkMommyRec (OwlItemMeta -> Int
_owlItemMeta_parent (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl)) Set Int
forall a. Set a
Set.empty
nextVisited :: Set Int
nextVisited =
if Bool
passMommyCheck
then Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Int
visited Set Int
visitedMommies
else Set Int
visited
(Set Int
_, Set Int
_, Bool
r1) = ((Set Int, Set Int, Bool) -> SuperOwl -> (Set Int, Set Int, Bool))
-> (Set Int, Set Int, Bool)
-> Seq SuperOwl
-> (Set Int, Set Int, Bool)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Set Int, Set Int, Bool) -> SuperOwl -> (Set Int, Set Int, Bool)
foldlfn (Set Int, Set Int, Bool)
acc0 Seq SuperOwl
kiddosFirst
r2 :: Bool
r2 = OwlTree -> Seq SuperOwl -> SuperOwlParliament
makeSortedSuperOwlParliament OwlTree
od Seq SuperOwl
owls SuperOwlParliament -> SuperOwlParliament -> Bool
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 OwlTree
od (SuperOwlParliament Seq SuperOwl
sowls) = Seq (Int, SEltLabel) -> SEltTree
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Int, SEltLabel) -> SEltTree)
-> Seq (Int, SEltLabel) -> SEltTree
forall a b. (a -> b) -> a -> b
$ Seq (Seq (Int, SEltLabel)) -> Seq (Int, SEltLabel)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Seq (Seq (Int, SEltLabel))
r
where
makeSElt :: REltId -> SuperOwl -> (REltId, Seq (REltId, SEltLabel))
makeSElt :: Int -> SuperOwl -> (Int, Seq (Int, SEltLabel))
makeSElt Int
maxid SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
kiddos) -> (Int
newmaxid,
(Int, SEltLabel) -> Seq (Int, SEltLabel)
forall a. a -> Seq a
Seq.singleton (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, Text -> SElt -> SEltLabel
SEltLabel (OwlInfo -> Text
_owlInfo_name OwlInfo
oinfo) SElt
SEltFolderStart)
Seq (Int, SEltLabel)
-> Seq (Int, SEltLabel) -> Seq (Int, SEltLabel)
forall a. Seq a -> Seq a -> Seq a
>< (Seq (Seq (Int, SEltLabel)) -> Seq (Int, SEltLabel)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Seq (Seq (Int, SEltLabel))
childSElts)
Seq (Int, SEltLabel)
-> Seq (Int, SEltLabel) -> Seq (Int, SEltLabel)
forall a. Seq a -> Seq a -> Seq a
>< (Int, SEltLabel) -> Seq (Int, SEltLabel)
forall a. a -> Seq a
Seq.singleton (Int
maxid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Text -> SElt -> SEltLabel
SEltLabel (OwlInfo -> Text
_owlInfo_name OwlInfo
oinfo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(end)") SElt
SEltFolderEnd)
)
where
kiddoS :: Seq SuperOwl
kiddoS = (SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament (SuperOwlParliament -> Seq SuperOwl)
-> (Seq Int -> SuperOwlParliament) -> Seq Int -> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od (OwlParliament -> SuperOwlParliament)
-> (Seq Int -> OwlParliament) -> Seq Int -> SuperOwlParliament
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> OwlParliament
OwlParliament (Seq Int -> Seq SuperOwl) -> Seq Int -> Seq SuperOwl
forall a b. (a -> b) -> a -> b
$ Seq Int
kiddos)
(Int
newmaxid, Seq (Seq (Int, SEltLabel))
childSElts) = (Int -> SuperOwl -> (Int, Seq (Int, SEltLabel)))
-> Int -> Seq SuperOwl -> (Int, Seq (Seq (Int, SEltLabel)))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> SuperOwl -> (Int, Seq (Int, SEltLabel))
makeSElt (Int
maxid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Seq SuperOwl
kiddoS
OwlItem
_ -> (Int
maxid, (Int, SEltLabel) -> Seq (Int, SEltLabel)
forall a. a -> Seq a
Seq.singleton ((Int, SEltLabel) -> Seq (Int, SEltLabel))
-> (Int, SEltLabel) -> Seq (Int, SEltLabel)
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, OwlItem -> SEltLabel
forall o. HasOwlItem o => o -> SEltLabel
hasOwlItem_toSEltLabel_hack (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl)))
(Int
_, Seq (Seq (Int, SEltLabel))
r) = (Int -> SuperOwl -> (Int, Seq (Int, SEltLabel)))
-> Int -> Seq SuperOwl -> (Int, Seq (Seq (Int, SEltLabel)))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> SuperOwl -> (Int, Seq (Int, SEltLabel))
makeSElt (OwlTree -> Int
owlTree_maxId OwlTree
od) Seq SuperOwl
sowls
newtype CanvasSelection = CanvasSelection { CanvasSelection -> Seq SuperOwl
unCanvasSelection :: Seq SuperOwl } deriving (Int -> CanvasSelection -> ShowS
[CanvasSelection] -> ShowS
CanvasSelection -> String
(Int -> CanvasSelection -> ShowS)
-> (CanvasSelection -> String)
-> ([CanvasSelection] -> ShowS)
-> Show CanvasSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CanvasSelection -> ShowS
showsPrec :: Int -> CanvasSelection -> ShowS
$cshow :: CanvasSelection -> String
show :: CanvasSelection -> String
$cshowList :: [CanvasSelection] -> ShowS
showList :: [CanvasSelection] -> ShowS
Show, CanvasSelection -> CanvasSelection -> Bool
(CanvasSelection -> CanvasSelection -> Bool)
-> (CanvasSelection -> CanvasSelection -> Bool)
-> Eq CanvasSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CanvasSelection -> CanvasSelection -> Bool
== :: CanvasSelection -> CanvasSelection -> Bool
$c/= :: CanvasSelection -> CanvasSelection -> Bool
/= :: CanvasSelection -> CanvasSelection -> Bool
Eq)
superOwlParliament_convertToCanvasSelection :: OwlTree -> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection :: OwlTree
-> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection OwlTree
od SuperOwl -> Bool
filterfn (SuperOwlParliament Seq SuperOwl
sowls) = CanvasSelection
r where
filtered :: Seq SuperOwl
filtered = (SuperOwl -> Bool) -> Seq SuperOwl -> Seq SuperOwl
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter SuperOwl -> Bool
filterfn Seq SuperOwl
sowls
sopify :: Seq Int -> SuperOwlParliament
sopify Seq Int
children = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od (Seq Int -> OwlParliament
OwlParliament Seq Int
children)
mapfn :: SuperOwl -> Seq SuperOwl
mapfn SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
OwlItem OwlInfo
_ (OwlSubItemFolder Seq Int
kiddos) -> CanvasSelection -> Seq SuperOwl
unCanvasSelection (CanvasSelection -> Seq SuperOwl)
-> CanvasSelection -> Seq SuperOwl
forall a b. (a -> b) -> a -> b
$ OwlTree
-> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection OwlTree
od SuperOwl -> Bool
filterfn (Seq Int -> SuperOwlParliament
sopify Seq Int
kiddos)
OwlItem
_ -> SuperOwl -> Seq SuperOwl
forall a. a -> Seq a
Seq.singleton SuperOwl
sowl
r :: CanvasSelection
r = Seq SuperOwl -> CanvasSelection
CanvasSelection (Seq SuperOwl -> CanvasSelection)
-> (Seq SuperOwl -> Seq SuperOwl)
-> Seq SuperOwl
-> CanvasSelection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Seq SuperOwl) -> Seq SuperOwl
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Seq (Seq SuperOwl) -> Seq SuperOwl)
-> (Seq SuperOwl -> Seq (Seq SuperOwl))
-> Seq SuperOwl
-> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Seq SuperOwl) -> Seq SuperOwl -> Seq (Seq SuperOwl)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Seq SuperOwl
mapfn (Seq SuperOwl -> CanvasSelection)
-> Seq SuperOwl -> CanvasSelection
forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
filtered
superOwlParliament_convertToSeqWithChildren :: OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren :: OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren OwlTree
od (SuperOwlParliament Seq SuperOwl
sowls) = Seq SuperOwl
r where
sopify :: Seq Int -> SuperOwlParliament
sopify Seq Int
children = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od (Seq Int -> OwlParliament
OwlParliament Seq Int
children)
mapfn :: SuperOwl -> Seq SuperOwl
mapfn SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
OwlItem OwlInfo
_ (OwlSubItemFolder Seq Int
kiddos) -> SuperOwl
sowl SuperOwl -> Seq SuperOwl -> Seq SuperOwl
forall a. a -> Seq a -> Seq a
<| (OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren OwlTree
od (Seq Int -> SuperOwlParliament
sopify Seq Int
kiddos))
OwlItem
_ -> SuperOwl -> Seq SuperOwl
forall a. a -> Seq a
Seq.singleton SuperOwl
sowl
r :: Seq SuperOwl
r = Seq (Seq SuperOwl) -> Seq SuperOwl
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Seq (Seq SuperOwl) -> Seq SuperOwl)
-> (Seq SuperOwl -> Seq (Seq SuperOwl))
-> Seq SuperOwl
-> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Seq SuperOwl) -> Seq SuperOwl -> Seq (Seq SuperOwl)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Seq SuperOwl
mapfn (Seq SuperOwl -> Seq SuperOwl) -> Seq SuperOwl -> Seq SuperOwl
forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
sowls
owlParliament_convertToMiniOwltree :: OwlTree -> OwlParliament -> MiniOwlTree
owlParliament_convertToMiniOwltree :: OwlTree -> OwlParliament -> OwlTree
owlParliament_convertToMiniOwltree OwlTree
od op :: OwlParliament
op@(OwlParliament Seq Int
owls) = Bool -> OwlTree -> OwlTree
forall a. HasCallStack => Bool -> a -> a
assert Bool
valid OwlTree
r where
valid :: Bool
valid = OwlTree -> SuperOwlParliament -> Bool
superOwlParliament_isValid OwlTree
od (SuperOwlParliament -> Bool) -> SuperOwlParliament -> Bool
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 :: Int
-> Int
-> Seq Int
-> (OwlMapping, REltIdMap Int, Int, Int)
-> (OwlMapping, REltIdMap Int, Int)
addOwl Int
newprid Int
rid Seq Int
newchildrids (OwlMapping
om, REltIdMap Int
ridremap, Int
nrid, Int
pos) = (OwlMapping
newom, REltIdMap Int
newridremap, Int
nridInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) where
sowl :: SuperOwl
sowl = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid
newoem :: OwlItemMeta
newoem = OwlItemMeta {
_owlItemMeta_parent :: Int
_owlItemMeta_parent = Int
newprid
, _owlItemMeta_depth :: Int
_owlItemMeta_depth = Int
0
, _owlItemMeta_position :: Int
_owlItemMeta_position = Int
pos
}
newoe :: OwlItem
newoe = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
_) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq Int -> OwlSubItem
OwlSubItemFolder Seq Int
newchildrids)
OwlItem
x -> OwlItem
x
newom :: OwlMapping
newom = Int -> (OwlItemMeta, OwlItem) -> OwlMapping -> OwlMapping
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
nrid (OwlItemMeta
newoem, OwlItem
newoe) OwlMapping
om
newridremap :: REltIdMap Int
newridremap = Int -> Int -> REltIdMap Int -> REltIdMap Int
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid Int
nrid REltIdMap Int
ridremap
addOwlRecursive :: Int -> REltId -> REltId -> (OwlMapping, IM.IntMap REltId, REltId, SiblingPosition) -> ((OwlMapping, IM.IntMap REltId, REltId, SiblingPosition), REltId)
addOwlRecursive :: Int
-> Int
-> Int
-> (OwlMapping, REltIdMap Int, Int, Int)
-> ((OwlMapping, REltIdMap Int, Int, Int), Int)
addOwlRecursive Int
depth Int
prid Int
rid (OwlMapping
om, REltIdMap Int
ridremap, Int
nrid, Int
pos) = ((OwlMapping, REltIdMap Int, Int, Int), Int)
rslt where
newprid :: Int
newprid = if Int
prid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl then Int
noOwl else REltIdMap Int
ridremap REltIdMap Int -> Int -> Int
forall a. IntMap a -> Int -> a
IM.! Int
prid
(OwlMapping
newom', REltIdMap Int
newridremap', Int
newnrid') = Int
-> Int
-> Seq Int
-> (OwlMapping, REltIdMap Int, Int, Int)
-> (OwlMapping, REltIdMap Int, Int)
addOwl Int
newprid Int
rid (Seq Int
newchildrids) (OwlMapping
om, REltIdMap Int
ridremap, Int
nrid, Int
pos)
children :: Seq Int
children = Seq Int -> Maybe (Seq Int) -> Seq Int
forall a. a -> Maybe a -> a
fromMaybe Seq Int
forall a. Seq a
Seq.empty (Maybe (Seq Int) -> Seq Int) -> Maybe (Seq Int) -> Seq Int
forall a b. (a -> b) -> a -> b
$ SuperOwl -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos (SuperOwl -> Maybe (Seq Int)) -> SuperOwl -> Maybe (Seq Int)
forall a b. (a -> b) -> a -> b
$ HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid
((OwlMapping
newom, REltIdMap Int
newridremap, Int
newnrid, Int
_), Seq Int
newchildrids) = ((OwlMapping, REltIdMap Int, Int, Int)
-> Int -> ((OwlMapping, REltIdMap Int, Int, Int), Int))
-> (OwlMapping, REltIdMap Int, Int, Int)
-> Seq Int
-> ((OwlMapping, REltIdMap Int, Int, Int), Seq Int)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\(OwlMapping, REltIdMap Int, Int, Int)
acc Int
crid -> Int
-> Int
-> Int
-> (OwlMapping, REltIdMap Int, Int, Int)
-> ((OwlMapping, REltIdMap Int, Int, Int), Int)
addOwlRecursive (Int
depthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
rid Int
crid (OwlMapping, REltIdMap Int, Int, Int)
acc) (OwlMapping
newom', REltIdMap Int
newridremap', Int
newnrid', Int
0) Seq Int
children
rslt :: ((OwlMapping, REltIdMap Int, Int, Int), Int)
rslt = ((OwlMapping
newom, REltIdMap Int
newridremap, Int
newnrid, Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1), Int
nrid)
((OwlMapping
om1, REltIdMap Int
_, Int
_, Int
_), Seq Int
newtopowls) = ((OwlMapping, REltIdMap Int, Int, Int)
-> Int -> ((OwlMapping, REltIdMap Int, Int, Int), Int))
-> (OwlMapping, REltIdMap Int, Int, Int)
-> Seq Int
-> ((OwlMapping, REltIdMap Int, Int, Int), Seq Int)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\(OwlMapping, REltIdMap Int, Int, Int)
acc Int
rid -> Int
-> Int
-> Int
-> (OwlMapping, REltIdMap Int, Int, Int)
-> ((OwlMapping, REltIdMap Int, Int, Int), Int)
addOwlRecursive Int
0 Int
noOwl Int
rid (OwlMapping, REltIdMap Int, Int, Int)
acc) (OwlMapping
forall a. IntMap a
IM.empty, REltIdMap Int
forall a. IntMap a
IM.empty, OwlTree -> Int
owlTree_maxId OwlTree
od Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0) Seq Int
owls
r :: OwlTree
r = OwlTree {
_owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
om1
, _owlTree_topOwls :: Seq Int
_owlTree_topOwls = Seq Int
newtopowls
}
type OwlParliamentSet = IS.IntSet
superOwlParliament_toOwlParliamentSet :: SuperOwlParliament -> OwlParliamentSet
superOwlParliament_toOwlParliamentSet :: SuperOwlParliament -> IntSet
superOwlParliament_toOwlParliamentSet (SuperOwlParliament Seq SuperOwl
sowls) = [Int] -> IntSet
IS.fromList ([Int] -> IntSet)
-> (Seq SuperOwl -> [Int]) -> Seq SuperOwl -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Int -> [Int])
-> (Seq SuperOwl -> Seq Int) -> Seq SuperOwl -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Int) -> Seq SuperOwl -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Int
_superOwl_id (Seq SuperOwl -> IntSet) -> Seq SuperOwl -> IntSet
forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
sowls
owlParliamentSet_member :: REltId -> OwlParliamentSet -> Bool
owlParliamentSet_member :: Int -> IntSet -> Bool
owlParliamentSet_member = Int -> IntSet -> Bool
IS.member
owlParliamentSet_descendent :: OwlTree -> REltId -> OwlParliamentSet -> Bool
owlParliamentSet_descendent :: OwlTree -> Int -> IntSet -> Bool
owlParliamentSet_descendent OwlTree
ot Int
rid IntSet
sset = if Int -> IntSet -> Bool
owlParliamentSet_member Int
rid IntSet
sset
then Bool
True
else case OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
ot Int
rid of
Maybe SuperOwl
Nothing -> Bool
False
Just SuperOwl
x -> OwlTree -> Int -> IntSet -> Bool
owlParliamentSet_descendent OwlTree
ot (SuperOwl -> Int
superOwl_parentId SuperOwl
x) IntSet
sset
owlParliamentSet_findParents :: OwlTree -> OwlParliamentSet -> OwlParliamentSet
owlParliamentSet_findParents :: OwlTree -> IntSet -> IntSet
owlParliamentSet_findParents OwlTree
od IntSet
ops = IntSet
r where
foldrfn :: Int -> IntSet -> IntSet
foldrfn Int
rid IntSet
acc = case OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od Int
rid of
Maybe SuperOwl
Nothing -> IntSet
acc
Just SuperOwl
sowl -> let
prid :: Int
prid = OwlItemMeta -> Int
_owlItemMeta_parent (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl)
in if Int
prid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl
then IntSet
acc
else Int -> IntSet -> IntSet
IS.insert Int
prid IntSet
acc
parents :: IntSet
parents = (Int -> IntSet -> IntSet) -> IntSet -> IntSet -> IntSet
forall b. (Int -> b -> b) -> b -> IntSet -> b
IS.foldr Int -> 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 Int
_owlTree_topOwls :: Seq REltId
}
deriving (Int -> OwlTree -> ShowS
[OwlTree] -> ShowS
OwlTree -> String
(Int -> OwlTree -> ShowS)
-> (OwlTree -> String) -> ([OwlTree] -> ShowS) -> Show OwlTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OwlTree -> ShowS
showsPrec :: Int -> OwlTree -> ShowS
$cshow :: OwlTree -> String
show :: OwlTree -> String
$cshowList :: [OwlTree] -> ShowS
showList :: [OwlTree] -> ShowS
Show, OwlTree -> OwlTree -> Bool
(OwlTree -> OwlTree -> Bool)
-> (OwlTree -> OwlTree -> Bool) -> Eq OwlTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OwlTree -> OwlTree -> Bool
== :: OwlTree -> OwlTree -> Bool
$c/= :: OwlTree -> OwlTree -> Bool
/= :: OwlTree -> OwlTree -> Bool
Eq, (forall x. OwlTree -> Rep OwlTree x)
-> (forall x. Rep OwlTree x -> OwlTree) -> Generic OwlTree
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
$cfrom :: forall x. OwlTree -> Rep OwlTree x
from :: forall x. OwlTree -> Rep OwlTree x
$cto :: forall x. Rep OwlTree x -> OwlTree
to :: forall x. Rep OwlTree x -> OwlTree
Generic)
instance NFData OwlTree
instance MommyOwl OwlTree where
mommyOwl_kiddos :: OwlTree -> Maybe (Seq Int)
mommyOwl_kiddos OwlTree
o = Seq Int -> Maybe (Seq Int)
forall a. a -> Maybe a
Just (Seq Int -> Maybe (Seq Int)) -> Seq Int -> Maybe (Seq Int)
forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq Int
_owlTree_topOwls OwlTree
o
type MiniOwlTree = OwlTree
owlTree_equivalent :: OwlTree -> OwlTree -> Bool
owlTree_equivalent :: OwlTree -> OwlTree -> Bool
owlTree_equivalent OwlTree
ota OwlTree
otb = Bool
r
where
mustFind :: Int -> OwlTree -> (OwlItemMeta, OwlItem)
mustFind Int
rid OwlTree
ot = case Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
ot) of
Maybe (OwlItemMeta, OwlItem)
Nothing -> Text -> (OwlItemMeta, OwlItem)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (OwlItemMeta, OwlItem)) -> Text -> (OwlItemMeta, OwlItem)
forall a b. (a -> b) -> a -> b
$ OwlTree -> Int -> Text
errorMsg_owlTree_lookupFail OwlTree
ot Int
rid
Just (OwlItemMeta, OwlItem)
x -> (OwlItemMeta, OwlItem)
x
kiddos_equivalent :: Seq Int -> Seq Int -> Bool
kiddos_equivalent Seq Int
kiddosa Seq Int
kiddosb =
Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
kiddosa Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
kiddosb
Bool -> Bool -> Bool
&& (Bool -> Bool) -> Seq Bool -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id ((Int -> Int -> Bool) -> Seq Int -> Seq Int -> Seq Bool
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (Int -> Int -> Bool
owl_equivalent') Seq Int
kiddosa Seq Int
kiddosb)
owl_equivalent' :: Int -> Int -> Bool
owl_equivalent' Int
rida Int
ridb = OwlItem -> OwlItem -> Bool
owl_equivalent OwlItem
a' OwlItem
b'
where
(OwlItemMeta
_, OwlItem
a') = Int -> OwlTree -> (OwlItemMeta, OwlItem)
mustFind Int
rida OwlTree
ota
(OwlItemMeta
_, OwlItem
b') = Int -> OwlTree -> (OwlItemMeta, OwlItem)
mustFind Int
ridb OwlTree
otb
owl_equivalent :: OwlItem -> OwlItem -> Bool
owl_equivalent (OwlItem OwlInfo
oia (OwlSubItemFolder Seq Int
kiddosa)) (OwlItem OwlInfo
oib (OwlSubItemFolder Seq Int
kiddosb)) = OwlInfo
oia OwlInfo -> OwlInfo -> Bool
forall a. Eq a => a -> a -> Bool
== OwlInfo
oib Bool -> Bool -> Bool
&& Seq Int -> Seq Int -> Bool
kiddos_equivalent Seq Int
kiddosa Seq Int
kiddosb
owl_equivalent (OwlItem OwlInfo
oia OwlSubItem
osia) (OwlItem OwlInfo
oib OwlSubItem
osib) = OwlInfo
oia OwlInfo -> OwlInfo -> Bool
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 Int -> Seq Int -> Bool
kiddos_equivalent (OwlTree -> Seq Int
_owlTree_topOwls OwlTree
ota) (OwlTree -> Seq Int
_owlTree_topOwls OwlTree
otb)
instance PotatoShow OwlTree where
potatoShow :: OwlTree -> Text
potatoShow OwlTree
od = Text
r where
foldlfn :: Text -> Int -> Text
foldlfn Text
acc Int
rid =
let sowl :: SuperOwl
sowl = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid
selfEntry' :: Text
selfEntry' = Int -> Text -> Text
T.replicate (OwlItemMeta -> Int
_owlItemMeta_depth (OwlItemMeta -> Int)
-> (SuperOwl -> OwlItemMeta) -> SuperOwl -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta (SuperOwl -> Int) -> SuperOwl -> Int
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SuperOwl -> Text
forall a. PotatoShow a => a -> Text
potatoShow SuperOwl
sowl
selfEntry :: Text
selfEntry = Text
selfEntry' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
in Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case SuperOwl -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos SuperOwl
sowl of
Maybe (Seq Int)
Nothing -> Text
selfEntry
Just Seq Int
kiddos -> Text
selfEntry Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Seq Int -> Text
printKiddos Seq Int
kiddos
printKiddos :: Seq REltId -> Text
printKiddos :: Seq Int -> Text
printKiddos Seq Int
kiddos = (Text -> Int -> Text) -> Text -> Seq Int -> Text
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Int -> Text
foldlfn Text
"" Seq Int
kiddos
r :: Text
r = Seq Int -> Text
printKiddos (Maybe (Seq Int) -> Seq Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Seq Int) -> Seq Int) -> Maybe (Seq Int) -> Seq Int
forall a b. (a -> b) -> a -> b
$ OwlTree -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos OwlTree
od)
owlTree_validate :: OwlTree -> (Bool, Text)
owlTree_validate :: OwlTree -> (Bool, Text)
owlTree_validate OwlTree
od = Text -> Int -> Int -> Seq Int -> (Bool, Text)
checkRecursive Text
"" Int
noOwl Int
0 (OwlTree -> Seq Int
_owlTree_topOwls OwlTree
od)
where
checkRecursive :: Text -> Int -> Int -> Seq Int -> (Bool, Text)
checkRecursive Text
msg0 Int
parentrid Int
depth Seq Int
kiddos = (Bool, Text)
r
where
foldfn :: (Bool, Text) -> Int -> Int -> (Bool, Text)
foldfn (Bool
pass', Text
msg') Int
i Int
rid = case OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od Int
rid of
Maybe SuperOwl
Nothing -> (Bool
False, Text
msg' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nmissing REltId " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
rid)
Just SuperOwl
x -> (Bool
rpass, Text
rmsg)
where
expected :: OwlItemMeta
expected =
OwlItemMeta
{ _owlItemMeta_parent :: Int
_owlItemMeta_parent = Int
parentrid,
_owlItemMeta_depth :: Int
_owlItemMeta_depth = Int
depth,
_owlItemMeta_position :: Int
_owlItemMeta_position = Int
i
}
rpass1 :: Bool
rpass1 = Bool
pass' Bool -> Bool -> Bool
&& OwlItemMeta
expected OwlItemMeta -> OwlItemMeta -> Bool
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' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nbad meta at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
rid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OwlItemMeta -> Text
forall b a. (Show a, IsString b) => a -> b
show (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OwlItemMeta -> Text
forall b a. (Show a, IsString b) => a -> b
show OwlItemMeta
expected
(Bool
rpass2, Text
rmsg2) = case (SuperOwl -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos SuperOwl
x) of
Maybe (Seq Int)
Nothing -> (Bool
rpass1, Text
rmsg1)
Just Seq Int
kiddos' -> Text -> Int -> Int -> Seq Int -> (Bool, Text)
checkRecursive Text
msg0 (SuperOwl -> Int
_superOwl_id SuperOwl
x) (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Seq Int
kiddos'
(Bool
rpass, Text
rmsg) = (Bool
rpass1 Bool -> Bool -> Bool
&& Bool
rpass2, Text
rmsg2)
r :: (Bool, Text)
r = ((Bool, Text) -> Int -> Int -> (Bool, Text))
-> (Bool, Text) -> Seq Int -> (Bool, Text)
forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
Seq.foldlWithIndex (Bool, Text) -> Int -> Int -> (Bool, Text)
foldfn (Bool
True, Text
msg0) Seq Int
kiddos
owlTree_maxId :: OwlTree -> REltId
owlTree_maxId :: OwlTree -> Int
owlTree_maxId OwlTree
s = Int
-> ((Int, (OwlItemMeta, OwlItem)) -> Int)
-> Maybe (Int, (OwlItemMeta, OwlItem))
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, (OwlItemMeta, OwlItem)) -> Int
forall a b. (a, b) -> a
fst (OwlMapping -> Maybe (Int, (OwlItemMeta, OwlItem))
forall a. IntMap a -> Maybe (Int, a)
IM.lookupMax (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
s))
internal_owlTree_reorgKiddos :: OwlTree -> REltId -> OwlTree
internal_owlTree_reorgKiddos :: OwlTree -> Int -> OwlTree
internal_owlTree_reorgKiddos OwlTree
od Int
prid = OwlTree
od {_owlTree_mapping = om}
where
childrenToUpdate :: Seq Int
childrenToUpdate = Maybe (Seq Int) -> Seq Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Seq Int) -> Seq Int) -> Maybe (Seq Int) -> Seq Int
forall a b. (a -> b) -> a -> b
$ OwlTree -> Int -> Maybe (Seq Int)
owlTree_findKiddos OwlTree
od Int
prid
setRelPos :: Int -> (OwlItemMeta, b) -> (OwlItemMeta, b)
setRelPos Int
i (OwlItemMeta
oem, b
oe) = (OwlItemMeta
oem {_owlItemMeta_position = i}, b
oe)
om :: OwlMapping
om = (OwlMapping -> Int -> Int -> OwlMapping)
-> OwlMapping -> Seq Int -> OwlMapping
forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
Seq.foldlWithIndex (\OwlMapping
om' Int
i Int
x -> ((OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem))
-> Int -> OwlMapping -> OwlMapping
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (Int -> (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
forall {b}. Int -> (OwlItemMeta, b) -> (OwlItemMeta, b)
setRelPos Int
i) Int
x OwlMapping
om') (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
od) Seq Int
childrenToUpdate
emptyOwlTree :: OwlTree
emptyOwlTree :: OwlTree
emptyOwlTree =
OwlTree
{ _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
forall a. IntMap a
IM.empty,
_owlTree_topOwls :: Seq Int
_owlTree_topOwls = Seq Int
forall a. Seq a
Seq.empty
}
owlTree_exists :: OwlTree -> REltId -> Bool
owlTree_exists :: OwlTree -> Int -> Bool
owlTree_exists OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} Int
rid = Int -> OwlMapping -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
rid OwlMapping
_owlTree_mapping
owlTree_findSuperOwl :: OwlTree -> REltId -> Maybe SuperOwl
owlTree_findSuperOwl :: OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} Int
rid = do
(OwlItemMeta
meta, OwlItem
elt) <- Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid OwlMapping
_owlTree_mapping
SuperOwl -> Maybe SuperOwl
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (SuperOwl -> Maybe SuperOwl) -> SuperOwl -> Maybe SuperOwl
forall a b. (a -> b) -> a -> b
$ Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
rid OwlItemMeta
meta OwlItem
elt
owlTree_mustFindSuperOwl :: HasCallStack => OwlTree -> REltId -> SuperOwl
owlTree_mustFindSuperOwl :: HasCallStack => OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid = case OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od Int
rid of
Maybe SuperOwl
Nothing -> Text -> SuperOwl
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> SuperOwl) -> Text -> SuperOwl
forall a b. (a -> b) -> a -> b
$ OwlTree -> Int -> Text
errorMsg_owlTree_lookupFail OwlTree
od Int
rid
Just SuperOwl
x -> SuperOwl
x
owlTree_findKiddos :: OwlTree -> REltId -> Maybe (Seq REltId)
owlTree_findKiddos :: OwlTree -> Int -> Maybe (Seq Int)
owlTree_findKiddos OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} Int
rid = case Int
rid of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> Seq Int -> Maybe (Seq Int)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq Int
_owlTree_topOwls
Int
x -> do
(OwlItemMeta
_, OwlItem
oelt) <- Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
x OwlMapping
_owlTree_mapping
OwlItem -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos OwlItem
oelt
owlTree_findSuperOwlAtOwlSpot :: OwlTree -> OwlSpot -> Maybe SuperOwl
owlTree_findSuperOwlAtOwlSpot :: OwlTree -> OwlSpot -> Maybe SuperOwl
owlTree_findSuperOwlAtOwlSpot OwlTree
od OwlSpot {Int
Maybe Int
_owlSpot_parent :: OwlSpot -> Int
_owlSpot_leftSibling :: OwlSpot -> Maybe Int
_owlSpot_parent :: Int
_owlSpot_leftSibling :: Maybe Int
..} = do
Seq Int
kiddos <- OwlTree -> Int -> Maybe (Seq Int)
owlTree_findKiddos OwlTree
od Int
_owlSpot_parent
Int
kid <- case Maybe Int
_owlSpot_leftSibling of
Maybe Int
Nothing -> Int -> Seq Int -> Maybe Int
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq Int
kiddos
Just Int
rid -> Int -> Seq Int -> Maybe Int
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 (Seq Int -> Maybe Int)
-> (Seq Int -> Seq Int) -> Seq Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 (Seq Int -> Seq Int) -> (Seq Int -> Seq Int) -> Seq Int -> Seq Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.dropWhileL (\Int
rid' -> Int
rid' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
rid) (Seq Int -> Maybe Int) -> Seq Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Seq Int
kiddos
OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
od Int
kid
owlTree_goRightFromOwlSpot :: OwlTree -> OwlSpot -> Maybe OwlSpot
owlTree_goRightFromOwlSpot :: OwlTree -> OwlSpot -> Maybe OwlSpot
owlTree_goRightFromOwlSpot OwlTree
od OwlSpot
ospot = do
SuperOwl
sowl <- OwlTree -> OwlSpot -> Maybe SuperOwl
owlTree_findSuperOwlAtOwlSpot OwlTree
od OwlSpot
ospot
return $ OwlSpot
ospot {_owlSpot_leftSibling = Just $ _superOwl_id sowl}
owlTree_owlItemMeta_toOwlSpot :: OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot :: OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} OwlItemMeta {Int
_owlItemMeta_parent :: OwlItemMeta -> Int
_owlItemMeta_depth :: OwlItemMeta -> Int
_owlItemMeta_position :: OwlItemMeta -> Int
_owlItemMeta_parent :: Int
_owlItemMeta_depth :: Int
_owlItemMeta_position :: Int
..} = OwlSpot
r
where
msiblings :: Maybe (Seq Int)
msiblings = case Int
_owlItemMeta_parent of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> Seq Int -> Maybe (Seq Int)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq Int
_owlTree_topOwls
Int
x -> do
(OwlItemMeta
_, OwlItem
oelt) <- Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
x OwlMapping
_owlTree_mapping
OwlItem -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos OwlItem
oelt
siblings :: Seq Int
siblings = Maybe (Seq Int) -> Seq Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Int)
msiblings
r :: OwlSpot
r =
OwlSpot
{ _owlSpot_parent :: Int
_owlSpot_parent = Int
_owlItemMeta_parent,
_owlSpot_leftSibling :: Maybe Int
_owlSpot_leftSibling = OwlMapping -> Seq Int -> Int -> Maybe Int
locateLeftSiblingIdFromSiblingPosition OwlMapping
_owlTree_mapping Seq Int
siblings Int
_owlItemMeta_position
}
owlTree_rEltId_toOwlSpot :: (HasCallStack) => OwlTree -> REltId -> OwlSpot
owlTree_rEltId_toOwlSpot :: HasCallStack => OwlTree -> Int -> OwlSpot
owlTree_rEltId_toOwlSpot od :: OwlTree
od@OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} Int
rid = OwlSpot
r
where
(OwlItemMeta
oem, OwlItem
_) = Maybe (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem))
-> Maybe (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
forall a b. (a -> b) -> a -> b
$ Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid OwlMapping
_owlTree_mapping
r :: OwlSpot
r = OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
od OwlItemMeta
oem
owlTree_rEltId_toFlattenedIndex_debug :: OwlTree -> REltId -> Int
owlTree_rEltId_toFlattenedIndex_debug :: OwlTree -> Int -> Int
owlTree_rEltId_toFlattenedIndex_debug OwlTree
od Int
rid = Int
r
where
sowls :: Seq SuperOwl
sowls = OwlTree -> Seq SuperOwl
owliterateall OwlTree
od
r :: Int
r = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> Bool) -> Seq SuperOwl -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
Seq.findIndexL (\SuperOwl
sowl -> SuperOwl -> Int
_superOwl_id SuperOwl
sowl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rid) Seq SuperOwl
sowls
owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap
owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap
owlTree_makeAttachmentMap OwlTree
od = Seq SuperOwl -> AttachmentMap -> AttachmentMap
forall (f :: * -> *).
Foldable f =>
f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls (OwlTree -> Seq SuperOwl
owliterateall OwlTree
od) AttachmentMap
forall a. IntMap a
IM.empty
owlTree_hasDanglingAttachments :: OwlTree -> Bool
owlTree_hasDanglingAttachments :: OwlTree -> Bool
owlTree_hasDanglingAttachments od :: OwlTree
od@OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> Bool) -> Seq SuperOwl -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\SuperOwl
sowl -> (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
x -> Int -> OwlMapping -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
x (OwlMapping
_owlTree_mapping)) ((Attachment -> Int) -> [Attachment] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Attachment -> Int
_attachment_target ([Attachment] -> [Int]) -> [Attachment] -> [Int]
forall a b. (a -> b) -> a -> b
$ SuperOwl -> [Attachment]
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 = (Int -> SuperOwl) -> Seq Int -> Seq SuperOwl
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od) (OwlTree -> Seq Int
_owlTree_topOwls OwlTree
od)
areOwlsInFactSuper :: Bool
areOwlsInFactSuper = (SuperOwl -> Bool) -> Seq SuperOwl -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SuperOwl -> Bool
superOwl_isTopOwl Seq SuperOwl
sowls
r :: Seq SuperOwl
r = Bool -> Seq SuperOwl -> Seq SuperOwl
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 Int
kiddos) -> (a -> Int -> a) -> a -> Seq Int -> a
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc' Int
rid' -> (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' a -> SuperOwl -> a
f a
acc' OwlTree
od (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid')) (a -> SuperOwl -> a
f a
acc SuperOwl
sowl) Seq Int
kiddos
OwlItem
_ -> a -> SuperOwl -> a
f a
acc SuperOwl
sowl
owlTree_foldAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldAt :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> Int -> a
owlTree_foldAt a -> SuperOwl -> a
f a
acc OwlTree
od Int
rid = (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' a -> SuperOwl -> a
f a
acc OwlTree
od (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
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 Int
kiddos) -> (a -> Int -> a) -> a -> Seq Int -> a
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc' Int
rid' -> (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldAt' a -> SuperOwl -> a
f a
acc' OwlTree
od (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid')) a
acc Seq Int
kiddos
OwlItem
_ -> a
acc
owlTree_foldChildrenAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldChildrenAt :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> Int -> a
owlTree_foldChildrenAt a -> SuperOwl -> a
f a
acc OwlTree
od Int
rid = (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a
owlTree_foldChildrenAt' a -> SuperOwl -> a
f a
acc OwlTree
od (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
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 = (a -> Int -> a) -> a -> Seq Int -> a
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a
acc Int
rid -> (a -> SuperOwl -> a) -> a -> OwlTree -> Int -> a
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> Int -> a
owlTree_foldAt a -> SuperOwl -> a
f a
acc OwlTree
od Int
rid) a
acc0 (Seq Int -> a) -> Seq Int -> a
forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq Int
_owlTree_topOwls OwlTree
od
owlTree_owlCount :: OwlTree -> Int
owlTree_owlCount :: OwlTree -> Int
owlTree_owlCount OwlTree
od = (Int -> SuperOwl -> Int) -> Int -> OwlTree -> Int
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> a
owlTree_fold (\Int
acc SuperOwl
_ -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 OwlTree
od
owliterateat :: OwlTree -> REltId -> Seq SuperOwl
owliterateat :: OwlTree -> Int -> Seq SuperOwl
owliterateat OwlTree
od Int
rid = (Seq SuperOwl -> SuperOwl -> Seq SuperOwl)
-> Seq SuperOwl -> OwlTree -> Int -> Seq SuperOwl
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> Int -> a
owlTree_foldAt Seq SuperOwl -> SuperOwl -> Seq SuperOwl
forall a. Seq a -> a -> Seq a
(|>) Seq SuperOwl
forall a. Seq a
Seq.empty OwlTree
od Int
rid where
owliteratechildrenat :: OwlTree -> REltId -> Seq SuperOwl
owliteratechildrenat :: OwlTree -> Int -> Seq SuperOwl
owliteratechildrenat OwlTree
od Int
rid = (Seq SuperOwl -> SuperOwl -> Seq SuperOwl)
-> Seq SuperOwl -> OwlTree -> Int -> Seq SuperOwl
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> Int -> a
owlTree_foldChildrenAt Seq SuperOwl -> SuperOwl -> Seq SuperOwl
forall a. Seq a -> a -> Seq a
(|>) Seq SuperOwl
forall a. Seq a
Seq.empty OwlTree
od Int
rid where
owliterateall :: OwlTree -> Seq SuperOwl
owliterateall :: OwlTree -> Seq SuperOwl
owliterateall OwlTree
od = (Seq SuperOwl -> SuperOwl -> Seq SuperOwl)
-> Seq SuperOwl -> OwlTree -> Seq SuperOwl
forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> a
owlTree_fold Seq SuperOwl -> SuperOwl -> Seq SuperOwl
forall a. Seq a -> a -> Seq a
(|>) Seq SuperOwl
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 Int
rid = OwlTree -> Int -> Bool
forall o. HasOwlTree o => o -> Int -> Bool
hasOwlTree_exists (o -> OwlTree
forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree o
o) Int
rid
hasOwlTree_findSuperOwl :: o -> REltId -> Maybe SuperOwl
hasOwlTree_findSuperOwl o
o Int
rid = OwlTree -> Int -> Maybe SuperOwl
forall o. HasOwlTree o => o -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl (o -> OwlTree
forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree o
o) Int
rid
hasOwlTree_mustFindSuperOwl :: HasCallStack => o -> REltId -> SuperOwl
hasOwlTree_mustFindSuperOwl o
o Int
rid = OwlTree -> Int -> SuperOwl
forall o. (HasOwlTree o, HasCallStack) => o -> Int -> SuperOwl
hasOwlTree_mustFindSuperOwl (o -> OwlTree
forall o. HasOwlTree o => o -> OwlTree
hasOwlTree_owlTree o
o) Int
rid
hasOwlTree_test_findFirstSuperOwlByName :: o -> Text -> Maybe SuperOwl
hasOwlTree_test_findFirstSuperOwlByName o
o Text
t = OwlTree -> Text -> Maybe SuperOwl
forall o. HasOwlTree o => o -> Text -> Maybe SuperOwl
hasOwlTree_test_findFirstSuperOwlByName (o -> OwlTree
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 = Maybe SuperOwl -> SuperOwl
forall a. HasCallStack => Maybe a -> a
fromJust (o -> Text -> Maybe SuperOwl
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 = OwlTree -> OwlTree
forall a. a -> a
id
hasOwlTree_exists :: OwlTree -> Int -> Bool
hasOwlTree_exists = OwlTree -> Int -> Bool
owlTree_exists
hasOwlTree_findSuperOwl :: OwlTree -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl = OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl
hasOwlTree_mustFindSuperOwl :: HasCallStack => OwlTree -> Int -> SuperOwl
hasOwlTree_mustFindSuperOwl = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl
hasOwlTree_test_findFirstSuperOwlByName :: OwlTree -> Text -> Maybe SuperOwl
hasOwlTree_test_findFirstSuperOwlByName OwlTree
ot Text
label = (SuperOwl -> Bool) -> [SuperOwl] -> Maybe SuperOwl
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SuperOwl
sowl -> SuperOwl -> Text
forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
sowl Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
label) ([SuperOwl] -> Maybe SuperOwl)
-> (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> Maybe SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq SuperOwl -> Maybe SuperOwl) -> Seq SuperOwl -> Maybe SuperOwl
forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq SuperOwl
owliterateall OwlTree
ot
owlTree_toSuperOwlParliament :: OwlTree -> SuperOwlParliament
owlTree_toSuperOwlParliament :: OwlTree -> SuperOwlParliament
owlTree_toSuperOwlParliament od :: OwlTree
od@OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} = SuperOwlParliament
r
where
r :: SuperOwlParliament
r = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
od (OwlParliament -> SuperOwlParliament)
-> (Seq Int -> OwlParliament) -> Seq Int -> SuperOwlParliament
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> OwlParliament
OwlParliament (Seq Int -> SuperOwlParliament) -> Seq Int -> SuperOwlParliament
forall a b. (a -> b) -> a -> b
$ Seq Int
_owlTree_topOwls
owlTree_removeREltId :: Bool -> REltId -> OwlTree -> OwlTree
owlTree_removeREltId :: Bool -> Int -> OwlTree -> OwlTree
owlTree_removeREltId Bool
keepChildren Int
rid OwlTree
od = Bool -> SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl Bool
keepChildren (HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
rid) OwlTree
od
owlTree_removeSuperOwl :: Bool -> SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl :: Bool -> SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl Bool
keepChildren SuperOwl
sowl OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} = OwlTree
r
where
newMapping'' :: OwlMapping
newMapping'' = Int -> OwlMapping -> OwlMapping
forall a. Int -> IntMap a -> IntMap a
IM.delete (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) OwlMapping
_owlTree_mapping
removeEltWithoutAdjustMommyFn :: Int -> OwlMapping -> OwlMapping
removeEltWithoutAdjustMommyFn Int
rid OwlMapping
mapping = case Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid OwlMapping
mapping of
Maybe (OwlItemMeta, OwlItem)
Nothing -> Text -> OwlMapping
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> OwlMapping) -> Text -> OwlMapping
forall a b. (a -> b) -> a -> b
$ OwlMapping -> Int -> Text
errorMsg_owlMapping_lookupFail OwlMapping
mapping Int
rid
Just (OwlItemMeta
_, OwlItem OwlInfo
_ (OwlSubItemFolder Seq Int
kiddos)) -> (Int -> OwlMapping -> OwlMapping)
-> OwlMapping -> Seq Int -> OwlMapping
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> OwlMapping -> OwlMapping
removeEltWithoutAdjustMommyFn (Int -> OwlMapping -> OwlMapping
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
rid OwlMapping
mapping) Seq Int
kiddos
Just (OwlItemMeta, OwlItem)
_ -> Int -> OwlMapping -> OwlMapping
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
rid OwlMapping
mapping
newMapping' :: OwlMapping
newMapping' = if Bool
keepChildren
then OwlMapping
newMapping''
else case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
OwlItem OwlInfo
_ (OwlSubItemFolder Seq Int
kiddos) -> (Int -> OwlMapping -> OwlMapping)
-> OwlMapping -> Seq Int -> OwlMapping
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> OwlMapping -> OwlMapping
removeEltWithoutAdjustMommyFn OwlMapping
newMapping'' Seq Int
kiddos
OwlItem
_ -> OwlMapping
newMapping''
removeSuperOwlFromSeq :: Seq REltId -> SuperOwl -> Seq REltId
removeSuperOwlFromSeq :: Seq Int -> SuperOwl -> Seq Int
removeSuperOwlFromSeq Seq Int
s SuperOwl
so = Bool -> Seq Int -> Seq Int
forall a. HasCallStack => Bool -> a -> a
assert (Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
deletedSeq Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Seq Int
deletedSeq
where
deletedSeq :: Seq Int
deletedSeq = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
Seq.deleteAt (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Int -> Seq Int -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL (SuperOwl -> Int
_superOwl_id SuperOwl
so) Seq Int
s)) Seq Int
s
removeChildFn :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
removeChildFn (OwlItemMeta, OwlItem)
parent = case (OwlItemMeta, OwlItem)
parent of
(OwlItemMeta
oem, OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
kiddos)) -> (OwlItemMeta
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq Int -> OwlSubItem
OwlSubItemFolder (Seq Int -> SuperOwl -> Seq Int
removeSuperOwlFromSeq Seq Int
kiddos SuperOwl
sowl)))
(OwlItemMeta, OwlItem)
_ -> Text -> (OwlItemMeta, OwlItem)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected parent to be a folder"
newMapping :: OwlMapping
newMapping = case OwlItemMeta -> Int
_owlItemMeta_parent (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl) of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> OwlMapping
newMapping'
Int
rid -> ((OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem))
-> Int -> OwlMapping -> OwlMapping
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
removeChildFn Int
rid OwlMapping
newMapping'
newTopOwls :: Seq Int
newTopOwls =
if SuperOwl -> Bool
superOwl_isTopOwl SuperOwl
sowl
then Seq Int -> SuperOwl -> Seq Int
removeSuperOwlFromSeq Seq Int
_owlTree_topOwls SuperOwl
sowl
else Seq Int
_owlTree_topOwls
r' :: OwlTree
r' =
OwlTree
{ _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
newMapping,
_owlTree_topOwls :: Seq Int
_owlTree_topOwls = Seq Int
newTopOwls
}
r :: OwlTree
r = OwlTree -> Int -> OwlTree
internal_owlTree_reorgKiddos OwlTree
r' (OwlItemMeta -> Int
_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 {Int
Maybe Int
_owlSpot_parent :: OwlSpot -> Int
_owlSpot_leftSibling :: OwlSpot -> Maybe Int
_owlSpot_parent :: Int
_owlSpot_leftSibling :: Maybe Int
..} od :: OwlTree
od@OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} = Bool -> (OwlTree, [SuperOwl]) -> (OwlTree, [SuperOwl])
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
isValid :: Bool
isValid = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> Seq Int -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Int
x -> HasCallStack => OwlMapping -> Int -> Int -> Bool
OwlMapping -> Int -> Int -> Bool
isDescendentOf OwlMapping
_owlTree_mapping Int
x Int
_owlSpot_parent) ((SuperOwl -> Int) -> Seq SuperOwl -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Int
_superOwl_id Seq SuperOwl
sowls)
removedOd :: OwlTree
removedOd = (OwlTree -> SuperOwl -> OwlTree)
-> OwlTree -> Seq SuperOwl -> OwlTree
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\OwlTree
acc SuperOwl
sowl -> Bool -> SuperOwl -> OwlTree -> OwlTree
owlTree_removeSuperOwl Bool
False SuperOwl
sowl OwlTree
acc) OwlTree
od Seq SuperOwl
sowls
removed :: [Int]
removed = (SuperOwl -> Int) -> [SuperOwl] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Int
_superOwl_id
([SuperOwl] -> [Int])
-> (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Int) -> [SuperOwl] -> [SuperOwl]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (OwlItemMeta -> Int
_owlItemMeta_position (OwlItemMeta -> Int)
-> (SuperOwl -> OwlItemMeta) -> SuperOwl -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta)
([SuperOwl] -> [SuperOwl])
-> (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> [SuperOwl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Bool) -> [SuperOwl] -> [SuperOwl]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
_owlSpot_parent) (Int -> Bool) -> (SuperOwl -> Int) -> SuperOwl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlItemMeta -> Int
_owlItemMeta_parent (OwlItemMeta -> Int)
-> (SuperOwl -> OwlItemMeta) -> SuperOwl -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta)
([SuperOwl] -> [SuperOwl])
-> (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> [SuperOwl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
(Seq SuperOwl -> [Int]) -> Seq SuperOwl -> [Int]
forall a b. (a -> b) -> a -> b
$ Seq SuperOwl
sowls
origSiblings :: Seq Int
origSiblings = Seq Int -> Maybe (Seq Int) -> Seq Int
forall a. a -> Maybe a -> a
fromMaybe (Text -> Seq Int
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected siblings") (Maybe (Seq Int) -> Seq Int) -> Maybe (Seq Int) -> Seq Int
forall a b. (a -> b) -> a -> b
$ if Int
_owlSpot_parent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl
then OwlTree -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos (OwlTree -> Maybe (Seq Int)) -> OwlTree -> Maybe (Seq Int)
forall a b. (a -> b) -> a -> b
$ OwlTree
od
else SuperOwl -> Maybe (Seq Int)
forall o. MommyOwl o => o -> Maybe (Seq Int)
mommyOwl_kiddos (SuperOwl -> Maybe (Seq Int)) -> SuperOwl -> Maybe (Seq Int)
forall a b. (a -> b) -> a -> b
$ HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
od Int
_owlSpot_parent
findPos ::
REltId
-> [REltId]
-> [REltId]
-> Bool
-> Maybe REltId
findPos :: Int -> [Int] -> [Int] -> Bool -> Maybe Int
findPos Int
_ [Int]
_ [] Bool
_ = Maybe Int
forall a. Maybe a
Nothing
findPos Int
targetrid [] (Int
y:[Int]
ys) Bool
past = if Bool
past
then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y
else if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
targetrid
then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y
else Int -> [Int] -> [Int] -> Bool -> Maybe Int
findPos Int
targetrid [] [Int]
ys Bool
past
findPos Int
targetrid (Int
x:[Int]
xs) (Int
y:[Int]
ys) Bool
past = if Bool
past Bool -> Bool -> Bool
|| (Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
targetrid)
then if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y
then Int -> [Int] -> [Int] -> Bool -> Maybe Int
findPos Int
targetrid [Int]
xs [Int]
ys Bool
True
else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y
else if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y
then Int -> [Int] -> [Int] -> Bool -> Maybe Int
findPos Int
targetrid [Int]
xs [Int]
ys Bool
past
else Int -> [Int] -> [Int] -> Bool -> Maybe Int
findPos Int
targetrid (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs) [Int]
ys Bool
past
newLeftSibling :: Maybe Int
newLeftSibling = case Maybe Int
_owlSpot_leftSibling of
Maybe Int
Nothing -> Maybe Int
forall a. Maybe a
Nothing
Just Int
target -> Int -> [Int] -> [Int] -> Bool -> Maybe Int
findPos Int
target ([Int] -> [Int]
forall {a}. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall {a}. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Int]
removed) ([Int] -> [Int]
forall {a}. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
origSiblings) Bool
False
correctedSpot :: OwlSpot
correctedSpot = OwlSpot
spot { _owlSpot_leftSibling = 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
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
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 :: Int -> OwlTree -> OwlTree
owlTree_reindex Int
start OwlTree
ot = Bool -> OwlTree -> OwlTree
forall a. HasCallStack => Bool -> a -> a
assert Bool
valid OwlTree
r where
valid :: Bool
valid = OwlTree -> Int
owlTree_maxId OwlTree
ot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start
adjustkeyfn :: Int -> Int
adjustkeyfn Int
k = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl then Int
noOwl else Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start
oldmap :: OwlMapping
oldmap = OwlTree -> OwlMapping
_owlTree_mapping OwlTree
ot
newMap' :: OwlMapping
newMap' = (Int -> Int) -> OwlMapping -> OwlMapping
forall a. (Int -> Int) -> IntMap a -> IntMap a
IM.mapKeysMonotonic Int -> Int
adjustkeyfn OwlMapping
oldmap
ridremap :: REltIdMap Int
ridremap = (Int -> (OwlItemMeta, OwlItem) -> Int)
-> OwlMapping -> REltIdMap Int
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
rid (OwlItemMeta, OwlItem)
_ -> Int -> Int
adjustkeyfn Int
rid) OwlMapping
oldmap
mapoem :: OwlItemMeta -> OwlItemMeta
mapoem OwlItemMeta
oem = OwlItemMeta
oem { _owlItemMeta_parent = adjustkeyfn (_owlItemMeta_parent oem) }
mapoe :: OwlItem -> OwlItem
mapoe OwlItem
oe =
Bool -> REltIdMap Int -> OwlItem -> OwlItem
owlItem_updateAttachments Bool
True REltIdMap Int
ridremap
(OwlItem -> OwlItem) -> OwlItem -> OwlItem
forall a b. (a -> b) -> a -> b
$ (case OwlItem
oe of
OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
kiddos) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq Int -> OwlSubItem
OwlSubItemFolder ((Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
adjustkeyfn Seq Int
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 = ((OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem))
-> OwlMapping -> OwlMapping
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
mapowlfn OwlMapping
newMap'
newTopOwls :: Seq Int
newTopOwls = (Int -> Int) -> Seq Int -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
adjustkeyfn (OwlTree -> Seq Int
_owlTree_topOwls OwlTree
ot)
r :: OwlTree
r = OwlMapping -> Seq Int -> OwlTree
OwlTree OwlMapping
newMap Seq Int
newTopOwls
owlTree_addMiniOwlTree :: OwlSpot -> MiniOwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree :: OwlSpot -> OwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree OwlSpot
targetspot OwlTree
miniot OwlTree
od0 = Bool -> (OwlTree, [SuperOwl]) -> (OwlTree, [SuperOwl])
forall a. HasCallStack => Bool -> a -> a
assert (Int
collisions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ((OwlTree, [SuperOwl]) -> (OwlTree, [SuperOwl]))
-> (OwlTree, [SuperOwl]) -> (OwlTree, [SuperOwl])
forall a b. (a -> b) -> a -> b
$ (OwlTree, [SuperOwl])
r where
od1indices :: Set Int
od1indices = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ OwlMapping -> [Int]
forall a. IntMap a -> [Int]
IM.keys (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
od0)
od2indices :: Set Int
od2indices = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ OwlMapping -> [Int]
forall a. IntMap a -> [Int]
IM.keys (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
miniot)
collisions :: Int
collisions = Set Int -> Int
forall a. Set a -> Int
Set.size (Set Int -> Int) -> Set Int -> Int
forall a b. (a -> b) -> a -> b
$ Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set Int
od1indices Set Int
od2indices
mapaccumlfn :: OwlTree -> (OwlSpot, SuperOwl) -> (OwlTree, SuperOwl)
mapaccumlfn OwlTree
od (OwlSpot
spot, SuperOwl
sowl) = HasCallStack =>
OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem OwlSpot
ospot Int
rid OwlItem
oeltmodded OwlTree
od where
rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
meta :: OwlItemMeta
meta = SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl
ospot :: OwlSpot
ospot = if OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
meta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl Bool -> Bool -> Bool
&& OwlItemMeta -> Int
_owlItemMeta_position OwlItemMeta
meta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then OwlSpot
targetspot
else if OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
meta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl
then OwlSpot
spot { _owlSpot_parent = _owlSpot_parent targetspot}
else OwlSpot
spot
oeltmodded :: OwlItem
oeltmodded = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
_) -> OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq Int -> OwlSubItem
OwlSubItemFolder Seq Int
forall a. Seq a
Seq.empty)
OwlItem
x -> OwlItem
x
(OwlTree
newot, [SuperOwl]
addedSowls) = (OwlTree -> (OwlSpot, SuperOwl) -> (OwlTree, SuperOwl))
-> OwlTree -> [(OwlSpot, SuperOwl)] -> (OwlTree, [SuperOwl])
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 ([(OwlSpot, SuperOwl)] -> (OwlTree, [SuperOwl]))
-> [(OwlSpot, SuperOwl)] -> (OwlTree, [SuperOwl])
forall a b. (a -> b) -> a -> b
$ Seq (OwlSpot, SuperOwl) -> [(OwlSpot, SuperOwl)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (OwlSpot, SuperOwl) -> [(OwlSpot, SuperOwl)])
-> Seq (OwlSpot, SuperOwl) -> [(OwlSpot, SuperOwl)]
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> (OwlSpot, SuperOwl))
-> Seq SuperOwl -> Seq (OwlSpot, SuperOwl)
forall a b. (a -> b) -> Seq a -> Seq 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)
r :: (OwlTree, [SuperOwl])
r = (OwlTree
newot, [SuperOwl]
addedSowls)
internal_owlTree_recalculateChildrenDepths_recursive :: OwlTree -> REltId -> OwlTree
internal_owlTree_recalculateChildrenDepths_recursive :: OwlTree -> Int -> OwlTree
internal_owlTree_recalculateChildrenDepths_recursive OwlTree
ot Int
rid = OwlTree
r_0 where
sowl :: SuperOwl
sowl = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
ot Int
rid
adjustdepthfn :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
adjustdepthfn (OwlItemMeta
oem, OwlItem
oitem) = (,OwlItem
oitem) (OwlItemMeta -> (OwlItemMeta, OwlItem))
-> OwlItemMeta -> (OwlItemMeta, OwlItem)
forall a b. (a -> b) -> a -> b
$ OwlItemMeta
oem { _owlItemMeta_depth = _owlItemMeta_depth (_superOwl_meta sowl) + 1 }
r_0 :: OwlTree
r_0 = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
kiddos) -> OwlTree
r_1 where
omwithadjusteddepth :: OwlMapping
omwithadjusteddepth = (Int -> OwlMapping -> OwlMapping)
-> OwlMapping -> Seq Int -> OwlMapping
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
kid OwlMapping
om -> ((OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem))
-> Int -> OwlMapping -> OwlMapping
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
adjustdepthfn Int
kid OwlMapping
om) (OwlTree -> OwlMapping
_owlTree_mapping OwlTree
ot) Seq Int
kiddos
newot_0 :: OwlTree
newot_0 = OwlTree
ot {_owlTree_mapping = omwithadjusteddepth}
r_1 :: OwlTree
r_1 = (OwlTree -> Int -> OwlTree) -> OwlTree -> Seq Int -> OwlTree
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (OwlTree -> Int -> OwlTree
internal_owlTree_recalculateChildrenDepths_recursive) OwlTree
newot_0 Seq Int
kiddos
OwlItem
x -> OwlTree
ot
internal_owlTree_addOwlItem :: (HasCallStack) => OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem :: HasCallStack =>
OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem OwlSpot {Int
Maybe Int
_owlSpot_parent :: OwlSpot -> Int
_owlSpot_leftSibling :: OwlSpot -> Maybe Int
_owlSpot_parent :: Int
_owlSpot_leftSibling :: Maybe Int
..} Int
rid OwlItem
oitem OwlTree {Seq Int
OwlMapping
_owlTree_mapping :: OwlTree -> OwlMapping
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_mapping :: OwlMapping
_owlTree_topOwls :: Seq Int
..} = (OwlTree, SuperOwl)
r
where
meta :: OwlItemMeta
meta =
OwlItemMeta
{ _owlItemMeta_parent :: Int
_owlItemMeta_parent = Int
_owlSpot_parent,
_owlItemMeta_depth :: Int
_owlItemMeta_depth = case Int
_owlSpot_parent of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> Int
0
Int
_ -> case Int -> OwlMapping -> Maybe (OwlItemMeta, OwlItem)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
_owlSpot_parent OwlMapping
_owlTree_mapping of
Maybe (OwlItemMeta, OwlItem)
Nothing -> Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ OwlMapping -> Int -> Text
errorMsg_owlMapping_lookupFail OwlMapping
_owlTree_mapping Int
_owlSpot_parent
Just (OwlItemMeta
x, OwlItem
_) -> OwlItemMeta -> Int
_owlItemMeta_depth OwlItemMeta
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,
_owlItemMeta_position :: Int
_owlItemMeta_position = Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this thunk should never get evaluated"
}
newMapping' :: OwlMapping
newMapping' = (Int
-> (OwlItemMeta, OwlItem)
-> (OwlItemMeta, OwlItem)
-> (OwlItemMeta, OwlItem))
-> Int -> (OwlItemMeta, OwlItem) -> OwlMapping -> OwlMapping
forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWithKey (\Int
k (OwlItemMeta, OwlItem)
_ (OwlItemMeta, OwlItem)
ov -> Text -> (OwlItemMeta, OwlItem)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text
"key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists with value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (OwlItemMeta, OwlItem) -> Text
forall b a. (Show a, IsString b) => a -> b
show (OwlItemMeta, OwlItem)
ov)) Int
rid (OwlItemMeta
meta, OwlItem
oitem) OwlMapping
_owlTree_mapping
updateSiblings :: Seq Int -> Seq Int
updateSiblings Seq Int
kiddos = Int -> Int -> Seq Int -> Seq Int
forall a. Int -> a -> Seq a -> Seq a
Seq.insertAt Int
position Int
rid Seq Int
kiddos
where
position :: Int
position = case Maybe Int
_owlSpot_leftSibling of
Maybe Int
Nothing -> Int
0
Just Int
leftsibrid -> case Int -> Seq Int -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
Seq.elemIndexL Int
leftsibrid Seq Int
kiddos of
Maybe Int
Nothing -> Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text
"expected to find leftmost sibling " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
leftsibrid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Seq Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Seq Int
kiddos
Just Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
adjustfn :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
adjustfn (OwlItemMeta
oem, OwlItem
oitem') = case OwlItem
oitem' of
OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq Int
kiddos) -> (OwlItemMeta
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem OwlInfo
oinfo (Seq Int -> OwlSubItem
OwlSubItemFolder (Seq Int -> Seq Int
updateSiblings Seq Int
kiddos)))
OwlItem
_ -> Text -> (OwlItemMeta, OwlItem)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (OwlItemMeta, OwlItem)) -> Text -> (OwlItemMeta, OwlItem)
forall a b. (a -> b) -> a -> b
$ Text
"expected OwlItemFolder"
newMapping :: OwlMapping
newMapping = case Int
_owlSpot_parent of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> OwlMapping
newMapping'
Int
_ -> Bool -> OwlMapping -> OwlMapping
forall a. HasCallStack => Bool -> a -> a
assert (Int -> OwlMapping -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
_owlSpot_parent OwlMapping
newMapping') (OwlMapping -> OwlMapping) -> OwlMapping -> OwlMapping
forall a b. (a -> b) -> a -> b
$ ((OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem))
-> Int -> OwlMapping -> OwlMapping
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
adjustfn Int
_owlSpot_parent OwlMapping
newMapping'
newTopOwls :: Seq Int
newTopOwls = case Int
_owlSpot_parent of
Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> Seq Int -> Seq Int
updateSiblings Seq Int
_owlTree_topOwls
Int
_ -> Seq Int
_owlTree_topOwls
tree_1 :: OwlTree
tree_1 =
OwlTree
{ _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
newMapping,
_owlTree_topOwls :: Seq Int
_owlTree_topOwls = Seq Int
newTopOwls
}
tree_2 :: OwlTree
tree_2 = OwlTree -> Int -> OwlTree
internal_owlTree_reorgKiddos OwlTree
tree_1 Int
_owlSpot_parent
tree_3 :: OwlTree
tree_3 = OwlTree -> Int -> OwlTree
internal_owlTree_recalculateChildrenDepths_recursive OwlTree
tree_2 Int
rid
newsowl :: SuperOwl
newsowl = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
tree_3 Int
rid
r :: (OwlTree, SuperOwl)
r = (OwlTree
tree_3, SuperOwl
newsowl)
owlTree_addOwlItem :: OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItem :: OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItem OwlSpot
ospot Int
rid OwlItem
oitem OwlTree
ot = (OwlTree, [SuperOwl])
r where
(OwlTree
newot, SuperOwl
addedSowls) = HasCallStack =>
OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem OwlSpot
ospot Int
rid OwlItem
oitem OwlTree
ot
addedSowlsWithChildren :: [SuperOwl]
addedSowlsWithChildren = Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq SuperOwl -> [SuperOwl])
-> (SuperOwl -> Seq SuperOwl) -> SuperOwl -> [SuperOwl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> Int -> Seq SuperOwl
owliterateat OwlTree
newot (Int -> Seq SuperOwl)
-> (SuperOwl -> Int) -> SuperOwl -> Seq SuperOwl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> Int
_superOwl_id (SuperOwl -> [SuperOwl]) -> SuperOwl -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ SuperOwl
addedSowls
r :: (OwlTree, [SuperOwl])
r = (OwlTree
newot, [SuperOwl]
addedSowlsWithChildren)
owlTree_addOwlItemList :: [(REltId, OwlSpot, OwlItem)] -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItemList :: [(Int, OwlSpot, OwlItem)] -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItemList [(Int, OwlSpot, OwlItem)]
seltls OwlTree
od0 = (OwlTree, [SuperOwl])
r where
mapaccumlfn :: OwlTree -> (Int, OwlSpot, OwlItem) -> (OwlTree, SuperOwl)
mapaccumlfn OwlTree
od (Int
rid,OwlSpot
ospot,OwlItem
oitem) = HasCallStack =>
OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
internal_owlTree_addOwlItem OwlSpot
ospot Int
rid OwlItem
oitemmodded OwlTree
od where
osubitemmodded :: OwlSubItem
osubitemmodded = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
oitem of
OwlSubItemFolder Seq Int
_ -> Seq Int -> OwlSubItem
OwlSubItemFolder Seq Int
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
r :: (OwlTree, [SuperOwl])
r = (OwlTree -> (Int, OwlSpot, OwlItem) -> (OwlTree, SuperOwl))
-> OwlTree -> [(Int, OwlSpot, OwlItem)] -> (OwlTree, [SuperOwl])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL OwlTree -> (Int, OwlSpot, OwlItem) -> (OwlTree, SuperOwl)
mapaccumlfn OwlTree
od0 [(Int, OwlSpot, OwlItem)]
seltls
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 :: Int
d1 = OwlItemMeta -> Int
_owlItemMeta_depth OwlItemMeta
m1
d2 :: Int
d2 = OwlItemMeta -> Int
_owlItemMeta_depth OwlItemMeta
m2
p1 :: Int
p1 = OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
m1
p2 :: Int
p2 = OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
m2
s1 :: Int
s1 = OwlItemMeta -> Int
_owlItemMeta_position OwlItemMeta
m1
s2 :: Int
s2 = OwlItemMeta -> Int
_owlItemMeta_position OwlItemMeta
m2
psowl1 :: SuperOwl
psowl1 = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
ot Int
p1
psowl2 :: SuperOwl
psowl2 = HasCallStack => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl OwlTree
ot Int
p2
r :: Ordering
r = if Int
d1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
d2
then if Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2
then Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
s1 Int
s2
else OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
ot SuperOwl
psowl1 SuperOwl
psowl2
else if Int
d1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
internal_addUntilFolderEndRecursive ::
REltIdMap SEltLabel ->
Seq REltId ->
Int ->
REltId ->
Int ->
REltIdMap (OwlItemMeta, OwlItem) ->
Seq REltId ->
(Int, REltIdMap (OwlItemMeta, OwlItem), Seq REltId)
internal_addUntilFolderEndRecursive :: REltIdMap SEltLabel
-> Seq Int
-> Int
-> Int
-> Int
-> OwlMapping
-> Seq Int
-> (Int, OwlMapping, Seq Int)
internal_addUntilFolderEndRecursive REltIdMap SEltLabel
oldDir Seq Int
oldLayers Int
lp Int
parent Int
depth OwlMapping
accDir Seq Int
accSiblings =
let recurfn :: Int
-> Int
-> Int
-> OwlMapping
-> Seq Int
-> (Int, OwlMapping, Seq Int)
recurfn = REltIdMap SEltLabel
-> Seq Int
-> Int
-> Int
-> Int
-> OwlMapping
-> Seq Int
-> (Int, OwlMapping, Seq Int)
internal_addUntilFolderEndRecursive REltIdMap SEltLabel
oldDir Seq Int
oldLayers
rid :: Int
rid = Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
Seq.index Seq Int
oldLayers Int
lp
SEltLabel Text
name SElt
selt = REltIdMap SEltLabel
oldDir REltIdMap SEltLabel -> Int -> SEltLabel
forall a. IntMap a -> Int -> a
IM.! Int
rid
selfMeta :: OwlItemMeta
selfMeta = Int -> Int -> Int -> OwlItemMeta
OwlItemMeta Int
parent Int
depth (Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
accSiblings)
newSiblings :: Seq Int
newSiblings = Seq Int
accSiblings Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
rid
in if Int
lp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
oldLayers
then
(Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, OwlMapping
accDir, Seq Int
accSiblings)
else
case SElt
selt of
SElt
SEltFolderStart -> (Int, OwlMapping, Seq Int)
r
where
(Int
lp', OwlMapping
accDir', Seq Int
accSiblings') = Int
-> Int
-> Int
-> OwlMapping
-> Seq Int
-> (Int, OwlMapping, Seq Int)
recurfn (Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
rid (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) OwlMapping
accDir Seq Int
forall a. Seq a
Seq.empty
selfOwl :: OwlItem
selfOwl = OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (Seq Int -> OwlSubItem
OwlSubItemFolder Seq Int
accSiblings')
r :: (Int, OwlMapping, Seq Int)
r = Int
-> Int
-> Int
-> OwlMapping
-> Seq Int
-> (Int, OwlMapping, Seq Int)
recurfn Int
lp' Int
parent Int
depth (Int -> (OwlItemMeta, OwlItem) -> OwlMapping -> OwlMapping
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid (OwlItemMeta
selfMeta, OwlItem
selfOwl) OwlMapping
accDir') Seq Int
newSiblings
SElt
SEltFolderEnd -> (Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, OwlMapping
accDir, Seq Int
accSiblings)
SElt
_ -> Int
-> Int
-> Int
-> OwlMapping
-> Seq Int
-> (Int, OwlMapping, Seq Int)
recurfn (Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
parent Int
depth (Int -> (OwlItemMeta, OwlItem) -> OwlMapping -> OwlMapping
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid (OwlItemMeta
selfMeta, (OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (SElt -> OwlSubItem
sElt_to_owlSubItem SElt
selt))) OwlMapping
accDir) Seq Int
newSiblings
owlTree_fromSEltTree :: SEltTree -> OwlTree
owlTree_fromSEltTree :: SEltTree -> OwlTree
owlTree_fromSEltTree SEltTree
selttree = OwlTree
r
where
seltmap :: REltIdMap SEltLabel
seltmap = SEltTree -> REltIdMap SEltLabel
forall a. [(Int, a)] -> IntMap a
IM.fromList SEltTree
selttree
layers :: [Int]
layers = ((Int, SEltLabel) -> Int) -> SEltTree -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, SEltLabel) -> Int
forall a b. (a, b) -> a
fst SEltTree
selttree
r :: OwlTree
r = REltIdMap SEltLabel -> Seq Int -> OwlTree
owlTree_fromOldState REltIdMap SEltLabel
seltmap ([Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList [Int]
layers)
owlTree_fromOldState :: REltIdMap SEltLabel -> Seq REltId -> OwlTree
owlTree_fromOldState :: REltIdMap SEltLabel -> Seq Int -> OwlTree
owlTree_fromOldState REltIdMap SEltLabel
oldDir Seq Int
oldLayers = OwlTree
r
where
(Int
_, OwlMapping
newDir, Seq Int
topOwls) = REltIdMap SEltLabel
-> Seq Int
-> Int
-> Int
-> Int
-> OwlMapping
-> Seq Int
-> (Int, OwlMapping, Seq Int)
internal_addUntilFolderEndRecursive REltIdMap SEltLabel
oldDir Seq Int
oldLayers Int
0 Int
noOwl Int
0 OwlMapping
forall a. IntMap a
IM.empty Seq Int
forall a. Seq a
Seq.empty
r :: OwlTree
r =
OwlTree
{ _owlTree_mapping :: OwlMapping
_owlTree_mapping = OwlMapping
newDir,
_owlTree_topOwls :: Seq Int
_owlTree_topOwls = Seq Int
topOwls
}
owlTree_toSEltTree :: OwlTree -> SEltTree
owlTree_toSEltTree :: OwlTree -> SEltTree
owlTree_toSEltTree OwlTree
od = OwlTree -> SuperOwlParliament -> SEltTree
superOwlParliament_toSEltTree OwlTree
od (OwlTree -> SuperOwlParliament
owlTree_toSuperOwlParliament OwlTree
od)
superOwl_toSElt_hack :: SuperOwl -> SElt
superOwl_toSElt_hack :: SuperOwl -> SElt
superOwl_toSElt_hack = OwlItem -> SElt
forall o. HasOwlItem o => o -> SElt
hasOwlItem_toSElt_hack (OwlItem -> SElt) -> (SuperOwl -> OwlItem) -> SuperOwl -> SElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItem
_superOwl_elt
superOwl_toSEltLabel_hack :: SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack :: SuperOwl -> SEltLabel
superOwl_toSEltLabel_hack = OwlItem -> SEltLabel
forall o. HasOwlItem o => o -> SEltLabel
hasOwlItem_toSEltLabel_hack (OwlItem -> SEltLabel)
-> (SuperOwl -> OwlItem) -> SuperOwl -> SEltLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItem
_superOwl_elt