tinytools-0.1.0.3
Safe HaskellSafe-Inferred
LanguageHaskell2010

Potato.Flow.Owl

Synopsis

Documentation

owlItem_updateAttachments :: Bool -> REltIdMap REltId -> OwlItem -> OwlItem Source #

update attachments based on remap

data OwlItemMeta Source #

Instances

Instances details
Generic OwlItemMeta Source # 
Instance details

Defined in Potato.Flow.Owl

Associated Types

type Rep OwlItemMeta :: Type -> Type #

Show OwlItemMeta Source # 
Instance details

Defined in Potato.Flow.Owl

NFData OwlItemMeta Source # 
Instance details

Defined in Potato.Flow.Owl

Methods

rnf :: OwlItemMeta -> () #

Eq OwlItemMeta Source # 
Instance details

Defined in Potato.Flow.Owl

PotatoShow OwlItemMeta Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep OwlItemMeta Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep OwlItemMeta = D1 ('MetaData "OwlItemMeta" "Potato.Flow.Owl" "tinytools-0.1.0.3-HF5s50ZrT30LQps3nQySnP" 'False) (C1 ('MetaCons "OwlItemMeta" 'PrefixI 'True) (S1 ('MetaSel ('Just "_owlItemMeta_parent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 REltId) :*: (S1 ('MetaSel ('Just "_owlItemMeta_depth") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int) :*: S1 ('MetaSel ('Just "_owlItemMeta_position") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SiblingPosition))))

data OwlSpot Source #

Instances

Instances details
Generic OwlSpot Source # 
Instance details

Defined in Potato.Flow.Owl

Associated Types

type Rep OwlSpot :: Type -> Type #

Methods

from :: OwlSpot -> Rep OwlSpot x #

to :: Rep OwlSpot x -> OwlSpot #

Show OwlSpot Source # 
Instance details

Defined in Potato.Flow.Owl

NFData OwlSpot Source # 
Instance details

Defined in Potato.Flow.Owl

Methods

rnf :: OwlSpot -> () #

type Rep OwlSpot Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep OwlSpot = D1 ('MetaData "OwlSpot" "Potato.Flow.Owl" "tinytools-0.1.0.3-HF5s50ZrT30LQps3nQySnP" 'False) (C1 ('MetaCons "OwlSpot" 'PrefixI 'True) (S1 ('MetaSel ('Just "_owlSpot_parent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 REltId) :*: S1 ('MetaSel ('Just "_owlSpot_leftSibling") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe REltId))))

data SuperOwl Source #

Instances

Instances details
Generic SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

Associated Types

type Rep SuperOwl :: Type -> Type #

Methods

from :: SuperOwl -> Rep SuperOwl x #

to :: Rep SuperOwl x -> SuperOwl #

Show SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

NFData SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

Methods

rnf :: SuperOwl -> () #

Eq SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

PotatoShow SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

HasOwlItem SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

MommyOwl SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep SuperOwl Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep SuperOwl = D1 ('MetaData "SuperOwl" "Potato.Flow.Owl" "tinytools-0.1.0.3-HF5s50ZrT30LQps3nQySnP" 'False) (C1 ('MetaCons "SuperOwl" 'PrefixI 'True) (S1 ('MetaSel ('Just "_superOwl_id") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 REltId) :*: (S1 ('MetaSel ('Just "_superOwl_meta") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OwlItemMeta) :*: S1 ('MetaSel ('Just "_superOwl_elt") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OwlItem))))

updateAttachmentMapFromSuperOwlChanges :: SuperOwlChanges -> AttachmentMap -> AttachmentMap Source #

update AttachmentMap from SuperOwlChanges (call on SuperOwlChanges produced by updateOwlPFWorkspace)

getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges Source #

update SuperOwlChanges to include stuff attached to stuff that changed (call before rendering)

superOwl_isTopOwlSurely :: SuperOwl -> Bool Source #

same as superOwl_isTopOwl except checks all conditions, intended to be used in asserts

newtype OwlParliament Source #

Constructors

OwlParliament 

Instances

Instances details
Generic OwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

Associated Types

type Rep OwlParliament :: Type -> Type #

Show OwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

NFData OwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

Methods

rnf :: OwlParliament -> () #

IsParliament OwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep OwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep OwlParliament = D1 ('MetaData "OwlParliament" "Potato.Flow.Owl" "tinytools-0.1.0.3-HF5s50ZrT30LQps3nQySnP" 'True) (C1 ('MetaCons "OwlParliament" 'PrefixI 'True) (S1 ('MetaSel ('Just "unOwlParliament") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Seq REltId))))

newtype SuperOwlParliament Source #

Instances

Instances details
Generic SuperOwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

Associated Types

type Rep SuperOwlParliament :: Type -> Type #

Show SuperOwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

NFData SuperOwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

Methods

rnf :: SuperOwlParliament -> () #

Eq SuperOwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

PotatoShow SuperOwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

IsParliament SuperOwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep SuperOwlParliament Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep SuperOwlParliament = D1 ('MetaData "SuperOwlParliament" "Potato.Flow.Owl" "tinytools-0.1.0.3-HF5s50ZrT30LQps3nQySnP" 'True) (C1 ('MetaCons "SuperOwlParliament" 'PrefixI 'True) (S1 ('MetaSel ('Just "unSuperOwlParliament") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Seq SuperOwl))))

disjointUnion :: Eq a => [a] -> [a] -> [a] Source #

partitionN :: (a -> Int) -> Seq a -> IntMap (Seq a) Source #

partition a list into groups based on int pairings

superOwlParliament_convertToCanvasSelection :: OwlTree -> (SuperOwl -> Bool) -> SuperOwlParliament -> CanvasSelection Source #

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

owlParliament_convertToMiniOwltree :: OwlTree -> OwlParliament -> MiniOwlTree Source #

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

owlParliamentSet_descendent :: OwlTree -> REltId -> OwlParliamentSet -> Bool Source #

returns true if rid is a contained in the OwlParliamentSet or is a descendent of sset

data OwlTree Source #

 

Instances

Instances details
Generic OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

Associated Types

type Rep OwlTree :: Type -> Type #

Methods

from :: OwlTree -> Rep OwlTree x #

to :: Rep OwlTree x -> OwlTree #

Show OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

NFData OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

Methods

rnf :: OwlTree -> () #

Eq OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

Methods

(==) :: OwlTree -> OwlTree -> Bool #

(/=) :: OwlTree -> OwlTree -> Bool #

PotatoShow OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

HasOwlTree OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

MommyOwl OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

type Rep OwlTree = D1 ('MetaData "OwlTree" "Potato.Flow.Owl" "tinytools-0.1.0.3-HF5s50ZrT30LQps3nQySnP" 'False) (C1 ('MetaCons "OwlTree" 'PrefixI 'True) (S1 ('MetaSel ('Just "_owlTree_mapping") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OwlMapping) :*: S1 ('MetaSel ('Just "_owlTree_topOwls") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Seq REltId))))

owlTree_equivalent :: OwlTree -> OwlTree -> Bool Source #

check if two OwlTree's are equivalent checks if structure is the same, REltIds can differ

owlTree_owlItemMeta_toOwlSpot :: OwlTree -> OwlItemMeta -> OwlSpot Source #

throws if OwlItemMeta is invalid in OwlTree TODO make naming consistent in this file...

owlTree_rEltId_toOwlSpot :: HasCallStack => OwlTree -> REltId -> OwlSpot Source #

throws if REltId is invalid in OwlTree

owlTree_rEltId_toFlattenedIndex_debug :: OwlTree -> REltId -> Int Source #

super inefficient implementation for testing only

owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap Source #

NOTE this will return an AttachmentMap containing targets that have since been deleted

owlTree_hasDanglingAttachments :: OwlTree -> Bool Source #

return fales if any attachments are dangling (i.e. they are attached to a target that does not exist in the tree)

owlTree_foldAt' :: (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a Source #

owlTree_foldAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a Source #

fold over an element in the tree and all its children

owlTree_foldChildrenAt' :: (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a Source #

owlTree_foldChildrenAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a Source #

same as owlTree_foldAt but excludes parent

owlTree_fold :: (a -> SuperOwl -> a) -> a -> OwlTree -> a Source #

owliterateat :: OwlTree -> REltId -> Seq SuperOwl Source #

iterates an element and all its children

owliteratechildrenat :: OwlTree -> REltId -> Seq SuperOwl Source #

iterates an element's children (excluding self)

owliterateall :: OwlTree -> Seq SuperOwl Source #

iterates everything in the directory

class HasOwlTree o where Source #

Minimal complete definition

hasOwlTree_owlTree

Instances

Instances details
HasOwlTree OwlTree Source # 
Instance details

Defined in Potato.Flow.Owl

HasOwlTree OwlPFState Source # 
Instance details

Defined in Potato.Flow.OwlState

HasOwlTree RenderContext Source # 
Instance details

Defined in Potato.Flow.Render

owlTree_toSuperOwlParliament :: OwlTree -> SuperOwlParliament Source #

select everything in the OwlTree

owlTree_addSEltTree :: OwlSpot -> SEltTree -> OwlTree -> (OwlTree, [SuperOwl]) Source #

assumes SEltTree REltIds do not collide with OwlTree

owlTree_reindex :: Int -> OwlTree -> OwlTree Source #

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

internal_addUntilFolderEndRecursive Source #

Arguments

:: REltIdMap SEltLabel 
-> Seq REltId 
-> Int

current layer position we are adding

-> REltId

parent

-> Int

depth

-> REltIdMap (OwlItemMeta, OwlItem)

accumulated directory

-> Seq REltId

accumulated children at current level

-> (Int, REltIdMap (OwlItemMeta, OwlItem), Seq REltId)

(next lp, accumulated directory, children of current level)

use to convert old style layers to Owl