{-# 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)

-- | update attachments based on remap
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
          -- could not find attachment, break it
          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



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

-- TODO remove OwlMapping arg not needed
locateLeftSiblingIdFromSiblingPosition :: OwlMapping -> Seq REltId -> SiblingPosition -> Maybe REltId
locateLeftSiblingIdFromSiblingPosition :: OwlMapping -> Seq 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

 
-- TODO
--isAncestorOf

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
")"

-- a simpler version of OwlItemMeta used for inserting new Owls
data OwlSpot = OwlSpot {
    -- NOTE _owlSpot_parent is redundant if _owlSpot_leftSibling is not Nothing
    OwlSpot -> 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

-- TODO try and get rid of deriving Eq
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)

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

instance NFData SuperOwl

instance MommyOwl SuperOwl where
  mommyOwl_kiddos :: SuperOwl -> Maybe (Seq 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)

-- updates AttachmeentMap with a list of SuperOwls (that may be attached to stuff)
attachmentMap_addSuperOwls' :: (Foldable f) => (Attachment -> Bool) -> f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls' :: forall (f :: * -> *).
Foldable f =>
(Attachment -> Bool)
-> f SuperOwl -> AttachmentMap -> AttachmentMap
attachmentMap_addSuperOwls' Attachment -> Bool
filterfn f SuperOwl
sowls AttachmentMap
am = AttachmentMap
r where
  foldrfn :: SuperOwl -> AttachmentMap -> AttachmentMap
foldrfn SuperOwl
sowl AttachmentMap
m = AttachmentMap
newmap where
    --find all targets we are attached to
    attachedstuff :: [Attachment]
attachedstuff = (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)

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

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

  -- remove changed elems from all value sets (this could be done more efficiently if we know the previous things they were attached to, but oh well)
  setToRemove :: IntSet
setToRemove = 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

  -- add attachment targets of changed elems to value sets of those targets
  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

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

-- | update SuperOwlChanges to include stuff attached to stuff that changed (call before rendering)
getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges
getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges
getChangesFromAttachmentMap OwlTree
owltreeafterchanges AttachmentMap
am SuperOwlChanges
changes = SuperOwlChanges
r where
  -- collect all stuff attaching to changed stuff
  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)

  -- create SuperOwlChanges from changeset
  -- currently nothing can be attached to something that is attaching to thing sso you don't need to make this operation recursive
  r :: SuperOwlChanges
r = [(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

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

--superOwl_id :: Lens' SuperOwl REltId
superOwl_id :: Functor f => (REltId -> f REltId) -> SuperOwl -> f SuperOwl
superOwl_id :: forall (f :: * -> *).
Functor f =>
(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))

-- TODO rest of lenses

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

-- | same as superOwl_isTopOwl except checks all conditions, intended to be used in asserts
superOwl_isTopOwlSurely :: SuperOwl -> Bool
superOwl_isTopOwlSurely :: SuperOwl -> Bool
superOwl_isTopOwlSurely SuperOwl {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)

-- if parent is selected, then kiddos must not be directly included in the parliament
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

-- same as OwlParialment but contains more information
-- TODO consider adding OwlTree reference to this type and rename to SuperDuperOwlParliament or something like that
newtype SuperOwlParliament = SuperOwlParliament {SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament :: Seq SuperOwl} deriving (SuperOwlParliament -> SuperOwlParliament -> Bool
(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

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

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


-- | partition a list into groups based on int pairings
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

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

  -- attach parents (at front of list, last elt is child and actuall part of original selection)
  makeParentChain :: SuperOwl -> [SuperOwl]
  makeParentChain :: SuperOwl -> [SuperOwl]
makeParentChain SuperOwl
sowl = [SuperOwl]
done where
    makeParentChain' :: SuperOwl -> [SuperOwl] -> [SuperOwl]
makeParentChain' SuperOwl
sowl' [SuperOwl]
acc = case SuperOwl -> 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

  -- this function is sketch af D:
  sortrec :: Seq [SuperOwl] -> Seq SuperOwl
  sortrec :: Seq [SuperOwl] -> Seq SuperOwl
sortrec Seq [SuperOwl]
chains = Seq SuperOwl
done where
    frontid :: [SuperOwl] -> 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"

    -- it's not necessary to look up rid as it will be the first element in each Seq elt in the value but whatever this is easier (to fix, you should rewrite partitionN)
    groupedParentChains2 :: Seq (SuperOwl, Seq [SuperOwl])
groupedParentChains2 = ((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

    -- sketchy logic here reliant on assumptions carried over from previous iteration... TODO rewrite this so it's not so weird
    fmapfn :: (a, Seq [SuperOwl]) -> Seq SuperOwl
fmapfn (a
_, Seq [SuperOwl]
chains') = if 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
      -- this is unititive, but if the group has only 1 chain in it, that means it's already sorted and hence are leaf node case
      then 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'
      -- otherwise, we have more children to process, note that if assumptions are correct, then each chain in the sequence has at least 2 elts (otherwise it would have been caught by the above condition in the previous iteration)
      else Seq [SuperOwl] -> Seq SuperOwl
sortrec (([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

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

  -- first convert s1 into a map
  mapsop0 :: IM.IntMap SuperOwl
  mapsop0 :: IntMap SuperOwl
mapsop0 = [(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

    -- add self to map
    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

    -- check if any children are selected and remove them from selection
    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

  -- assumes sowl is NOT in mapsop and that one of its ancestors is
  -- removes sowl from mapsop and adds its siblings and recurses on its parent until it reaches a selected parent
  removeFromInheritSelection :: SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection SuperOwl
sowl IntMap SuperOwl
mapsop = IntMap SuperOwl
rslt where
    prid :: Int
prid = SuperOwl -> Int
superOwl_parentId SuperOwl
sowl
    -- the parent is guaranteed to exist because we only call this on elements who inheritSelected
    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)
    -- add siblings to selection (guaranteed that none of their children are selected by assumption)
    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'
      -- we've reached the selected parent, deselect it and return our new selection
      then Int -> IntMap SuperOwl -> IntMap SuperOwl
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
prid IntMap SuperOwl
mapsop'
      -- recursively deselect the parent
      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
    -- we are selected, remove self from selection
    then Int -> IntMap SuperOwl -> IntMap SuperOwl
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
rid IntMap SuperOwl
acc
    -- we are not selected
    else if Int -> IntMap SuperOwl -> Bool
isDescendentOfOwlMap Int
rid IntMap SuperOwl
acc
      -- parent selected
      then SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
removeFromInheritSelection SuperOwl
sowl IntMap SuperOwl
acc
      -- parent not selected, add self to selection
      else SuperOwl -> IntMap SuperOwl -> IntMap SuperOwl
addToSelection SuperOwl
sowl IntMap SuperOwl
acc
    where
      rid :: 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

    -- check if a mommy owl is selected, that no descendant of that mommy owl is selected
    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
        -- remove self from list of mommies
        -- TODO you  don't actually need to check two elts at the same level, you can be smarter about removing mommies at each level
        mommies :: Set 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
          -- made it to the top
          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
            -- we've been here before, must be OK
            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
              -- one of our mommies, not OK
              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
                -- add self to list of mommies to visit and recurse
                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

    -- check that parliament is in fact ordered correctly (inefficiently 😭)
    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)

-- | convert SuperOwlParliament to CanvasSelection (includes children and no folders)
-- does not omits locked/hidden elts since Owl should not depend on Layers, you should do this using filterfn I guess??
superOwlParliament_convertToCanvasSelection :: OwlTree -> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection :: OwlTree
-> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection
superOwlParliament_convertToCanvasSelection 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)
  -- if folder then recursively include children otherwise include self
  mapfn :: SuperOwl -> Seq SuperOwl
mapfn SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
    OwlItem OwlInfo
_ (OwlSubItemFolder Seq 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

-- converts a SuperOwlParliament to its ordered Seq of SuperOwls including its children
superOwlParliament_convertToSeqWithChildren :: OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren :: OwlTree -> SuperOwlParliament -> Seq SuperOwl
superOwlParliament_convertToSeqWithChildren 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)
  -- if folder then recursively include children otherwise include self
  mapfn :: SuperOwl -> Seq SuperOwl
mapfn SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
    OwlItem OwlInfo
_ (OwlSubItemFolder Seq 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

-- | intended for use in OwlWorkspace to create PFCmd
-- generate MiniOwlTree will be reindexed so as not to conflict with OwlTree
-- relies on OwlParliament being correctly ordered
owlParliament_convertToMiniOwltree :: OwlTree -> OwlParliament -> MiniOwlTree
owlParliament_convertToMiniOwltree :: OwlTree -> OwlParliament -> OwlTree
owlParliament_convertToMiniOwltree 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 -- relies on OwlParliament being correctly ordered
      }
    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

  -- TODO this needs to return remapped rids (use mapAccumL)
  addOwlRecursive :: Int -> REltId -> REltId -> (OwlMapping, IM.IntMap REltId, REltId, SiblingPosition) -> ((OwlMapping, IM.IntMap REltId, REltId, SiblingPosition), REltId)
  addOwlRecursive :: 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

    -- add self (note that nrid is the new rid of the owl we just added)
    (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

    -- recursively add children
    ((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)


  -- recursively add all children to owltree and reindex
  ((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

-- | returns true if rid is a contained in the OwlParliamentSet or is a descendent of sset
owlParliamentSet_descendent :: OwlTree -> REltId -> OwlParliamentSet -> Bool
owlParliamentSet_descendent :: OwlTree -> 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

-- UNTESTED
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

-- | check if two OwlTree's are equivalent
-- checks if structure is the same, REltIds can differ
owlTree_equivalent :: OwlTree -> OwlTree -> Bool
owlTree_equivalent :: OwlTree -> OwlTree -> Bool
owlTree_equivalent OwlTree
ota OwlTree
otb = Bool
r
  where
    mustFind :: 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

-- oops, this should have been -1 but it's 0 so we start indexing stuff at 1 🤷🏼‍♀️
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))

-- reorganize the children of the given parent
-- i.e. update their position in the directory
internal_owlTree_reorgKiddos :: OwlTree -> REltId -> OwlTree
internal_owlTree_reorgKiddos :: OwlTree -> 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
    -- take until we reach the point and return one to the right
    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

-- move one spot to the left, returns Nothing if not possible
owlTree_goRightFromOwlSpot :: OwlTree -> OwlSpot -> Maybe OwlSpot
owlTree_goRightFromOwlSpot :: OwlTree -> OwlSpot -> Maybe OwlSpot
owlTree_goRightFromOwlSpot 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}

-- |
-- throws if OwlItemMeta is invalid in OwlTree
-- TODO make naming consistent in this file...
owlTree_owlItemMeta_toOwlSpot :: OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot :: OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree {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
        }


-- |
-- throws if REltId is invalid in OwlTree
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

-- |
-- super inefficient implementation for testing only
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

-- |
-- NOTE this will return an AttachmentMap containing targets that have since been deleted
owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap
owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap
owlTree_makeAttachmentMap OwlTree
od = 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

-- | return fales if any attachments are dangling (i.e. they are attached to a target that does not exist in the tree)
owlTree_hasDanglingAttachments :: OwlTree -> Bool
owlTree_hasDanglingAttachments :: OwlTree -> Bool
owlTree_hasDanglingAttachments od :: OwlTree
od@OwlTree {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

-- | fold over an element in the tree and all its children
owlTree_foldAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldAt :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> 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

-- | same as owlTree_foldAt but excludes parent
owlTree_foldChildrenAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a
owlTree_foldChildrenAt :: forall a. (a -> SuperOwl -> a) -> a -> OwlTree -> 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

-- | iterates an element and all its children
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

-- | iterates an element's children (excluding self)
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

-- | iterates everything in the directory
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

  -- only intended for use in tests
  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

-- | select everything in the OwlTree
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
    -- remove the element itself
    newMapping'' :: OwlMapping
newMapping'' = Int -> OwlMapping -> OwlMapping
forall a. Int -> IntMap a -> IntMap a
IM.delete (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) OwlMapping
_owlTree_mapping


    -- remove all children recursively if desired
    -- NOTE if keepChildren is true, this will put the OwlTree in an invalid state (presumably so that you can fix it later)
    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
        -- sowl meta may be incorrect at this point so we do linear search to remove the elt
        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
        -- TODO switch to this version once you fix issue in owlTree_moveOwlParliament (see comments there)
        --sp = _owlItemMeta_position . _superOwl_meta $ so
        --deletedSeq = Seq.deleteAt sp s

    -- remove from children of the element's mommy if needed
    removeChildFn :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
removeChildFn (OwlItemMeta, OwlItem)
parent = case (OwlItemMeta, OwlItem)
parent of
      (OwlItemMeta
oem, OwlItem OwlInfo
oinfo (OwlSubItemFolder Seq 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'

    -- remove from top owls if needed
    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

    -- check that we aren't doing circular parenting 😱
    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)

    -- NOTE, that _owlItemMeta_position in sowls may be incorrect in the middle of this fold
    -- this forces us to do linear search in the owlTree_removeSuperOwl call rather than use sibling position as index into children D:
    -- TODO fix by always sort from right to left to avoid this
    removedOd :: OwlTree
removedOd = (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

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

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

    -- list of removed element sorted in order
    removed :: [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

    -- list of all siblings on the spot we are dragging to
    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

    -- now we will walk from right to left picking out the first elt that is on or after the target spot we are dragging to (_owlSpot_leftSibling) and isn't in the removed list
    findPos ::
      REltId -- ^ original _owlSpot_leftSibling
      -> [REltId] -- ^ list of removed elements
      -> [REltId] -- ^ list of siblings
      -> Bool -- ^ whether we've gone past our target or not
      -> Maybe REltId -- ^ new non-removed leftSibling
    findPos :: 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

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

owlTree_reindex :: Int -> OwlTree -> OwlTree
owlTree_reindex :: 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
  -- TODO someday, when we're actually worried about id space size (i.e. when we have multi user mode) we will need to do this more efficiently
  adjustkeyfn :: 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
  -- adjust keys to their new ones
  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
  -- next adjust children and attachments to the new ids
  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 =
    -- remap attachments
    Bool -> REltIdMap Int -> OwlItem -> OwlItem
owlItem_updateAttachments Bool
True REltIdMap Int
ridremap
    -- remap kiddos
    (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

-- TODO check that there are no dangling attachments in MiniOwlTree (attach to non existant element), this is expected to be cleaned up in a previous step, use owlTree_hasDanglingAttachments
-- ^ actually this might be OK... or at least we want to check against tree we are attaching to such that if we copy paste something that was attached it keeps those attachments (or maybe we don't!)
owlTree_addMiniOwlTree :: OwlSpot -> MiniOwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree :: OwlSpot -> OwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree OwlSpot
targetspot OwlTree
miniot OwlTree
od0 = 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
      -- first element goes to target spot
      then OwlSpot
targetspot
      else if OwlItemMeta -> Int
_owlItemMeta_parent OwlItemMeta
meta Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl
        -- top level elements share the parent of the target spot
        then OwlSpot
spot { _owlSpot_parent = _owlSpot_parent targetspot}
        -- everything else has a valid spot from previous tree
        else OwlSpot
spot

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

  -- go from left to right such that parents/left siblings are added first
  (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
      -- update the depth of all its kiddos
      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}
      -- recurse
      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

-- parents allowed ONLY if all the children already exist in the tree (as orphans) or it will crash
-- returns the added element for convenience but NOT its children 
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

    -- first add the OwlItem to the mapping
    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,
          -- this will get set correctly when we call internal_owlTree_reorgKiddos later
          _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

    -- update siblings in the parent we are adding to, leaving the tree in an invalid state (siblings have wrong position index in their OwlItemMeta)
    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'
    -- or top owls if there is no parent
    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
        }

    -- correct the sibling indices
    tree_2 :: OwlTree
tree_2 = OwlTree -> Int -> OwlTree
internal_owlTree_reorgKiddos OwlTree
tree_1 Int
_owlSpot_parent

    -- correct the children depths
    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)

-- NOTE parents are allowed here IF all the children already exist in the tree
-- returns the added element and all its children
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)

  

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

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

  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
      -- temp remove kiddos from parent as needed by internal_owlTree_addOwlItem
      -- the kiddos will be set correctly when the children get added further down the seltls list
      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

  -- go from left to right such that parents are added first
  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


-- TODO TEST
owlTree_superOwl_comparePosition :: OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition :: OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition OwlTree
ot SuperOwl
sowl1 SuperOwl
sowl2 = Ordering
r where
  m1 :: OwlItemMeta
m1 = SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl1
  m2 :: OwlItemMeta
m2 = SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl2
  d1 :: 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

-- | use to convert old style layers to Owl
internal_addUntilFolderEndRecursive ::
  REltIdMap SEltLabel ->
  Seq REltId ->
  -- | current layer position we are adding
  Int ->
  -- | parent
  REltId ->
  -- | depth
  Int ->
  -- | accumulated directory
  REltIdMap (OwlItemMeta, OwlItem) ->
  -- | accumulated children at current level
  Seq REltId ->
  -- | (next lp, accumulated directory, children of current level)
  (Int, REltIdMap (OwlItemMeta, OwlItem), Seq REltId)
internal_addUntilFolderEndRecursive :: REltIdMap SEltLabel
-> Seq 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
      -- the elt we want to add
      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 -- this means we've reached the end of layers, nothing to do
          (Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, OwlMapping
accDir, Seq Int
accSiblings)
        else -- normal case
        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
          -- we're done! throw out this elt
          SElt
SEltFolderEnd -> (Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, OwlMapping
accDir, Seq Int
accSiblings)
          -- nothing special, keep going
          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)

-- DELETE use hasOwlElt variant
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

-- DELETE use hasOwlElt variant
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