tinytools 0.1.0.5 → 0.1.0.6

raw patch · 38 files changed

+448/−151 lines, 38 filesdep −MonadRandomdep −hashabledep −listsafe

Dependencies removed: MonadRandom, hashable, listsafe, patch, random-shuffle

Files

• ChangeLog.md +4/−0
• src/Potato/Data/Text/Zipper.hs +1/−1
• src/Potato/Flow/BroadPhase.hs +5/−1
• src/Potato/Flow/Controller/Goat.hs +35/−17
• src/Potato/Flow/Controller/Handler.hs +0/−3
• src/Potato/Flow/Controller/Manipulator/Box.hs +16/−9
• src/Potato/Flow/Controller/Manipulator/BoxText.hs +3/−4
• src/Potato/Flow/Controller/Manipulator/Layers.hs +21/−13
• src/Potato/Flow/Controller/Manipulator/Line.hs +2/−2
• src/Potato/Flow/Controller/Manipulator/Pan.hs +0/−1
• src/Potato/Flow/Controller/Manipulator/TextArea.hs +0/−1
• src/Potato/Flow/Controller/OwlLayers.hs +1/−1
• src/Potato/Flow/Controller/Types.hs +0/−2
• src/Potato/Flow/Llama.hs +2/−2
• src/Potato/Flow/Methods/LineDrawer.hs +2/−2
• src/Potato/Flow/Methods/LlamaWorks.hs +0/−4
• src/Potato/Flow/Owl.hs +6/−2
• src/Potato/Flow/OwlState.hs +1/−3
• src/Potato/Flow/OwlWorkspace.hs +1/−19
• src/Potato/Flow/Preview.hs +1/−0
• src/Potato/Flow/Render.hs +19/−13
• src/Potato/Flow/RenderCache.hs +0/−1
• src/Potato/Flow/Serialization/Versions/V1/SElts.hs +2/−2
• src/Potato/Flow/Types.hs +1/−0
• test/Potato/Data/Text/UnicodeSpec.hs +5/−0
• test/Potato/Data/Text/ZipperSpec.hs +10/−1
• test/Potato/Flow/AttachmentsSpec.hs +0/−2
• test/Potato/Flow/Controller/GeneralSpec.hs +47/−0
• test/Potato/Flow/Controller/Manipulator/BoxSpec.hs +0/−1
• test/Potato/Flow/Controller/Manipulator/LayersSpec.hs +115/−2
• test/Potato/Flow/Controller/Manipulator/LineSpec.hs +2/−1
• test/Potato/Flow/Controller/Manipulator/TestHelpers.hs +1/−1
• test/Potato/Flow/Deprecated/Controller/EverythingWidgetSpec.hs +0/−20
• test/Potato/Flow/GoatTester.hs +55/−4
• test/Potato/Flow/LlamaSpec.hs +1/−1
• test/Potato/Flow/Methods/LineDrawerSpec.hs +1/−1
• test/Potato/Flow/RenderSpec.hs +83/−2
• tinytools.cabal +5/−12

@@ -2,6 +2,10 @@  ## [unreleased] +## [0.1.0.6]+- fix several bugs+- remove patch dependency+   ## [0.1.0.5] - various internal improvements to how previews are staged and committed - fix crash issue with undoing drags that contained folders

@@ -492,7 +492,7 @@           else (nextacc, [Span tag t])       ((_, ecpos_out), curlinespans) = if T.null curlinetext         -- manually handle empty case because mapaccumlfn doesn't handle it-        then ((0, Right (0, alignmentOffset alignment width "")), [[Span tag ""]])+        then ((0, Right (0, alignmentOffset alignment width "")), [[Span cursorTag ""]])         else L.mapAccumL mapaccumlfn (0, Left 0) curwrappedlines        (cursorY', cursorX) = case ecpos_out of

@@ -27,6 +27,7 @@ import           Potato.Flow.Serialization.Snake import           Potato.Flow.Types +import qualified Text.Show import qualified Data.IntMap.Strict        as IM  type AABB = LBox@@ -37,10 +38,13 @@ data BPTree = BPTree {   -- TODO you want something sortable too...   _bPTree_potato_tree :: REltIdMap AABB-} deriving (Show, Eq)+} deriving (Eq)  emptyBPTree :: BPTree emptyBPTree = BPTree IM.empty++instance Show BPTree where+  show BPTree {..} = "BPTree:\n" <> IM.foldrWithKey (\k v acc -> show k <> ": " <> show v <> "\n" <> acc) "" _bPTree_potato_tree  -- TODO --bPTreeFromPFState :: PFState -> BPTree

@@ -49,7 +49,6 @@ import           Potato.Flow.OwlWorkspace import           Potato.Flow.Render import           Potato.Flow.Methods.SEltMethods-import           Potato.Flow.Serialization.Snake import           Potato.Flow.Types import  Potato.Flow.Preview  import Potato.Flow.Methods.LlamaWorks@@ -130,8 +129,14 @@       , _renderContext_renderedCanvasRegion = initialemptyrcr       , _renderContext_cache = emptyRenderCache     }+    +    -- TODO this is incorrect becaues it doesn't use pan or screenx/y     initialrc = _renderContext_renderedCanvasRegion $ render initialCanvasBox initialselts initialrendercontext +    -- TODO use this, except this breaks the initial render whne opening tinytools-vty for some reason (it should rerender in the endoSetCanvasSide function aftre postbuild where the screenx/y get set corrcetly but it dosen't)+    --initialrc = _renderContext_renderedCanvasRegion $ render_new (LBox (-(_controllerMeta_pan controllermeta)) sr) (traceShowId $ initialselts) initialrendercontext++     goat = GoatState {         _goatState_workspace      = fst $ loadOwlPFStateIntoWorkspace (initialstate) emptyWorkspace         , _goatState_pan             = _controllerMeta_pan controllermeta@@ -298,12 +303,14 @@  endoGoatCmdLoad :: (SPotatoFlow, ControllerMeta) -> GoatState -> GoatState endoGoatCmdLoad (spf, cm) gs = r where-  gs' = goat_applyWSEvent WSEventType_Local_Refresh (WSELoad spf) gs-  r = gs' {+  gs_after_load = goat_applyWSEvent WSEventType_Local_Refresh (WSELoad spf) gs+  gs_for_move = gs_after_load {       _goatState_pan = _controllerMeta_pan cm-      , _goatState_layersState = makeLayersStateFromOwlPFState (goatState_pFState gs') (_controllerMeta_layers cm)+      , _goatState_layersState = makeLayersStateFromOwlPFState (goatState_pFState gs_after_load) (_controllerMeta_layers cm)       -- NOTE _goatState_layersHandler gets set by goat_applyWSEvent during refresh     }+  -- rerenderAfterMove since we may have loaded a different pan+  r = goat_rerenderAfterMove gs_for_move  goat_setFocusedArea :: GoatFocusedArea -> GoatState -> GoatState goat_setFocusedArea gfa goatState = r where@@ -316,7 +323,7 @@     then let         goatState_afterAction = case pHandleKeyboard (_goatState_layersHandler goatState) potatoHandlerInput (KeyboardData KeyboardKey_Return []) of           Nothing -> noactionneeded-          Just pho -> traceShow "press enter" $ goat_processLayersHandlerOutput pho goatstatewithnewfocus+          Just pho -> goat_processLayersHandlerOutput pho goatstatewithnewfocus       in assert (_goatState_focusedArea goatState == GoatFocusedArea_Layers) $ goatState_afterAction     else noactionneeded @@ -386,7 +393,7 @@   endoGoatCmdKeyboard :: KeyboardData -> GoatState -> GoatState-endoGoatCmdKeyboard kbd' goatState = r where+endoGoatCmdKeyboard kbd' goatState = r_d0 where   -- TODO you need to do reset logic for this (basically, reset it anytime there was a non-keyboard event)   last_unbrokenInput = _goatState_unbrokenInput goatState   next_unbrokenInput = case kbd' of@@ -399,7 +406,7 @@   -- TODO rename to canvasHandler   handler = _goatState_handler goatState_withKeyboard -  r = case mkbd of+  r_d0 = case mkbd of     Nothing -> goatState_withKeyboard     -- special case, treat escape cancel mouse drag as a mouse input     Just (KeyboardData KeyboardKey_Esc _) | mouseDrag_isActive (_goatState_mouseDrag goatState_withKeyboard) -> r where@@ -480,6 +487,7 @@                 'p' -> Just Tool_Pan                 'b' -> Just Tool_Box                 'l' -> Just Tool_Line+                't' -> Just Tool_Text                 'n' -> Just Tool_TextArea                 _   -> Nothing               newHandler = maybe (_goatState_handler goatState_withKeyboard) (makeHandlerFromNewTool goatState_withKeyboard) mtool@@ -497,7 +505,7 @@     else (rc, False)  -goat_renderCanvas_update :: (HasCallStack) => RenderContext -> NeedsUpdateSet -> SuperOwlChanges -> RenderContext+goat_renderCanvas_update :: RenderContext -> NeedsUpdateSet -> SuperOwlChanges -> RenderContext goat_renderCanvas_update rc needsupdateaabbs cslmap = r where   r = if IM.null cslmap     then rc@@ -572,7 +580,7 @@       , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterselection     } -computeCanvasSelection :: (HasCallStack) => GoatState -> CanvasSelection+computeCanvasSelection :: GoatState -> CanvasSelection computeCanvasSelection goatState = r where   pfs = goatState_pFState goatState   filterHiddenOrLocked sowl = not $ layerMetaMap_isInheritHiddenOrLocked (_owlPFState_owlTree pfs) (_superOwl_id sowl) (_layersState_meta (_goatState_layersState goatState))@@ -657,9 +665,23 @@     HOA_Nothing -> goatState  + goat_processLayersHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState-goat_processLayersHandlerOutput pho goatState = goat_processHandlerOutput_noSetHandler pho $ goatState { _goatState_layersHandler = fromMaybe (_goatState_layersHandler goatState) (_potatoHandlerOutput_nextHandler pho) }+goat_processLayersHandlerOutput pho goatState = r where+  gs' = goatState { +      _goatState_layersHandler = fromMaybe (_goatState_layersHandler goatState) (_potatoHandlerOutput_nextHandler pho) +    }+  gs'' = goat_processHandlerOutput_noSetHandler pho gs' +  -- layers output may have changed our selection so update the handler+  prevcanvasselection = _goatState_canvasSelection goatState+  nextcanvasselection = computeCanvasSelection gs''+  r = if prevcanvasselection == nextcanvasselection+    then gs''+    else gs'' { _goatState_handler = makeHandlerFromSelection nextcanvasselection }+++ goat_processCanvasHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState goat_processCanvasHandlerOutput pho goatState = r where   canvasSelection = computeCanvasSelection goatState@@ -736,9 +758,6 @@     then let         layersHandler = _goatState_layersHandler goatState_afterSelection         canvasHandler = _goatState_handler goatState_afterSelection -        -- TODO remove this assert, this will happen for stuff like boxtexthandler-        -- since we don't have multi-user events, the handler should never be active when this happens-        checkvalid = assert (pIsHandlerActive canvasHandler /= HAS_Active_Mouse && pIsHandlerActive layersHandler /= HAS_Active_Mouse)          -- safe for now, since `potatoHandlerInputFromGoatState` does not use `_goatState_handler/_goatState_layersHandler finalGoatState` which is set to `next_handler/next_layersHandler`         next_potatoHandlerInput = potatoHandlerInputFromGoatState goatState_afterSelection@@ -749,7 +768,7 @@         -- TODO cancel the preview          -      in checkvalid goatState_afterSelection {+      in goatState_afterSelection {           _goatState_handler = refreshedCanvasHandler           , _goatState_layersHandler = refreshedLayersHandler         }@@ -762,12 +781,11 @@   -- | set the new handler based on the new Selection and LayersState   next_canvasSelection = computeCanvasSelection goatState_afterSetLayersState -- (TODO pretty sure this is the same as `canvasSelection = computeCanvasSelection goatState_afterSelection` above..) -   -- we check both the pIsHandlerActive and goatState_hasLocalPreview condition to see if we want to recreate the handler   -- actually, we could only check pIsHandlerActive if all handlers properly reported their state-   -- TODO the issue with not (goatState_hasLocalPreview goatState_afterSetLayersState) is that we may actually want to regen the handler we just haven't commit its preview yet (i.e. box creation)-  -- NO that's not true because in those cases you can return an explicit commit action or you return HOA_Nothing which should also commit when the handler is replaced+  --  NO that's not true because in those cases you can return an explicit commit action or you return HOA_Nothing which should also commit when the handler is replaced+  --  ☝🏽 pretty this TODO is not relevant anymore 🤷🏼‍♀️   (next_handler, next_workspace) = if (not . handlerActiveState_isActive) (pIsHandlerActive (_goatState_handler goatState_afterSetLayersState)) && not (goatState_hasLocalPreview goatState_afterSetLayersState)     -- if we replaced the handler, commit its local preview if there was one     then (makeHandlerFromSelection next_canvasSelection, maybeCommitLocalPreviewToLlamaStackAndClear $ _goatState_workspace goatState_afterSetLayersState)

@@ -13,14 +13,12 @@ import           Potato.Flow.Owl import           Potato.Flow.Render import           Potato.Flow.OwlState-import           Potato.Flow.OwlWorkspace import           Potato.Flow.Serialization.Snake import qualified Potato.Flow.Preview as Preview  import qualified Potato.Data.Text.Zipper          as TZ  import           Data.Default-import qualified Data.IntMap                      as IM import qualified Data.Sequence                    as Seq import qualified Data.Text                        as T import qualified Text.Show@@ -31,7 +29,6 @@   | HOA_Pan XY    | HOA_Select Bool Selection   | HOA_Layers LayersState SuperOwlChanges-  | HOA_LayersScroll Int   | HOA_Preview Preview.Preview    deriving (Show) 

@@ -24,7 +24,6 @@ import           Potato.Flow.OwlItem import Potato.Flow.Owl import Potato.Flow.OwlState-import Potato.Flow.OwlWorkspace import Potato.Flow.Methods.Types import Potato.Flow.Llama import           Potato.Flow.Methods.LlamaWorks@@ -46,11 +45,18 @@ superOwl_isTransformable sowl ot = case _owlItem_subItem (_superOwl_elt sowl) of   OwlSubItemNone -> False   OwlSubItemFolder _ -> False-  OwlSubItemLine sline -> not $-    (fromMaybe False $ _sAutoLine_attachStart sline <&> (\att -> hasOwlTree_exists ot (_attachment_target att)))-    && (fromMaybe False $ _sAutoLine_attachEnd sline <&> (\att -> hasOwlTree_exists ot (_attachment_target att)))++  -- THE REASON YOU DID THIS IS TO PREVENT FULLY ATTACHED LINES FROM BEING MOVED (because then thei'r endpoints jump around when the attached objects are destroyed)+  -- TODO FIX THE ABOVE+  -- I forgot why I added this, but in any case, we definitely DO want to transform lines if all it's attached parents are also being transformed+  --OwlSubItemLine sline -> not $+  --  (fromMaybe False $ _sAutoLine_attachStart sline <&> (\att -> hasOwlTree_exists ot (_attachment_target att)))+  --  && (fromMaybe False $ _sAutoLine_attachEnd sline <&> (\att -> hasOwlTree_exists ot (_attachment_target att)))++     _ -> True +-- TODO you MAY want to consider adding all lines that have both attachments in the selection to the modify set  transformableSelection :: PotatoHandlerInput -> Seq SuperOwl transformableSelection PotatoHandlerInput {..} = transformableSelection' _potatoHandlerInput_pFState _potatoHandlerInput_canvasSelection @@ -180,7 +186,7 @@ -- reduces the DeltaLBox such that the LBox does not invert -- assumes LBox is canonical and that LBox is not already smaller than the desired constrained size constrainDeltaLBox :: Int -> DeltaLBox -> LBox -> DeltaLBox-constrainDeltaLBox minsize d1@(DeltaLBox (V2 dx dy) (V2 dw dh)) d2@((LBox (V2 x y) (V2 w h))) = r where+constrainDeltaLBox minsize d1@(DeltaLBox (V2 dx dy) (V2 dw dh)) (LBox _ (V2 w h)) = r where   optuple e = (e, -e)    (ndx, ndw) = if dx /= 0 @@ -224,12 +230,13 @@ makeDragOperation phi dbox = op where   selection = transformableSelection phi   selectionl = toList $ transformableSelection phi-  pfs = _potatoHandlerInput_pFState phi-  lboxes = fmap (\sowl -> _sEltDrawer_box (getDrawer . hasOwlItem_toOwlSubItem $ sowl) pfs) selectionl-+  +     -- go through each element in selection and ensure that dbox does not invert that element   -- DANGER you need to make sure you have sensible bounding box functions or you might put things in a non-resizeable state-  constraineddbox = foldl' (constrainDeltaLBox 0) dbox lboxes+  --pfs = _potatoHandlerInput_pFState phi+  --lboxes = fmap (\sowl -> _sEltDrawer_box (getDrawer . hasOwlItem_toOwlSubItem $ sowl) pfs) selectionl+  --constraineddbox = foldl' (constrainDeltaLBox 0) dbox lboxes    makeController _ = cmd where     cmd = CTagBoundingBox :=> (Identity $ CBoundingBox {

@@ -27,7 +27,6 @@ import           Potato.Flow.Serialization.Snake import           Potato.Flow.Types import Potato.Flow.Owl-import Potato.Flow.OwlWorkspace import Potato.Flow.Llama import           Potato.Flow.Preview @@ -367,8 +366,8 @@   }  -inputBoxLabel :: TextInputState -> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)-inputBoxLabel tais undoFirst sowl kk = (newtais, mop) where+inputBoxLabel :: TextInputState -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe Llama)+inputBoxLabel tais sowl kk = (newtais, mop) where   (changed, newtais) = inputSingleLineZipper tais kk   newtext = TZ.value (_textInputState_zipper newtais)   controller = CTagBoxLabelText :=> (Identity $ CMaybeText (DeltaMaybeText (_textInputState_original tais, if newtext == "" then Nothing else Just newtext)))@@ -428,7 +427,7 @@        -- TODO decide what to do with mods -      (nexttais, mllama) = inputBoxLabel _boxLabelHandler_state _boxLabelHandler_undoFirst sowl k+      (nexttais, mllama) = inputBoxLabel _boxLabelHandler_state sowl k       r = def {           _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {               _boxLabelHandler_state  = nexttais

@@ -190,32 +190,33 @@       (MouseDragState_Dragging, LDS_Dragging) -> r where          -- we will always place between dropSowl and justAboveDropSowl-        mDropSowlWithOffset = do-          (downsowl, _, offset') <- clickLayerNew lentries leposxy-          return (downsowl, offset')+        mDropSowl = do+          (downsowl, _, _) <- clickLayerNew lentries leposxy+          return downsowl          mJustAboveDropSowl = do-          lentry <- case mDropSowlWithOffset of+          lentry <- case mDropSowl of             Nothing -> Seq.lookup (Seq.length lentries - 1) lentries             Just _  -> Seq.lookup (lepos-1) lentries           return $ _layerEntry_superOwl lentry  -        nparentoffset = case mDropSowlWithOffset of+        nparentoffset = case mDropSowl of           Nothing -> case mJustAboveDropSowl of             Nothing    -> error "this should never happen"             -- we are at the very bottom             Just asowl -> rawxoffset - superOwl_depth asowl -          Just (dsowl, x) -> case mJustAboveDropSowl of+          Just dsowl -> case mJustAboveDropSowl of             -- we are at the very top             Nothing    -> 0             -- limit how deep in the hierarchy we can move based on what's below the cursor-            Just asowl -> max x (superOwl_depth dsowl - superOwl_depth asowl)+            Just asowl -> max x diff where+              x = rawxoffset - superOwl_depth asowl+              diff = superOwl_depth dsowl - superOwl_depth asowl          nsibling = max 0 (- (min 0 nparentoffset)) -         targetspot = case mJustAboveDropSowl of           -- we are dropping at the top of our LayerEntries           Nothing -> OwlSpot noOwl Nothing@@ -253,6 +254,7 @@         }        (MouseDragState_Up, LDS_Selecting leposdown) -> r where+        -- TODO do proper shift selecting         shift = elem KeyModifier_Shift _mouseDrag_modifiers         sowl = _layerEntry_superOwl $ Seq.index lentries leposdown         r = Just $ def {@@ -271,11 +273,16 @@             -- TODO great place for TZ.selectAll when you add selection capability into TZ             zipper = TZ.fromText $ hasOwlItem_name downsowl -            r = Just $ setHandlerOnly LayersRenameHandler {-                _layersRenameHandler_original = resetLayersHandler lh-                , _layersRenameHandler_renaming   = downsowl-                , _layersRenameHandler_index = lepos-                , _layersRenameHandler_zipper   = zipper+            r = if Seq.length (unSuperOwlParliament selection) == 1+              then Just $ setHandlerOnly LayersRenameHandler {+                  _layersRenameHandler_original = resetLayersHandler lh+                  , _layersRenameHandler_renaming   = downsowl+                  , _layersRenameHandler_index = lepos+                  , _layersRenameHandler_zipper   = zipper+                }+              else Just $ def {+                _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler (resetLayersHandler lh)+                , _potatoHandlerOutput_action = HOA_Select False (SuperOwlParliament $ Seq.singleton downsowl)               }  @@ -412,6 +419,7 @@             else (False, selstack)       newlhre = if childSelected         then case lhre of+          -- TODO this is wrong            LayersHandlerRenderEntryNormal _ mdots renaming lentry -> LayersHandlerRenderEntryNormal LHRESS_ChildSelected mdots renaming lentry           x -> x         else lhre

@@ -23,7 +23,6 @@ import           Potato.Flow.Owl import           Potato.Flow.OwlItem import           Potato.Flow.OwlState-import           Potato.Flow.OwlWorkspace import           Potato.Flow.Serialization.Snake import Potato.Flow.Methods.LlamaWorks import Potato.Flow.Preview@@ -457,6 +456,7 @@   -- TODO finish+{- adjustLineLabelPositionsAfterModifyingOrAddingMidpoint ::   (HasOwlTree a)   => a@@ -484,7 +484,7 @@   -- adjust distance by the change in ratio    r = undefined-+-}   

@@ -38,7 +38,6 @@           MouseDragState_Up -> case _panHandler_maybePrevHandler of             Nothing -> Just $ SomePotatoHandler (def :: PanHandler)             Just x  -> Just x-          _ -> error "not posible"         , _potatoHandlerOutput_action = HOA_Pan (delta - _panHandler_panDelta)         --, _potatoHandlerOutput_pan = trace (show x <> " delta " <> show delta <> " pan " <> show _panHandler_panDelta <> " from " <> show _mouseDrag_from <> " to " <> show _mouseDrag_to) $ Just (delta - _panHandler_panDelta)       } where delta = _mouseDrag_to - _mouseDrag_from

@@ -16,7 +16,6 @@ import           Potato.Flow.Llama import           Potato.Flow.Math import           Potato.Flow.Owl-import           Potato.Flow.OwlWorkspace import           Potato.Flow.Serialization.Snake import           Potato.Flow.Types import Potato.Flow.Preview

@@ -109,7 +109,7 @@       then if _layerEntry_isCollapsed         then ">"         else "v"-      else " "+      else "●"     hideText = case _layerEntry_hideState of       LHS_True              -> "▓"       LHS_False             -> " "

@@ -38,8 +38,6 @@   }  --- TODO remove Tool_TextArea--- TOOL data Tool = Tool_Select | Tool_Pan | Tool_Box | Tool_Line | Tool_Text | Tool_TextArea deriving (Eq, Show, Enum)  tool_isCreate :: Tool -> Bool

@@ -69,7 +69,7 @@       else Left $ ApplyLLamaError_Soft $ "Invalid canvas size operation " <> show x    r = case r' of -    Right (newState, changes) -> assert (owlPFState_isValid newState) r'+    Right (newState, _) -> assert (owlPFState_isValid newState) r'     Left e -> Left e  undoCmdState :: OwlPFCmd -> OwlPFState -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges)@@ -90,7 +90,7 @@       else Left $ ApplyLLamaError_Soft $ "Invalid canvas size operation " <> show x    r = case r' of-    Right (newState, changes) -> assert (owlPFState_isValid newState) r'+    Right (newState, _) -> assert (owlPFState_isValid newState) r'     Left e                    -> Left e  

@@ -160,7 +160,7 @@   revgo acc ((cd,d,False):[]) = (flipCartDir cd,d,True):acc   revgo _ ((_,_,True):[]) = error "unexpected subsegment starting anchor at end"   revgo acc ((cd,d,False):xs) = revgo ((flipCartDir cd, d, False):acc) xs-  revgo _ ((_,_,True):xs) = error "TODO this does not handle midpoint subsegment starting anchors correctly (not that it needs to right now)"+  revgo _ ((_,_,True):_) = error "TODO this does not handle midpoint subsegment starting anchors correctly (not that it needs to right now)"   revgostart [] = []   revgostart ((cd,d,True):xs) = revgo [(flipCartDir cd,d,False)] xs   revgostart _ = error "unexpected non-subsegment starting anchor at start"@@ -674,7 +674,7 @@   walk (x@(cd,d,_):rest) curbegin traveld = r2 where     nextbegin = curbegin + cartDirWithDistanceToV2 x     r2 = if traveld + d >= targetd-      then curbegin + cartDirWithDistanceToV2 (cd, targetd - traveld, undefined)+      then curbegin + cartDirWithDistanceToV2 (cd, targetd - traveld, undefined) -- why undefined -__- lol       else walk rest nextbegin (traveld + d)   r = walk (_lineAnchorsForRender_rest lar) (_lineAnchorsForRender_start lar) 0 

@@ -7,11 +7,8 @@  import           Relude -import           Potato.Flow.Math import           Potato.Flow.Owl import Potato.Flow.OwlItem-import Potato.Flow.Attachments-import Potato.Flow.OwlWorkspace import Potato.Flow.OwlState import Potato.Flow.Llama import           Potato.Flow.Serialization.Snake@@ -19,7 +16,6 @@  import           Control.Exception (assert) -import qualified Data.Text         as T import qualified Data.IntMap as IM import qualified Data.IntSet as IS import qualified Data.Sequence as Seq

@@ -122,6 +122,10 @@  type SuperOwlChanges = REltIdMap (Maybe SuperOwl) ++instance PotatoShow SuperOwlChanges where+  potatoShow = (<>) "SuperOwlChanges:\n" . foldr (\msowl acc -> maybe "Nothing" potatoShow msowl <> "\n" <> acc) ""+ -- 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' filterfn sowls am = r where@@ -979,13 +983,13 @@   sowl = owlTree_mustFindSuperOwl ot rid   adjustdepthfn (oem, oitem) = (,oitem) $ oem { _owlItemMeta_depth = _owlItemMeta_depth (_superOwl_meta sowl) + 1 }   r_0 = case _superOwl_elt sowl of-    OwlItem oinfo (OwlSubItemFolder kiddos) -> r_1 where+    OwlItem _ (OwlSubItemFolder kiddos) -> r_1 where       -- update the depth of all its kiddos       omwithadjusteddepth = foldr (\kid om -> IM.adjust adjustdepthfn kid om) (_owlTree_mapping ot) kiddos       newot_0 = ot {_owlTree_mapping = omwithadjusteddepth}       -- recurse       r_1 = foldl (internal_owlTree_recalculateChildrenDepths_recursive) newot_0 kiddos-    x -> ot+    _ -> 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 

@@ -18,10 +18,8 @@ import           Data.List.Ordered       (isSortedBy) import           Data.Maybe import qualified Data.Text as T-import qualified Data.Sequence as Seq  - -- prob not the best place for these... maybeGetAttachmentPosition :: (HasCallStack) => Bool -> OwlPFState -> Attachment -> Maybe XY maybeGetAttachmentPosition offsetBorder pfs a = do@@ -115,7 +113,7 @@ owlPFState_to_SuperOwlParliament :: OwlPFState -> SuperOwlParliament owlPFState_to_SuperOwlParliament OwlPFState {..} = owlParliament_toSuperOwlParliament _owlPFState_owlTree $ OwlParliament $ _owlTree_topOwls _owlPFState_owlTree -do_newElts :: (HasCallStack) => [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)+do_newElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges) do_newElts seltls pfs@OwlPFState {..} = r where    -- notably, passing in a list here rather than SuperOwlParialment allows us to add parents with children so long as everything is sorted from left to right (such that the parent/sibling exist when the child gets added)

@@ -18,18 +18,13 @@ import           Relude  import           Potato.Flow.Llama-import           Potato.Flow.Math import           Potato.Flow.Owl-import           Potato.Flow.OwlItem import           Potato.Flow.OwlState-import           Potato.Flow.Serialization.Snake import           Potato.Flow.Types import Potato.Flow.Preview  import           Control.Exception    (assert) import qualified Data.IntMap.Strict   as IM-import qualified Data.IntSet          as IS-import qualified Data.Sequence        as Seq  -- TODO get rid of this, now needed data OwlPFWorkspace = OwlPFWorkspace {@@ -178,16 +173,6 @@ doCmdWorkspace cmd pfw = force r where   r = doLlamaWorkspace (makePFCLlama cmd) pfw -doCmdOwlPFWorkspaceUndoPermanentFirst :: (OwlPFState -> OwlPFCmd) -> OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)-doCmdOwlPFWorkspaceUndoPermanentFirst cmdFn ws = r where-  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways-  (undoedws, undochanges) = undoPermanentWorkspace ws-  undoedpfs = _owlPFWorkspace_owlPFState undoedws-  cmd = cmdFn undoedpfs-  (newpfs, changes) = doLlamaWorkspace (makePFCLlama cmd) undoedws-  r = (newpfs, IM.union changes undochanges)-- ------ update functions via commands data WSEvent =   -- TODO DELETE@@ -206,16 +191,13 @@ debugPrintBeforeAfterState stateBefore stateAfter = fromString $ "BEFORE: " <> debugPrintOwlPFState stateBefore <> "\nAFTER: " <> debugPrintOwlPFState stateAfter  -noChanges :: OwlPFWorkspace -> (OwlPFWorkspace, SuperOwlChanges)-noChanges ws = (ws, IM.empty)- clearLocalPreview :: (OwlPFWorkspace, SuperOwlChanges) -> (OwlPFWorkspace, SuperOwlChanges) clearLocalPreview (ws, changes) = (ws { _owlPFWorkspace_localPreview = Nothing }, changes)  maybeCommitLocalPreviewToLlamaStackAndClear :: OwlPFWorkspace -> OwlPFWorkspace maybeCommitLocalPreviewToLlamaStackAndClear ws = case _owlPFWorkspace_localPreview ws of   Nothing -> ws-  Just (shep, shift, undollama) -> r_1 where+  Just (_, _, undollama) -> r_1 where     newstack = moveLlamaStackDone undollama (_owlPFWorkspace_llamaStack ws)     r_1 = ws {          _owlPFWorkspace_llamaStack = newstack 

@@ -55,6 +55,7 @@ previewOperation_toUndoFirst :: PreviewOperation -> Bool previewOperation_toUndoFirst po = case po of   PO_Start -> False+  PO_CommitAndStart -> False   PO_Continue -> True   PO_StartAndCommit -> False   PO_ContinueAndCommit -> True

@@ -18,6 +18,7 @@   , printRenderedCanvasRegion   , potatoRenderWithOwlTree   , potatoRenderPFState+  , renderedCanvasRegion_getAt   , renderedCanvasToText   , renderedCanvasRegionToText @@ -43,7 +44,6 @@ import Potato.Flow.Owl import           Potato.Flow.Controller.Types import           Potato.Flow.Controller.OwlLayers-import           Potato.Flow.Methods.LineTypes   import qualified Data.IntMap             as IM@@ -72,6 +72,7 @@     r = fmap (,hidden) $ owlTree_findSuperOwl ot rid   sortForRendering (ot,_) sowls = sortForRendering ot sowls + -- RenderContext is a helper container type that provides both read and write data for various render operations data RenderContext = RenderContext {   _renderContext_cache :: RenderCache -- r/w@@ -95,13 +96,8 @@   hasOwlTree_owlTree = hasOwlTree_owlTree . _renderContext_owlTree  instance OwlRenderSet RenderContext where-  findSuperOwl RenderContext {..} rid = findSuperOwl (_renderContext_owlTree, _renderContext_layerMetaMap) rid-  sortForRendering RenderContext {..} sowls = sortForRendering (_renderContext_owlTree, _renderContext_layerMetaMap) sowls----emptyChar :: PChar-emptyChar = ' '+  findSuperOwl RenderContext {..} = findSuperOwl (_renderContext_owlTree, _renderContext_layerMetaMap)+  sortForRendering RenderContext {..} = sortForRendering (_renderContext_owlTree, _renderContext_layerMetaMap)   -- TODO for selection rendering you want to make it V.Vector (Maybe PChar) or maybe you can just use a map?@@ -227,6 +223,9 @@ renderedCanvasToText rcr = renderedCanvasRegionToText (_renderedCanvasRegion_box rcr) rcr  +renderedCanvasRegion_getAt :: RenderedCanvasRegion -> V2 Int -> MWidePChar+renderedCanvasRegion_getAt rcr = (V.!) (_renderedCanvasRegion_contents rcr) . toIndex (_renderedCanvasRegion_box rcr)+ -- TODO this does not handle wide chars at all fack -- | assumes region LBox is strictly contained in _renderedCanvasRegion_box renderedCanvasRegionToText :: LBox -> RenderedCanvasRegion -> Text@@ -326,14 +325,21 @@     Just aabb -> r where       rids = broadPhase_cull aabb (_broadPhaseState_bPTree _renderContext_broadPhase) +      -- NOTE you could just call findSuperOwlForRendering here but you wouldn't get the error+      getSowlFromContext :: REltId -> Maybe SuperOwl+      getSowlFromContext rid = case findSuperOwl rctx rid of+        Nothing -> error "this should never happen, because broadPhase_cull should only give existing seltls"+        -- changes could indicate hidden, if that's the case, give a dummy object to render+        Just (sowl, hidden) -> if hidden then Nothing else Just sowl+       msowls = flip fmap rids $ \rid -> case IM.lookup rid cslmap of-        Nothing -> case findSuperOwl _renderContext_owlTree rid of-          Nothing -> error "this should never happen, because broadPhase_cull should only give existing seltls"-          -- changes could indicate hidden, if that's the case, give a dummy object to render-          Just (sowl, hidden) -> if hidden then Nothing else Just sowl+        Nothing -> getSowlFromContext rid          Just msowl -> case msowl of           Nothing -> error "this should never happen, because deleted seltl would have been culled in broadPhase_cull"-          Just sowl -> Just sowl+          -- this way is a little more performant but doesn't cover the edge case where an element got moved into a hidden folder (you need to set msowl to Nothing outside of this function)+          --Just sowl -> Just sowl+          Just _ -> getSowlFromContext rid+       sowls = sortForRendering _renderContext_owlTree $ Seq.fromList (catMaybes msowls)       sortedrids = fmap _superOwl_id $ toList sowls       r = render_new aabb sortedrids rctx

@@ -13,7 +13,6 @@   import qualified Data.IntMap             as IM-import qualified Data.Text.IO as T import qualified Data.Vector.Unboxed     as V import Control.Exception (assert) 

@@ -74,7 +74,7 @@   show = superStyle_toListFormat  superStyle_fromListFormat :: [PChar] -> SuperStyle-superStyle_fromListFormat chars = assert (l == 7 || l == 8) $ r where+superStyle_fromListFormat chars = assert (l == 6 || l == 7) $ r where   l = length chars   r = SuperStyle {     _superStyle_tl = Just $ chars L.!! 0@@ -84,7 +84,7 @@     , _superStyle_vertical   = Just $ chars L.!! 4     , _superStyle_horizontal = Just $ chars L.!! 5     , _superStyle_point = Just $ chars L.!! 6-    , _superStyle_fill = if l == 7 then FillStyle_Blank else FillStyle_Simple (chars `debugBangBang` 7)+    , _superStyle_fill = if l == 6 then FillStyle_Blank else FillStyle_Simple (chars `debugBangBang` 6)   }  -- superStyle_fromListFormat "╔╗╚╝║═█" `shouldBe` def

@@ -67,6 +67,7 @@   + type LayerPos = Int type REltIdMap a = IM.IntMap a type SuperSEltLabel = (REltId, LayerPos, SEltLabel)

@@ -13,6 +13,8 @@ import           Potato.Data.Text.Unicode  +doubleWidthChars :: String+doubleWidthChars = "ｔｈｅｒｅ　ａｒｅ　ｎｏ　ｓｐａｃｅ　ｂｅｔｗｅｅｎ　ａｄｊａｃｅｎｔ　ｃｈａｒａｃｔｅｒｓ"  spec :: Spec spec = describe "Unicode" $ do@@ -36,3 +38,6 @@   it "containsGraphemeCluster" $ do     containsGraphemeCluster "👎👎👎👎👎" `shouldBe` False     containsGraphemeCluster "👎👎👎🏿👎👎👎" `shouldBe` True+  forM_ doubleWidthChars $ \c -> do+    it ("getCharWidth " <> show c) $ do+      getCharWidth c `shouldBe` 2

@@ -85,7 +85,9 @@       dl1 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu\n\n\naoeu")       dl2 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "\n\n\naoeu")       dl3 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu\n\n\n")+      dl4 = displayLinesWithAlignment TextAlignment_Right 10 () () empty +     insertcharnewlinesentence `shouldBe` fromText newlineSentence      -- NOTE last " " is the generated cursor span char@@ -93,7 +95,14 @@     _displayLines_spans dl1 `shouldBe` makespans [["aoeu"],[""],[""],["aoeu", ""]]     _displayLines_spans dl2 `shouldBe` makespans [[""],[""],[""],["aoeu", ""]]     _displayLines_spans dl3 `shouldBe` makespans [["aoeu"],[""],[""],[""]]-    +    _displayLines_spans dl4 `shouldBe` makespans [[""]]++  it "displayLinesWithAlignment - cursor tag" $ do +    let+      dl0 = displayLinesWithAlignment TextAlignment_Right 10 0 1 (fromText "abc")+      dl1 = displayLinesWithAlignment TextAlignment_Right 10 0 1 empty+    _displayLines_spans dl0 `shouldBe` [[Span 0 "abc", Span 1 ""]]+    _displayLines_spans dl1 `shouldBe` [[Span 1 ""]]     it "displayLines - cursorPos" $ do

@@ -9,8 +9,6 @@ import           Test.Hspec  import           Potato.Flow.Attachments-import Potato.Flow.Methods.LineDrawer-import Potato.Flow.Methods.LineTypes import           Potato.Flow.Math import Potato.Flow.Serialization.Snake 

@@ -0,0 +1,47 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Controller.GeneralSpec (+  spec+) where++import           Relude                                         hiding (empty,+                                                                 fromList)++import           Test.Hspec++import           Potato.Flow.GoatTester++import           Potato.Flow+import           Potato.Flow.Controller.Manipulator.TestHelpers++verifyHasUnsavedChanges :: Bool -> GoatTester ()+verifyHasUnsavedChanges b = do+  gs <- getGoatState+  let b' = goatState_hasUnsavedChanges gs+  verify "has unsaved changes" $ if b' == b then Nothing else Just $ "expected " <> show b <> " got " <> show b'++has_unsaved_changes_basic :: Spec+has_unsaved_changes_basic = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do+  setMarker "draw a box"+  drawCanvasBox (0,0,10,10)+  verifyHasUnsavedChanges True++  setMarker "save"+  markSaved+  verifyHasUnsavedChanges False++  setMarker "undo"+  pressUndo +  verifyHasUnsavedChanges True++  setMarker "redo"+  pressRedo+  verifyHasUnsavedChanges False+++spec :: Spec+spec = do+  describe "General" $ do+    describe "has_unsaved_changes_basic" $ has_unsaved_changes_basic+

@@ -13,7 +13,6 @@ import           Potato.Flow.GoatTester  import           Potato.Flow-import           Potato.Flow.Common import           Potato.Flow.Controller.Manipulator.TestHelpers  

@@ -11,14 +11,13 @@ import           Test.Hspec  import           Potato.Flow.GoatTester- import           Potato.Flow import           Potato.Flow.Controller.Manipulator.TestHelpers -import qualified Data.List                                      as L import qualified Data.Sequence as Seq  + someFolderName :: Text someFolderName = "testfolder" @@ -32,7 +31,21 @@ verifyLayersCount n =  verifyState ("layers count is " <> show n) $ \s -> if (countentriesfn s) == n then Nothing else Just $ "expected " <> show n <> " elts, got " <> show (countentriesfn s)   where countentriesfn = Seq.length . _layersState_entries . _goatState_layersState +verifyNthEntryInLayersPropertyIs :: (Show a, Eq a) => Int -> (LayerEntry -> a) -> a -> GoatTester()+verifyNthEntryInLayersPropertyIs n f v = verifyState (show n <> " entry in layers has property " <> show v) $ vf where+  vf s = r where+    lentries = _layersState_entries . _goatState_layersState $ s+    mfirstentry = Seq.lookup n lentries+    r = case mfirstentry of+      Nothing -> Just $ "no " <> show n <> " entry in layers"+      Just lentry -> if firstentry == v then Nothing else Just $ "expected " <> show v <> ", got " <> show firstentry where+        firstentry = f lentry+ verifyNthEntryInLayersIs :: Int -> REltId -> GoatTester()+verifyNthEntryInLayersIs n rid = verifyNthEntryInLayersPropertyIs n (_superOwl_id . _layerEntry_superOwl) rid++{--+verifyNthEntryInLayersIs :: Int -> REltId -> GoatTester() verifyNthEntryInLayersIs n rid = verifyState (show n <> " entry in layers is " <> show rid) $ vf where   vf s = r where     lentries = _layersState_entries . _goatState_layersState $ s@@ -41,11 +54,16 @@       Nothing -> Just $ "no " <> show n <> " entry in layers"       Just lentry -> if firstentry == rid then Nothing else Just $ "expected REltId " <> show rid <> ", got " <> show firstentry where         firstentry = _superOwl_id . _layerEntry_superOwl $ lentry+--}  verifyFirstEntryInLayersIs :: REltId -> GoatTester() verifyFirstEntryInLayersIs = verifyNthEntryInLayersIs 0      +verifyNthEntryInLayersHasDepth :: Int -> Int -> GoatTester()+verifyNthEntryInLayersHasDepth n d = verifyNthEntryInLayersPropertyIs n layerEntry_depth d++ create_select_test :: Spec create_select_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do @@ -63,7 +81,36 @@   layerMouseDownUp (5,0)   verifyFolderSelected someFolderName +shift_select_test :: Spec+shift_select_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do +  let xoff = 10++  setMarker "draw several boxes"+  forM_ [0..9] $ \_ -> drawCanvasBox (0, 0, 100, 100)+  verifyOwlCount 10+  pressEscape+  verifySelectionCount 0++  setMarker "shift select some stuff"+  forM_ [0..9] $ \n -> layerMouseDownUpWithModifier (xoff, n) KeyModifier_Shift+  verifySelectionCount 10+  +  setMarker "shift unselect stuff"+  layerMouseDownUpWithModifier (xoff, 5) KeyModifier_Shift+  verifySelectionCount 9+  layerMouseDownUpWithModifier (xoff, 8) KeyModifier_Shift+  verifySelectionCount 8+  +  setMarker "regular select one already selected element"+  layerMouseDownUp (xoff, 2)+  verifySelectionCount 1+  +  setMarker "deselect everything"+  pressEscape+  verifySelectionCount 0++ rename_focus_clickCanvas_test :: Spec rename_focus_clickCanvas_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do @@ -332,10 +379,75 @@     +drag_folder_depth_test :: Spec+drag_folder_depth_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  setMarker "setup scene"+  drawCanvasBox (0,0,10,10) -- 1+  addFolder someFolderName -- 2+  addFolder someFolderName -- 3+  addFolder someFolderName -- 4+  addFolder someFolderName -- 5+  addFolder someFolderName -- 6+  addFolder someFolderName -- 7+  addFolder someFolderName -- 8++  -- 2testfolder+  --   3testfolder+  --     4testfolder+  --       5testfolder+  --         6testfolder+  --           7testfolder+  --             8testfolder+  -- 1<box>++  setMarker "drag the box into the 8th folder"+  layerMouseDownUpRel LMO_Normal 7 0+  layerMouseDownRel LMO_Normal 7 0+  -- we are outside of the last folder so we need to drag above ourselves+  layerMouseDownUpRel (LMO_DropInFolder 0) 7 7+  verifyNthEntryInLayersIs 7 1+  verifyNthEntryInLayersHasDepth 7 7++  -- 2testfolder+  --   3testfolder+  --     4testfolder+  --       5testfolder+  --         6testfolder+  --           7testfolder+  --             8testfolder+  --               1<box>++  setMarker "deselect"+  pressEscape++  setMarker "drag the box into the 5th folder"+  layerMouseDownUpRel LMO_Normal 7 7+  layerMouseDownRel LMO_Normal 7 7++  -- we are inside the last folder, we are dragging BELOW ourselves+  layerMouseDownUpRel (LMO_DropInFolder (-3)) 8 7+  verifyNthEntryInLayersIs 7 1+  verifyNthEntryInLayersHasDepth 7 4++++  -- 2testfolder+  --   3testfolder+  --     4testfolder+  --       5testfolder+  --         6testfolder+  --           7testfolder+  --             8testfolder+  --         1<box>+++ spec :: Spec spec = do   describe "Layers" $ do     describe "create_select_test" $ create_select_test+    describe "shift_select_test" $ shift_select_test     describe "rename_focus_clickCanvas_test" $ rename_focus_clickCanvas_test      describe "rename_focus_setFocus_test canvas" $ rename_focus_setFocus_test GoatFocusedArea_Canvas     describe "rename_focus_setFocus_test other" $ rename_focus_setFocus_test GoatFocusedArea_Other@@ -345,3 +457,4 @@     describe "lock_or_hide_select_test lock" $ lock_or_hide_select_test LMO_Lock     describe "drag_folder_test" $ drag_folder_test     describe "drag_folder2_test" $ drag_folder2_test+    describe "drag_folder_depth_test" $ drag_folder_depth_test

@@ -565,7 +565,8 @@     describe "midpoint_modify_basic" $  midpoint_modify_basic_test     describe "midpoint_double_adjacent_delete" $  midpoint_double_adjacent_delete_test     describe "attaching_delete_test" $ attaching_delete_test-    describe "attaching_fully_attached_wont_move_test" $ attaching_fully_attached_wont_move_test+    -- TODO reenable once you fix the issue in Box.hs -- THE REASON YOU DID THIS IS TO PREVENT FULLY ATTACHED LINES FROM BEING MOVED+    --describe "attaching_fully_attached_wont_move_test" $ attaching_fully_attached_wont_move_test     describe "label_undo_test" $ label_undo_test      describe "label_cursor_test" $ label_cursor_test

@@ -16,7 +16,7 @@   let     f sowl = case _superOwl_elt sowl of       OwlItem _ (OwlSubItemBox _) -> Nothing-      x                           -> Just ("expected box, got " <> show x)+      xx                           -> Just ("expected box, got " <> show xx)   verifySelectionIsAndOnlyIs "box is selected" f  

@@ -284,26 +284,6 @@      ] --- TODO FINISH-everything_newfolder_test :: Test-everything_newfolder_test = constructTest "new folder" owlpfstate_basic1 bs expected where-  bs = [-      EWCLabel "New Folder (no selection)"-      , EWCNewFolder--      , EWCLabel "New Folder (with selection)"-      -- TODO open up some folder, and select some stuff-      --, EWCNewFolder-    ]-  expected = [-      LabelCheck "New Folder (no selection)"-      , firstSelectedSuperOwlPredicate (Just "<folder>") (\sowl -> case hasOwlItem_toSElt_hack sowl of-        SEltFolderStart -> True-        _                                        -> False)--      , LabelCheck "New Folder (with selection)"-    ]- moveOffset :: Int moveOffset = 100 

@@ -238,8 +238,23 @@   layerMouseDown (x,y)   layerMouseUp (x,y) -data LayerMouseOp = LMO_Collapse | LMO_Hide | LMO_Lock | LMO_Normal deriving (Show, Eq) +layerMouseDownWithModifier :: (Monad m) =>  (Int, Int) -> KeyModifier -> GoatTesterT m ()+layerMouseDownWithModifier (x,y) modifier = mouse False False [modifier] MouseButton_Left (V2 x y)++layerMouseUpWithModifier :: (Monad m) =>  (Int, Int) -> KeyModifier -> GoatTesterT m ()+layerMouseUpWithModifier (x,y) modifier = mouse False True [modifier] MouseButton_Left (V2 x y)++layerMouseDownUpWithModifier :: (Monad m) =>  (Int, Int) -> KeyModifier -> GoatTesterT m ()+layerMouseDownUpWithModifier (x,y) modifier = do+  layerMouseDownWithModifier (x,y) modifier +  layerMouseUpWithModifier (x,y) modifier+++data LayerMouseOp = LMO_Collapse | LMO_Hide | LMO_Lock | LMO_Normal +  | LMO_DropInFolder Int -- desired position relative to depth+  deriving (Show, Eq)+ layerMouseRel' :: (Monad m) => Bool -> LayerMouseOp -> Int -> Int -> GoatTesterT m () layerMouseRel' isup op y' depth = do   scrollPos <- (_layersState_scrollPos . _goatState_layersState . _goatTesterState_goatState) <$> get@@ -249,6 +264,7 @@       LMO_Hide     -> 1       LMO_Lock     -> 2       LMO_Normal -> 3+      LMO_DropInFolder rel -> rel     y = y' - scrollPos     x = x' + depth   putRecord "validate y pos" (if y < 0 then Just ("y: " <> show y <> " outside of scroll position: " <> show scrollPos) else Nothing)@@ -263,11 +279,13 @@ layerMouseUpRel = layerMouseRel' True  layerMouseDownUpRel :: (Monad m) => LayerMouseOp -> Int -> Int -> GoatTesterT m ()-layerMouseDownUpRel op x y = do-  layerMouseDownRel op x y-  layerMouseUpRel op x y+layerMouseDownUpRel op y depth = do+  layerMouseDownRel op y depth+  layerMouseUpRel op y depth  ++ pressKeyboardKey :: (Monad m) => KeyboardKey -> GoatTesterT m () pressKeyboardKey k = runEndo $ endoGoatCmdKeyboard (KeyboardData k []) @@ -352,6 +370,26 @@       then Just $ "failed, expected 1 selected 🦉, got " <> show nselection       else (\m -> "failed with message: " <> m <> "\ngot:\n" <> potatoShow (_superOwl_elt sowl)) <$> f sowl +++verifyRenderNonEmptyCount :: (Monad m) => Int -> GoatTesterT m ()+verifyRenderNonEmptyCount expected = verifyState "verifyRenderNonEmptyCount" f where+  f gs = if n == expected+    then Nothing+    else Just $ "got " <> show n <> " non-empty chars, expected " <> show expected+    where n =  renderedCanvasRegion_nonEmptyCount (_goatState_renderedCanvas gs)++verifyCharRenderedAt :: (Monad m) => V2 Int -> Maybe Char -> GoatTesterT m ()+verifyCharRenderedAt pos mchar = verifyState "verifyCharRenderedAt" f where+  f gs = if mchar == mchar'+    then Nothing+    else Just $ "expected: " <> show mchar <> "\ngot: " <> show mchar'+    where+      mchar' = case renderedCanvasRegion_getAt (_goatState_renderedCanvas gs) pos of+        (-1, _) -> Nothing+        (_, c) -> Just c++ -- otheruseful stuff  -- export as part of this module becaues it's super useful@@ -364,3 +402,16 @@ alwaysFail :: (Monad m) => Text -> GoatTesterT m () alwaysFail msg = GoatTesterT $ do   unGoatTesterT $ putRecord "this test always fails" (Just msg)+++debugFailWithLayers :: (Monad m) => GoatTesterT m ()+debugFailWithLayers = do+  gs <- getGoatState+  putRecord "debugFailWithLayers" (Just $ potatoShow $ _goatState_layersState gs)++debugFailWithRenderedCanvas :: (Monad m) => GoatTesterT m ()+debugFailWithRenderedCanvas = do+  gs <- getGoatState+  let+    canvas = _goatState_renderedCanvas gs+  putRecord "debugFailWithRenderedCanvas" (Just $ renderedCanvasToText canvas)

@@ -7,7 +7,7 @@  import           Test.Hspec -import Potato.Flow.Llama+--import Potato.Flow.Llama  spec :: Spec spec = do

@@ -131,7 +131,7 @@       fmap fst3 (getSortedSAutoLineLabelPositions owlpfstate_zero someSAutoLine_withLabels) `shouldBe` [V2 0 0, V2 25 0, V2 50 0]  -  describe "Lines - rendering" $ it "autorendercase" $ forM_ generateTestCases $ \pfs -> do+  describe "Lines - rendering" $ it "autorendercase" $ forM_ generateTestCases $ \_ -> do     --putTextLn (renderedCanvasToText (potatoRenderPFState pfs))     True `shouldBe` True 

@@ -14,7 +14,10 @@  import           Potato.Flow import           Potato.Flow.TestStates+import Potato.Flow.GoatTester+import           Potato.Flow.Controller.Manipulator.TestHelpers + testCanvas :: Int -> Int -> Int -> Int -> RenderedCanvasRegion testCanvas x y w h = emptyRenderedCanvasRegion (LBox (V2 x y) (V2 w h)) @@ -33,8 +36,10 @@ testsstyle :: SuperStyle testsstyle = def { _superStyle_fill = FillStyle_Simple '@' } -spec :: Spec-spec = do+++spec1 :: Spec+spec1 = do   describe "Canvas" $ do     it "potato renders blank text" $ do       let@@ -164,3 +169,79 @@         canvas1 = _renderContext_renderedCanvasRegion rendercontext1       -- TODO test something       canvas1 `shouldBe` canvas1+++emptyOwlStateWithSize :: (Int, Int) -> OwlPFState+emptyOwlStateWithSize (x, y) = OwlPFState emptyOwlTree (SCanvas (LBox 0 (V2 x y)))++render_basic :: Spec+render_basic = hSpecGoatTesterWithOwlPFState (emptyOwlStateWithSize (20,20)) $ do++  setMarker "verify empty initial state"+  verifyRenderNonEmptyCount 0++  setMarker "draw a box"+  drawCanvasBox (0, 0, 2, 2)+  verifyRenderNonEmptyCount 4++  setMarker "hide the box"+  layerMouseDownUpRel LMO_Hide 0 0+  verifyRenderNonEmptyCount 0++  setMarker "unhide the box"+  layerMouseDownUpRel LMO_Hide 0 0+  verifyRenderNonEmptyCount 4++  setMarker "delete the box"+  pressBackspace+  verifyRenderNonEmptyCount 0+++render_hide_basic :: Spec+render_hide_basic = hSpecGoatTesterWithOwlPFState (emptyOwlStateWithSize (20,20)) $ do++  setMarker "verify empty initial state"+  verifyRenderNonEmptyCount 0++  setMarker "make a folder"+  addFolder "hide me"++  setMarker "draw a box"+  drawCanvasBox (0, 0, 2, 2)+  verifyRenderNonEmptyCount 4++  setMarker "hide the folder"+  layerMouseDownUpRel LMO_Hide 0 0+  verifyRenderNonEmptyCount 0++  setMarker "deselect evertyhing"+  pressEscape+  verifySelectionCount 0++  setMarker "drag the box out of the folder"+  layerMouseDownUpRel LMO_Normal 1 1+  verifySelectionCount 1+  layerMouseDownRel LMO_Normal 1 1+  layerMouseDownUpRel (LMO_DropInFolder 0) 2 0+  verifyRenderNonEmptyCount 4++  setMarker "drag the box into the folder"+  layerMouseDownRel LMO_Normal 1 0+  layerMouseDownUpRel (LMO_DropInFolder 0) 1 1+  verifyRenderNonEmptyCount 0++  +++spec2 :: Spec+spec2 = do+  describe "Render" $ do+    describe "render_basic" $ render_basic+    describe "render_hide_basic" $ render_hide_basic++++spec :: Spec+spec = do+  spec1+  spec2

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           tinytools-version:        0.1.0.5+version:        0.1.0.6 description:    tinytools is a mono-space unicode diagram editor homepage:       https://github.com/minimapletinytools/tinytools#readme bug-reports:    https://github.com/minimapletinytools/tinytools/issues@@ -17,6 +17,7 @@     README.md     ChangeLog.md +Tested-With: GHC ==9.2.5  source-repository head   type: git@@ -115,8 +116,7 @@       NoImplicitPrelude   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-ignore-asserts   build-depends:-      MonadRandom-    , aeson+    aeson     , aeson-pretty     , base >=4.7 && <5     , bimap@@ -131,15 +131,11 @@     , dependent-sum     , dependent-sum-template     , extra-    , hashable     , ilist     , lens     , linear-    , listsafe     , mtl-    , patch     , pretty-simple-    , random-shuffle     , ref-tf     , reflex >= 0.9.2 && < 1     , reflex-potatoes >=0.1@@ -169,6 +165,7 @@       Potato.Flow.Controller.Manipulator.LayersSpec       Potato.Flow.Controller.Manipulator.LineSpec       Potato.Flow.Controller.Manipulator.PanSpec+      Potato.Flow.Controller.GeneralSpec       Potato.Flow.Controller.Manipulator.TestHelpers       Potato.Flow.Deprecated.Controller.EverythingWidgetSpec       Potato.Flow.Deprecated.Controller.LayersSpec@@ -230,7 +227,6 @@   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts   build-depends:       HUnit-    , MonadRandom     , aeson     , base >=4.7 && <5     , bimap@@ -245,17 +241,13 @@     , dependent-sum     , dependent-sum-template     , extra-    , hashable     , hspec     , hspec-contrib     , ilist     , lens     , linear-    , listsafe     , mtl-    , patch     , pretty-simple-    , random-shuffle     , ref-tf     , reflex >= 0.9.2 && < 1     , reflex-potatoes >=0.1@@ -268,4 +260,5 @@     , tinytools     , vector     , vty+  build-tool-depends: hspec-discover:hspec-discover   default-language: Haskell2010