packages feed

tinytools (empty) → 0.1.0.0

raw patch · 86 files changed

+17990/−0 lines, 86 filesdep +HUnitdep +MonadRandomdep +aesonsetup-changed

Dependencies added: HUnit, MonadRandom, aeson, base, bimap, binary, bytestring, constraints-extras, containers, data-default, data-ordlist, deepseq, dependent-map, dependent-sum, dependent-sum-template, extra, hashable, hspec, hspec-contrib, ilist, lens, linear, listsafe, mtl, patch, pretty-simple, random-shuffle, ref-tf, reflex, reflex-potatoes, reflex-test-host, relude, semialign, template-haskell, text, text-icu, these, tinytools, vector, vty

Files

+ ChangeLog.md view
@@ -0,0 +1,7 @@+# Changelog++## [Unreleased]++## [0.0.1]+### Added+- tinytools
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,50 @@+[![CircleCI](https://circleci.com/gh/pdlla/potato-flow.svg?style=svg)](https://circleci.com/gh/pdlla/potato-flow)++# potato-illustrator+`potato-illustrator` is a mono-space text flow-chart editor written in Haskell. It is currently a work in progress and an ALPHA release should be available soon.++# architecture+`potato-illustrator` is written using [reflex](https://github.com/reflex-frp/reflex) and follows a strict MVC architecture. This repository contains the platform-independent model and controller.+The View is connected to the reflex interface defined by `GoatWidget`.++[potato-illustrator-vty](https://github.com/pdlla/potato-illustrator-vty) is currently the only view implementation. It is written in [reflex-vty](https://github.com/reflex-frp/reflex-vty) and runs in a terminal yay. Please see [potato-illustrator-vty](https://github.com/pdlla/potato-illustrator-vty) if you'd like to try it out.++# features (completed)+- sophisticated hierarchical layer system+- transactional operations and change history+- several configurable primitives including boxes, lines and text boxes++# roadmap++## alpha+- save/load/export interface+- multi-segment line input+- free form text-area input++## v1+- UNICODE wide character support+- UNICODE glyph widget++## v2+- attached line support+- multi-document support+- refactor handle non-linear action do/undo operations in preparation for multi-user mode++## v3+- graphene clusters support+- multi-user mode+  - ordering service interface+  - basic single client authoritative implementation of ordering service interface (for now)+- scripting+++# Contribution Guide++Help wanted! I will of course review any PR. For large or small ideas, it would be best to drop me an email first at chippermonky at gmail dot com++Below are a list of tasks that I think would be extra good projects to work on++- CI scripts for creating binary releases+- UNICODE wide character support+- add text selection support to current `TextZipper` implementation+- refactoring 😑
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Potato/Data/Text/Unicode.hs view
@@ -0,0 +1,67 @@++module Potato.Data.Text.Unicode where++import           Prelude++import Graphics.Text.Width (wcwidth)++import Data.Int +import qualified Data.Text.ICU as ICU+import qualified Data.Text as T+import Data.Text (Text)+import qualified Potato.Data.Text.Zipper as TZ++++-- NOTE this function won't work as expected until you've loaded a termal char width file via vty!+getCharWidth :: Char -> Int8+getCharWidth = fromIntegral . TZ.charWidth++removeWideChars :: Text -> Text+removeWideChars = T.filter (\c -> getCharWidth c <= 1) ++internal_getCharacterBreaks :: Text -> [ICU.Break ()]+internal_getCharacterBreaks input = r where +  breaker = ICU.breakCharacter ICU.Current +  r = ICU.breaks breaker input++zwidge :: Char+zwidge = '\8205'++-- | True if the Text is a single grapheme cluster, False otherwise+isSingleGraphemeCluster :: Text -> Bool+isSingleGraphemeCluster input = r where+  tbreaks = internal_getCharacterBreaks input+  r = case tbreaks of +    -- no characters, not a grapheme cluster+    [] -> False +    -- only one break, it's a grapheme cluster if it has more than one unicode char in it+    (b:[]) -> T.length (ICU.brkBreak b) > 1+    -- more than one character break+    _ -> False ++-- | True if the last character in the text is a single grapheme cluster, False otherwise+endsInGraphemeCluster :: Text -> Bool+endsInGraphemeCluster input = r where+  tbreaks' = internal_getCharacterBreaks input+  gotoend tbreaks = case tbreaks of +    [] -> False+    (b:[]) -> isSingleGraphemeCluster (ICU.brkBreak b)+    (_:bs) -> gotoend bs+  r = gotoend tbreaks'++-- most terminals do not support grapheme clusters right now :( 👎🏻👎🏼👎🏽👎🏾👎🏿+-- | removes grapheme clusters from the text and replaces them with the first character in the cluster+removeGraphemeCluster :: Text -> Text+removeGraphemeCluster input = r where+  tbreaks = internal_getCharacterBreaks input+  -- if there is more than one character in the break then it must have been a grapheme cluster+  -- so just use the first character+  fmapfn b = case T.uncons (ICU.brkBreak b) of+    Nothing -> ""+    Just (c, _) -> T.singleton c+  r = mconcat $ fmap fmapfn tbreaks++-- | True if the input text contains a grapheme cluster+containsGraphemeCluster :: Text -> Bool+containsGraphemeCluster input = removeGraphemeCluster input /= input
+ src/Potato/Data/Text/Zipper.hs view
@@ -0,0 +1,545 @@+{-|+Module: Data.Text.Zipper+Description: A zipper for text documents that allows convenient editing and navigation++'TextZipper' is designed to be help manipulate the contents of a text input field. It keeps track of the logical lines of text (i.e., lines separated by user-entered newlines) and the current cursor position. Several functions are defined in this module to navigate and edit the TextZipper from the cursor position.++'TextZipper's can be converted into 'DisplayLines', which describe how the contents of the zipper will be displayed when wrapped to fit within a container of a certain width. It also provides some convenience facilities for converting interactions with the rendered DisplayLines back into manipulations of the underlying TextZipper.++-}+module Potato.Data.Text.Zipper where++import           Prelude++import Control.Exception (assert)+import Control.Monad.State (evalState, forM, get, put)+import Data.Char (isSpace)+import Data.Map (Map)+import Data.Maybe (fromMaybe)+import Data.String+import Data.Text (Text)+import Data.Text.Internal (Text(..), text)+import Data.Text.Internal.Fusion (stream)+import Data.Text.Internal.Fusion.Types (Stream(..), Step(..))+import Data.Text.Unsafe+import qualified Data.List as L+import qualified Data.Map as Map+import qualified Data.Text as T++import Graphics.Text.Width (wcwidth)+++-- | A zipper of the logical text input contents (the "document"). The lines+-- before the line containing the cursor are stored in reverse order.+-- The cursor is logically between the "before" and "after" text.+-- A "logical" line of input is a line of input up until a user-entered newline+-- character (as compared to a "display" line, which is wrapped to fit within+-- a given viewport width).+data TextZipper = TextZipper+  { _textZipper_linesBefore :: [Text] -- reversed+  , _textZipper_before :: Text+  , _textZipper_after :: Text -- The cursor is on top of the first character of this text+  , _textZipper_linesAfter :: [Text]+  }+  deriving (Show, Eq)++instance IsString TextZipper where+  fromString = fromText . T.pack++-- | Map a replacement function over the characters in a 'TextZipper'+mapZipper :: (Char -> Char) -> TextZipper -> TextZipper+mapZipper f (TextZipper lb b a la) = TextZipper+  { _textZipper_linesBefore = fmap (T.map f) lb+  , _textZipper_before = T.map f b+  , _textZipper_after = T.map f a+  , _textZipper_linesAfter = fmap (T.map f) la+  }++-- | Move the cursor left one character, if possible+left :: TextZipper -> TextZipper+left = leftN 1++-- | Move the cursor left by the given number of characters, or, if the document+-- isn't long enough, to the beginning of the document+leftN :: Int -> TextZipper -> TextZipper+leftN n z@(TextZipper lb b a la) =+  if T.length b >= n+    then+      let n' = T.length b - n+      in  TextZipper lb (T.take n' b) (T.drop n' b <> a) la+    else case lb of+           [] -> home z+           (l:ls) -> leftN (n - T.length b - 1) $ TextZipper ls l "" ((b <> a) : la)++-- | Move the cursor right one character, if possible+right :: TextZipper -> TextZipper+right = rightN 1++-- | Move the character right by the given number of characters, or, if the document+-- isn't long enough, to the end of the document+rightN :: Int -> TextZipper -> TextZipper+rightN n z@(TextZipper lb b a la) =+  if T.length a >= n+    then TextZipper lb (b <> T.take n a) (T.drop n a) la+    else case la of+           [] -> end z+           (l:ls) -> rightN (n - T.length a - 1) $ TextZipper ((b <> a) : lb) "" l ls++-- | Move the cursor up one logical line, if possible+up :: TextZipper -> TextZipper+up z@(TextZipper lb b a la) = case lb of+  [] -> z+  (l:ls) ->+    let (b', a') = T.splitAt (T.length b) l+    in TextZipper ls b' a' ((b <> a) : la)++-- | Move the cursor down one logical line, if possible+down :: TextZipper -> TextZipper+down z@(TextZipper lb b a la) = case la of+  [] -> z+  (l:ls) ->+    let (b', a') = T.splitAt (T.length b) l+    in TextZipper ((b <> a) : lb) b' a' ls++-- | Move the cursor up by the given number of lines+pageUp :: Int -> TextZipper -> TextZipper+pageUp pageSize z = if pageSize <= 0+  then z+  else pageUp (pageSize - 1) $ up z++-- | Move the cursor down by the given number of lines+pageDown :: Int -> TextZipper -> TextZipper+pageDown pageSize z = if pageSize <= 0+  then z+  else pageDown (pageSize - 1) $ down z++-- | Move the cursor to the beginning of the current logical line+home :: TextZipper -> TextZipper+home (TextZipper lb b a la) = TextZipper lb "" (b <> a) la++-- | Move the cursor to the end of the current logical line+end :: TextZipper -> TextZipper+end (TextZipper lb b a la) = TextZipper lb (b <> a) "" la++-- | Move the cursor to the top of the document+top :: TextZipper -> TextZipper+top (TextZipper lb b a la) = case reverse lb of+  [] -> TextZipper [] "" (b <> a) la+  (start:rest) -> TextZipper [] "" start (rest <> [b <> a] <> la)++-- | Insert a character at the current cursor position+insertChar :: Char -> TextZipper -> TextZipper+insertChar i = insert (T.singleton i)++-- | Insert text at the current cursor position+insert :: Text -> TextZipper -> TextZipper+insert i z@(TextZipper lb b a la) = case T.split (=='\n') i of+  [] -> z+  (start:rest) -> case reverse rest of+    [] -> TextZipper lb (b <> start) a la+    (l:ls) -> TextZipper (ls <> [b <> start] <> lb) l a la++-- | Delete the character to the left of the cursor+deleteLeft :: TextZipper-> TextZipper+deleteLeft z@(TextZipper lb b a la) = case T.unsnoc b of+  Nothing -> case lb of+    [] -> z+    (l:ls) -> TextZipper ls l a la+  Just (b', _) -> TextZipper lb b' a la++-- | Delete the character under/to the right of the cursor+deleteRight :: TextZipper -> TextZipper+deleteRight z@(TextZipper lb b a la) = case T.uncons a of+  Nothing -> case la of+    [] -> z+    (l:ls) -> TextZipper lb b l ls+  Just (_, a') -> TextZipper lb b a' la++-- | Delete a word to the left of the cursor. Deletes all whitespace until it+-- finds a non-whitespace character, and then deletes contiguous non-whitespace+-- characters.+deleteLeftWord :: TextZipper -> TextZipper+deleteLeftWord (TextZipper lb b a la) =+  let b' = T.dropWhileEnd isSpace b+  in  if T.null b'+        then case lb of+          [] -> TextZipper [] b' a la+          (l:ls) -> deleteLeftWord $ TextZipper ls l a la+        else TextZipper lb (T.dropWhileEnd (not . isSpace) b') a la++-- | Insert up to n spaces to get to the next logical column that is a multiple of n+tab :: Int -> TextZipper -> TextZipper+tab n z@(TextZipper _ b _ _) =+  insert (T.replicate (fromEnum $ n - T.length b `mod` max 1 n) " ") z++-- | The plain text contents of the zipper+value :: TextZipper -> Text+value (TextZipper lb b a la) = T.intercalate "\n" $ mconcat [ reverse lb+  , [b <> a]+  , la+  ]++-- | The empty zipper+empty :: TextZipper+empty = TextZipper [] "" "" []++-- | Constructs a zipper with the given contents. The cursor is placed after+-- the contents.+fromText :: Text -> TextZipper+fromText = flip insert empty++-- | A span of text tagged with some metadata that makes up part of a display+-- line.+data Span tag = Span tag Text+  deriving (Eq, Show)++-- | Text alignment type+data TextAlignment =+  TextAlignment_Left+  | TextAlignment_Right+  | TextAlignment_Center+  deriving (Eq, Show)++-- A map from the index (row) of display line to (fst,snd)+-- fst: leading empty spaces from left (may be negative) to adjust for alignment+-- snd: the text offset from the beginning of the document+-- to the first character of the display line+type OffsetMapWithAlignment = Map Int (Int, Int)++-- helper type representing a single visual line that may be part of a wrapped logical line+data WrappedLine = WrappedLine+  { _wrappedLines_text :: Text+  , _wrappedLines_hiddenWhitespace :: Bool -- ^ 'True' if this line ends with a deleted whitespace character+  , _wrappedLines_offset :: Int -- ^ offset from beginning of line+  }+  deriving (Eq, Show)++-- | Information about the document as it is displayed (i.e., post-wrapping)+data DisplayLines tag = DisplayLines+  { _displayLines_spans :: [[Span tag]]+  , _displayLines_offsetMap :: OffsetMapWithAlignment+  , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner+  }+  deriving (Eq, Show)++-- | Split a 'Text' at the given column index. For example+--+-- > splitAtWidth 3 "ᄀabc" == ("ᄀa", "bc")+--+-- because the first character has a width of two (see 'charWidth' for more on that).+splitAtWidth :: Int -> Text -> (Text, Text)+splitAtWidth n t@(Text arr off len)+    | n <= 0 = (T.empty, t)+    | n >= textWidth t = (t, T.empty)+    | otherwise = let k = toLogicalIndex n t+                  in (text arr off k, text arr (off+k) (len-k))++toLogicalIndex :: Int -> Text -> Int+toLogicalIndex n' t'@(Text _ _ len') = loop 0 0+  where loop !i !cnt+            | i >= len' || cnt + w > n' = i+            | otherwise = loop (i+d) (cnt + w)+          where Iter c d = iter t' i+                w = charWidth c++-- | Takes the given number of columns of characters. For example+--+-- > takeWidth 3 "ᄀabc" == "ᄀa"+--+-- because the first character has a width of 2 (see 'charWidth' for more on that).+-- This function will not take a character if its width exceeds the width it seeks to take.+takeWidth :: Int -> Text -> Text+takeWidth n = fst . splitAtWidth n++-- | Drops the given number of columns of characters. For example+--+-- > dropWidth 2 "ᄀabc" == "abc"+--+-- because the first character has a width of 2 (see 'charWidth' for more on that).+-- This function will not drop a character if its width exceeds the width it seeks to drop.+dropWidth :: Int -> Text -> Text+dropWidth n = snd . splitAtWidth n++-- | Get the display width of a 'Char'. "Full width" and "wide" characters+-- take two columns and everything else takes a single column. See+-- <https://www.unicode.org/reports/tr11/> for more information+-- This is implemented using wcwidth from Vty such that it matches what will+-- be displayed on the terminal. Note that this method can change depending+-- on how vty is configed. Please see vty documentation for details.+charWidth :: Char -> Int+charWidth = wcwidth++-- | Get the width of the text in a set of 'Span's, taking into account unicode character widths+spansWidth :: [Span tag] -> Int+spansWidth = sum . map (\(Span _ t) -> textWidth t)++-- | Get the length (number of characters) of the text in a set of 'Span's+spansLength :: [Span tag] -> Int+spansLength = sum . map (\(Span _ t) -> T.length t)++-- | Compute the width of some 'Text', taking into account fullwidth+-- unicode forms.+textWidth :: Text -> Int+textWidth t = widthI (stream t)++-- | Compute the width of a stream of characters, taking into account+-- fullwidth unicode forms.+widthI :: Stream Char -> Int+widthI (Stream next s0 _len) = loop_length 0 s0+    where+      loop_length !z s  = case next s of+                           Done       -> z+                           Skip    s' -> loop_length z s'+                           Yield c s' -> loop_length (z + charWidth c) s'+{-# INLINE[0] widthI #-}++-- | Compute the logical index position of a stream of characters from a visual+-- position taking into account fullwidth unicode forms.+charIndexAt :: Int -> Stream Char -> Int+charIndexAt pos (Stream next s0 _len) = loop_length 0 0 s0+    where+      loop_length i !z s  = case next s of+                           Done       -> i+                           Skip    s' -> loop_length i z s'+                           Yield c s' -> if w > pos then i else loop_length (i+1) w s' where+                             w = z + charWidth c+{-# INLINE[0] charIndexAt #-}+++++-- | Same as T.words except whitespace characters are included at end (i.e. ["line1 ", ...])+-- 'Char's representing white space.+wordsWithWhitespace :: Text -> [Text]+wordsWithWhitespace t@(Text arr off len) = loop 0 0 False+  where+    loop !start !n !wasSpace+        | n >= len = [Text arr (start+off) (n-start) | not (start == n)]+        | isSpace c = loop start (n+d) True+        | wasSpace = Text arr (start+off) (n-start) : loop n n False+        | otherwise = loop start (n+d) False+        where Iter c d = iter t n+{-# INLINE wordsWithWhitespace #-}++-- | Split words into logical lines, 'True' in the tuple indicates line ends with a whitespace character that got deleted+splitWordsAtDisplayWidth :: Int -> [Text] -> [(Text, Bool)]+splitWordsAtDisplayWidth maxWidth wwws = reverse $ loop wwws 0 [] where+  appendOut :: [(Text,Bool)] -> Text -> Bool -> [(Text,Bool)]+  appendOut [] t b           = [(t,b)]+  appendOut ((t',_):ts') t b = (t'<>t,b) : ts'++  -- remove the last whitespace in output+  modifyOutForNewLine :: [(Text,Bool)] -> [(Text,Bool)]+  modifyOutForNewLine [] = error "should never happen"+  modifyOutForNewLine ((t',_):ts) = case T.unsnoc t' of+    Nothing           -> error "should never happen"+    Just (t,lastChar) -> assert (isSpace lastChar) $ (t,True):ts -- assume last char is whitespace++  loop :: [Text] -> Int -> [(Text,Bool)] -> [(Text,Bool)]+  loop [] _ out = out+  loop (x:xs) cumw out = r where+    newWidth = textWidth x + cumw+    r = if newWidth > maxWidth+      -- TODO index out of bounds sometimes in the presence of widechars+      then if isSpace $ T.index x (toLogicalIndex (maxWidth - cumw) x)+        -- if line runs over but character of splitting is whitespace then split on the whitespace+        then let (t1,t2) = splitAtWidth (maxWidth - cumw) x+          in loop (T.drop 1 t2:xs) 0 [] <> appendOut out t1 True+        else if cumw == 0+          -- single word exceeds max width, so just split on the word+          then let (t1,t2) = splitAtWidth (maxWidth - cumw) x+            in loop (t2:xs) 0 [] <> appendOut out t1 False+          -- otherwise start a new line+          else loop (x:xs) 0 [] <> modifyOutForNewLine out+      else loop xs newWidth $ appendOut out x False++++-- | Wraps a logical line of text to fit within the given width. The first+-- wrapped line is offset by the number of columns provided. Subsequent wrapped+-- lines are not.+wrapWithOffsetAndAlignment+  :: TextAlignment+  -> Int -- ^ Maximum width+  -> Int -- ^ Offset for first line+  -> Text -- ^ Text to be wrapped+  -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line)+wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = []+wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where+  r' = splitWordsAtDisplayWidth maxWidth $ wordsWithWhitespace ( T.replicate n "." <> txt)+  fmapfn (t,b) = case alignment of+    TextAlignment_Left   -> WrappedLine t b 0+    TextAlignment_Right  -> WrappedLine t b (maxWidth-l)+    TextAlignment_Center -> WrappedLine t b ((maxWidth-l) `div` 2)+    where l = textWidth t+  r'' =  case r' of+    []       -> []+    (x,b):xs -> (T.drop n x,b):xs+  r = fmap fmapfn r''++-- converts deleted eol spaces into logical lines+eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]]+eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . ((L.groupBy (\(WrappedLine _ b _) _ -> not b)) =<<)++offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment+offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines++offsetMapWithAlignment+  :: [[(Text, Int)]] -- ^ The outer list represents logical lines, inner list represents wrapped lines+  -> OffsetMapWithAlignment+offsetMapWithAlignment ts = evalState (offsetMap' ts) (0, 0)+  where+    offsetMap' xs = fmap Map.unions $ forM xs $ \x -> do+      maps <- forM x $ \(line,align) -> do+        let l = T.length line+        (dl, o) <- get+        put (dl + 1, o + l)+        return $ Map.singleton dl (align, o)+      (dl, o) <- get+      put (dl, o + 1)+      -- add additional offset to last line in wrapped lines (for newline char)+      return $ Map.adjust (\(align,_)->(align,o+1)) dl $ Map.unions maps+++-- | Given a width and a 'TextZipper', produce a list of display lines+-- (i.e., lines of wrapped text) with special attributes applied to+-- certain segments (e.g., the cursor). Additionally, produce the current+-- y-coordinate of the cursor and a mapping from display line number to text+-- offset+displayLinesWithAlignment+  :: TextAlignment+  -> Int -- ^ Width, used for wrapping+  -> tag -- ^ Metadata for normal characters+  -> tag -- ^ Metadata for the cursor+  -> TextZipper -- ^ The text input contents and cursor state+  -> DisplayLines tag+displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) =+  let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line+      linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb+      linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line+      linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la++      -- simulate trailing cursor character when computing OffsetMap+      afterWithCursor = if T.null a then " " else a+      offsets :: OffsetMapWithAlignment+      offsets = offsetMapWithAlignmentInternal $ mconcat+        [ linesBefore+        , [wrapWithOffsetAndAlignment alignment width 0 $ b <> afterWithCursor]+        , linesAfter+        ]+      flattenLines = concatMap (fmap _wrappedLines_text)+      spansBefore = map ((:[]) . Span tag) $ flattenLines linesBefore+      spansAfter = map ((:[]) . Span tag) $ flattenLines linesAfter+      -- Separate the spans before the cursor into+      -- * spans that are on earlier display lines (though on the same logical line), and+      -- * spans that are on the same display line++      (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $+        initLast $ map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width 0 b)+      -- Calculate the number of columns on the cursor's display line before the cursor+      curLineOffset = spansWidth spansCurLineBefore+      -- Check whether the spans on the current display line are long enough that+      -- the cursor has to go to the next line+      cursorAfterEOL = curLineOffset == width+      cursorCharWidth = case T.uncons a of+        Nothing     -> 1+        Just (c, _) -> charWidth c++      -- Separate the span after the cursor into+      -- * spans that are on the same display line, and+      -- * spans that are on later display lines (though on the same logical line)++      (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $+        headTail $ case T.uncons a of+          Nothing -> [[Span cursorTag " "]]+          Just (c, rest) ->+            let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth+                cursor = Span cursorTag (T.singleton c)+            in case map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width o rest) of+                  []     -> [[cursor]]+                  (l:ls) -> (cursor : l) : ls++      curLineSpanNormalCase = if cursorAfterEOL+        then [ spansCurLineBefore, spansCurLineAfter ]+        else [ spansCurLineBefore <> spansCurLineAfter ]++      -- for right alignment, we want draw the cursor tag to be on the character just before the logical cursor position+      curLineSpan = if alignment == TextAlignment_Right && not cursorAfterEOL+        then case reverse spansCurLineBefore of+          [] -> curLineSpanNormalCase+          (Span _ x):xs -> case spansCurLineAfter of+            [] -> error "should not be possible" -- curLineSpanNormalCase+            (Span _ y):ys -> [reverse (Span cursorTag x:xs) <> ((Span tag y):ys)]+        else curLineSpanNormalCase++      cursorY = sum+        [ length spansBefore+        , length spansCurrentBefore+        , if cursorAfterEOL then 1 else 0+        ]+      -- a little silly to convert back to text but whatever, it works+      cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore)++  in  DisplayLines+        { _displayLines_spans = concat+          [ spansBefore+          , spansCurrentBefore+          , curLineSpan+          , spansCurrentAfter+          , spansAfter+          ]+        , _displayLines_offsetMap = offsets+        , _displayLines_cursorPos = (cursorX, cursorY)+        }+  where+    initLast :: [a] -> Maybe ([a], a)+    initLast = \case+      [] -> Nothing+      (x:xs) -> case initLast xs of+        Nothing      -> Just ([], x)+        Just (ys, y) -> Just (x:ys, y)+    headTail :: [a] -> Maybe (a, [a])+    headTail = \case+      [] -> Nothing+      x:xs -> Just (x, xs)+++-- | Move the cursor of the given 'TextZipper' to the logical position indicated+-- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment'+-- information.  If the x coordinate is beyond the end of a line, the cursor is+-- moved to the end of the line.+goToDisplayLinePosition :: Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper+goToDisplayLinePosition x y dl tz =+  let offset = Map.lookup y $ _displayLines_offsetMap dl+  in  case offset of+        Nothing -> tz+        Just (alignOff,o) ->+          let+            trueX = max 0 (x - alignOff)+            moveRight = case drop y $ _displayLines_spans dl of+                []    -> 0+                (s:_) -> charIndexAt trueX . stream . mconcat . fmap (\(Span _ t) -> t) $ s+          in  rightN (o + moveRight) $ top tz++-- | Given a width and a 'TextZipper', produce a list of display lines+-- (i.e., lines of wrapped text) with special attributes applied to+-- certain segments (e.g., the cursor). Additionally, produce the current+-- y-coordinate of the cursor and a mapping from display line number to text+-- offset+displayLines+  :: Int -- ^ Width, used for wrapping+  -> tag -- ^ Metadata for normal characters+  -> tag -- ^ Metadata for the cursor+  -> TextZipper -- ^ The text input contents and cursor state+  -> DisplayLines tag+displayLines = displayLinesWithAlignment TextAlignment_Left++-- | Wraps a logical line of text to fit within the given width. The first+-- wrapped line is offset by the number of columns provided. Subsequent wrapped+-- lines are not.+wrapWithOffset+  :: Int -- ^ Maximum width+  -> Int -- ^ Offset for first line+  -> Text -- ^ Text to be wrapped+  -> [Text]+wrapWithOffset maxWidth n xs = _wrappedLines_text <$> wrapWithOffsetAndAlignment TextAlignment_Left maxWidth n xs
+ src/Potato/Data/Text/Zipper2.hs view
@@ -0,0 +1,276 @@+-- WIP+module Potato.Data.Text.Zipper2 where++import           Prelude++import Control.Exception (assert)+import Control.Monad.State (evalState, forM, get, put)+import Data.Char (isSpace)+import Data.Map (Map)+import Data.Maybe (fromMaybe)+import Data.String+import Data.Text (Text)+import Data.Text.Internal (Text(..), text)+import Data.Text.Internal.Fusion (stream)+import Data.Text.Internal.Fusion.Types (Stream(..), Step(..))+import Data.Text.Unsafe+import qualified Data.List as L+import qualified Data.Map as Map+import qualified Data.Text as T++import Graphics.Text.Width (wcwidth)++import qualified Data.List.NonEmpty as NE++-- | Get the display width of a 'Char'. "Full width" and "wide" characters+-- take two columns and everything else takes a single column. See+-- <https://www.unicode.org/reports/tr11/> for more information+-- This is implemented using wcwidth from Vty such that it matches what will+-- be displayed on the terminal. Note that this method can change depending+-- on how vty is configed. Please see vty documentation for details.+charWidth :: Char -> Int+charWidth = wcwidth++-- TERMINOLOGY+-- selection: the portion of the TextZipper that is selected+-- cursor: the cursor is defined as the begining and end of the selection+-- word: a word is defined as a contiguous set of non-whitespace characters in the TextZipper+--   the position one word to the left/right of the cursor is the position after all non-white space to the left/right of the cursor until it hits non-whitespace character followde by all contiguous non-whitespace characters in that direction+-- logical lines: logical lines of the TextZipper are lines created by explicit new line characters+-- display lines: display lines of a TextZipper ar the lines rendered to screen+--   display lines are bound by some width+--++data TextZipper = TextZipper+  { _textZipper_linesBefore :: [Text] -- reversed+  , _textZipper_before :: Text+  , _textZipper_selected :: [Text]+  , _textZipper_after :: Text+  , _textZipper_linesAfter :: [Text]+  }+  deriving (Show, Eq)++-- example:+--+-- this is an example content of+-- a text zipper+-- the capital TEXT IS THE SELECTED+-- PORTION of the+-- text zipper+--+-- _textZipper_linesBefore = ["this is an example content of", "a text zipper"]+-- _textZipper_before = "the capital "+-- _textZipper_selected = ["TEXT IS THE SELECTED", "PORTION"]+-- _textZipper_after = " of the"+-- _textZipper_linesAfter = ["text zipper"]++instance IsString TextZipper where+  fromString = fromText . T.pack++-- | Map a replacement function over the characters in a 'TextZipper'+mapZipper :: (Char -> Char) -> TextZipper -> TextZipper+mapZipper f (TextZipper lb b s a la) = TextZipper+  { _textZipper_linesBefore = fmap (T.map f) lb+  , _textZipper_before = T.map f b+  , _textZipper_selected = fmap (T.map f) s+  , _textZipper_after = T.map f a+  , _textZipper_linesAfter = fmap (T.map f) la+  }++appendEnd :: [Text] -> Text -> [Text]+appendEnd stuff addme = case stuff of+  [] -> [addme]+  (x:[]) -> [x <> addme]+  (x:xs) -> x : appendEnd xs addme++-- | Move the cursor left one character (clearing the selection)+left :: TextZipper -> TextZipper+left = leftN 1++-- UNTESTED+-- | Move the cursor left by the given number of characters (clearing the selection)+leftN :: Int -> TextZipper -> TextZipper+leftN n z@(TextZipper lb b [] a la) =+  if T.length b >= n+    then+      let n' = T.length b - n+      in  TextZipper lb (T.take n' b) [] (T.drop n' b <> a) la+    else case lb of+           [] -> home z+           (l:ls) -> leftN (n - T.length b - 1) $ TextZipper ls l [] "" ((b <> a) : la)+leftN n (TextZipper lb b s a la) = leftN n $ TextZipper lb b [] newa newla  where+  (newa, newla') = case s of+    [] -> (a, la)+    (x:[]) -> (x <> a, la)+    (x:xs) -> (x, appendEnd xs a)+  newla = newla' <> la+++-- | expand the selection to the left the given number of characters+shiftLeftN :: TextZipper -> TextZipper+shiftLeftN = undefined++-- | Move the cursor to the left one word (clearing the selection)+leftWord :: TextZipper -> TextZipper+leftWord = undefined++-- | Expand the selection to the left by one word+shiftLeftWord :: TextZipper -> TextZipper+shiftLeftWord = undefined+++-- | Move the cursor right one character (clearing the selection)+right :: TextZipper -> TextZipper+right = rightN 1++-- | Move the character right by the given number of characters (clearing the selection)+rightN :: Int -> TextZipper -> TextZipper+rightN n z@(TextZipper lb b s a la) = undefined++-- | expand the selection to the right the given number of characters+shiftRightN :: TextZipper -> TextZipper+shiftRightN = undefined++-- | Move the cursor to the right one word (clearing the selection)+rightWord :: TextZipper -> TextZipper+rightWord = undefined++-- | Expand the selection to the right by one word+rightLeftWord :: TextZipper -> TextZipper+rightLeftWord = undefined++-- | Clear the selection and move the cursor to the end of selection+deselect :: TextZipper -> TextZipper+deselect tz@(TextZipper lb b []           a la) = tz+deselect    (TextZipper lb b [x]          a la) = TextZipper lb (b <> x) [] a la+deselect    (TextZipper lb b (x:(xs:xss)) a la) = TextZipper ((reverse $ NE.init xs') <> [b <> x] <> lb) (NE.last xs') [] a la where+                xs' = xs NE.:| xss++-- | Move the cursor up one logical line (clearing the selection)+up ::  TextZipper -> TextZipper+up    (TextZipper [] b [] a la) = TextZipper [] "" [] (b <> a) la+up    (TextZipper (x:xs) b [] a la) = TextZipper xs b' [] a' ([b <> a] <> la) where+        (b', a') = T.splitAt (T.length b) x+up tz@(TextZipper lb b s a la) = up $ deselect tz++-- | Move the cursor down one logical line (clearing the selection)+down :: TextZipper -> TextZipper+down    (TextZipper lb b []  a []) = TextZipper lb (b <> a) [] "" []+down    (TextZipper lb b [] a (x:xs)) = TextZipper ([b <> a] <> lb) b' [] a' xs where+          (b', a') = T.splitAt (T.length b) x+down tz@(TextZipper lb b s a la) = down $ deselect tz++-- | Move the cursor up by the given number of lines (clearing the selection)+pageUp :: Int -> TextZipper -> TextZipper+pageUp pageSize z = undefined++-- | Move the cursor down by the given number of lines (clearing the selection)+pageDown :: Int -> TextZipper -> TextZipper+pageDown pageSize z = undefined++-- | Move the cursor to the beginning of the current logical line (clearing the selection)+home :: TextZipper -> TextZipper+home (TextZipper lb b [] a la) = TextZipper lb "" [] (b <> a) la+home (TextZipper lb b (x:[]) a la) = TextZipper lb "" [] (b <> x <> a) la+home (TextZipper lb b (x:(xs:xss)) a la) = TextZipper lb "" [] (b <> x) (NE.init xs' <> [NE.last xs' <> a] <> la) where+   xs' = xs NE.:| xss++-- | Move the cursor to the end of the current logical line (clearing the selection)+end :: TextZipper -> TextZipper+end (TextZipper lb b [] a la) = TextZipper lb (b <> a) [] "" la+end (TextZipper lb b (x:[]) a la) = TextZipper lb (b <> x <> a) [] "" la+end (TextZipper lb b (x:(xs:xss)) a la) =TextZipper (lb <> ([b <> x] <> NE.init xs')) (NE.last xs' <> a) [] "" la where+   xs' = xs NE.:| xss++-- | Move the cursor to the top of the document (clearing the selection)+top :: TextZipper -> TextZipper+top tz@(TextZipper [] "" [] _ _) = tz+top (TextZipper [x]    "" [] a la) = TextZipper [] "" [] x (a:la)+top (TextZipper (x:xs) "" [] a la) = TextZipper [] "" [] (NE.last xs') ((reverse $ NE.init xs') <> (a:la)) where+    xs' = x NE.:| xs+top tz = top $ home tz++-- | Insert a character at the current cursor position (overwriting the selection)+insertChar :: Char -> TextZipper -> TextZipper+insertChar i = insert (T.singleton i)++-- | Insert text at the current cursor position (overwriting the selection)+insert :: Text -> TextZipper -> TextZipper+insert i z@(TextZipper lb b s a la) = case T.split (=='\n') i of+  [] -> z+  (x:xs) -> undefined++-- | Delete the selection+deleteSelection :: TextZipper -> TextZipper+deleteSelection = undefined++-- | Delete the selection or the character to the left of the cursor if there was no selection+deleteLeft :: TextZipper-> TextZipper+deleteLeft z@(TextZipper lb b s a la) = undefined++-- | Delete the selection to the character to the right of the cursor if there was no selection+deleteRight :: TextZipper -> TextZipper+deleteRight z@(TextZipper lb b s a la) = undefined++-- | Delete the selection and the word to the left of the cursor and the selection.+-- When deleting the word to the left of the selection, deletes all whitespace until it finds a non-whitespace character, and then deletes contiguous non-whitespace characters.+deleteLeftWord :: TextZipper -> TextZipper+deleteLeftWord (TextZipper lb b s a la) = undefined++-- | Insert up to n spaces to get to the next logical column that is a multiple of n+tab :: Int -> TextZipper -> TextZipper+tab n (TextZipper _ b s _ _) = undefined++-- | The plain text contents of the zipper+value :: TextZipper -> Text+value (TextZipper lb b s a la) = undefined+++-- | The empty zipper+empty :: TextZipper+empty = TextZipper [] "" [] "" []++-- | Constructs a zipper with the given contents. The cursor is placed after the contents.+fromText :: Text -> TextZipper+fromText = flip insert empty+++-- | Text alignment type+data TextAlignment =+  TextAlignment_Left+  | TextAlignment_Right+  | TextAlignment_Center+  deriving (Eq, Show)++++-- A map from the row index of display line to a tuple (fst,snd) where+--   fst: leading empty spaces from left (may be negative) to adjust for alignment+--   snd: the text offset from the beginning of the document+type OffsetMapWithAlignment = Map Int (Int, Int)+++-- | Information about the document as it is displayed (i.e., post-wrapping)+data DisplayLines = DisplayLines+  { _displayLines_text :: [[Text]] -- outer is logical lines, inner list is display lines created due to wrapping logical lines to display width+  , _displayLines_offsetMap :: OffsetMapWithAlignment -- note that the row index (key) of OffsetMapWithAlignment counts display lines which includes logical lines+  , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner+  , _displayLines_selectionCount :: Int+  }+  deriving (Eq, Show)++-- | Adjust the cursor and/or selection of the 'TextZipper' by the given display line coordinates+-- If the x coordinate is beyond the start/end of a line, the cursor is moved to the start/end of that line respectively+-- if `add` is true, the selection is expanded to the given position+-- if `add` is false, the selection is cleared and the cursor is moved to the given position+goToDisplayLinePosition :: Bool -> Int -> Int -> DisplayLines -> TextZipper -> TextZipper+goToDisplayLinePosition add x y dl tz = undefined+-- | Given a `TextAlignment`, a width and a 'TextZipper', produce a `DisplayLines`+-- wrapping happens at word boundaries such that the most possible words fit into each display line+-- if a line can not be wrapped (i.e. it contains a word longer than the display width) then the line is cropped in the middle of the word as necessary+displayLinesWithAlignment+  :: TextAlignment+  -> Int -- ^ Width, used for wrapping+  -> TextZipper -- ^ The text input contents and cursor state+  -> DisplayLines+displayLinesWithAlignment = undefined
+ src/Potato/Flow.hs view
@@ -0,0 +1,35 @@+module Potato.Flow (+  module Potato.Flow.SElts+  , module Potato.Flow.Math+  , module Potato.Flow.SEltMethods+  , module Potato.Flow.Types+  , module Potato.Flow.Methods.Types+  , module Potato.Flow.Render+  , module Potato.Flow.BroadPhase+  , module Potato.Flow.Controller+  , module Potato.Flow.Llama+  , module Potato.Flow.OwlWorkspace+  , module Potato.Flow.OwlState+  , module Potato.Flow.Owl+  , module Potato.Flow.OwlHelpers+  , module Potato.Flow.OwlItem+  , module Potato.Flow.Reflex+  , module Potato.Data.Text.Unicode+) where++import           Potato.Flow.BroadPhase+import           Potato.Flow.Controller+import           Potato.Flow.Math+import           Potato.Flow.Render+import           Potato.Flow.SEltMethods+import           Potato.Flow.Methods.Types+import           Potato.Flow.SElts+import           Potato.Flow.Types+import Potato.Flow.OwlHelpers+import Potato.Flow.OwlWorkspace+import Potato.Flow.OwlState+import Potato.Flow.Owl+import Potato.Flow.OwlItem+import Potato.Flow.Reflex+import Potato.Flow.Llama+import Potato.Data.Text.Unicode
+ src/Potato/Flow/Attachments.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Attachments (+  AvailableAttachment+  , BoxWithAttachmentLocation+  , attachLocationFromLBox_conjugateCartRotationReflection+  , attachLocationFromLBox+  , availableAttachLocationsFromLBox+  , owlItem_availableAttachments+  , owlItem_availableAttachmentsAtDefaultLocation+  , isOverAttachment+  , projectAttachment+  , attachmentRenderChar++) where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.OwlItem+import Potato.Flow.Owl+import Potato.Flow.SElts+import Potato.Flow.Methods.LineTypes++import Data.List (minimumBy)+import Data.Ratio+import Data.Tuple.Extra+import Control.Exception (assert)+++data CartSegment = CartSegment {+    _cartSegment_isVertical :: Bool+    , _cartSegment_common :: Int+    , _cartSegment_leftOrTop :: Int+    , _cartSegment_rightOrBot :: Int+  } deriving (Eq, Show)+-- represents possible place to attach+data AvailableAttachment = AvailableAttachment_CartSegment CartSegment AttachmentLocation deriving (Show, Eq)++type BoxWithAttachmentLocation = (LBox, AttachmentLocation, AttachmentOffsetRatio)++-- uh not sure if this is actually conjugation...+attachLocationFromLBox_conjugateCartRotationReflection :: CartRotationReflection -> Bool -> BoxWithAttachmentLocation -> XY+attachLocationFromLBox_conjugateCartRotationReflection crr offsetBorder (box, al, af) = r where+  r' = attachLocationFromLBox offsetBorder (cartRotationReflection_invert_apply crr box, cartRotationReflection_invert_apply crr al, cartRotationReflection_invert_apply crr af)+  r = cartRotationReflection_apply crr r'++-- NOTE assumes LBox is canonical+attachLocationFromLBox :: Bool -> BoxWithAttachmentLocation -> XY+attachLocationFromLBox True (lbx, al, af) = attachLocationFromLBox False (lBox_expand lbx (1,1,1,1), al, af)+attachLocationFromLBox offset (LBox (V2 x y) (V2 w h), al, af) = case al of+  AL_Top -> V2 (x+w * n `div` d) y+  AL_Bot -> V2 (x+(w-1) * dn `div` d) (y+h-1)+  AL_Left -> V2 x (y+(h-1) * dn `div` d )+  AL_Right -> V2 (x+w-1) (y+h * n `div` d )+  -- or maybe in the middle is better?+  AL_Any -> V2 x y+  where+    n = numerator af+    d = denominator af+    dn = d-n+++defaultAttachLocationsFromLBox :: Bool -> LBox -> [(AttachmentLocation, XY)]+defaultAttachLocationsFromLBox offsetBorder lbx = fmap (\a -> (a, attachLocationFromLBox offsetBorder (lbx, a, attachment_offset_rel_default))) [AL_Top, AL_Bot, AL_Left, AL_Right]++-- NOTE assumes LBox is canonical+availableAttachLocationFromLBox :: Bool -> (LBox, AttachmentLocation) -> AvailableAttachment+availableAttachLocationFromLBox offset (LBox (V2 x y) (V2 w h), al)+  | offset = flip AvailableAttachment_CartSegment al $ case al of+    AL_Top -> CartSegment False (y-1) x (x+w)+    AL_Bot -> CartSegment False (y+h) x (x+w)+    AL_Left -> CartSegment True (x-1) y (y+h)+    AL_Right -> CartSegment True (x+w) y (y+h)+    AL_Any -> assert False $ CartSegment False x y y+  | otherwise = flip AvailableAttachment_CartSegment al $ case al of+    AL_Top -> CartSegment False y x (x+w)+    AL_Bot -> CartSegment False (y+h-1) x (x+w)+    AL_Left -> CartSegment True x y (y+h)+    AL_Right -> CartSegment True (x+w-1) y (y+h)+    AL_Any -> assert False $ CartSegment False x y y++availableAttachLocationsFromLBox :: Bool -> LBox -> [AvailableAttachment]+availableAttachLocationsFromLBox offsetBorder lbx = fmap (\a -> (availableAttachLocationFromLBox offsetBorder (lbx, a))) [AL_Top, AL_Bot, AL_Left, AL_Right]++owlItem_availableAttachmentsAtDefaultLocation :: Bool -> Bool -> OwlItem -> [(AttachmentLocation, XY)]+owlItem_availableAttachmentsAtDefaultLocation includeNoBorder offsetBorder o = case _owlItem_subItem o of+  OwlSubItemBox sbox | not includeNoBorder && not (sBoxType_hasBorder (_sBox_boxType sbox)) -> []+  OwlSubItemBox sbox -> defaultAttachLocationsFromLBox offsetBorder (_sBox_box sbox)+  _ -> []++owlItem_availableAttachments :: Bool -> Bool -> OwlItem -> [AvailableAttachment]+owlItem_availableAttachments includeNoBorder offsetBorder o = case _owlItem_subItem o of+  OwlSubItemBox sbox | not includeNoBorder && not (sBoxType_hasBorder (_sBox_boxType sbox)) -> []+  OwlSubItemBox sbox -> availableAttachLocationsFromLBox offsetBorder (_sBox_box sbox)+  _ -> []++isOverAttachment :: XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)+isOverAttachment pos attachments = find (\(a,x) -> x == pos) attachments+++projectAttachment :: AttachmentLocation -> XY -> REltId -> LBox -> Maybe (Attachment, XY)+projectAttachment preval (V2 x y) rid lbox = r where+  als = availableAttachLocationsFromLBox False lbox++  -- returns (projection distance, (projection ratio, projection position)+  projdfn :: AvailableAttachment -> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)+  projdfn aa@(AvailableAttachment_CartSegment (CartSegment {..}) al) = r2 where+    projcomp = if _cartSegment_isVertical then x else y+    (orthd, orthcomp) = (abs (projcomp - _cartSegment_common), _cartSegment_common)+    slidecomp = if _cartSegment_isVertical then y else x+    (parad, paracomp) = if slidecomp < _cartSegment_leftOrTop+      then (_cartSegment_leftOrTop - slidecomp, _cartSegment_leftOrTop)+      else if slidecomp > _cartSegment_rightOrBot+        then (slidecomp - _cartSegment_rightOrBot, _cartSegment_rightOrBot)+        else (0, slidecomp)++    pos@(V2 px py) = if _cartSegment_isVertical then V2 orthcomp paracomp else V2 paracomp orthcomp+    segl = _cartSegment_rightOrBot - _cartSegment_leftOrTop+    ratio = case al of+      AL_Top -> (px - _cartSegment_leftOrTop) % segl+      AL_Bot -> (_cartSegment_rightOrBot - px) % segl+      AL_Left -> (_cartSegment_rightOrBot - py) % segl+      AL_Right -> (py - _cartSegment_leftOrTop) % segl+      AL_Any -> error "unexpected"++    r2 = (parad+orthd, (ratio, pos), aa)++  rslts = fmap projdfn als+  cmpfn (d1, _, AvailableAttachment_CartSegment _ al1) (d2, _, AvailableAttachment_CartSegment _ al2) = compare d1 d2 <> compare (al2 == preval) (al1 == preval)+  (d, (ratio, pos), AvailableAttachment_CartSegment _ al) = minimumBy cmpfn rslts++  attachment = Attachment {+      _attachment_target = rid+      , _attachment_location = al+      , _attachment_offset_rel = ratio+    }++  r = if d > 2+    then Nothing+    else Just $ (attachment, pos)++++attachmentRenderChar :: Attachment -> PChar+attachmentRenderChar att = case _attachment_location att of+  AL_Top -> '⇈'+  AL_Bot -> '⇊'+  AL_Left -> '⇇'+  AL_Right -> '⇉'+  AL_Any -> ' ' -- should never be rendered
+ src/Potato/Flow/BroadPhase.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.BroadPhase (+  AABB+  , NeedsUpdateSet+  , BPTree(..)+  , bPTreeFromOwlPFState+  , emptyBPTree+  , broadPhase_cull+  , broadPhase_cull_includeZero++  , BroadPhaseState(..)+  , emptyBroadPhaseState++  -- exposed for testing+  , update_bPTree+) where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.Methods.Types+import           Potato.Flow.Owl+import           Potato.Flow.OwlItem+import           Potato.Flow.OwlState+import           Potato.Flow.SEltMethods+import           Potato.Flow.SElts+import           Potato.Flow.Types++import qualified Data.IntMap.Strict        as IM++type AABB = LBox++type NeedsUpdateSet = [AABB]++-- TODO actual BroadPhase...+data BPTree = BPTree {+  -- TODO you want something sortable too...+  _bPTree_potato_tree :: REltIdMap AABB+} deriving (Show, Eq)++emptyBPTree :: BPTree+emptyBPTree = BPTree IM.empty++-- TODO+--bPTreeFromPFState :: PFState -> BPTree+--bPTreeFromPFState PFState {..} = r where+--  potato_tree = IM.mapMaybe (getSEltBox_naive . _sEltLabel_sElt) _pFState_directory+--  r = BPTree potato_tree++bPTreeFromOwlPFState :: OwlPFState -> BPTree+bPTreeFromOwlPFState OwlPFState {..} = r where+  potato_tree = IM.mapMaybe (\(_,oelt) -> getSEltBox_naive . owlItem_toSElt_hack $ oelt) (_owlTree_mapping _owlPFState_owlTree)+  r = BPTree potato_tree++data BroadPhaseState = BroadPhaseState {+  _broadPhaseState_bPTree    :: BPTree -- updated BPTree+} deriving (Show, Eq)++emptyBroadPhaseState :: BroadPhaseState+emptyBroadPhaseState = BroadPhaseState emptyBPTree+++++-- | updates a BPTree and returns list of AABBs that were affected+-- exposed for testing only, do not call this directly+update_bPTree :: (HasOwlTree a) => a -> SuperOwlChanges -> BPTree -> (NeedsUpdateSet, BroadPhaseState)+update_bPTree ot changes BPTree {..} = r where+  -- deletions+  deletefn (aabbs, im) rid = (newaabbs, newim) where+    (moldaabb, newim) = IM.updateLookupWithKey (\_ _ -> Nothing) rid im+    newaabbs = maybe aabbs (\oldaabb -> oldaabb:aabbs) moldaabb++  -- modify/insert+  insmodfn (aabbs, im) (rid, lbox) = (newaabbs, newim) where+    (moldaabb :: Maybe AABB, newim) = IM.insertLookupWithKey (\_ a _ -> a) rid lbox im+    newaabbs' = lbox:aabbs+    newaabbs = maybe newaabbs' (\oldaabb -> oldaabb:newaabbs') moldaabb++  (insmods, deletes) = foldl'+    (\(insmods',deletes') (rid, msowl) -> case msowl of+      Nothing    -> (insmods', rid:deletes')++      -- TODO don't use getSEltBox_naive like this come on -__-+      Just sowl -> case getSEltBox_naive (superOwl_toSElt_hack sowl) of+        Nothing   -> (insmods', rid:deletes')+        +        -- TODO this needs to use expanded wide char box+        Just _ -> ((rid, _sEltDrawer_box (getDrawer (_owlItem_subItem $ _superOwl_elt sowl)) ot):insmods', deletes'))+++    ([],[])+    (IM.toList changes)+  (aabbs', nbpt) = foldl' insmodfn (foldl' deletefn ([], _bPTree_potato_tree) deletes) insmods+  r = (aabbs', BroadPhaseState (BPTree nbpt))++-- TODO prob don't need this, DELETE+--update_bPTree' ::  (REltId, Maybe SEltLabel) -> BPTree -> BPTree+--update_bPTree' (rid, ms) BPTree {..} = BPTree $ IM.alter (const (ms >>= getSEltBox_naive . _sEltLabel_sElt)) rid _bPTree_potato_tree++-- | returns list of REltIds that intersect with given AABB+broadPhase_cull :: AABB -> BPTree -> [REltId]+broadPhase_cull box BPTree {..} = r where+  foldfn rid aabb cols = if does_lBox_intersect box aabb then rid:cols else cols+  r = IM.foldrWithKey foldfn [] _bPTree_potato_tree++-- | same as above but also returns zero area elements for selecting+broadPhase_cull_includeZero :: AABB -> BPTree -> [REltId]+broadPhase_cull_includeZero box BPTree {..} = r where+  foldfn rid aabb cols = if does_lBox_intersect_include_zero_area box aabb then rid:cols else cols+  r = IM.foldrWithKey foldfn [] _bPTree_potato_tree
+ src/Potato/Flow/Cmd.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE UndecidableInstances #-}++module Potato.Flow.Cmd (+  PFCmdTag(..)+  , PFCmd++) where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.Types++import           Data.Constraint.Extras.TH+import qualified Data.Dependent.Sum        as DS+import           Data.GADT.Compare.TH+import           Data.GADT.Show.TH+import qualified Text.Show++data PFCmdTag a where+  -- LayerPos indices are as if all elements already exist in the map, must be in order+  PFCNewElts :: PFCmdTag [SuperSEltLabel]+  -- LayerPos indices are the current indices of elements to be removed, must be in order+  PFCDeleteElts :: PFCmdTag [SuperSEltLabel]+  -- all LayerPos indices are before move, must be in order+  PFCMove :: PFCmdTag ([LayerPos], LayerPos)+  --PFCDuplicate :: PFCmdTag [REltId]+  PFCManipulate :: PFCmdTag ControllersWithId+  PFCResizeCanvas :: PFCmdTag DeltaLBox++instance Text.Show.Show (PFCmdTag a) where+  show PFCNewElts      = "PFCNewElts"+  show PFCDeleteElts   = "PFCDeleteElts"+  show PFCMove = "PFCMove"+  show PFCManipulate   = "PFCManipulate"+  show PFCResizeCanvas = "PFCResize"++type PFCmd = DS.DSum PFCmdTag Identity++instance NFData PFCmd where+  rnf (PFCNewElts DS.:=> Identity a)      = rnf a+  rnf (PFCDeleteElts DS.:=> Identity a)   = rnf a+  rnf (PFCMove DS.:=> Identity a)         = rnf a+  rnf (PFCManipulate DS.:=> Identity a)   = rnf a+  rnf (PFCResizeCanvas DS.:=> Identity a) = rnf a++deriveGEq      ''PFCmdTag+deriveGCompare ''PFCmdTag+deriveGShow ''PFCmdTag+deriveArgDict ''PFCmdTag
+ src/Potato/Flow/Configuration.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Configuration where++import           Relude++import           Potato.Data.Text.Unicode++import           Data.Default+import           Data.Int+import qualified Text.Show++data PotatoConfiguration = PotatoConfiguration {+    _potatoConfiguration_allowGraphemeClusters            :: Bool -- NOTE we don't support replacing grapheme clusters as this would require reverting past inputs+    , _potatoConfiguration_allowOrReplaceUnicodeWideChars :: Maybe (Maybe Char) -- outer Maybe is if we allow, inner Maybe is what we replace with+    , _potatoConfiguration_unicodeWideCharFn              :: Char -> Int8+  }++instance Show PotatoConfiguration where+  show PotatoConfiguration {..} = "_potatoConfiguration_allowGraphemeClusters: " <> show _potatoConfiguration_allowGraphemeClusters <> "\n_potatoConfiguration_allowOrReplaceUnicodeWideChars: " <> show _potatoConfiguration_allowOrReplaceUnicodeWideChars++instance Default PotatoConfiguration where+  def = PotatoConfiguration {+      _potatoConfiguration_allowGraphemeClusters = False+      , _potatoConfiguration_allowOrReplaceUnicodeWideChars = Just (Just '☺')+      -- NOTE getCharWidth is unsafely modified by vty on initialization based on the terminal config file+      , _potatoConfiguration_unicodeWideCharFn = getCharWidth+    }
+ src/Potato/Flow/Controller.hs view
@@ -0,0 +1,26 @@+module Potato.Flow.Controller(+  module Potato.Flow.Controller.Manipulator.Box+  , module Potato.Flow.Controller.Manipulator.Line+  , module Potato.Flow.Controller.Manipulator.Pan+  , module Potato.Flow.Controller.Manipulator.Select+  , module Potato.Flow.Controller.Handler+  , module Potato.Flow.Controller.Manipulator.BoxText+  , module Potato.Flow.Controller.Manipulator.Common+  , module Potato.Flow.Controller.Goat+  , module Potato.Flow.Controller.Input+  , module Potato.Flow.Controller.OwlLayers+  , module Potato.Flow.Controller.Types++) where++import           Potato.Flow.Controller.Goat+import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.OwlLayers+import           Potato.Flow.Controller.Manipulator.Box+import           Potato.Flow.Controller.Manipulator.BoxText+import           Potato.Flow.Controller.Manipulator.Common+import           Potato.Flow.Controller.Manipulator.Line+import           Potato.Flow.Controller.Manipulator.Pan+import           Potato.Flow.Controller.Manipulator.Select+import           Potato.Flow.Controller.Types
+ src/Potato/Flow/Controller/Goat.hs view
@@ -0,0 +1,823 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Controller.Goat (+  GoatFocusedArea(..)+  , goatState_hasUnsavedChanges+  , makeGoatState+  , goatState_pFState+  , goatState_selectedTool+  , GoatState(..)+  , GoatCmd(..)+  , foldGoatFn++  -- exposed for testing+  , potatoHandlerInputFromGoatState+) where++import           Relude++import           Potato.Data.Text.Unicode+import           Potato.Flow.BroadPhase+import           Potato.Flow.Configuration+import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Manipulator.Box+import           Potato.Flow.Controller.Manipulator.CartLine+import           Potato.Flow.Controller.Manipulator.Common+import           Potato.Flow.Controller.Manipulator.Layers+import           Potato.Flow.Controller.Manipulator.Line+import           Potato.Flow.Controller.Manipulator.Pan+import           Potato.Flow.Controller.Manipulator.Select+import           Potato.Flow.Controller.OwlLayers+import           Potato.Flow.Controller.Types+import           Potato.Flow.Llama+import           Potato.Flow.Math+import           Potato.Flow.Owl+import           Potato.Flow.OwlItem+import           Potato.Flow.OwlState+import           Potato.Flow.OwlWorkspace+import           Potato.Flow.Render+import           Potato.Flow.SEltMethods+import           Potato.Flow.Types++import           Control.Exception                           (assert)+import           Data.Default+import qualified Data.IntMap                                 as IM+import qualified Data.IntSet                                 as IS+import           Data.Maybe+import qualified Data.Sequence                               as Seq+import qualified Data.Text                                   as T+++catMaybesSeq :: Seq (Maybe a) -> Seq a+catMaybesSeq = fmap fromJust . Seq.filter isJust++data GoatFocusedArea =+  GoatFocusedArea_Layers+  | GoatFocusedArea_Canvas+  | GoatFocusedArea_Other -- focus is some area that is not owned by tinytools (e.g. the params widgets)+  | GoatFocusedArea_None+  deriving (Eq, Show)++-- TODO move into its own file+data GoatState = GoatState {++    -- TODO make GoatTab+    -- unique to each document+    _goatState_workspace                 :: OwlPFWorkspace+    , _goatState_pan                     :: XY -- panPos is position of upper left corner of canvas relative to screen+    , _goatState_selection               :: Selection+    , _goatState_canvasSelection         :: CanvasSelection+    , _goatState_broadPhaseState         :: BroadPhaseState+    , _goatState_layersState             :: LayersState+    , _goatState_renderedCanvas          :: RenderedCanvasRegion+    , _goatState_renderedSelection       :: RenderedCanvasRegion -- TODO need sparse variant+    , _goatState_handler                 :: SomePotatoHandler+    , _goatState_layersHandler           :: SomePotatoHandler+    -- TODO consider moving into _goatState_workspace+    , _goatState_attachmentMap           :: AttachmentMap -- map of targets to things attached to it. This is a cache that gets updated over time and can be regenerated from the current OwlTree+    , _goatState_renderCache             :: RenderCache++    -- shared across documents+    , _goatState_configuration           :: PotatoConfiguration -- maybe also move PotatoDefaultParameters into this+    , _goatState_potatoDefaultParameters :: PotatoDefaultParameters+    , _goatState_mouseDrag               :: MouseDrag -- last mouse dragging state, this is a little questionable, arguably we should only store stuff needed, not the entire mouseDrag+    , _goatState_screenRegion            :: XY -- the screen dimensions+    , _goatState_clipboard               :: Maybe SEltTree+    , _goatState_focusedArea             :: GoatFocusedArea+    , _goatState_unbrokenInput       :: Text -- grapheme clusters are inputed as several keyboard character events so we track these inputs here++    -- debug stuff (shared across documents)+    , _goatState_debugLabel              :: Text+    , _goatState_debugCommands           :: [GoatCmd]++  } deriving (Show)++makeGoatState :: XY -> (OwlPFState, ControllerMeta) -> GoatState+makeGoatState (V2 screenx screeny) (initialstate, controllermeta) = goat where+    initialowlpfstate = initialstate+    -- initialize broadphase with initial state+    initialAsSuperOwlChanges = IM.mapWithKey (\rid (oem, oe) -> Just $ SuperOwl rid oem oe) . _owlTree_mapping . _owlPFState_owlTree $ initialstate+    (_, initialbp) = update_bPTree initialowlpfstate initialAsSuperOwlChanges emptyBPTree+    initiallayersstate = makeLayersStateFromOwlPFState initialowlpfstate (_controllerMeta_layers controllermeta)++    -- TODO DELETE+    -- TODO wrap this in a helper function in Render+    -- TODO we want to render the whole screen, not just the canvas+    initialCanvasBox = _sCanvas_box . _owlPFState_canvas $ initialowlpfstate+    initialselts = fmap (\(_, oelt) -> _owlItem_subItem oelt) . toList . _owlTree_mapping . _owlPFState_owlTree $ initialowlpfstate+    initialemptyrcr = emptyRenderedCanvasRegion initialCanvasBox+    initialrendercontext = RenderContext {+      _renderContext_owlTree = hasOwlTree_owlTree initialowlpfstate+      , _renderContext_layerMetaMap = _layersState_meta initiallayersstate+      , _renderContext_broadPhase = initialbp -- this is ignored but we may as well set in correctly+      , _renderContext_renderedCanvasRegion = initialemptyrcr+    }+    initialrc = _renderContext_renderedCanvasRegion $ render initialCanvasBox initialselts initialrendercontext++    goat = GoatState {+        _goatState_workspace      = loadOwlPFStateIntoWorkspace (initialstate) emptyWorkspace+        , _goatState_pan             = _controllerMeta_pan controllermeta+        , _goatState_mouseDrag       = def+        , _goatState_handler         = SomePotatoHandler EmptyHandler+        , _goatState_layersHandler   = SomePotatoHandler (def :: LayersHandler)+        , _goatState_configuration = def+        , _goatState_potatoDefaultParameters = def+        , _goatState_attachmentMap = owlTree_makeAttachmentMap (_owlPFState_owlTree initialstate)+        , _goatState_debugLabel      = ""+        , _goatState_selection       = isParliament_empty+        , _goatState_canvasSelection = CanvasSelection Seq.empty+        , _goatState_broadPhaseState = initialbp+        , _goatState_renderedCanvas = initialrc+        , _goatState_renderedSelection = initialemptyrcr+        , _goatState_layersState     = initiallayersstate+        , _goatState_renderCache = emptyRenderCache+        , _goatState_clipboard = Nothing+        , _goatState_focusedArea = GoatFocusedArea_None+        , _goatState_unbrokenInput = ""+        , _goatState_screenRegion = V2 screenx screeny - (_controllerMeta_pan controllermeta)+        , _goatState_debugCommands = []+      }+++goatState_pFState :: GoatState -> OwlPFState+goatState_pFState = _owlPFWorkspace_owlPFState . _goatState_workspace++-- TODO instance GoatState HasOwlTree+goatState_owlTree :: GoatState -> OwlTree+goatState_owlTree = _owlPFState_owlTree . goatState_pFState++goatState_hasUnsavedChanges :: GoatState -> Bool+goatState_hasUnsavedChanges = llamaStack_hasUnsavedChanges . _owlPFWorkspace_llamaStack . _goatState_workspace++goatState_selectedTool :: GoatState -> Tool+goatState_selectedTool = fromMaybe Tool_Select . pHandlerTool . _goatState_handler++-- TODO deprecate this in favor of Endo style+data GoatCmd =+  GoatCmdTool Tool+  | GoatCmdSetFocusedArea GoatFocusedArea+  | GoatCmdLoad EverythingLoadState++  -- command based input for widgets not owned by tiny tools+  | GoatCmdWSEvent WSEvent+  | GoatCmdSetCanvasRegionDim XY+  | GoatCmdNewFolder Text++  -- direct input for widgets owned by tiny tools+  | GoatCmdMouse LMouseData+  | GoatCmdKeyboard KeyboardData++  -- debug nonsense+  | GoatCmdSetDebugLabel Text+  deriving (Show)++++-- Ok, don't think this needs to be a part of GoatCmdTempOutput but does need to be a part of GoatState+-- TODO do this later+{-+data DynGoatFlags = DynGoatFlags {+  _dynGoatFlags_tool           = r_tool+  , _dynGoatFlags_selection    = r_selection+  , _dynGoatFlags_layers       = r_layers+  , _dynGoatFlags_pan          = r_pan+  , _dynGoatFlags_broadPhase   = r_broadphase+  , _dynGoatFlags_canvas = r_canvas+  , _dynGoatFlags_renderedCanvas = r_renderedCanvas+  , _dynGoatFlags_handlerRenderOutput =  r_handlerRenderOutput+} deriving (Show)++data GoatStateFlag = GoatStateFlag_Tool | GoatStateFlag_Selection | GoatStateFlag_Layers | GoatStateFlag_Pan | GoatStateFlag_BroadPhase | GoatStateFlag_Canvas | GoatStateFlag_RenderedCanvasRegion | GoatStateFlag_HandlerRenderOutput deriving (Show, Eq)+-}+++data GoatCmdTempOutput = GoatCmdTempOutput {+  _goatCmdTempOutput_goatState               :: GoatState+  --, _goatCmdTempOutput_wasCanvasInput :: Bool+  --, _goatCmdTempOutput_wasLayerInput :: Bool++  , _goatCmdTempOutput_nextHandler           :: Maybe SomePotatoHandler++  , _goatCmdTempOutput_select                :: Maybe (Bool, Selection)+  , _goatCmdTempOutput_pFEvent               :: Maybe (Bool, WSEvent) -- bool is true if it was a canvas handler event+  , _goatCmdTempOutput_pan                   :: Maybe XY+  , _goatCmdTempOutput_layersState           :: Maybe LayersState+  , _goatCmdTempOutput_changesFromToggleHide :: SuperOwlChanges+} deriving (Show)++-- helpers to extract stuff out of goatState because we use record wildcards and can't access otherwise+goatCmdTempOutput_screenRegion :: GoatCmdTempOutput -> XY+goatCmdTempOutput_screenRegion = _goatState_screenRegion . _goatCmdTempOutput_goatState++goatCmdTempOutput_layersHandler :: GoatCmdTempOutput -> SomePotatoHandler+goatCmdTempOutput_layersHandler = _goatState_layersHandler . _goatCmdTempOutput_goatState+++instance Default GoatCmdTempOutput where+  def = GoatCmdTempOutput {++      -- TODO just don't use Default if you're gonna do this...+      _goatCmdTempOutput_goatState = undefined --error "this is expected to be overwritten during initialization"++      , _goatCmdTempOutput_nextHandler  = Nothing+      , _goatCmdTempOutput_select      = Nothing+      , _goatCmdTempOutput_pFEvent     = Nothing+      , _goatCmdTempOutput_pan         = Nothing+      , _goatCmdTempOutput_layersState = Nothing+      , _goatCmdTempOutput_changesFromToggleHide = IM.empty+    }++makeGoatCmdTempOutputFromNothing :: GoatState -> GoatCmdTempOutput+makeGoatCmdTempOutputFromNothing goatState = def {+    _goatCmdTempOutput_goatState = goatState++    -- NOTE the value of _potatoHandlerOutput_nextHandler is not directly translated here+    -- PotatoHandlerOutput interpretation: isNothing _potatoHandlerOutput_nextHandler => handler does not capture input+    -- GoatCmdTempOutput interpretation (when non-canvas input):+    --    -isNothing _potatoHandlerOutput_nextHandler => the particular event we just processed is not related to the canvas handler+    --    -so in this case we default _goatCmdTempOutput_nextHandler = Just _goatState_handler+    , _goatCmdTempOutput_nextHandler = Just (_goatState_handler goatState)+  }++makeGoatCmdTempOutputFromNothingClearHandler :: GoatState -> GoatCmdTempOutput+makeGoatCmdTempOutputFromNothingClearHandler goatState = def {+    _goatCmdTempOutput_goatState = goatState+  }++makeGoatCmdTempOutputFromEvent :: GoatState -> WSEvent -> GoatCmdTempOutput+makeGoatCmdTempOutputFromEvent goatState wsev = (makeGoatCmdTempOutputFromNothing goatState) {+    _goatCmdTempOutput_pFEvent = Just (False, wsev)+  }++makeGoatCmdTempOutputFromMaybeEvent :: GoatState -> Maybe WSEvent -> GoatCmdTempOutput+makeGoatCmdTempOutputFromMaybeEvent goatState mwsev = (makeGoatCmdTempOutputFromNothing goatState) {+    _goatCmdTempOutput_pFEvent = fmap (\x -> (False,x)) mwsev+  }++makeGoatCmdTempOutputFromPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput+makeGoatCmdTempOutputFromPotatoHandlerOutput goatState PotatoHandlerOutput {..} =  def {+    _goatCmdTempOutput_goatState = goatState+    , _goatCmdTempOutput_nextHandler = _potatoHandlerOutput_nextHandler+    , _goatCmdTempOutput_select      = _potatoHandlerOutput_select+    , _goatCmdTempOutput_pFEvent     = fmap (\x -> (True,x)) _potatoHandlerOutput_pFEvent+    , _goatCmdTempOutput_pan         = _potatoHandlerOutput_pan+    , _goatCmdTempOutput_layersState = _potatoHandlerOutput_layersState+    , _goatCmdTempOutput_changesFromToggleHide = _potatoHandlerOutput_changesFromToggleHide -- actually not needed, only used by layers+  }+++makeGoatCmdTempOutputFromLayersPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput+makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState PotatoHandlerOutput {..} =  def {+    _goatCmdTempOutput_goatState = goatState {+        _goatState_layersHandler = case _potatoHandlerOutput_nextHandler of+          Just h  -> h+          Nothing -> error "expected LayersHandler to return a new handler"+      }+    -- TODO flag that this was not canvas input+    , _goatCmdTempOutput_nextHandler = Nothing+    , _goatCmdTempOutput_select      = _potatoHandlerOutput_select+    , _goatCmdTempOutput_pFEvent     = fmap (\x -> (False,x)) _potatoHandlerOutput_pFEvent+    , _goatCmdTempOutput_pan         = _potatoHandlerOutput_pan+    , _goatCmdTempOutput_layersState = _potatoHandlerOutput_layersState+    , _goatCmdTempOutput_changesFromToggleHide = _potatoHandlerOutput_changesFromToggleHide+  }++makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea :: GoatState -> GoatFocusedArea -> GoatCmdTempOutput+makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea goatState gfa = r where+  didchange = gfa /= _goatState_focusedArea goatState+  goatstatewithnewfocus = goatState { _goatState_focusedArea = gfa }+  noactionneeded = makeGoatCmdTempOutputFromNothing goatstatewithnewfocus+  potatoHandlerInput = potatoHandlerInputFromGoatState goatState+  -- if we were renaming, finalize the rename operation by sending a fake return key event, I can't think of a less ad-hoc way to do this+  r = if didchange && pHandlerName (_goatState_layersHandler goatState) == handlerName_layersRename+    then assert (_goatState_focusedArea goatState == GoatFocusedArea_Layers) $ case pHandleKeyboard (_goatState_layersHandler goatState) potatoHandlerInput (KeyboardData KeyboardKey_Return []) of+      Nothing -> noactionneeded+      Just pho -> makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatstatewithnewfocus pho+    else noactionneeded++-- | hack function for resetting both handlers+-- It would be nice if we actually cancel/reset the handlers (such that in progress operations are undone), but I don't think it really matters+forceResetBothHandlersAndMakeGoatCmdTempOutput :: GoatState -> GoatCmdTempOutput+forceResetBothHandlersAndMakeGoatCmdTempOutput goatState = r where++  -- I think this is Ok+  msph_h = Nothing+  msph_lh = Just (SomePotatoHandler (def :: LayersHandler))++  r = def {+      _goatCmdTempOutput_goatState = goatState {+          _goatState_layersHandler = case msph_lh of+            Just x  -> x+            Nothing -> error "expected LayersHandler to return a new handler"+        }+      , _goatCmdTempOutput_nextHandler = msph_h+    }++makeHandlerFromNewTool :: GoatState -> Tool -> SomePotatoHandler+makeHandlerFromNewTool GoatState{..} = \case+  Tool_Box    -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_Box }+  Tool_Line   -> SomePotatoHandler $ def { _autoLineHandler_isCreation = True }+  Tool_CartLine -> SomePotatoHandler $ def { _cartLineHandler_isCreation = True }+  Tool_Select -> makeHandlerFromSelection _goatState_canvasSelection+  Tool_Text   -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_Text }+  Tool_TextArea -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_TextArea }+  Tool_Pan           -> SomePotatoHandler $ (def :: PanHandler)+++-- TODO rename to makeHandlerFromCanvasSelection+makeHandlerFromSelection :: CanvasSelection -> SomePotatoHandler+makeHandlerFromSelection selection = case computeSelectionType selection of+  SMTBox         -> SomePotatoHandler $ (def :: BoxHandler)+  SMTBoxText     -> SomePotatoHandler $ (def :: BoxHandler)+  SMTLine        -> SomePotatoHandler $ (def :: AutoLineHandler)+  SMTTextArea    -> SomePotatoHandler $ (def :: BoxHandler)+  SMTBoundingBox -> SomePotatoHandler $ (def :: BoxHandler)+  SMTNone        -> SomePotatoHandler EmptyHandler++maybeUpdateHandlerFromSelection :: SomePotatoHandler -> CanvasSelection -> SomePotatoHandler+maybeUpdateHandlerFromSelection sph selection = case sph of+  SomePotatoHandler h -> if pIsHandlerActive h+    then sph+    else makeHandlerFromSelection selection++makeClipboard :: GoatState -> Maybe SEltTree+makeClipboard goatState@GoatState {..} = r where+  r = if isParliament_null _goatState_selection+    then _goatState_clipboard+    else Just $ superOwlParliament_toSEltTree (goatState_owlTree goatState) _goatState_selection++deleteSelectionEvent :: GoatState -> Maybe WSEvent+deleteSelectionEvent GoatState {..} = if isParliament_null _goatState_selection+  then Nothing+  else Just $ WSERemoveEltAndUpdateAttachments (superOwlParliament_toOwlParliament _goatState_selection) (_goatState_attachmentMap)++potatoHandlerInputFromGoatState :: GoatState -> PotatoHandlerInput+potatoHandlerInputFromGoatState GoatState {..} = r where+  last_workspace = _goatState_workspace+  last_pFState = _owlPFWorkspace_owlPFState last_workspace+  r = PotatoHandlerInput {+    _potatoHandlerInput_pFState       = last_pFState+    , _potatoHandlerInput_potatoDefaultParameters = _goatState_potatoDefaultParameters+    , _potatoHandlerInput_broadPhase  = _goatState_broadPhaseState+    , _potatoHandlerInput_renderCache = _goatState_renderCache++    -- the screen region in canvas space+    , _potatoHandlerInput_screenRegion = LBox (-_goatState_pan) _goatState_screenRegion++    , _potatoHandlerInput_layersState     = _goatState_layersState+    , _potatoHandlerInput_selection   = _goatState_selection+    , _potatoHandlerInput_canvasSelection = _goatState_canvasSelection+  }+++++-- | filters out keyboard input based on the configuration+-- must provide last character-unbroken sequence of text input in order to detect grapheme cluster+-- relies on assumption 🙈+-- let ...(n-1)(n) be a sequence of codepoints that is a grapheme cluster+-- then ...(n-1) is also a grapheme cluster+potatoModifyKeyboardKey :: PotatoConfiguration -> Text -> KeyboardData -> Maybe KeyboardData+potatoModifyKeyboardKey PotatoConfiguration {..} lastUnbrokenCharacters k = case k of+  KeyboardData (KeyboardKey_Char c) mods -> r where+    fulltext = T.snoc lastUnbrokenCharacters c+    r = if not _potatoConfiguration_allowGraphemeClusters && endsInGraphemeCluster fulltext+      then Nothing+      else case _potatoConfiguration_allowOrReplaceUnicodeWideChars of+        Nothing -> Just k+        Just x -> if getCharWidth c > 1+          then maybe Nothing (\nc -> Just (KeyboardData (KeyboardKey_Char nc) mods))  x+          else Just k+  _ -> Just k++-- TODO probably should have done "Endo GoatState" instead of "GoatCmd"+-- TODO extract this method into another file+-- TODO make State monad for this+foldGoatFn :: GoatCmd -> GoatState -> GoatState+--foldGoatFn cmd goatStateIgnore = trace ("FOLDING " <> show cmd) $ finalGoatState where+foldGoatFn cmd goatStateIgnore = finalGoatState where++  -- TODO do some sort of rolling buffer here prob+  -- NOTE even with a rolling buffer, I think this will leak if no one forces the thunk!+  --goatState = goatStateIgnore { _goatState_debugCommands = cmd:_goatState_debugCommands }+  goatState' = goatStateIgnore++  -- it's convenient/lazy to reset unbrokenInput here, this will get overriden in cases where it needs to be+  goatState = goatState' { _goatState_unbrokenInput = "" }+  last_unbrokenInput = _goatState_unbrokenInput goatState'+  last_workspace = _goatState_workspace goatState+  last_pFState = _owlPFWorkspace_owlPFState last_workspace++  potatoHandlerInput = potatoHandlerInputFromGoatState goatState++  -- TODO this step can update OwlState built-in cache (via select operation)+  -- | Process commands |+  goatCmdTempOutput = case (_goatState_handler goatState) of+    SomePotatoHandler handler -> case cmd of+      GoatCmdSetDebugLabel x -> makeGoatCmdTempOutputFromNothing $ goatState { _goatState_debugLabel = x }+      GoatCmdSetCanvasRegionDim x -> makeGoatCmdTempOutputFromNothing $ goatState { _goatState_screenRegion = x }+      GoatCmdWSEvent x ->  makeGoatCmdTempOutputFromEvent goatState x+      GoatCmdNewFolder x -> makeGoatCmdTempOutputFromEvent goatState newFolderEv where+        folderPos = lastPositionInSelection (_owlPFState_owlTree . _owlPFWorkspace_owlPFState $  (_goatState_workspace goatState)) (_goatState_selection goatState)+        newFolderEv = WSEAddFolder (folderPos, x)+      GoatCmdLoad (spf, cm) -> r where+        -- HACK this won't get generated until later but we need this to generate layersState...+        -- someday we'll split up foldGoatFn by `GoatCmd` (or switch to Endo `GoatState`) and clean this up+        tempOwlPFStateHack = sPotatoFlow_to_owlPFState spf+        r = (makeGoatCmdTempOutputFromEvent goatState (WSELoad spf)) {+            _goatCmdTempOutput_pan = Just $ _controllerMeta_pan cm+            , _goatCmdTempOutput_layersState = Just $ makeLayersStateFromOwlPFState tempOwlPFStateHack (_controllerMeta_layers cm)+           }+++      GoatCmdTool x -> r where+        -- TODO do we need to cancel the old handler?+        r = makeGoatCmdTempOutputFromNothing (goatState { _goatState_handler = makeHandlerFromNewTool goatState x })++      GoatCmdSetFocusedArea gfa -> makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea goatState gfa++      GoatCmdMouse mouseData ->+        let+          sameSource = _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState) == _lMouseData_isLayerMouse mouseData+          mouseSourceFailure = _mouseDrag_state (_goatState_mouseDrag goatState) /= MouseDragState_Up && not sameSource+          mouseDrag = case _mouseDrag_state (_goatState_mouseDrag goatState) of+            MouseDragState_Up        -> newDrag mouseData+            MouseDragState_Cancelled -> (continueDrag mouseData (_goatState_mouseDrag goatState)) { _mouseDrag_state = MouseDragState_Cancelled }++            _                        ->  continueDrag mouseData (_goatState_mouseDrag goatState)++          canvasDrag = toRelMouseDrag last_pFState (_goatState_pan goatState) mouseDrag++          goatState_withNewMouse = goatState {+              _goatState_mouseDrag = mouseDrag+              , _goatState_focusedArea = if isLayerMouse then GoatFocusedArea_Layers else GoatFocusedArea_Canvas+            }+          -- TODO call makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea and merge outputs instead UG, or is there a trick for us to be renentrant into foldGoatFn?++          noChangeOutput = makeGoatCmdTempOutputFromNothing goatState_withNewMouse++          isLayerMouse = _mouseDrag_isLayerMouse mouseDrag++        in case _mouseDrag_state mouseDrag of++          -- hack to recover after sameSource issue+          -- TODO TEST+          _ | mouseSourceFailure -> assert False $+            forceResetBothHandlersAndMakeGoatCmdTempOutput goatState_withNewMouse++          -- if mouse was cancelled, update _goatState_mouseDrag accordingly+          MouseDragState_Cancelled -> if _lMouseData_isRelease mouseData+            then makeGoatCmdTempOutputFromNothing $ goatState_withNewMouse { _goatState_mouseDrag = def }+            else noChangeOutput -- still cancelled++          -- if mouse is intended for layers+          _ | isLayerMouse -> case pHandleMouse (_goatState_layersHandler goatState) potatoHandlerInput (RelMouseDrag mouseDrag) of+            Just pho -> makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState_withNewMouse pho+            Nothing  -> noChangeOutput++          -- if middle mouse button, create a temporary PanHandler+          MouseDragState_Down | _lMouseData_button mouseData == MouseButton_Middle -> r where+            panhandler = def { _panHandler_maybePrevHandler = Just (SomePotatoHandler handler) }+            r = case pHandleMouse panhandler potatoHandlerInput canvasDrag of+              Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho+              Nothing -> error "PanHandler expected to capture mouse input"++          -- pass onto canvas handler+          _ -> case pHandleMouse handler potatoHandlerInput canvasDrag of+            Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho++            -- input not captured by handler, pass onto select or select+drag+            Nothing | _mouseDrag_state mouseDrag == MouseDragState_Down -> assert (not $ pIsHandlerActive handler) r where+              r = case pHandleMouse (def :: SelectHandler) potatoHandlerInput canvasDrag of+                Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho+                Nothing -> error "handler was expected to capture this mouse state"++            Nothing -> error $ "handler " <> show (pHandlerName handler) <> "was expected to capture mouse state " <> show (_mouseDrag_state mouseDrag)++      GoatCmdKeyboard kbd' -> let+          next_unbrokenInput = case kbd' of+            KeyboardData (KeyboardKey_Char c) _ -> T.snoc last_unbrokenInput c+            _ -> ""+          mkbd =   potatoModifyKeyboardKey (_goatState_configuration goatState) last_unbrokenInput kbd'+          goatState_withKeyboard =  goatState { _goatState_unbrokenInput = next_unbrokenInput}+        in case mkbd of+          Nothing -> makeGoatCmdTempOutputFromNothing 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+            canceledMouse = cancelDrag (_goatState_mouseDrag goatState_withKeyboard)+            goatState_withNewMouse = goatState_withKeyboard {+                _goatState_mouseDrag = canceledMouse++                -- escape will cancel mouse focus+                -- TODO this isn't correct, you have some handlers that cancel into each other, you should only reset to GoatFocusedArea_None if they canceled to Nothing+                , _goatState_focusedArea = GoatFocusedArea_None++              }++            -- TODO use _goatState_focusedArea instead+            r = if _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState_withKeyboard)+              then case pHandleMouse (_goatState_layersHandler goatState_withKeyboard) potatoHandlerInput (RelMouseDrag canceledMouse) of+                Just pho -> makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState_withNewMouse pho+                Nothing  -> makeGoatCmdTempOutputFromNothingClearHandler goatState_withNewMouse+              else case pHandleMouse handler potatoHandlerInput (toRelMouseDrag last_pFState (_goatState_pan goatState_withKeyboard) canceledMouse) of+                Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho+                Nothing  -> makeGoatCmdTempOutputFromNothingClearHandler goatState_withNewMouse++          -- we are in the middle of mouse drag, ignore all keyboard inputs+          -- perhaps a better way to do this is to have handlers capture all inputs when active+          Just _ | mouseDrag_isActive (_goatState_mouseDrag goatState_withKeyboard) -> makeGoatCmdTempOutputFromNothing goatState_withKeyboard++          Just kbd ->+            let+              maybeHandleLayers = do+                guard $ _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState_withKeyboard)+                pho <- pHandleKeyboard (_goatState_layersHandler goatState_withKeyboard) potatoHandlerInput kbd+                return $ makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState_withKeyboard pho+            in case maybeHandleLayers of+              Just x -> x+              Nothing -> case pHandleKeyboard handler potatoHandlerInput kbd of+                Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withKeyboard pho+                -- input not captured by handler+                -- TODO consider wrapping this all up in KeyboardHandler or something? Unfortunately, copy needs to modify goatState_withKeyboard which PotatoHandlerOutput can't atm+                Nothing -> case kbd of+                  KeyboardData KeyboardKey_Esc _ ->+                    (makeGoatCmdTempOutputFromNothing goatState_withKeyboard) {+                        -- TODO change tool back to select?+                        -- cancel selection if we are in a neutral mouse state and there is no handler+                        _goatCmdTempOutput_select = case _mouseDrag_state (_goatState_mouseDrag goatState_withKeyboard) of+                          MouseDragState_Up        -> Just (False, isParliament_empty)+                          MouseDragState_Cancelled -> Just (False, isParliament_empty)+                          _                        -> Nothing+                      }++                  KeyboardData (KeyboardKey_Delete) [] -> r where+                    r = makeGoatCmdTempOutputFromMaybeEvent goatState_withKeyboard (deleteSelectionEvent goatState_withKeyboard)+                  KeyboardData (KeyboardKey_Backspace) [] -> r where+                    r = makeGoatCmdTempOutputFromMaybeEvent goatState_withKeyboard (deleteSelectionEvent goatState_withKeyboard)++                  KeyboardData (KeyboardKey_Char 'c') [KeyModifier_Ctrl] -> r where+                    copied = makeClipboard goatState_withKeyboard+                    r = makeGoatCmdTempOutputFromNothing $ goatState_withKeyboard { _goatState_clipboard = copied }+                  KeyboardData (KeyboardKey_Char 'x') [KeyModifier_Ctrl] -> r where+                    copied = makeClipboard goatState_withKeyboard+                    r = makeGoatCmdTempOutputFromMaybeEvent (goatState_withKeyboard { _goatState_clipboard = copied }) (deleteSelectionEvent goatState_withKeyboard)+                  KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl] -> case _goatState_clipboard goatState_withKeyboard of+                    Nothing    -> makeGoatCmdTempOutputFromNothing goatState_withKeyboard+                    Just stree -> r where++                      -- TODO this is totally wrong, it won't handle parent/children stuff correctly+                      -- TODO convert to MiniOwlTree :D+                      offsetstree = offsetSEltTree (V2 1 1) stree+                      minitree' = owlTree_fromSEltTree offsetstree+                      maxid1 = owlTree_maxId minitree' + 1+                      maxid2 = owlPFState_nextId (_owlPFWorkspace_owlPFState (_goatState_workspace goatState_withKeyboard))+                      minitree = owlTree_reindex (max maxid1 maxid2) minitree'+                      spot = lastPositionInSelection (goatState_owlTree goatState_withKeyboard) (_goatState_selection goatState_withKeyboard)+                      treePastaEv = WSEAddTree (spot, minitree)++++                      r = makeGoatCmdTempOutputFromEvent (goatState_withKeyboard { _goatState_clipboard = Just offsetstree }) treePastaEv+                  KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl] -> r where+                    r = makeGoatCmdTempOutputFromEvent goatState_withKeyboard WSEUndo+                  KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl] -> r where+                    r = makeGoatCmdTempOutputFromEvent goatState_withKeyboard WSERedo+                  -- tool hotkeys+                  KeyboardData (KeyboardKey_Char key) _ -> r where+                    mtool = case key of+                      'v' -> Just Tool_Select+                      '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+                    r = makeGoatCmdTempOutputFromNothing $ goatState_withKeyboard { _goatState_handler = newHandler }++                  -- unhandled input+                  _ -> makeGoatCmdTempOutputFromNothing goatState_withKeyboard++  -- | update OwlPFWorkspace from GoatCmdTempOutput |+  (workspace_afterEvent, cslmap_afterEvent) = case _goatCmdTempOutput_pFEvent goatCmdTempOutput of+    -- if there was no update, then changes are not valid+    Nothing   -> (_goatState_workspace goatState, IM.empty)+    Just (_, wsev) -> (r1,r2) where+      r1 = updateOwlPFWorkspace wsev (_goatState_workspace goatState)+      r2 = _owlPFWorkspace_lastChanges r1+  pFState_afterEvent = _owlPFWorkspace_owlPFState workspace_afterEvent++  -- | update pan from GoatCmdTempOutput |+  next_pan = case _goatCmdTempOutput_pan goatCmdTempOutput of+    Nothing -> _goatState_pan goatState+    Just (V2 dx dy) -> V2 (cx0+dx) (cy0 + dy) where+      V2 cx0 cy0 = _goatState_pan goatState++  -- | get layersState from GoatCmdTempOutput |+  next_layersState'' = case _goatCmdTempOutput_layersState goatCmdTempOutput of+    Nothing -> _goatState_layersState goatState+    Just ls -> ls++  -- | get selection from GoatCmdTempOutput |+  mSelectionFromPho = case _goatCmdTempOutput_select goatCmdTempOutput of+    Nothing -> Nothing+    --Just (add, sel) -> assert (superOwlParliament_isValid nextot r) $ Just r where+    Just (add, sel) -> assert (superOwlParliament_isValid nextot r) (Just r)where+      nextot = _owlPFState_owlTree pFState_afterEvent+      r' = if add+        then superOwlParliament_disjointUnionAndCorrect nextot (_goatState_selection goatState) sel+        else sel+      r = SuperOwlParliament . Seq.sortBy (owlTree_superOwl_comparePosition nextot) . unSuperOwlParliament $ r'++  -- | compute selection based on changes from updating OwlPFState (i.e. auto select newly created stuff if appropriate) |+  (isNewSelection', selectionAfterChanges) = if IM.null cslmap_afterEvent+    then (False, _goatState_selection goatState)+    else r where++      -- extract elements that got created+      newEltFoldMapFn rid v = case v of+        Nothing     -> []+        Just sowl -> if IM.member rid (_owlTree_mapping . _owlPFState_owlTree $ last_pFState) then [] else [sowl]++      -- NOTE, undoing a deleted element counts as a newly created element (and will be auto-selected)+      newlyCreatedSEltls = IM.foldMapWithKey newEltFoldMapFn cslmap_afterEvent++      sortedNewlyCreatedSEltls = SuperOwlParliament $ Seq.sortBy (owlTree_superOwl_comparePosition $ _owlPFState_owlTree $ pFState_afterEvent) (Seq.fromList newlyCreatedSEltls)+      -- pretty sure this does the same thing..+      --sortedNewlyCreatedSEltls = makeSortedSuperOwlParliament (_owlPFState_owlTree $ pFState_afterEvent) (Seq.fromList newlyCreatedSEltls)++      wasLoad = case cmd of+        GoatCmdLoad _ -> True+        _             -> False++      r = if wasLoad || null newlyCreatedSEltls+        -- if there are no newly created elts, we still need to update the selection+        then (\x -> (False, SuperOwlParliament x)) $ catMaybesSeq . flip fmap (unSuperOwlParliament (_goatState_selection goatState)) $ \sowl ->+          case IM.lookup (_superOwl_id sowl) cslmap_afterEvent of+            -- no changes means not deleted+            Nothing       -> Just sowl+            -- if deleted, remove it+            Just Nothing  -> Nothing+            -- it was changed, update selection to newest version+            Just (Just x) -> Just x+        else (True, sortedNewlyCreatedSEltls)++  -- for now, newly created stuff is the same as anything that got auto selected+  --newlyCreatedRids = IS.fromList . toList . fmap _superOwl_id . unSuperOwlParliament $ selectionAfterChanges++  -- | update the new selection based on previous computations|+  (isNewSelection, next_selection) = case mSelectionFromPho of+    Just x  -> assert (not isNewSelection') (True, x)+    -- better/more expensive check to ensure mSelectionFromPho stuff is mutually exclusive to selectionAfterChanges+    --Just x -> assert (selectionAfterChanges == _goatState_selection) (True, x)+    Nothing -> (isNewSelection', selectionAfterChanges)++  -- | update LayersState based from SuperOwlChanges after applying events |+  next_layersState' = updateLayers pFState_afterEvent cslmap_afterEvent next_layersState''++  -- | auto-expand folders and compute LayersState |+  -- auto expand folders for selected elements + (this will also auto expand when you drag or paste stuff into a folder)+  -- NOTE this will prevent you from ever collapsing a folder that has a selected child in it+  -- so maybe auto expand should only happen on newly created elements or add a way to detect for newly selected elements (e.g. diff between old selection)+  next_layersState = expandAllCollapsedParents next_selection pFState_afterEvent next_layersState'+  --next_layersState = next_layersState'+++  -- | update the next handler |+  mHandlerFromPho = _goatCmdTempOutput_nextHandler goatCmdTempOutput+  filterHiddenOrLocked sowl = not $ layerMetaMap_isInheritHiddenOrLocked (_owlPFState_owlTree pFState_afterEvent) (_superOwl_id sowl) (_layersState_meta next_layersState)+  next_canvasSelection = superOwlParliament_convertToCanvasSelection (_owlPFState_owlTree pFState_afterEvent) filterHiddenOrLocked next_selection+  nextHandlerFromSelection = makeHandlerFromSelection next_canvasSelection+  next_handler' = if isNewSelection+    -- if there is a new selection, update the handler with new selection if handler wasn't active+    then maybeUpdateHandlerFromSelection (fromMaybe (SomePotatoHandler EmptyHandler) mHandlerFromPho) next_canvasSelection+    -- otherwise, use the returned handler or make a new one from selection+    else fromMaybe nextHandlerFromSelection mHandlerFromPho+  next_layersHandler' = goatCmdTempOutput_layersHandler goatCmdTempOutput+  (next_handler, next_layersHandler) = case _goatCmdTempOutput_pFEvent goatCmdTempOutput of+++    -- TODO you only need to do this if handler is one that came from mHandlerFromPho+    -- if there was a non-canvas event, reset the handler D:+    -- since we don't have multi-user events, the handler should never be active when this happens+    Just (False, _) -> assert (not (pIsHandlerActive next_handler')) $ (refreshedHandler,refreshedLayersHandler) where+      -- CAREFUL INFINITE LOOP DANGER WITH USE OF `finalGoatState`+      -- safe for now, since `potatoHandlerInputFromGoatState` does not use `_goatState_handler/_goatState_layersHandler finalGoatState` which is set to `next_handler/next_layersHandler`+      next_potatoHandlerInput = potatoHandlerInputFromGoatState finalGoatState+      refreshedHandler = fromMaybe nextHandlerFromSelection ( pRefreshHandler next_handler' next_potatoHandlerInput)+      refreshedLayersHandler = fromMaybe (SomePotatoHandler (def :: LayersHandler)) (pRefreshHandler next_layersHandler' next_potatoHandlerInput)++++    _ -> (next_handler', next_layersHandler')++  -- | TODO enter rename mode for newly created folders |+  -- TODO if cslmap_afterEvent has a newly created folder (i.e. we just createda folder) then we want to enter rename mode for that folder+    -- this is not correct, we want a condition for when we hit the "new folder" button. Perhaps there needs to be a separate command for enter rename and FE triggers 2 events in succession?+  --_goatState_layersHandler++  -- | update AttachmentMap based on new state and clear the cache on these changes |+  next_attachmentMap = updateAttachmentMapFromSuperOwlChanges cslmap_afterEvent (_goatState_attachmentMap goatState)+  -- we need to union with `_goatState_attachmentMap` as next_attachmentMap does not contain deleted targets and stuff we detached from+  attachmentMapForComputingChanges = IM.unionWith IS.union next_attachmentMap (_goatState_attachmentMap goatState)+  --attachmentChanges = trace "ATTACHMENTS" $ traceShow (IM.size cslmap_afterEvent) $ traceShowId $ getChangesFromAttachmentMap (_owlPFState_owlTree pFState_afterEvent) attachmentMapForComputingChanges cslmap_afterEvent+  attachmentChanges = getChangesFromAttachmentMap (_owlPFState_owlTree pFState_afterEvent) attachmentMapForComputingChanges cslmap_afterEvent++  -- | compute SuperOwlChanges for rendering |+  cslmap_withAttachments = IM.union cslmap_afterEvent attachmentChanges+  cslmap_fromLayersHide = _goatCmdTempOutput_changesFromToggleHide goatCmdTempOutput+  cslmap_forRendering = cslmap_fromLayersHide `IM.union` cslmap_withAttachments++  -- | clear the cache at places that have changed+  renderCache_resetOnChangesAndAttachments = renderCache_clearAtKeys (_goatState_renderCache goatState) (IM.keys cslmap_withAttachments)++  -- | update the BroadPhase+  (needsupdateaabbs, next_broadPhaseState) = update_bPTree (_owlPFState_owlTree pFState_afterEvent) cslmap_forRendering (_broadPhaseState_bPTree (_goatState_broadPhaseState goatState))++  -- | update the rendered region if we moved the screen |+  canvasRegionBox = LBox (-next_pan) (goatCmdTempOutput_screenRegion goatCmdTempOutput)+  newBox = canvasRegionBox+  didScreenRegionMove = _renderedCanvasRegion_box (_goatState_renderedCanvas goatState) /= newBox+  rendercontext_forMove = RenderContext {+      _renderContext_cache = renderCache_resetOnChangesAndAttachments+      , _renderContext_owlTree = _owlPFState_owlTree pFState_afterEvent+      , _renderContext_layerMetaMap = _layersState_meta next_layersState+      , _renderContext_broadPhase = next_broadPhaseState+      , _renderContext_renderedCanvasRegion = _goatState_renderedCanvas goatState+    }+  rendercontext_forUpdate = if didScreenRegionMove+    then moveRenderedCanvasRegion newBox rendercontext_forMove+    else rendercontext_forMove++  -- | render the scene if there were changes, note that updates from actual changes are mutually exclusive from updates due to panning (although I think it would still work even if it weren't) |+  rendercontext_afterUpdate = if IM.null cslmap_forRendering+    then rendercontext_forUpdate+    else updateCanvas cslmap_forRendering needsupdateaabbs rendercontext_forUpdate++  next_renderedCanvas = _renderContext_renderedCanvasRegion rendercontext_afterUpdate++  -- | render the selection |+  rendercontext_forSelection = rendercontext_afterUpdate {+      -- NOTE this will render hidden stuff that's selected via layers!!+      _renderContext_layerMetaMap = IM.empty++      -- TODO DELETE THIS YOU SHOULDN'T HAVE TO DO THIS, this is breaking caching (you can fix by commenting it out)+      -- IDK WHY BUT IF YOU SELECT AUTOLINE WITH BOX AND MOVE BOTH THE CACHE STAYS WITH ORIGINAL PLACE AND SELECTED LINE DOESN'T MOVE+      -- so temp fix it by reseting the cache on attached lines whos target moved+      , _renderContext_cache = renderCache_resetOnChangesAndAttachments++      -- empty canvas to render our selection in+      -- we just re-render everything for now (in the future you can try and do partial rendering though)+      , _renderContext_renderedCanvasRegion = emptyRenderedCanvasRegion newBox+    }+  selectionselts = toList . fmap _superOwl_id $ unSuperOwlParliament next_selection++  (next_renderedSelection, next_renderCache) = if _goatState_selection goatState == next_selection && not didScreenRegionMove && IM.null cslmap_forRendering+    -- nothing changed, we can keep our selection rendering+    then (_goatState_renderedSelection goatState, _renderContext_cache rendercontext_afterUpdate)+    else (_renderContext_renderedCanvasRegion rctx, _renderContext_cache rctx) where+      rctx = render_new newBox selectionselts rendercontext_forSelection++  -- TODO just DELETE this...+  {- TODO render only parts of selection that have changed TODO broken+  next_renderedSelection' = if didScreenRegionMove+    then moveRenderedCanvasRegion next_broadPhaseState (owlTree_withCacheResetOnAttachments) newBox _goatState_renderedSelection+    else _goatState_renderedSelection+  prevSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Nothing)) $ unSuperOwlParliament _goatState_selection+  curSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Just sowl)) $ unSuperOwlParliament next_selection+  -- TODO you can be even smarter about this by combining cslmap_forRendering I think+  cslmapForSelectionRendering = curSelChangeMap `IM.union` prevSelChangeMap+  -- you need to do something like this but this is wrong....+  --(needsupdateaabbsforrenderselection, _) = update_bPTree cslmapForSelectionRendering (_broadPhaseState_bPTree next_broadPhaseState)+  needsupdateaabbsforrenderselection = needsupdateaabbs+  next_renderedSelection = if IM.null cslmapForSelectionRendering+    then next_renderedSelection'+    else updateCanvas cslmapForSelectionRendering needsupdateaabbsforrenderselection next_broadPhaseState pFState_withCacheResetOnAttachments next_renderedSelection'+  -}++  next_pFState = pFState_afterEvent { _owlPFState_owlTree = _renderContext_owlTree rendercontext_forSelection }+  next_workspace = workspace_afterEvent { _owlPFWorkspace_owlPFState = next_pFState}++  checkAttachmentMap = owlTree_makeAttachmentMap (_owlPFState_owlTree next_pFState) == next_attachmentMap++  -- TODO remove assert in production builds+  finalGoatState = if not checkAttachmentMap+    then error $ (show (owlTree_makeAttachmentMap (_owlPFState_owlTree next_pFState))) <> "\n\n\n" <> show next_attachmentMap+    else+      (_goatCmdTempOutput_goatState goatCmdTempOutput) {+        _goatState_workspace      = next_workspace+        , _goatState_pan             = next_pan+        , _goatState_layersHandler  = next_layersHandler+        , _goatState_handler         = next_handler+        , _goatState_selection       = next_selection+        , _goatState_canvasSelection = next_canvasSelection+        , _goatState_broadPhaseState = next_broadPhaseState+        , _goatState_renderedCanvas = next_renderedCanvas+        , _goatState_renderedSelection = next_renderedSelection+        , _goatState_layersState     = next_layersState+        , _goatState_attachmentMap = next_attachmentMap+        , _goatState_renderCache = next_renderCache+      }
+ src/Potato/Flow/Controller/Handler.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Controller.Handler where++import           Relude++import           Potato.Flow.BroadPhase+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.OwlLayers+import           Potato.Flow.Controller.Types+import           Potato.Flow.Math+import           Potato.Flow.Owl+import           Potato.Flow.Render+import           Potato.Flow.OwlState+import           Potato.Flow.OwlWorkspace+import           Potato.Flow.SElts++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++data PotatoHandlerOutput = PotatoHandlerOutput {+    _potatoHandlerOutput_nextHandler             :: Maybe SomePotatoHandler+    , _potatoHandlerOutput_select                :: Maybe (Bool, Selection)+    , _potatoHandlerOutput_pFEvent               :: Maybe WSEvent+    , _potatoHandlerOutput_pan                   :: Maybe XY+    , _potatoHandlerOutput_layersState           :: Maybe LayersState+    , _potatoHandlerOutput_changesFromToggleHide :: SuperOwlChanges+  } deriving (Show)++instance Default PotatoHandlerOutput where+  def = PotatoHandlerOutput {+      _potatoHandlerOutput_nextHandler = Nothing+      , _potatoHandlerOutput_pFEvent = Nothing+      , _potatoHandlerOutput_pan = Nothing+      , _potatoHandlerOutput_select = Nothing+      , _potatoHandlerOutput_layersState = Nothing+      , _potatoHandlerOutput_changesFromToggleHide = IM.empty+    }++-- TODO replace this with just GoatState+data PotatoHandlerInput = PotatoHandlerInput {+    -- from PFOutput+    _potatoHandlerInput_pFState                   :: OwlPFState+    , _potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters+    , _potatoHandlerInput_broadPhase              :: BroadPhaseState+    , _potatoHandlerInput_renderCache :: RenderCache++    -- from Frontend+    , _potatoHandlerInput_layersState             :: LayersState+    , _potatoHandlerInput_screenRegion            :: LBox+++    -- from Backend+    -- basically, handlers are created based on contents of selection, and handlers themselves are expected to use partial methods on selection to get relevant information in order to modify the selection+    -- note that selection is dynamically updated each type a change is made so it always has up to date information during a multi-step manipulate+    -- this is sort of just how it is right now, I wish it weren't so :_(+    , _potatoHandlerInput_selection               :: Selection+    , _potatoHandlerInput_canvasSelection         :: CanvasSelection++    -- TODO+    --, _potatoHandlerInput_canvasSelection :: CanvasSelection+    -- superOwlParliament_convertToCanvasSelection+  }++type ColorType = ()+data SimpleBoxHandlerRenderOutput = SimpleBoxHandlerRenderOutput {+    _simpleBoxHandlerRenderOutput_box             :: LBox+    , _simpleBoxHandlerRenderOutput_fillText      :: Maybe PChar -- fills the entire box with the same char+    , _simpleBoxHandlerRenderOutput_fillTextColor :: ColorType+    , _simpleBoxHandlerRenderOutput_bgColor       :: ColorType+  }++-- TODO remove renaming and move it into LayersHandlerRenderEntry+data LayersHandlerRenderEntrySelectedState = LHRESS_ChildSelected | LHRESS_Selected | LHRESS_InheritSelected | LHRESS_None deriving (Show, Eq)++{--instance Eq LayersHandlerRenderEntrySelectedState where+  (==) (LHRESS_Renaming x) (LHRESS_Renaming y) = x == y+  (==) LHRESS_Selected LHRESS_Selected = True+  (==) LHRESS_InheritSelected LHRESS_InheritSelected = True+  (==) LHRESS_None LHRESS_None = True+  (==) LHRESS_ChildSelected LHRESS_ChildSelected = True+  (==) _ _ = False--}++-- depth at which dots are added if any+type LayersHandlerRenderEntryDots = Maybe Int+-- are we renaming this one+type LayersHandlerRenderEntryRenaming = Maybe TZ.TextZipper++data LayersHandlerRenderEntry =+  LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState LayersHandlerRenderEntryDots LayersHandlerRenderEntryRenaming LayerEntry+  | LayersHandlerRenderEntryDummy Int+  deriving (Eq, Show)++layersHandlerRenderEntry_depth :: LayersHandlerRenderEntry -> Int+layersHandlerRenderEntry_depth (LayersHandlerRenderEntryNormal _ _ _ lentry) = layerEntry_depth lentry+layersHandlerRenderEntry_depth (LayersHandlerRenderEntryDummy i) = i++-- hack to render layers view via HandlerRenderOutput (we could have just as well put this in LayerState I guesss)+data LayersViewHandlerRenderOutput = LayersViewHandlerRenderOutput {+    _layersViewHandlerRenderOutput_entries :: Seq LayersHandlerRenderEntry+  } deriving (Eq, Show)++instance Default LayersViewHandlerRenderOutput where+  def = LayersViewHandlerRenderOutput {+      _layersViewHandlerRenderOutput_entries = Seq.empty+    }++data RenderHandleColor = RHC_Default | RHC_Attachment | RHC_AttachmentHighlight deriving (Show, Eq)++-- TODO come up with better name+data RenderHandle = RenderHandle {+    _renderHandle_box     :: LBox+    , _renderHandle_char  :: Maybe PChar+    , _renderHandle_color :: RenderHandleColor+  } deriving (Show, Eq)++defaultRenderHandle :: LBox -> RenderHandle+defaultRenderHandle lbox = RenderHandle lbox (Just 'X') RHC_Default++-- TODO come up with better name+data HandlerRenderOutput = HandlerRenderOutput {+    _handlerRenderOutput_temp :: [RenderHandle] -- list of coordinates where there are handles+  } deriving (Eq)++instance Semigroup HandlerRenderOutput where+  a <> b = HandlerRenderOutput {+      _handlerRenderOutput_temp = _handlerRenderOutput_temp a <> _handlerRenderOutput_temp b+    }++instance Default HandlerRenderOutput where+  def = emptyHandlerRenderOutput++emptyHandlerRenderOutput :: HandlerRenderOutput+emptyHandlerRenderOutput = HandlerRenderOutput { _handlerRenderOutput_temp = [] }+++-- we check handler name for debug reasons so it's useful to have constants+-- there should be no non-test code that depends on comparing pHandlerName+handlerName_box :: Text+handlerName_box = "BoxHandler"+handlerName_simpleLine :: Text+handlerName_simpleLine = "AutoLineHandler"+handlerName_simpleLine_endPoint :: Text+handlerName_simpleLine_endPoint = "AutoLineEndPointHandler"+handlerName_simpleLine_midPoint :: Text+handlerName_simpleLine_midPoint = "AutoLineMidPointHandler"+handlerName_simpleLine_textLabel :: Text+handlerName_simpleLine_textLabel = "AutoLineLabelHandler"+handlerName_simpleLine_textLabelMover :: Text+handlerName_simpleLine_textLabelMover = "AutoLineLabelMoverHandler"+handlerName_layers :: Text+handlerName_layers = "LayersHandler"+handlerName_layersRename :: Text+handlerName_layersRename = "LayersRenameHandler"+handlerName_cartesianLine :: Text+handlerName_cartesianLine = "CartesianLineHandler"+handlerName_boxText :: Text+handlerName_boxText = "BoxTextHandler"+handlerName_boxLabel :: Text+handlerName_boxLabel = "BoxLabelHandler"+handlerName_textArea :: Text+handlerName_textArea = "TextAreaHandler"+handlerName_pan :: Text+handlerName_pan = "PanHandler"+handlerName_select :: Text+handlerName_select = "SelectHandler"+handlerName_empty :: Text+handlerName_empty = "EmptyHandler"+++-- TODO prob replace this with 'data PotatoHandler' rather than typeclass+-- TODO rename methods in here..+-- TODO rename to Manipulator XD+class PotatoHandler h where+  pHandlerName :: h -> Text++  -- TODO do the generic thing where (Show h) whatever (I guess this only works when you use deriving or something though?)+  pHandlerDebugShow :: h -> Text+  pHandlerDebugShow h = pHandlerName h <> " <no debug info>"++  -- TODO consider removing Selection from input args since it should be static through lifetime of handler and therefore passed in during construction+  -- i.e. invariant is selection changed -> new handler++  -- TODO need to add broadphase to args as it's used for finding new selections..+  -- TODO maybe split into handleLayerMouse (MouseDrag) and handleCanvasMouse (RelMosueDrag)?+  -- NOTE, MouseDragState_Cancelled will never be passed into this+  -- return type of Nothing means input is not captured+  pHandleMouse :: h -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput+  pHandleMouse _ _ _ = Nothing++  -- return type of Nothing means input is not captured+  pHandleKeyboard :: h -> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput+  pHandleKeyboard _ _ _ = Nothing++  -- reset handler if an event came in in between (e.g. due to undo, redo)+  -- returns Nothing if the handler no longer exists after refreshing+  --+  -- FOR NOW we expect this to only be called if handler is not active+  -- FOR NOW this is only allowed to return the existing handler+  -- when we have multi-user, this may return actions (to undo some inprogress state I guess?), and may happen when a handler is active+  --+  pRefreshHandler :: h -> PotatoHandlerInput -> Maybe SomePotatoHandler+  pRefreshHandler _ _ = Nothing++  -- active manipulators will not be overwritten by new handlers via selection from changes+  pIsHandlerActive :: h -> Bool+  pIsHandlerActive _ = False++  pRenderHandler :: h -> PotatoHandlerInput -> HandlerRenderOutput+  pRenderHandler _ _ = def++  -- ad-hoc render function just for layers+  -- note that this renders layers even when there is no drop location to be rendered (which is owned by the LayersHandler)+  -- a bit of a hack but it's easier this way, the other way to do it would have been to put drop location inside of LayersState+  -- layers are different because when rendering drop location, it's not a strict overlay so normal render/handler render (drop location) are combined+  pRenderLayersHandler :: h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput+  pRenderLayersHandler _ _ = def++  -- helper method used to check that we aren't feeding invalid mouse states+  pValidateMouse :: h -> RelMouseDrag -> Bool+  -- default version that ensures mouse state is valid when handler is active+  pValidateMouse h (RelMouseDrag MouseDrag {..}) = case _mouseDrag_state of+    MouseDragState_Cancelled -> False+    MouseDragState_Down      -> not $ pIsHandlerActive h+    _                        -> True++  -- determine which selected tool to show+  pHandlerTool :: h -> Maybe Tool+  pHandlerTool _ = Nothing++data SomePotatoHandler = forall h . PotatoHandler h  => SomePotatoHandler h++instance PotatoHandler SomePotatoHandler where+  pHandlerName (SomePotatoHandler h) = pHandlerName h+  pHandlerDebugShow (SomePotatoHandler h) = pHandlerDebugShow h+  pHandleMouse (SomePotatoHandler h) = pHandleMouse h+  pHandleKeyboard (SomePotatoHandler h) = pHandleKeyboard h+  pIsHandlerActive (SomePotatoHandler h) = pIsHandlerActive h+  pRefreshHandler (SomePotatoHandler h) = pRefreshHandler h+  pRenderHandler (SomePotatoHandler h) = pRenderHandler h+  pRenderLayersHandler (SomePotatoHandler h) = pRenderLayersHandler h+  pValidateMouse (SomePotatoHandler h) = pValidateMouse h+  pHandlerTool (SomePotatoHandler h) = pHandlerTool h++captureWithNoChange :: (PotatoHandler h) => h -> PotatoHandlerOutput+captureWithNoChange h = def {+    _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler h+  }++setHandlerOnly :: (PotatoHandler h) => h -> PotatoHandlerOutput+setHandlerOnly = captureWithNoChange++instance Show SomePotatoHandler where+  show (SomePotatoHandler h) = T.unpack $ "SomePotatoHandler " <> pHandlerName h <> " active: " <> show (pIsHandlerActive h)++testHandleMouse :: SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput+testHandleMouse (SomePotatoHandler h) phi rmd = pHandleMouse h phi rmd+++data EmptyHandler = EmptyHandler++instance PotatoHandler EmptyHandler where+  pHandlerName _ = "EmptyHandler"+  pHandleMouse _ _ _ = Nothing+  pHandleKeyboard _ _ _ = Nothing+  pRenderHandler _ _ = def+  pValidateMouse _ _ = True+++{--+-- you can do something like the below to have handlers share some functionality+-- unfortuantely, the design below is not very composable, although maybe this isn't really something that can be composed+data ActiveHandlerState s = ActiveHandlerState {+    _activeHandlerState_isActive :: Bool+    _activeHandlerState_userState :: s+  }++data ActiveHandler s = ActiveHandler {+  _activeHandler_pHandleMouse :: s -> PotatoHandlerInput -> RelMouseDrag -> (Bool, Maybe PotatoHandlerOutput)+  -- ...+}+--}
+ src/Potato/Flow/Controller/Input.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Input (+  KeyModifier(..)+  , KeyboardData(..)+  , KeyboardKey(..)+  , MouseButton(..)+  , MouseDragState(..)+  , LMouseData(..)+  , MouseDrag(..)+  , mouseDrag_isActive+  , newDrag+  , continueDrag+  , cancelDrag+  , mouseDragDelta+  , RelMouseDrag(..)+  , toRelMouseDrag+) where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.OwlState++import           Control.Exception    (assert)+import           Data.Default++-- TODO consider adding space as a modifier so you can do space drag panning in web version+data KeyModifier = KeyModifier_Shift | KeyModifier_Alt | KeyModifier_Ctrl deriving (Show, Eq)++-- KEYBOARD+data KeyboardData = KeyboardData KeyboardKey [KeyModifier] deriving (Show)++data KeyboardKey =+  KeyboardKey_Esc+  | KeyboardKey_Return+  | KeyboardKey_Space+  | KeyboardKey_Delete+  | KeyboardKey_Backspace+  | KeyboardKey_Left+  | KeyboardKey_Right+  | KeyboardKey_Up+  | KeyboardKey_Down+  | KeyboardKey_Home+  | KeyboardKey_End+  | KeyboardKey_PageUp+  | KeyboardKey_PageDown+  | KeyboardKey_Char Char+  -- not really a keypress but it's fine to put it here+  | KeyboardKey_Paste Text++  -- easier to handle as keyboard input+  | KeyboardKey_Scroll Int+  deriving (Show, Eq)++-- MOUSE+data MouseButton = MouseButton_Left | MouseButton_Middle | MouseButton_Right deriving (Show, Eq)++data MouseDragState = MouseDragState_Down | MouseDragState_Dragging | MouseDragState_Up | MouseDragState_Cancelled deriving (Show, Eq)++-- TODO add modifier+-- TODO is this the all encompassing mouse event we want?+-- TODO is there a way to optionally support more fidelity here?+-- mouse drags are sent as click streams+data LMouseData = LMouseData {+  _lMouseData_position       :: XY+  , _lMouseData_isRelease    :: Bool+  , _lMouseData_button       :: MouseButton+  , _lMouseData_modifiers    :: [KeyModifier]+  , _lMouseData_isLayerMouse :: Bool+} deriving (Show, Eq)++data MouseDrag = MouseDrag {+  _mouseDrag_from           :: XY+  , _mouseDrag_button       :: MouseButton -- tracks button on start of drag+  , _mouseDrag_modifiers    :: [KeyModifier] -- tracks modifiers held at current state of drag+  , _mouseDrag_to           :: XY -- likely not needed as they will be in the input event, but whatever+  , _mouseDrag_state        :: MouseDragState+  , _mouseDrag_isLayerMouse :: Bool+} deriving (Show, Eq)++mouseDrag_isActive :: MouseDrag -> Bool+mouseDrag_isActive MouseDrag {..} = case _mouseDrag_state of+  MouseDragState_Down     -> True+  MouseDragState_Dragging -> True+  _                       -> False++instance Default MouseDrag where+  def = MouseDrag {+      _mouseDrag_from  = 0+      , _mouseDrag_button = MouseButton_Left+      , _mouseDrag_modifiers = []+      , _mouseDrag_to    = 0+      , _mouseDrag_state = MouseDragState_Up -- if the last state was MouseDragState_Up we are ready to process more inputs fresh+      , _mouseDrag_isLayerMouse = False+    }++newDrag :: LMouseData -> MouseDrag+newDrag LMouseData {..} = assert (not _lMouseData_isRelease) $ MouseDrag {+    _mouseDrag_from = _lMouseData_position+    , _mouseDrag_button = _lMouseData_button+    , _mouseDrag_modifiers = _lMouseData_modifiers+    , _mouseDrag_to = _lMouseData_position+    , _mouseDrag_state = MouseDragState_Down+    , _mouseDrag_isLayerMouse = _lMouseData_isLayerMouse+  }++continueDrag :: LMouseData -> MouseDrag -> MouseDrag+continueDrag LMouseData {..} md = md {+    _mouseDrag_to = _lMouseData_position+    , _mouseDrag_state = if _lMouseData_isRelease+      then MouseDragState_Up+      else MouseDragState_Dragging+    , _mouseDrag_modifiers = _lMouseData_modifiers+  }++cancelDrag :: MouseDrag -> MouseDrag+cancelDrag md = md { _mouseDrag_state = case _mouseDrag_state md of+    MouseDragState_Up -> MouseDragState_Up+    _                 -> MouseDragState_Cancelled+  }++-- wats this for D:?+mouseDragDelta :: MouseDrag -> MouseDrag -> XY+mouseDragDelta md prev = (_mouseDrag_to md) - (_mouseDrag_to prev)++-- TODO rename to CanvasMouseDrag+-- represents MouseDrag in local coordinates (e.g. canvas coordinates)+newtype RelMouseDrag = RelMouseDrag MouseDrag deriving (Show)++toRelMouseDrag :: OwlPFState -> XY -> MouseDrag -> RelMouseDrag+toRelMouseDrag pfs pan md = RelMouseDrag $ md {+    _mouseDrag_from = owlPFState_toCanvasCoordinates pfs (_mouseDrag_from md) - pan+    , _mouseDrag_to = owlPFState_toCanvasCoordinates pfs (_mouseDrag_to md) - pan+  }
+ src/Potato/Flow/Controller/Manipulator/Box.hs view
@@ -0,0 +1,388 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.Box (+  BoxHandleType(..)+  , BoxHandler(..)+  , BoxCreationType(..)+  , makeHandleBox+  , makeDeltaBox+  --, MouseManipulator(..)+) where++import           Relude++import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Manipulator.BoxText+import           Potato.Flow.Controller.Manipulator.TextArea+import           Potato.Flow.Controller.Manipulator.Common+import           Potato.Flow.Controller.Types+import           Potato.Flow.Math+import           Potato.Flow.SEltMethods+import           Potato.Flow.SElts+import           Potato.Flow.Types+import           Potato.Flow.OwlItem+import Potato.Flow.Owl+import           Potato.Flow.OwlItem+import Potato.Flow.OwlState+import           Potato.Flow.OwlItem+import Potato.Flow.OwlWorkspace+import Potato.Flow.Methods.Types+import Potato.Flow.Llama++import           Data.Default+import           Data.Dependent.Sum                         (DSum ((:=>)))+import qualified Data.IntMap                                as IM+import qualified Data.Map as Map+import qualified Data.List                                  as L+import qualified Data.Sequence as Seq++import Control.Exception (assert)++++superOwl_isTransformable :: (HasOwlTree o) => SuperOwl -> o -> Bool+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)))+  _ -> True++transformableSelection :: PotatoHandlerInput -> Seq SuperOwl+transformableSelection PotatoHandlerInput {..} = transformableSelection' _potatoHandlerInput_pFState _potatoHandlerInput_canvasSelection++transformableSelection' :: OwlPFState -> CanvasSelection -> Seq SuperOwl+transformableSelection' pfs sel = Seq.filter (flip superOwl_isTransformable pfs) (unCanvasSelection sel)+++-- TODO rework this stuff, it was written with old assumptions that don't make sense anymore+data MouseManipulatorType = MouseManipulatorType_Corner | MouseManipulatorType_Side | MouseManipulatorType_Point | MouseManipulatorType_Area | MouseManipulatorType_Text deriving (Show, Eq)+data MouseManipulator = MouseManipulator {+  _mouseManipulator_box    :: LBox+  , _mouseManipulator_type :: MouseManipulatorType+  -- back reference to object being manipulated?+  -- or just use a function+}+type MouseManipulatorSet = [MouseManipulator]+type ManipulatorIndex = Int++toMouseManipulators :: OwlPFState -> CanvasSelection -> MouseManipulatorSet+toMouseManipulators pfs selection' = bb where+  union_lBoxes :: NonEmpty LBox -> LBox+  union_lBoxes (x:|xs) = foldl' union_lBox x xs+  selection = transformableSelection' pfs selection'+  fmapfn sowl = _sEltDrawer_box (getDrawer . hasOwlItem_toOwlSubItem $ sowl) pfs+  -- consider filtering out boxes with 0 area, but really _sEltDrawer_box should have return type Maybe LBox+  sboxes = toList $ fmap fmapfn selection+  bb = case sboxes of+    []   -> []+    x:xs -> fmap (flip makeHandleBox (union_lBoxes (x:|xs))) [BH_TL .. BH_A]++findFirstMouseManipulator :: OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe ManipulatorIndex+findFirstMouseManipulator pfs (RelMouseDrag MouseDrag {..}) selection = r where+  mms = toMouseManipulators pfs selection+  smt = computeSelectionType selection++  -- TODO use select magic here+  normalSel = L.findIndex (\mm -> does_lBox_contains_XY (_mouseManipulator_box mm) _mouseDrag_from) mms+  r = case smt of+    SMTTextArea -> normalSel -- TODO figure out how to differentiate between area / text manipulator+    _       -> normalSel+++-- order is manipulator index+data BoxHandleType = BH_TL | BH_TR | BH_BL | BH_BR | BH_A | BH_T | BH_B | BH_L | BH_R  deriving (Show, Eq, Enum)++makeHandleBox ::+  BoxHandleType+  -> LBox -- ^ box being manipulated+  -> MouseManipulator+makeHandleBox bht (LBox (V2 x y) (V2 w h)) = case bht of+  BH_BR -> MouseManipulator box MouseManipulatorType_Corner+  BH_TL -> MouseManipulator box MouseManipulatorType_Corner+  BH_TR -> MouseManipulator box MouseManipulatorType_Corner+  BH_BL -> MouseManipulator box MouseManipulatorType_Corner+  BH_A  -> MouseManipulator box MouseManipulatorType_Area+  _     -> MouseManipulator box MouseManipulatorType_Side+  where+    (px, py) = (0,0) -- pan position+    CanonicalLBox _ _ clbox = canonicalLBox_from_lBox $ LBox (V2 (x+px) (y+py)) (V2 w h)+    nudgex = if w < 0 then 1 else 0+    nudgey = if h < 0 then 1 else 0+    l = x+px-1 + nudgex+    t = y+py-1 + nudgey+    r = x+px+w - nudgex+    b = y+py+h - nudgey+    box = case bht of+      BH_BR -> LBox (V2 r b) (V2 1 1)+      BH_TL -> LBox (V2 l t) (V2 1 1)+      BH_TR -> LBox (V2 r t) (V2 1 1)+      BH_BL -> LBox (V2 l b) (V2 1 1)+      BH_A  -> clbox+      _     -> error "not supported yet"++makeDeltaBox :: BoxHandleType -> XY -> DeltaLBox+makeDeltaBox bht (V2 dx dy) = case bht of+  BH_BR -> DeltaLBox 0 $ V2 dx dy+  BH_TL -> DeltaLBox (V2 dx dy) (V2 (-dx) (-dy))+  BH_TR -> DeltaLBox (V2 0 dy) (V2 dx (-dy))+  BH_BL -> DeltaLBox (V2 dx 0) (V2 (-dx) dy)+  BH_T  -> DeltaLBox (V2 0 dy) (V2 0 (-dy))+  BH_B  -> DeltaLBox 0 (V2 0 dy)+  BH_L  -> DeltaLBox (V2 dx 0) (V2 (-dx) 0)+  BH_R  -> DeltaLBox 0 (V2 dx 0)+  BH_A  -> DeltaLBox (V2 dx dy) (V2 0 0)++++-- TODO rename to BoxHandlerType or something+data BoxCreationType = BoxCreationType_None | BoxCreationType_Box | BoxCreationType_Text | BoxCreationType_TextArea | BoxCreationType_DragSelect deriving (Show, Eq)++boxCreationType_isCreation :: BoxCreationType -> Bool+boxCreationType_isCreation bct = bct /= BoxCreationType_None && bct /= BoxCreationType_DragSelect+++-- new handler stuff+data BoxHandler = BoxHandler {++    _boxHandler_handle      :: BoxHandleType -- the current handle we are dragging+    , _boxHandler_undoFirst :: Bool++    -- with this you can use same code for both create and manipulate (create the handler and immediately pass input to it)+    , _boxHandler_creation  :: BoxCreationType+    , _boxHandler_active    :: Bool++    , _boxHandler_downOnLabel :: Bool++  } deriving (Show)++makeDragDeltaBox :: BoxHandleType -> RelMouseDrag -> DeltaLBox+makeDragDeltaBox bht rmd = r where+  RelMouseDrag MouseDrag {..} = rmd+  dragDelta = _mouseDrag_to - _mouseDrag_from+  shiftClick = elem KeyModifier_Shift _mouseDrag_modifiers++  boxRestrictedDelta = if shiftClick+    then restrict8 dragDelta+    else dragDelta++  r = makeDeltaBox bht boxRestrictedDelta++makeDragOperation :: Bool -> PotatoHandlerInput -> DeltaLBox -> Maybe WSEvent+makeDragOperation undoFirst phi dbox = op where+  selection = transformableSelection phi++  makeController _ = cmd where+    cmd = CTagBoundingBox :=> (Identity $ CBoundingBox {+      _cBoundingBox_deltaBox = dbox+    })++  op = if Seq.null selection+    then Nothing+    else Just $ WSEApplyLlama (undoFirst, makePFCLlama . OwlPFCManipulate $ IM.fromList (fmap (\s -> (_superOwl_id s, makeController s)) (toList selection)))++-- TODO split this handler in two handlers+-- one for resizing selection (including boxes)+-- and one exclusively for creating boxes+instance Default BoxHandler where+  def = BoxHandler {+      _boxHandler_handle       = BH_BR+      , _boxHandler_undoFirst  = False+      , _boxHandler_creation = BoxCreationType_None+      , _boxHandler_active = False+      , _boxHandler_downOnLabel = False+      -- TODO whatever+      --, _boxHandler_wasDragged = False+    }++++selectionOnlySBox :: CanvasSelection -> Maybe SBox+selectionOnlySBox (CanvasSelection selection) = if Seq.length selection == 1+  then case superOwl_toSElt_hack (Seq.index selection 0) of+    SEltBox sbox -> Just sbox+    _ -> Nothing+  else Nothing+++isMouseOnSelectionSBoxBorder :: CanvasSelection -> RelMouseDrag -> Bool+isMouseOnSelectionSBoxBorder cs (RelMouseDrag MouseDrag {..}) = case selectionOnlySBox cs of+  -- not an SBox selected+  Nothing -> False+  Just sbox -> if sBoxType_hasBorder (_sBox_boxType sbox) && does_lBox_contains_XY (lBox_to_boxLabelBox (_sBox_box sbox)) _mouseDrag_from+    then True+    else False+++instance PotatoHandler BoxHandler where+  pHandlerName _ = handlerName_box+  pHandleMouse bh@BoxHandler {..} phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = case _mouseDrag_state of++    -- TODO creation should be a separate handler+    MouseDragState_Down | boxCreationType_isCreation _boxHandler_creation ->  Just $ def {+        _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler bh { _boxHandler_active = True }+      }+    -- if shift is held down, ignore inputs, this allows us to shift + click to deselect+    -- TODO consider moving this into GoatWidget since it's needed by many manipulators+    MouseDragState_Down | elem KeyModifier_Shift _mouseDrag_modifiers -> Nothing+    -- in DragSelect case we already have a selection+    MouseDragState_Down | _boxHandler_creation == BoxCreationType_DragSelect  -> assert (not . isParliament_null $ _potatoHandlerInput_selection) r where+        newbh = bh {+            -- drag select case is always BH_A+            _boxHandler_handle = BH_A+            , _boxHandler_active = True+          }+        r = Just def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh }+    MouseDragState_Down -> case findFirstMouseManipulator _potatoHandlerInput_pFState rmd _potatoHandlerInput_canvasSelection of+      Nothing -> Nothing++++      -- clicked on a manipulator, begin dragging+      Just mi -> r where+        newbh = bh {+            _boxHandler_handle = bht+            , _boxHandler_active = True+            -- label position always intersects BH_A so we do the test in here to see if we clicked on the label area+            , _boxHandler_downOnLabel = if bht == BH_A then isMouseOnSelectionSBoxBorder _potatoHandlerInput_canvasSelection rmd else False+          }+        bht = toEnum mi+        -- special case behavior for BH_A require actually clicking on something on selection+        clickOnSelection = any (doesSEltIntersectPoint _mouseDrag_to . superOwl_toSElt_hack) $ unCanvasSelection _potatoHandlerInput_canvasSelection+        r = if bht /= BH_A || clickOnSelection+          then Just def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh }+          else Nothing+++    MouseDragState_Dragging -> Just r where+      dragDelta = _mouseDrag_to - _mouseDrag_from+      newEltPos = lastPositionInSelection (_owlPFState_owlTree _potatoHandlerInput_pFState) _potatoHandlerInput_selection++      -- TODO do I use this for box creation? Prob want to restrictDiag or something though+      --shiftClick = elem KeyModifier_Shift _mouseDrag_modifiers+      --boxRestrictedDelta = if shiftClick then restrict8 dragDelta else dragDelta++      boxToAdd = def {+          _sBox_box     = canonicalLBox_from_lBox_ $ LBox _mouseDrag_from dragDelta+          -- consider using _potatoDefaultParameters_boxType instead+          , _sBox_boxType  = if _boxHandler_creation == BoxCreationType_Text+            then SBoxType_BoxText -- TODO pull from params+            else SBoxType_Box+          , _sBox_superStyle = _potatoDefaultParameters_superStyle _potatoHandlerInput_potatoDefaultParameters+          , _sBox_title = def { _sBoxTitle_align = _potatoDefaultParameters_box_label_textAlign _potatoHandlerInput_potatoDefaultParameters }+          , _sBox_text = def { _sBoxText_style = def { _textStyle_alignment = _potatoDefaultParameters_box_text_textAlign _potatoHandlerInput_potatoDefaultParameters } }+        }++      textAreaToAdd = def {+          _sTextArea_box   =  canonicalLBox_from_lBox_ $ LBox _mouseDrag_from dragDelta+          , _sTextArea_text        = Map.empty+          , _sTextArea_transparent = True+        }++      nameToAdd = case _boxHandler_creation of+        BoxCreationType_Box -> "<box>"+        BoxCreationType_Text -> "<text>"+        BoxCreationType_TextArea -> "<textarea>"+        _ -> error "invalid BoxCreationType"++      mop = case _boxHandler_creation of+        x | x == BoxCreationType_Box || x == BoxCreationType_Text -> Just $ WSEAddElt (_boxHandler_undoFirst, newEltPos, OwlItem (OwlInfo nameToAdd) (OwlSubItemBox boxToAdd))+        BoxCreationType_TextArea -> Just $ WSEAddElt (_boxHandler_undoFirst, newEltPos, OwlItem (OwlInfo nameToAdd) (OwlSubItemTextArea textAreaToAdd))+        _ -> makeDragOperation _boxHandler_undoFirst phi (makeDragDeltaBox _boxHandler_handle rmd)++      newbh = bh {+          _boxHandler_undoFirst = True+          -- if we drag, we are no longer in label case+          , _boxHandler_downOnLabel = False+        }++      -- NOTE, that if we did create a new box, it wil get auto selected and a new BoxHandler will be created for it++      r = def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh+          , _potatoHandlerOutput_pFEvent = mop+        }++    MouseDragState_Up | _boxHandler_downOnLabel -> if isMouseOnSelectionSBoxBorder _potatoHandlerInput_canvasSelection rmd+      -- clicked on the box label area+      -- pass on mouse as MouseDragState_Down is a hack but whatever it works+      -- TODO fix this hack, just have mouse up handle selection in this special case+      then pHandleMouse (makeBoxLabelHandler (SomePotatoHandler (def :: BoxHandler)) _potatoHandlerInput_canvasSelection rmd) phi rmd+      else Nothing+    MouseDragState_Up -> r where++      -- TODO do selectMagic here so we can enter text edit modes from multi-selections (you will also need to modify the selection)+      nselected = Seq.length (unCanvasSelection _potatoHandlerInput_canvasSelection)+      selt = superOwl_toSElt_hack <$> selectionToMaybeFirstSuperOwl _potatoHandlerInput_canvasSelection+      isText = nselected == 1 && case selt of+        Just (SEltBox SBox{..}) -> sBoxType_isText _sBox_boxType+        _                                    -> False+      isTextArea = nselected == 1 && case selt of+        Just (SEltTextArea _) -> True+        _ -> False+++      -- only enter sub handler if we weren't drag selecting (this includes selecting it from an unselect state without dragging)+      wasNotDragSelecting = not (_boxHandler_creation == BoxCreationType_DragSelect)+      -- only enter subHandler we did not drag (hack, we do this by testing form _boxHandler_undoFirst)+      wasNotActuallyDragging = not _boxHandler_undoFirst+      -- always go straight to handler after creating a new SElt+      isCreation = boxCreationType_isCreation _boxHandler_creation+      r = if isText+          && (wasNotActuallyDragging || isCreation)+          && wasNotDragSelecting+        -- create box handler and pass on the input+        then pHandleMouse (makeBoxTextHandler (SomePotatoHandler (def :: BoxHandler)) _potatoHandlerInput_canvasSelection rmd) phi rmd+        else if isTextArea+          && (wasNotActuallyDragging || isCreation)+          && wasNotDragSelecting+          then pHandleMouse (makeTextAreaHandler (SomePotatoHandler (def :: BoxHandler)) _potatoHandlerInput_canvasSelection rmd isCreation) phi rmd+          -- This clears the handler and causes selection to regenerate a new handler.+          -- Why do we do it this way instead of returning a handler? Not sure, doesn't matter.+          else Just def++      -- TODO consider handling special case, handle when you click and release create a box in one spot, create a box that has size 1 (rather than 0 if we did it during MouseDragState_Down normal way)++    -- TODO check undo first condition+    MouseDragState_Cancelled -> if _boxHandler_undoFirst then Just def { _potatoHandlerOutput_pFEvent = Just WSEUndo } else Just def+++  pHandleKeyboard bh phi@PotatoHandlerInput {..} (KeyboardData key _) = r where++    todlbox (x,y) = Just $ DeltaLBox (V2 x y) 0+    mmove = case key of+      KeyboardKey_Left -> todlbox (-1,0)+      KeyboardKey_Right -> todlbox (1,0)+      KeyboardKey_Up -> todlbox (0,-1)+      KeyboardKey_Down -> todlbox (0,1)+      _ -> Nothing++    r = if _boxHandler_active bh+      -- ignore inputs when we're in the middle of dragging+      then Nothing+      else case mmove of+        Nothing -> Nothing+        Just move -> Just r2 where+          mop = makeDragOperation False phi move+          r2 = def {+              _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler bh+              , _potatoHandlerOutput_pFEvent = mop+            }++  pRenderHandler BoxHandler {..} PotatoHandlerInput {..} = r where+    handlePoints = fmap _mouseManipulator_box . filter (\mm -> _mouseManipulator_type mm == MouseManipulatorType_Corner) $ toMouseManipulators _potatoHandlerInput_pFState _potatoHandlerInput_canvasSelection+    -- TODO highlight active manipulator if active+    --if (_boxHandler_active)+    r = if not _boxHandler_active && boxCreationType_isCreation _boxHandler_creation +      -- don't render anything if we are about to create a box+      then emptyHandlerRenderOutput+      else HandlerRenderOutput (fmap defaultRenderHandle handlePoints)+  pIsHandlerActive = _boxHandler_active++  pHandlerTool BoxHandler {..} = case _boxHandler_creation of+    BoxCreationType_Box -> Just Tool_Box+    BoxCreationType_Text -> Just Tool_Text+    BoxCreationType_TextArea -> Just Tool_TextArea+    _ -> Nothing
+ src/Potato/Flow/Controller/Manipulator/BoxText.hs view
@@ -0,0 +1,433 @@+{-# LANGUAGE RecordWildCards #-}++-- TODO probably move this to Manipulator.Box.Text+module Potato.Flow.Controller.Manipulator.BoxText (+  BoxTextHandler(..)+  , TextInputState(..)+  , makeBoxTextHandler+  , BoxLabelHandler(..)+  , makeBoxLabelHandler+  , lBox_to_boxLabelBox++  -- exposed for testing+  , makeTextInputState+  , mouseText++) where++import           Relude++import Potato.Flow.Controller.Manipulator.TextInputState+import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Manipulator.Common+import           Potato.Flow.Math+import           Potato.Flow.SElts+import           Potato.Flow.Types+import Potato.Flow.Owl+import Potato.Flow.OwlWorkspace+import Potato.Flow.Llama++import           Control.Exception+import           Data.Default+import           Data.Dependent.Sum                        (DSum ((:=>)))+import qualified Data.IntMap                               as IM+import qualified Data.Sequence                             as Seq+import qualified Potato.Data.Text.Zipper                          as TZ+import qualified Text.Pretty.Simple as Pretty+import qualified Data.Text.Lazy as LT++getSBox :: CanvasSelection -> (REltId, SBox)+getSBox selection = case superOwl_toSElt_hack sowl of+  SEltBox sbox -> (rid, sbox)+  selt -> error $ "expected SBox, got " <> show selt+  where+    sowl = selectionToSuperOwl selection+    rid = _superOwl_id sowl++-- | shrink an LBox uniformly in each direction, but don't allow it to become negative+shrink_lBox_no_negative :: LBox -> Int -> Int -> LBox+shrink_lBox_no_negative (LBox (V2 x y) (V2 w h)) dw dh = LBox (V2 nx ny) (V2 nw nh) where+  (nx, nw) = if w <= 2*dw +    then if w <= dw +      -- prioritize shrinking from the right+      then (x, 0)+      else (x + (w - dw), 0)+    else (x+dw, w-2*dw)+  (ny, nh) = if h <= 2*dh+    then if h <= dh+      -- prioritize shrinking from the bottom+      then (y, 0)+      else (y + (h - dh), 0)+    else (y+dh, h-2*dh)+++getSBoxTextBox :: SBox -> CanonicalLBox +getSBoxTextBox sbox = r where+  CanonicalLBox fx fy box' = canonicalLBox_from_lBox $ _sBox_box sbox+  r = CanonicalLBox fx fy $  if sBoxType_hasBorder (_sBox_boxType sbox)+    then shrink_lBox_no_negative box' 1 1+    else box'+++updateTextInputStateWithSBox :: SBox -> TextInputState -> TextInputState+updateTextInputStateWithSBox sbox btis = r where+  alignment = convertTextAlignToTextZipperTextAlignment . _textStyle_alignment . _sBoxText_style . _sBox_text $ sbox+  CanonicalLBox _ _ newBox@(LBox _ (V2 width _)) = getSBoxTextBox sbox+  r = btis {+      _textInputState_box = newBox+      , _textInputState_displayLines = TZ.displayLinesWithAlignment alignment width () () (_textInputState_zipper btis)+    }++-- TODO I think you need to pad empty lines in the zipper to fill out the box D:+-- ok, no you don't, that's only for the non-paragraph text area that we don't actually have yet+makeTextInputState :: REltId -> SBox -> RelMouseDrag -> TextInputState+makeTextInputState rid sbox rmd = r where+  ogtext = _sBoxText_text . _sBox_text $ sbox+  ogtz = TZ.fromText ogtext+  r' = TextInputState {+      _textInputState_rid = rid+      , _textInputState_original   = Just ogtext+      , _textInputState_zipper   = ogtz++      -- these fields get updated in next pass+      , _textInputState_box = error "expected to be filled"+      , _textInputState_displayLines = error "expected to be filled"++      --, _textInputState_selected = 0+    }+  r'' = updateTextInputStateWithSBox sbox r'+  r = mouseText r'' rmd++-- TODO support shift selecting text someday meh+-- | returns zipper in TextInputState after keyboard input has been applied+-- Bool indicates if there was any real input+inputBoxTextZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)+inputBoxTextZipper tais kk = (changed, tais { _textInputState_zipper = newZip }) where++  oldZip = _textInputState_zipper tais+  (changed, newZip) = case kk of+    KeyboardKey_Left    -> (False, TZ.left oldZip)+    KeyboardKey_Right   -> (False, TZ.right oldZip)+    KeyboardKey_Up      -> (False, TZ.up oldZip)+    KeyboardKey_Down    -> (False, TZ.down oldZip)+    KeyboardKey_Home    -> (False, TZ.home oldZip)+    KeyboardKey_End -> (False, TZ.end oldZip)+    KeyboardKey_PageUp -> (False, TZ.pageUp 5 oldZip)+    KeyboardKey_PageDown -> (False, TZ.pageDown 5 oldZip)++    KeyboardKey_Return  -> (True, TZ.insertChar '\n' oldZip)+    KeyboardKey_Space   -> (True, TZ.insertChar ' ' oldZip)+    KeyboardKey_Delete  -> (True, TZ.deleteRight oldZip)+    KeyboardKey_Backspace -> (True, TZ.deleteLeft oldZip)+    KeyboardKey_Char c  -> (True, TZ.insertChar c oldZip)+    KeyboardKey_Paste t -> (True, TZ.insert t oldZip)++    k                   -> error $ "unexpected keyboard char (event should have been handled outside of this handler)" <> show k++inputBoxText :: TextInputState -> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe WSEvent)+inputBoxText tais undoFirst sowl kk = (newtais, mop) where+  (changed, newtais) = inputBoxTextZipper tais kk+  controller = CTagBoxText :=> (Identity $ CBoxText {+      _cBoxText_deltaText = (fromMaybe "" (_textInputState_original tais), TZ.value (_textInputState_zipper newtais))+    })+  mop = if changed+    then Just $ WSEApplyLlama (undoFirst, makePFCLlama . OwlPFCManipulate $ IM.fromList [(_superOwl_id sowl,controller)])+    else Nothing++data BoxTextHandler = BoxTextHandler {+    -- TODO rename to active+    _boxTextHandler_isActive      :: Bool+    , _boxTextHandler_state       :: TextInputState+    -- TODO you can prob delete this now, we don't persist state between sub handlers in this case+    , _boxTextHandler_prevHandler :: SomePotatoHandler+    , _boxTextHandler_undoFirst   :: Bool+  }++makeBoxTextHandler :: SomePotatoHandler -> CanvasSelection -> RelMouseDrag -> BoxTextHandler+makeBoxTextHandler prev selection rmd = BoxTextHandler {+      _boxTextHandler_isActive = False+      , _boxTextHandler_state = uncurry makeTextInputState (getSBox selection) rmd+      , _boxTextHandler_prevHandler = prev+      , _boxTextHandler_undoFirst = False+    }++updateBoxTextHandlerState :: Bool -> CanvasSelection -> BoxTextHandler -> BoxTextHandler+updateBoxTextHandlerState reset selection tah@BoxTextHandler {..} = assert tzIsCorrect r where+  (_, sbox) = getSBox selection++  newText = _sBoxText_text . _sBox_text $ sbox++  recomputetz = TZ.fromText newText+  oldtz = _textInputState_zipper _boxTextHandler_state+  -- NOTE that recomputetz won't have the same cursor position+  -- TODO delete this check, not very meaningful, but good for development purposes I guess+  tzIsCorrect = TZ.value oldtz == TZ.value recomputetz++  nextstate = updateTextInputStateWithSBox sbox _boxTextHandler_state++  r = tah {+    _boxTextHandler_state = if reset+      then nextstate {+          _textInputState_original = Just newText+        }+      else nextstate+    , _boxTextHandler_undoFirst = if reset+      then False+      else _boxTextHandler_undoFirst+  }++instance PotatoHandler BoxTextHandler where+  pHandlerName _ = handlerName_boxText+  pHandlerDebugShow BoxTextHandler {..} = LT.toStrict $ Pretty.pShowNoColor _boxTextHandler_state+  pHandleMouse tah' phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let+      tah@BoxTextHandler {..} = updateBoxTextHandlerState False _potatoHandlerInput_canvasSelection tah'+    in case _mouseDrag_state of+      MouseDragState_Down -> r where+        clickInside = does_lBox_contains_XY (_textInputState_box _boxTextHandler_state) _mouseDrag_to+        newState = mouseText _boxTextHandler_state rmd+        r = if clickInside+          then Just $ def {+              _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {+                  _boxTextHandler_isActive = True+                  , _boxTextHandler_state = newState+                }+            }+          -- pass the input on to the base handler (so that you can interact with BoxHandler mouse manipulators too)+          else pHandleMouse _boxTextHandler_prevHandler phi rmd++      -- TODO drag select text someday+      MouseDragState_Dragging -> Just $ captureWithNoChange tah++      MouseDragState_Up -> Just $ def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {+              _boxTextHandler_isActive = False+              --, _boxTextHandler_undoFirst = False -- this variant adds new undo point each time cursor is moved+            }+        }+      MouseDragState_Cancelled -> Just $ captureWithNoChange tah++  pHandleKeyboard tah' PotatoHandlerInput {..} (KeyboardData k _) = case k of+    KeyboardKey_Esc -> Just $ def { _potatoHandlerOutput_nextHandler = Just (_boxTextHandler_prevHandler tah') }+    -- TODO should only capture stuff caught by inputBoxTextZipper++    _ -> Just r where+      -- this regenerates displayLines unecessarily but who cares+      tah@BoxTextHandler {..} = updateBoxTextHandlerState False _potatoHandlerInput_canvasSelection tah'+      sowl = selectionToSuperOwl _potatoHandlerInput_canvasSelection++      -- TODO decide what to do with mods++      (nexttais, mev) = inputBoxText _boxTextHandler_state _boxTextHandler_undoFirst sowl k+      r = def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {+              _boxTextHandler_state  = nexttais+              , _boxTextHandler_undoFirst = case mev of+                Nothing -> _boxTextHandler_undoFirst+                --Nothing -> False -- this variant adds new undo point each time cursoer is moved+                Just _  -> True+            }+          , _potatoHandlerOutput_pFEvent = mev+        }++  -- TODO do you need to reset _boxTextHandler_prevHandler as well?+  pRefreshHandler tah PotatoHandlerInput {..} = if Seq.null (unCanvasSelection _potatoHandlerInput_canvasSelection)+    then Nothing -- selection was deleted or something+    else if rid /= (_textInputState_rid $ _boxTextHandler_state tah)+      then Nothing -- selection was change to something else+      else case selt of+        SEltBox sbox -> if not $ sBoxType_isText (_sBox_boxType sbox)+          then Nothing -- SEltBox type changed to non-text+          -- TODO this needs to merge the TextZipper if change came due to remote event+          else Just $ SomePotatoHandler $ updateBoxTextHandlerState True _potatoHandlerInput_canvasSelection tah+        _ -> Nothing+      where+        sowl = selectionToSuperOwl _potatoHandlerInput_canvasSelection+        rid = _superOwl_id sowl+        selt = superOwl_toSElt_hack sowl++  pRenderHandler tah' phi@PotatoHandlerInput {..} = r where+    tah = updateBoxTextHandlerState False _potatoHandlerInput_canvasSelection tah'+    btis = _boxTextHandler_state tah+    r = pRenderHandler (_boxTextHandler_prevHandler tah) phi <> makeTextHandlerRenderOutput btis++  pIsHandlerActive = _boxTextHandler_isActive+++++-- BOX LABEL STUFF STARTS HERE+data BoxLabelHandler = BoxLabelHandler {+    _boxLabelHandler_active      :: Bool+    -- NOTE some fields in here are ignored or interpreted differently from BoxTextHandler+    , _boxLabelHandler_state       :: TextInputState+    , _boxLabelHandler_prevHandler :: SomePotatoHandler+    , _boxLabelHandler_undoFirst   :: Bool+  }++lBox_to_boxLabelBox :: LBox -> LBox+lBox_to_boxLabelBox lbx = r where+  CanonicalLBox _ _ (LBox (V2 x y) (V2 w _)) = canonicalLBox_from_lBox lbx+  width = max 0 (w - 2)+  r = LBox (V2 (x+1) y) (V2 width 1)+++updateBoxLabelInputStateWithSBox :: SBox -> TextInputState -> TextInputState+updateBoxLabelInputStateWithSBox sbox btis = r where+  alignment = convertTextAlignToTextZipperTextAlignment . _sBoxTitle_align . _sBox_title $ sbox+  newBox =  lBox_to_boxLabelBox $ _sBox_box sbox+  width = maxBound :: Int -- box label text always overflows+  r = btis {+      _textInputState_box = newBox+      , _textInputState_displayLines = TZ.displayLinesWithAlignment alignment width () () (_textInputState_zipper btis)+    }++makeBoxLabelInputState :: REltId -> SBox -> RelMouseDrag -> TextInputState+makeBoxLabelInputState rid sbox rmd = r where+  mogtext = _sBoxTitle_title . _sBox_title $ sbox+  ogtz = TZ.fromText (fromMaybe "" mogtext)+  r' = TextInputState {+      _textInputState_rid = rid+      , _textInputState_original   = mogtext+      , _textInputState_zipper   = ogtz++      -- these fields get updated in next pass+      , _textInputState_box = error "expected to be filled"+      , _textInputState_displayLines = error "expected to be filled"+    }+  r'' = updateBoxLabelInputStateWithSBox sbox r'+  r = mouseText r'' rmd++makeBoxLabelHandler :: SomePotatoHandler -> CanvasSelection -> RelMouseDrag -> BoxLabelHandler+makeBoxLabelHandler prev selection rmd = BoxLabelHandler {+      _boxLabelHandler_active = False+      , _boxLabelHandler_state = uncurry makeBoxLabelInputState (getSBox selection) rmd+      , _boxLabelHandler_prevHandler = prev+      , _boxLabelHandler_undoFirst = False+    }+++-- UNTESTED+updateBoxLabelHandlerState :: Bool -> CanvasSelection -> BoxLabelHandler -> BoxLabelHandler+updateBoxLabelHandlerState reset selection tah@BoxLabelHandler {..} = assert tzIsCorrect r where+  (_, sbox) = getSBox selection++  mNewText = _sBoxTitle_title . _sBox_title $ sbox++  recomputetz = TZ.fromText (fromMaybe "" mNewText)+  oldtz = _textInputState_zipper _boxLabelHandler_state+  -- NOTE that recomputetz won't have the same cursor position+  -- TODO delete this check, not very meaningful, but good for development purposes I guess+  tzIsCorrect = TZ.value oldtz == TZ.value recomputetz+  nextstate = updateBoxLabelInputStateWithSBox sbox _boxLabelHandler_state++  r = tah {+    _boxLabelHandler_state = if reset+      then nextstate {+          _textInputState_original = mNewText+        }+      else nextstate+    , _boxLabelHandler_undoFirst = if reset+      then False+      else _boxLabelHandler_undoFirst+  }+++inputBoxLabel :: TextInputState -> Bool -> SuperOwl -> KeyboardKey -> (TextInputState, Maybe WSEvent)+inputBoxLabel tais undoFirst 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)))+  mop = if changed+    then Just $ WSEApplyLlama (undoFirst, makePFCLlama . OwlPFCManipulate $ IM.fromList [(_superOwl_id sowl,controller)])+    else Nothing+++-- | just a helper for pHandleMouse+handleMouseDownOrFirstUpForBoxLabelHandler :: BoxLabelHandler -> PotatoHandlerInput -> RelMouseDrag -> SBox -> Bool -> Maybe PotatoHandlerOutput+handleMouseDownOrFirstUpForBoxLabelHandler tah@BoxLabelHandler {..} phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) sbox isdown = r where+  clickInside = does_lBox_contains_XY (_textInputState_box _boxLabelHandler_state) _mouseDrag_to+  newState = mouseText _boxLabelHandler_state rmd+  r = if clickInside+    then Just $ def {+        _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {+            _boxLabelHandler_active = isdown+            , _boxLabelHandler_state = newState+          }+      }+    -- pass the input on to the base handler (so that you can interact with BoxHandler mouse manipulators too)+    else pHandleMouse _boxLabelHandler_prevHandler phi rmd+++instance PotatoHandler BoxLabelHandler where+  pHandlerName _ = handlerName_boxLabel+  pHandlerDebugShow BoxLabelHandler {..} = LT.toStrict $ Pretty.pShowNoColor _boxLabelHandler_state++  -- UNTESTED+  pHandleMouse tah' phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let+      tah@BoxLabelHandler {..} = updateBoxLabelHandlerState False _potatoHandlerInput_canvasSelection tah'+      (_, sbox) = getSBox _potatoHandlerInput_canvasSelection+    in case _mouseDrag_state of+++      MouseDragState_Down -> handleMouseDownOrFirstUpForBoxLabelHandler tah phi rmd sbox True++      -- TODO drag select text someday+      MouseDragState_Dragging -> Just $ captureWithNoChange tah++      MouseDragState_Up -> if not _boxLabelHandler_active+        then handleMouseDownOrFirstUpForBoxLabelHandler tah phi rmd sbox False+        else Just $ def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {+                _boxLabelHandler_active = False+              }+          }++      MouseDragState_Cancelled -> Just $ captureWithNoChange tah++  pHandleKeyboard tah' PotatoHandlerInput {..} (KeyboardData k _) = case k of+    KeyboardKey_Esc -> Just $ def { _potatoHandlerOutput_nextHandler = Just (_boxLabelHandler_prevHandler tah') }+    -- TODO should only capture stuff caught by inputSingleLineZipper+    _ -> Just r where+      -- this regenerates displayLines unecessarily but who cares+      tah@BoxLabelHandler {..} = updateBoxLabelHandlerState False _potatoHandlerInput_canvasSelection tah'+      sowl = selectionToSuperOwl _potatoHandlerInput_canvasSelection++      -- TODO decide what to do with mods++      (nexttais, mev) = inputBoxLabel _boxLabelHandler_state _boxLabelHandler_undoFirst sowl k+      r = def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {+              _boxLabelHandler_state  = nexttais+              , _boxLabelHandler_undoFirst = case mev of+                Nothing -> _boxLabelHandler_undoFirst+                --Nothing -> False -- this variant adds new undo point each time cursoer is moved+                Just _  -> True+            }+          , _potatoHandlerOutput_pFEvent = mev+        }++  -- UNTESTED+  -- TODO do you need to reset _boxLabelHandler_prevHandler as well?+  pRefreshHandler tah PotatoHandlerInput {..} = if Seq.null (unCanvasSelection _potatoHandlerInput_canvasSelection)+    then Nothing -- selection was deleted or something+    else if rid /= (_textInputState_rid $ _boxLabelHandler_state tah)+      then Nothing -- selection was change to something else+      else case selt of+        SEltBox sbox -> if sBoxType_hasBorder (_sBox_boxType sbox)+          -- TODO this needs to merge the TextZipper if change came due to remote event+          then Just $ SomePotatoHandler $ updateBoxLabelHandlerState True _potatoHandlerInput_canvasSelection tah+          -- SEltBox type changed to non-text+          else Nothing+        _ -> Nothing+      where+        sowl = selectionToSuperOwl _potatoHandlerInput_canvasSelection+        rid = _superOwl_id sowl+        selt = superOwl_toSElt_hack sowl++  pRenderHandler tah' phi@PotatoHandlerInput {..} = r where+    tah = updateBoxLabelHandlerState False _potatoHandlerInput_canvasSelection tah'+    btis = _boxLabelHandler_state tah+    r = pRenderHandler (_boxLabelHandler_prevHandler tah) phi <> makeTextHandlerRenderOutput btis++  pIsHandlerActive = _boxLabelHandler_active
+ src/Potato/Flow/Controller/Manipulator/CartLine.hs view
@@ -0,0 +1,287 @@+-- TODO DELETE ME+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.CartLine (+  CartLineHandler(..)+) where++import           Relude++import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Manipulator.Common+import           Potato.Flow.Controller.Types+import           Potato.Flow.Math++import           Control.Exception+import           Data.Default+import qualified Text.Pretty.Simple as Pretty+import qualified Data.Text.Lazy as LT+++{- examples of how CartLine works++1---2+    |+    3+drag 2 up (1 moves as well)+1---2+    |+    |+    3+drag 2 right (3 moves as well)+1------2+       |+       |+       3++1---x---2+drag x down (later anchor always moves)+1---*+    |+    *---2++examples:+1---3---2+drag 2 up+    3---2+        |+1-------*++-}++isCartesian :: XY -> XY -> Bool+isCartesian (V2 ax ay) (V2 bx by) = ax == bx || ay == by++-- | predicate holds if pt is between a and b+-- expects a b to be in the same cartesian plane+isBetween :: XY -> (XY, XY) -> Bool+isBetween (V2 px py) (a@(V2 ax ay), b@(V2 bx by)) = assert (isCartesian a b) $ if ax == bx && ax == px+  -- if in same vertical line+  then (py >= ay && py <= by) || (py <= ay && py >= by)+  else if ay == by && ay == py+    -- if in same horizontal line+    then (px >= ax && px <= bx) || (px <= ax && px >= bx)+    else False++splitFind :: (a -> Bool) -> [a] -> ([a],[a])+splitFind p l = r where+  splitFind' rprevs [] = (rprevs,[])+  splitFind' rprevs (x:xs) = if p x+    -- note we built up backwards but we reverse at the very end+    then (reverse rprevs, x:xs)+    else splitFind' (x:rprevs) xs+  r = splitFind' [] l++-- first elt of second list is currently selected anchor (no anchor selected if empty)+-- by assumption each anchor can only differ in one component from the previous one+-- anchors must not continue forward in same direction+-- not ok: 1----2----3+--     ok: 1-3--2+data AnchorZipper = AnchorZipper [XY] [XY] deriving (Show)+emptyAnchorZipper :: AnchorZipper+emptyAnchorZipper = AnchorZipper [] []++flattenAnchors :: AnchorZipper -> [XY]+flattenAnchors (AnchorZipper xs ys) = xs <> ys++-- | flatten AnchorZipper to a plain list+-- used only in creation step, where no anchor can be focused, asserts if this condition fails+flattenAnchorsInCreation :: AnchorZipper -> [XY]+flattenAnchorsInCreation az@(AnchorZipper xs ys) = assert (length ys == 0) $ flattenAnchors az+++-- | adjacentPairs [1,2,3,4] `shouldBe` [(1,2),(2,3),(3,4)]+adjacentPairs :: [a] -> [(a,a)]+adjacentPairs [] = []+adjacentPairs (x:[]) = []+adjacentPairs (x:y:es) = (x,y) : adjacentPairs (y:es)+++-- TODO TEST+-- | validate if AnchorZipper assumptions hold+validateAnchorZipper :: AnchorZipper -> Bool+validateAnchorZipper (AnchorZipper xs1 xs2) = r where++  check1 (V2 ex ey) (V2 l1x l1y) = if ex == l1x+    then ey /= l1y+    else ey == l1y+  check2 (V2 ex ey) (V2 l1x l1y) (V2 l2x l2y) = if l1x == l2x+    -- last one was vertical, expect horizontal or reversal+    then ey == l1y || l1x - l2x > ex - l2x+    -- last one was horizontal, expect vertical or reversal+    else ex == l1x || l1y - l2y > ey - l2y++  foldfn e (pass, mlast1, mlast2) = if not pass+    then (False, Nothing, Nothing)+    else case mlast1 of+      Just last1 -> case mlast2 of+        Just last2 -> (check2 e last1 last2 , Just e, Just last1)+        Nothing -> (check1 e last1, Just e, Just last1)+      Nothing -> (True, Just e, Nothing)++  (r, _, _) = foldr foldfn (True, Nothing, Nothing) (xs1<>xs2)++data CartLineHandler = CartLineHandler {+    _cartLineHandler_anchors      :: AnchorZipper+    , _cartLineHandler_undoFirst  :: Bool+    , _cartLineHandler_isCreation :: Bool+    , _cartLineHandler_active     :: Bool+  } deriving (Show)++instance Default CartLineHandler where+  def = CartLineHandler {+      _cartLineHandler_anchors = emptyAnchorZipper+      , _cartLineHandler_undoFirst = False+      , _cartLineHandler_isCreation = False+      , _cartLineHandler_active = False+    }+++-- | get the last 2 elements of e1:e2:es+-- DELETE+last2 :: XY -> XY -> [XY] -> (XY, XY)+last2 e1 e2 es = r where+  l1 = last (e1:|e2:es)+  l2 = case (reverse es) of+    [] -> e1+    x:xs -> case xs of+      [] -> e2+      _ -> x+  r = (l1, l2)++-- helper method for creating new anchor at the end of a sequence of anchors (when creating new lines)+-- both input and output anchor list is REVERSED+elbowFromEnd :: XY -> [XY] -> [XY]+elbowFromEnd pos [] = [pos]+elbowFromEnd pos (e:[]) = r where+  V2 e1x e1y = e+  V2 dx dy = pos - e+  r = reverse $ if dx > dy+    then [e, V2 (e1x+dx) e1y] <> if dy == 0 then [] else [V2 (e1x+dx) (e1y + dy)]+    else [e, V2 e1x (e1y + dy)] <> if dx == 0 then [] else [V2 (e1x+dx) (e1y + dy)]+elbowFromEnd pos ls@(e1:(e2:es)) = r where+  V2 e1x e1y = e1+  V2 e2x e2y = e2+  V2 dx dy = pos - e1+  r = if dx == 0 && dy == 0+    then ls+    else if e1x == e2x+      -- if last was vertical+      then if dx == 0+        -- if there was no horizontal change, update the last point+        then pos:e2:es+        --last was vertical, go horizontal first+        else (if dy == 0 then [] else [V2 (e1x+dx) (e1y + dy)]) <> (V2 (e1x+dx) e1y : ls)+      -- last was horizontal+      else if dy == 0+        -- if there was no vertical change, update the last point+        then pos:e2:es+        --last was horizontal, go vertical first+        else (if dx == 0 then [] else [V2 (e1x+dx) (e1y + dy)]) <> (V2 e1x (e1y + dy) : ls)+++smartAutoPathDown :: XY -> [XY] -> [XY]+smartAutoPathDown pos es = reverse $ elbowFromEnd pos (reverse es)+++++instance PotatoHandler CartLineHandler where+  pHandlerName _ = handlerName_cartesianLine+  pHandlerDebugShow clh = LT.toStrict $ Pretty.pShowNoColor clh+  pHandleMouse clh@CartLineHandler {..} PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let++    -- restrict mouse+    dragDelta = _mouseDrag_to - _mouseDrag_from+    shiftClick = elem KeyModifier_Shift _mouseDrag_modifiers+    mousexy = _mouseDrag_from + if shiftClick+      then restrict4 dragDelta+      else dragDelta++    anchors = flattenAnchors _cartLineHandler_anchors++    in case _mouseDrag_state of+      -- if shift is held down, ignore inputs, this allows us to shift + click to deselect+      -- TODO consider moving this into GoatWidget since it's needed by many manipulators+      MouseDragState_Down | elem KeyModifier_Shift _mouseDrag_modifiers -> Nothing++      -- TODO creation should be a separate handler+      -- creation case+      MouseDragState_Down | _cartLineHandler_isCreation -> case _cartLineHandler_anchors of+        AnchorZipper _ (x:xs) -> error "this should never happen"+        AnchorZipper [] [] -> r where+          -- TODO track the fact we clicked, if we drag, pass on to SimpleLine? (but what happens if we drag back to start??)+          r = Just $ setHandlerOnly $ clh {+              _cartLineHandler_active = True+              , _cartLineHandler_anchors = AnchorZipper [mousexy] []+            }+        AnchorZipper (x:xs) [] -> if last (x :| xs) == mousexy+          -- if we click on the last dot, we're done, exit creation mode+          then Just $ setHandlerOnly $ clh {+              _cartLineHandler_isCreation = True+              , _cartLineHandler_active = False -- is it bad that we're still dragging but this is set to False?+            }+          -- otherwise, smartly path dot to destination (always make 90 degree bend from current if possible)+          else Just $ setHandlerOnly $ clh {+              _cartLineHandler_anchors = AnchorZipper+                (smartAutoPathDown mousexy (flattenAnchorsInCreation _cartLineHandler_anchors))+                []+            }+      -- TODO someday allow dragging dots on in creation case (to adjust position)+      MouseDragState_Dragging | _cartLineHandler_isCreation -> Just $ setHandlerOnly clh+      MouseDragState_Up | _cartLineHandler_isCreation ->  Just $ setHandlerOnly clh {+          -- disable creation mode on release (no reason besides it being convenient code wise)+          _cartLineHandler_isCreation = _cartLineHandler_active+        }++      -- modify existing line case+      MouseDragState_Down -> r where+        -- first go through and find dots we may have clicked on+        (dotfs,dotbs) = splitFind (== mousexy) anchors+        -- then go through and find any lines we may have clicked on+        (linefs, linebs) = splitFind (isBetween mousexy) (adjacentPairs anchors)++        r = if null dotbs+          -- we did not click on any dots+          then if null linebs+            -- we found nothing, input not captured+            then Nothing+            -- we clicked on a line+            else undefined -- TODO+          -- we clicked on a dot+          else undefined -- TODO++      -- TODO+      MouseDragState_Dragging -> r where+        r = undefined+      MouseDragState_Up -> r where+        -- on release cases, topology may change (some anchors removed), unclear how to map topology (probably need meta data to track)+        -- if release is on a dummy dot, (in between two other dots)+        -- TODO+        r = undefined++      MouseDragState_Cancelled -> Just def++  pHandleKeyboard clh PotatoHandlerInput {..} kbd = case kbd of+    -- TODO keyboard movement based on last selected manipulator I guess+    _                              -> Nothing++  pRenderHandler clh@CartLineHandler {..} PotatoHandlerInput {..} = r where+    toBoxHandle isactive xy = RenderHandle {+        _renderHandle_box = LBox xy 1+        , _renderHandle_char = if isactive then Just '+' else Just 'X'+        , _renderHandle_color = RHC_Default+      }+    AnchorZipper fronts' backs' = _cartLineHandler_anchors+    fronts = fmap (toBoxHandle False) fronts'+    backs = case backs' of+      [] -> []+      x:xs -> toBoxHandle True x : fmap (toBoxHandle False) fronts'+    r = HandlerRenderOutput (fronts <> backs)+  pIsHandlerActive = _cartLineHandler_active++  pHandlerTool CartLineHandler {..} = if _cartLineHandler_isCreation+    then Just Tool_CartLine+    else Nothing
+ src/Potato/Flow/Controller/Manipulator/Common.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.Common (+  SelectionManipulatorType(..)+  , computeSelectionType+  , restrict4+  , restrict8+  , selectionToSuperOwl+  , selectionToMaybeSuperOwl+  , selectionToFirstSuperOwl+  , selectionToMaybeFirstSuperOwl+  , lastPositionInSelection+) where++import           Relude++import           Potato.Flow.Controller.Types+import           Potato.Flow.Math+import           Potato.Flow.SElts+import           Potato.Flow.OwlItem+import Potato.Flow.Owl+import Potato.Flow.DebugHelpers++import qualified Data.Sequence                as Seq++data SelectionManipulatorType = SMTNone | SMTBox | SMTBoxText | SMTLine | SMTTextArea | SMTBoundingBox deriving (Show, Eq)++computeSelectionType :: CanvasSelection -> SelectionManipulatorType+computeSelectionType (CanvasSelection selection)= foldl' foldfn SMTNone selection where+  foldfn accType sowl = case accType of+    SMTNone -> case superOwl_toSElt_hack sowl of+      SEltBox sbox -> if sBoxType_isText (_sBox_boxType sbox) then SMTBoxText else SMTBox+      SEltLine _   -> SMTLine+      SEltTextArea _   -> SMTTextArea+      SEltFolderStart -> error "this should never happen by assumption of CanvasSelection type"+      SEltFolderEnd -> error "this should never happen by assumption of CanvasSelection type"+      --SEltNone -> SMTNone+      _            -> SMTBoundingBox+    _ -> SMTBoundingBox++restrict4 :: XY -> XY+restrict4 (V2 x y) = if abs x > abs y then V2 x 0 else V2 0 y++restrict8 :: XY -> XY+restrict8 (V2 x y) = r where+  normx = abs x+  normy = abs y+  r = if normx > normy+    then if normx*2 > normy+      then (V2 x 0)+      else (V2 x y)+    else if normy*2 > normx+      then (V2 0 y)+      else (V2 x y)++selectionToSuperOwl :: (HasCallStack) => CanvasSelection -> SuperOwl+selectionToSuperOwl (CanvasSelection selection) = assertShowAndDump selection (Seq.length selection == 1) $ Seq.index selection 0++selectionToMaybeFirstSuperOwl :: (HasCallStack) => CanvasSelection -> Maybe SuperOwl+selectionToMaybeFirstSuperOwl (CanvasSelection selection) = Seq.lookup 0 selection++selectionToMaybeSuperOwl :: (HasCallStack) => CanvasSelection -> Maybe SuperOwl+selectionToMaybeSuperOwl (CanvasSelection selection) = assertShowAndDump selection (Seq.length selection <= 1) $ Seq.lookup 0 selection++selectionToFirstSuperOwl :: (HasCallStack) => CanvasSelection -> SuperOwl+selectionToFirstSuperOwl (CanvasSelection selection) = assertShowAndDump selection (Seq.length selection > 0) $ Seq.index selection 0++-- NOTE if the only thing in selection is a folder, then this will put the item INSIDE the folder+lastPositionInSelection :: OwlTree -> Selection -> OwlSpot+lastPositionInSelection ot (SuperOwlParliament selection) = r where+  r = case Seq.lookup (Seq.length selection - 1) selection of+    Nothing -> topSpot+    Just x -> if hasOwlItem_isFolder x +      then OwlSpot {+          _owlSpot_parent = _superOwl_id x+          -- put it at the top of the folder, on top of everything+          , _owlSpot_leftSibling = Nothing+        }+      else owlTree_owlItemMeta_toOwlSpot ot (_superOwl_meta x)+
+ src/Potato/Flow/Controller/Manipulator/Layers.hs view
@@ -0,0 +1,528 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.Layers (+  LayersHandler(..)+) where++import           Relude++import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.OwlLayers+import           Potato.Flow.OwlItem+import Potato.Flow.Owl+import           Potato.Flow.Controller.Types+import           Potato.Flow.Math+import           Potato.Flow.Types+import           Potato.Flow.SElts+import           Potato.Flow.OwlItem+import Potato.Flow.OwlWorkspace+import Potato.Flow.OwlState+import Potato.Flow.Llama++import           Data.Dependent.Sum                        (DSum ((:=>)))+import           Data.Default+import qualified Data.IntMap                    as IM+import qualified Data.Sequence                  as Seq+import Data.Sequence ((<|))+import qualified Potato.Data.Text.Zipper                          as TZ+import qualified Data.Text as T+import Data.Char++data LayerDragState = LDS_None | LDS_Dragging | LDS_Selecting LayerEntryPos deriving (Show, Eq)++data LayerDownType = LDT_Hide | LDT_Lock | LDT_Collapse | LDT_Normal deriving (Show, Eq)++layersHandlerRenderEntry_selected :: LayersHandlerRenderEntry -> Bool+layersHandlerRenderEntry_selected (LayersHandlerRenderEntryNormal LHRESS_Selected _ _ _) = True+layersHandlerRenderEntry_selected (LayersHandlerRenderEntryNormal LHRESS_InheritSelected _ _ _) = True+layersHandlerRenderEntry_selected _ = False++-- TODO we could probably change this to do a more efficient binary search based on position in hierarchy+doesSelectionContainREltId_linear :: REltId -> Selection -> Bool+doesSelectionContainREltId_linear rid = isJust . find (\sowl -> rid == _superOwl_id sowl) . unSuperOwlParliament++collapseOffset :: Int+collapseOffset = 0++hideOffset :: Int+hideOffset = 1++lockOffset :: Int+lockOffset = 2++titleOffset :: Int+titleOffset = 3++clickLayerNew :: Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)+clickLayerNew lentries  (V2 absx lepos) = case Seq.lookup lepos lentries of+  Nothing                      -> Nothing+  Just le -> Just . (,,absx - layerEntry_depth le) sowl $ case () of+    () | layerEntry_isFolder le && layerEntry_depth le + collapseOffset == absx -> LDT_Collapse+    () | layerEntry_depth le + hideOffset == absx   -> LDT_Hide+    () | layerEntry_depth le + lockOffset == absx -> LDT_Lock+    () -> LDT_Normal+    where+      sowl = _layerEntry_superOwl le+++data LayersHandler = LayersHandler {+    _layersHandler_dragState   :: LayerDragState+    , _layersHandler_cursorPos :: XY+    , _layersHandler_dropSpot :: Maybe OwlSpot++  }++instance Default LayersHandler where+  def = LayersHandler {+      _layersHandler_dragState = LDS_None+      , _layersHandler_cursorPos = 0+      , _layersHandler_dropSpot = Nothing+    }++handleScroll :: (PotatoHandler h) => h -> PotatoHandlerInput -> Int -> PotatoHandlerOutput+handleScroll h PotatoHandlerInput {..} scroll  = r where+  -- TODO share this code with other handler+  scrollPos = _layersState_scrollPos _potatoHandlerInput_layersState+  maxentries = 10 + (Seq.length $ _layersState_entries _potatoHandlerInput_layersState)+  newScrollPos = max 0 (min maxentries (scrollPos + scroll))+  r = def {+      _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler h+      -- TODO clamp based on number of entries+      , _potatoHandlerOutput_layersState = Just $ _potatoHandlerInput_layersState { _layersState_scrollPos = newScrollPos}+    }+++resetLayersHandler :: LayersHandler -> LayersHandler+resetLayersHandler lh = lh {+    _layersHandler_dragState = LDS_None+    , _layersHandler_dropSpot = Nothing+  }+++-- spot is invalid if it's a descendent of a already selected element+isSpotValidToDrop :: OwlTree -> Selection -> OwlSpot -> Bool+isSpotValidToDrop ot sel spot = not $ owlParliamentSet_descendent ot (_owlSpot_parent spot) (superOwlParliament_toOwlParliamentSet sel)+++instance PotatoHandler LayersHandler where+  pHandlerName _ = handlerName_layers++  -- we incorrectly reuse RelMouseDrag for LayersHandler even though LayersHandler doesn't care about canvas pan coords+  -- pan offset should always be set to 0 in RelMouseDrag+  pHandleMouse lh@LayersHandler {..} PotatoHandlerInput {..} (RelMouseDrag MouseDrag {..}) = let++    selection = _potatoHandlerInput_selection+    ls@(LayersState _ lentries scrollPos) = _potatoHandlerInput_layersState+    pfs = _potatoHandlerInput_pFState+    owltree = (_owlPFState_owlTree pfs)++    V2 rawxoffset rawlepos = _mouseDrag_to+    leposxy@(V2 _ lepos) = V2 rawxoffset (rawlepos + scrollPos)++    in case (_mouseDrag_state, _layersHandler_dragState) of+      (MouseDragState_Down, LDS_None) -> r where+        shift = elem KeyModifier_Shift _mouseDrag_modifiers+        (nextDragState, mNextLayerState, changes) = case clickLayerNew lentries leposxy of+          Nothing -> (LDS_None, Nothing, IM.empty)+          -- (you can only click + drag selected elements)+          Just (downsowl, ldtdown, _) -> case ldtdown of++            LDT_Normal -> if shift || (not $ doesSelectionContainREltId_linear (_superOwl_id downsowl) selection)+              -- TODO check if element is descendent of selected element and return LDS_None if so+              -- if element wasn't selected or shift is held down, enter selection mode+              then (LDS_Selecting lepos, Nothing, IM.empty)+              else (LDS_Dragging, Nothing, IM.empty)++            -- DELETE+            -- this variant denies selecting children of selected parents but not the other way around...+            -- maybe easier to deny this at a higher level rather than here.+            {-+            LDT_Normal -> if shift+              then if exclusivedescendent+                -- element is descendent of selection and therefore do not allow selecting+                then (LDS_None, Nothing, IM.empty)+                else (LDS_Selecting lepos, Nothing, IM.empty)+              else if not isselected+                then if exclusivedescendent+                  -- element is descendent of selection and therefore do not allow selecting (TODO consider alternatively, enter dragging mode)+                  then (LDS_None, Nothing, IM.empty)+                  -- enter selection mode+                  else (LDS_Selecting lepos, Nothing, IM.empty)+                -- entry dragging mode+              else (LDS_Dragging, Nothing, IM.empty)+              where+                rid = _superOwl_id downsowl+                selectionset = superOwlParliament_toOwlParliamentSet selection+                isselected = owlParliamentSet_member rid selectionset+                exclusivedescendent = owlParliamentSet_descendent owltree rid selectionset && not isselected+            -}++            LDT_Hide -> r' where+              nextLayersState = toggleLayerEntry pfs ls lepos LHCO_ToggleHide+              hideChanges = changesFromToggleHide pfs nextLayersState lepos+              r' = (LDS_None, Just $ nextLayersState, hideChanges)+            LDT_Lock -> (LDS_None, Just $ toggleLayerEntry pfs ls lepos LHCO_ToggleLock, IM.empty)+            LDT_Collapse -> (LDS_None, Just $ toggleLayerEntry pfs ls lepos LHCO_ToggleCollapse, IM.empty)++        r = Just $ def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {+                _layersHandler_dragState = nextDragState+                , _layersHandler_cursorPos = _mouseDrag_to+                , _layersHandler_dropSpot = Nothing+              }+            , _potatoHandlerOutput_layersState = mNextLayerState+            , _potatoHandlerOutput_changesFromToggleHide = changes+          }+      (MouseDragState_Down, _) -> error "unexpected, _layersHandler_dragState should have been reset on last mouse up"+      (MouseDragState_Dragging, LDS_Dragging) -> r where++        -- we will always place between dropSowl and justAboveDropSowl+        mDropSowlWithOffset = do+          (downsowl, _, offset') <- clickLayerNew lentries leposxy+          return (downsowl, offset')++        mJustAboveDropSowl = do+          lentry <- case mDropSowlWithOffset of+            Nothing -> Seq.lookup (Seq.length lentries - 1) lentries+            Just _ -> Seq.lookup (lepos-1) lentries+          return $ _layerEntry_superOwl lentry+++        nparentoffset = case mDropSowlWithOffset 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+            -- 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)++        nsibling = max 0 (- (min 0 nparentoffset))+++        targetspot = case mJustAboveDropSowl of+          -- we are dropping at the top of our LayerEntries+          Nothing -> OwlSpot noOwl Nothing+          Just asowl -> if nparentoffset > 0 && hasOwlItem_isFolder asowl+            -- drop inside at the top+            then OwlSpot (_superOwl_id asowl) Nothing+            else case owlTree_findSuperOwl owltree newsiblingid of+              Nothing -> OwlSpot noOwl siblingout+              Just newsibling -> OwlSpot (superOwl_parentId newsibling) siblingout+              where+                newsiblingid = owlTree_superOwlNthParentId owltree asowl nsibling+                siblingout = case newsiblingid of+                  x | x == noOwl -> Nothing+                  x -> Just x++        -- check if spot is valid+        -- instead we do this check when we drop instead, that behavior "felt" nicer to me even though this is probably more correct+        --SuperOwlParliament selectedsowls = _potatoHandlerInput_selection+        --isSpotValid = isSpotValidToDrop owltree _potatoHandlerInput_selection spot+        isSpotValid = True++        r = Just $ def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {+              _layersHandler_cursorPos = _mouseDrag_to+              , _layersHandler_dropSpot = if isSpotValid then Just targetspot else Nothing+            }+        }++      -- TODO someday do drag for multi-select here+      (MouseDragState_Dragging, _) -> Just $ def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {+              _layersHandler_cursorPos = _mouseDrag_to+              , _layersHandler_dropSpot = Nothing+            }+        }++      (MouseDragState_Up, LDS_Selecting leposdown) -> r where+        shift = elem KeyModifier_Shift _mouseDrag_modifiers+        sowl = _layerEntry_superOwl $ Seq.index lentries leposdown+        r = Just $ def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler (resetLayersHandler lh)+            , _potatoHandlerOutput_select = Just (shift, SuperOwlParliament $ Seq.singleton sowl)+          }++      -- NOTE this will not work on inherit selected children, feature or bug??+      -- we clicked and released on a selected element, enter renaming mode+      (MouseDragState_Up, LDS_Dragging) | isNothing _layersHandler_dropSpot -> case clickLayerNew lentries leposxy of+        Nothing -> error "pretty sure this should never happen "+        -- (you can only click + drag selected elements)+        Just (downsowl, ldtdown, offset) -> case ldtdown of+          LDT_Normal | offset >= titleOffset -> r where++            -- 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+              }++++          _ -> Just $ setHandlerOnly (resetLayersHandler lh)+++++      -- TODO when we have multi-user mode, we'll want to test if the target drop space is still valid+      (MouseDragState_Up, LDS_Dragging) -> r where+        mev = do+          spot <- _layersHandler_dropSpot+          let+            isSpotValid = isSpotValidToDrop owltree _potatoHandlerInput_selection spot++            -- TODO modify if we drag on top of existing elt... Is there anything to do here? I can't remember why I added this comment. Pretty sure there's nothing to do+            modifiedSpot = spot+          guard isSpotValid+          return $ WSEMoveElt (modifiedSpot, superOwlParliament_toOwlParliament selection)++        r = Just $ def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler (resetLayersHandler lh)+            , _potatoHandlerOutput_pFEvent = mev+          }++      (MouseDragState_Up, LDS_None) -> Just $ def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler (resetLayersHandler lh)+          , _potatoHandlerOutput_select = Just (False, isParliament_empty)+        }++      (MouseDragState_Cancelled, _) -> Just $ setHandlerOnly (resetLayersHandler lh)++  pHandleKeyboard lh phi kbd = case kbd of+    KeyboardData (KeyboardKey_Scroll scroll) _ -> Just $ handleScroll lh phi scroll+    _ -> Nothing++  --pRenderHandler lh@LayersHandler {..} PotatoHandlerInput {..} = emptyHandlerRenderOutput++  pIsHandlerActive LayersHandler {..} = _layersHandler_dragState /= LDS_None++  -- TODO this is incorrect, we may be in the middle of dragging elements that got deleted+  pRefreshHandler h _ = Just $ SomePotatoHandler h++  -- TODO generate LHRESS_ChildSelected+  pRenderLayersHandler LayersHandler {..} PotatoHandlerInput {..} = LayersViewHandlerRenderOutput newlentries where+    selection = _potatoHandlerInput_selection+    LayersState _ lentries _ = _potatoHandlerInput_layersState+    --pfs = _potatoHandlerInput_pFState+    --owltree = (_owlPFState_owlTree pfs)++    -- TODO would also be best to cache this in LayerState since it's also used by other operations...+    selectionset = superOwlParliament_toOwlParliamentSet selection+    isSelected lentry = owlParliamentSet_member (layerEntry_rEltId lentry) selectionset+    -- perhaps linear search is faster for smaller sets though+    --isSelected lentry = doesSelectionContainREltId_linear (_superOwl_id $ _layerEntry_superOwl lentry) selection++    -- update the selected state+    mapaccumlfn_forselection mseldepth lentry = case mseldepth of+      Nothing -> normalcase+      Just x -> if layerEntry_depth lentry > x+        then (mseldepth, makelentry LHRESS_InheritSelected)+        else normalcase+      where+        -- dot depth will be filled in later+        makelentry x = LayersHandlerRenderEntryNormal x Nothing Nothing lentry+        normalcase = if isSelected lentry+          then (Just (layerEntry_depth lentry), makelentry LHRESS_Selected)+          else (Nothing, makelentry LHRESS_None)+    (_,newlentries1) = mapAccumL mapaccumlfn_forselection Nothing lentries++    -- next insert the drop spot+    newlentries2 = case _layersHandler_dropSpot of+      Nothing -> newlentries1+      Just ds -> r where+        (mleftmost, samelevel) = case _owlSpot_parent ds of+            x | x == noOwl -> (maybe Nothing Just (_owlSpot_leftSibling ds), True)+            x -> case _owlSpot_leftSibling ds of+              Nothing -> (Just x, False)+              Just s -> (Just s, True)++        r = case mleftmost of+          Nothing -> LayersHandlerRenderEntryDummy 0 <| newlentries1++          Just leftmostid -> r' where+            -- TODO you could probably do this more efficiently with a very bespoke fold but whatever+            (index, depth) = case Seq.findIndexL (\lentry -> _superOwl_id (_layerEntry_superOwl lentry) == leftmostid) lentries of+              Nothing -> error $ "expected to find id " <> show leftmostid <> " in " <> show lentries+              Just x -> (skipped, depth') where+                depth' = layerEntry_depth (Seq.index lentries x) + (if samelevel then 0 else 1)+                noskiplentries = Seq.drop (x+1) $ lentries+                skippedlentries = Seq.takeWhileL (\lentry -> layerEntry_depth lentry > depth') $ noskiplentries+                skipped = if samelevel then x + 1 + Seq.length skippedlentries else x+1++            r' = Seq.insertAt index (LayersHandlerRenderEntryDummy depth) newlentries1++    -- finally add the dots indicating drop spot depth+    mapaccumrfn_fordots mdropdepth lhre = case mdropdepth of+      Nothing -> case lhre of+        LayersHandlerRenderEntryDummy d -> (Just d, lhre)+        _ -> (mdropdepth, lhre)+      Just x -> case lhre of+        LayersHandlerRenderEntryNormal s _ _ lentry -> if layerEntry_depth lentry >= x+          then (mdropdepth, LayersHandlerRenderEntryNormal s (Just x) Nothing lentry)+          else (Nothing, lhre)+        _ -> error "unexpected LayersHandlerRenderEntryDummy"++    (_, newlentries3) = mapAccumR mapaccumrfn_fordots Nothing newlentries2++    -- determine parents of selection+    mapaccumrfn_forchildselected (selstack, lastdepth) lhre = ((newstack, depth), newlhre) where+      selected = layersHandlerRenderEntry_selected lhre+      depth = layersHandlerRenderEntry_depth lhre+      (childSelected, newstack) = if depth > lastdepth+        then (False, selected:selstack)+        else if selected+          then case selstack of+            [] -> (False, [True]) -- this happens if on the first element that we mapAccumR on+            _:xs -> (False, True:xs)+          else if depth < lastdepth+            then case selstack of+              [] -> error "this should never happen"+              x1:xs1 -> case xs1 of+                [] -> (x1, [x1])+                x2:xs2 -> (x1 && not x2, (x1 || x2) : xs2)+            else (False, selstack)+      newlhre = if childSelected+        then case lhre of+          LayersHandlerRenderEntryNormal _ mdots renaming lentry -> LayersHandlerRenderEntryNormal LHRESS_ChildSelected mdots renaming lentry+          x -> x+        else lhre+    (_, newlentries) = mapAccumR mapaccumrfn_forchildselected ([], 0) newlentries3+++++data LayersRenameHandler = LayersRenameHandler {+    _layersRenameHandler_original :: LayersHandler+    , _layersRenameHandler_renaming   :: SuperOwl+    , _layersRenameHandler_index :: Int -- LayerEntries index of what we are renaming+    , _layersRenameHandler_zipper   :: TZ.TextZipper+  }++isValidLayerRenameChar :: Char -> Bool+isValidLayerRenameChar c = case c of+  _ | isControl c -> False+  ' ' -> True -- only allow ' ' for whitespace character+  _ | isSpace c -> False+  _ -> True++renameTextZipperTransform :: KeyboardKey -> Maybe (TZ.TextZipper -> TZ.TextZipper)+renameTextZipperTransform = \case+  KeyboardKey_Space -> Just $ TZ.insertChar ' '+  KeyboardKey_Char k | isValidLayerRenameChar k -> Just $ TZ.insertChar k+  KeyboardKey_Backspace             -> Just $ TZ.deleteLeft+  KeyboardKey_Delete                 -> Just $ TZ.deleteRight+  KeyboardKey_Left               -> Just $ TZ.left+  KeyboardKey_Right             -> Just $ TZ.right+  KeyboardKey_Home              -> Just $ TZ.home+  KeyboardKey_End                  -> Just $ TZ.end+  KeyboardKey_Paste t | T.all isValidLayerRenameChar t -> Just $ TZ.insert t+  _                                   -> Nothing++renameToAndReturn :: LayersRenameHandler -> Text -> PotatoHandlerOutput+renameToAndReturn LayersRenameHandler {..} newName = r where+  controller = CTagRename :=> (Identity $ CRename {+      _cRename_deltaLabel = (hasOwlItem_name _layersRenameHandler_renaming, newName)+    })+  r = def {+      _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler _layersRenameHandler_original+      , _potatoHandlerOutput_pFEvent = Just $ WSEApplyLlama (False, makePFCLlama . OwlPFCManipulate $ IM.fromList [(_superOwl_id _layersRenameHandler_renaming,controller)])+    }++toDisplayLines :: LayersRenameHandler -> TZ.DisplayLines ()+toDisplayLines LayersRenameHandler {..} = TZ.displayLinesWithAlignment TZ.TextAlignment_Left 1000 () () _layersRenameHandler_zipper++-- TODO this should be configurable+-- hardcoded offset to the <elt name> e.g. " ea 𐂂 <elt name>"+layerJunkOffset :: Int+layerJunkOffset = 7++-- TODO confirm/cancel if click off the one we are renaming, cancle handler and pass input onto the replacement (see TODO in GoatWidget)+instance PotatoHandler LayersRenameHandler where+  pHandlerName _ = handlerName_layersRename++  -- we incorrectly reuse RelMouseDrag for LayersHandler even though LayersHandler doesn't care about canvas pan coords+  -- pan offset should always be set to 0 in RelMouseDrag+  pHandleMouse lh@LayersRenameHandler {..} phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let++    LayersState _ lentries scrollPos = _potatoHandlerInput_layersState+    V2 rawxoffset rawlepos = _mouseDrag_to+    leposxy@(V2 _ lepos) = V2 rawxoffset (rawlepos + scrollPos)++    renaminglepos = _layersRenameHandler_index++    in case _mouseDrag_state of+      MouseDragState_Down | lepos == renaminglepos -> r where+        xpos = case clickLayerNew lentries leposxy of+          Nothing -> error "this should never happen"+          Just (_, _, xoff) -> xoff - layerJunkOffset++        dl = toDisplayLines lh+        nexttz = TZ.goToDisplayLinePosition xpos 0 dl _layersRenameHandler_zipper++        r = Just $ def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {+                _layersRenameHandler_zipper = nexttz+              }+          }+      -- TODO drag + select when it's implemented in TZ+      MouseDragState_Dragging -> Just $ setHandlerOnly lh+      MouseDragState_Up -> Just $ setHandlerOnly lh++      _ -> Just r where+        -- we want to pass output to original hanler+        mpho' = pHandleMouse _layersRenameHandler_original phi rmd+        -- but we also want to return a rename event+        pho'' = renameToAndReturn lh (TZ.value _layersRenameHandler_zipper)+        -- so just do both and sketch combine the results... probably ok...+        r = case mpho' of+          Nothing -> error "this should never happen..."+          Just pho' -> pho' { _potatoHandlerOutput_pFEvent = _potatoHandlerOutput_pFEvent pho'' }++  pHandleKeyboard lh@LayersRenameHandler {..} phi@PotatoHandlerInput {..} kbd = case kbd of+    -- don't allow ctrl shortcuts while renaming+    KeyboardData _ [KeyModifier_Ctrl] -> Just $ setHandlerOnly lh+    KeyboardData KeyboardKey_Return [] -> Just $ renameToAndReturn lh (TZ.value _layersRenameHandler_zipper)+    KeyboardData KeyboardKey_Esc [] ->    Just $ setHandlerOnly _layersRenameHandler_original+    KeyboardData (KeyboardKey_Scroll scroll) _ -> Just $ handleScroll lh phi scroll+    KeyboardData key [] ->  case renameTextZipperTransform key of+      Nothing -> Nothing+      Just f -> r where+        nexttz = f _layersRenameHandler_zipper+        r = Just $ def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {+                _layersRenameHandler_zipper = nexttz+              }+          }+    _ -> Nothing++  -- TODO this is incorrect, we may be in the middle of renaming elements that got deleted+  pRefreshHandler h _ = Just $ SomePotatoHandler h+++  -- TODO render renaming stuff (or do we do this in pRenderLayersHandler?)+  --pRenderHandler lh@LayersRenameHandler {..} PotatoHandlerInput {..} = emptyHandlerRenderOutput++  pIsHandlerActive LayersRenameHandler {..} = True++  pRenderLayersHandler LayersRenameHandler {..} phi@PotatoHandlerInput {..} = r where+    r' = pRenderLayersHandler _layersRenameHandler_original phi+    entries' = _layersViewHandlerRenderOutput_entries r'++    -- PROBLEM you want to do some hcropping on the zipper but you don't know how much to crop by because width is unknown+    -- solution 1: align right+    -- solution 2: take over entire row from very left+    -- solution 3: ignore, user may need to resize layers area+    -- we will just do solution 3 cuz it's easiest+    adjustfn (LayersHandlerRenderEntryNormal lhress dots _ lentry) = LayersHandlerRenderEntryNormal lhress dots (Just _layersRenameHandler_zipper) lentry where+    adjustfn (LayersHandlerRenderEntryDummy _) = error "this should never happen"+    entries = Seq.adjust'  adjustfn _layersRenameHandler_index entries'+    r = LayersViewHandlerRenderOutput { _layersViewHandlerRenderOutput_entries = entries }
+ src/Potato/Flow/Controller/Manipulator/Line.hs view
@@ -0,0 +1,899 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.Line (+  AutoLineHandler(..)+) where++import           Relude++import qualified Potato.Data.Text.Zipper                           as TZ+import           Potato.Flow.Attachments+import           Potato.Flow.BroadPhase+import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Manipulator.Common+import           Potato.Flow.Controller.Manipulator.TextInputState+import           Potato.Flow.Controller.Types+import           Potato.Flow.DebugHelpers+import           Potato.Flow.Llama+import           Potato.Flow.Math+import           Potato.Flow.Methods.LineDrawer+import           Potato.Flow.Owl+import           Potato.Flow.OwlItem+import           Potato.Flow.OwlState+import           Potato.Flow.OwlWorkspace+import           Potato.Flow.SElts++import Control.Monad (msum)+import           Control.Exception+import           Data.Default+import qualified Data.List                                         as L+import qualified Data.List.Index                                   as L+import qualified Data.Sequence                                     as Seq+import qualified Data.Text                                         as T++import           Data.Maybe                                        (fromJust)+++maybeGetSLine :: CanvasSelection -> Maybe (REltId, SAutoLine)+maybeGetSLine selection = if Seq.length (unCanvasSelection selection) /= 1+  then Nothing+  else case superOwl_toSElt_hack sowl of+    SEltLine sline -> Just (rid, sline)+    _              -> Nothing+    where+      sowl = selectionToSuperOwl selection+      rid = _superOwl_id sowl++mustGetSLine :: CanvasSelection -> (REltId, SAutoLine)+mustGetSLine = fromJust . maybeGetSLine++-- TODO change return type to AvailableAttachment+-- TODO move me elsewhere+getAvailableAttachments :: Bool -> Bool -> OwlPFState -> BroadPhaseState -> LBox -> [(Attachment, XY)]+getAvailableAttachments includeNoBorder offsetBorder pfs bps screenRegion = r where+  culled = broadPhase_cull screenRegion (_broadPhaseState_bPTree bps)+  -- you could silently fail here by ignoring maybes but that would definitely be an indication of a bug so we fail here instead (you could do a better job about dumping debug info though)+  sowls = fmap (hasOwlTree_mustFindSuperOwl pfs) culled+  -- TODO sort sowls+  fmapfn sowl = fmap (\(a,p) -> (attachment_create_default (_superOwl_id sowl) a, p)) $ owlItem_availableAttachmentsAtDefaultLocation includeNoBorder offsetBorder (_superOwl_elt sowl)+  r = join $ fmap fmapfn sowls++renderAttachments :: PotatoHandlerInput -> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]+renderAttachments PotatoHandlerInput {..} (mstart, mend) = r where+  attachments = getAvailableAttachments False True _potatoHandlerInput_pFState _potatoHandlerInput_broadPhase _potatoHandlerInput_screenRegion+  fmapattachmentfn (a,p) = if matches mstart || matches mend then Nothing else Just $ RenderHandle {+      _renderHandle_box = (LBox p 1)+      , _renderHandle_char = Just (attachmentRenderChar a)+      , _renderHandle_color = RHC_Attachment+    } where+      rid = _attachment_target a+      al = _attachment_location a+      matches ma = fmap (\a' -> _attachment_target a' == rid && _attachment_location a' == al) ma == Just True+  r = catMaybes $ fmap fmapattachmentfn attachments++-- set midpointhighlightindex index to -1 for no highlight+maybeRenderPoints :: (Bool,Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]+maybeRenderPoints (highlightstart, highlightend) offsetAttach midpointhighlightindex PotatoHandlerInput {..} = r where+  -- in creation cases, _potatoHandlerInput_canvasSelection might not be a line+  -- however we only render points in non creation cases (I think) so this maybe should plainly not be necessary+  mselt = selectionToMaybeFirstSuperOwl _potatoHandlerInput_canvasSelection >>= return . superOwl_toSElt_hack+  r1 = case mselt of+    Just (SEltLine SAutoLine {..}) -> [makeRenderHandle (make_1area_lBox_from_XY startHandle) True, makeRenderHandle (make_1area_lBox_from_XY endHandle) False]+      where+        startHandle = fromMaybe _sAutoLine_start (maybeLookupAttachment offsetAttach _potatoHandlerInput_pFState _sAutoLine_attachStart)+        endHandle = fromMaybe _sAutoLine_end (maybeLookupAttachment offsetAttach _potatoHandlerInput_pFState _sAutoLine_attachEnd)+        makeRenderHandle b isstart = RenderHandle {+            _renderHandle_box     = b+            , _renderHandle_char  = if isstart then Just 'S' else Just 'E'+            , _renderHandle_color = if (isstart && highlightstart) || (not isstart && highlightend) then RHC_AttachmentHighlight else RHC_Default+          }+    _ -> []+  r2 = case mselt of+    Just (SEltLine SAutoLine {..}) -> L.imap imapfn _sAutoLine_midpoints+      where+        imapfn i mp = case mp of+          SAutoLineConstraintFixed pos -> RenderHandle {+              _renderHandle_box     = make_1area_lBox_from_XY pos+              , _renderHandle_char  = Just 'X'+              , _renderHandle_color = if midpointhighlightindex == i then RHC_AttachmentHighlight else RHC_Default+            }+    _ -> []+  r = r1 <> r2++renderLabels :: PotatoHandlerInput -> Bool -> [RenderHandle]+renderLabels PotatoHandlerInput {..} offsetByLabelHeight = r where+  (_, sal) = mustGetSLine _potatoHandlerInput_canvasSelection+  labels = getSortedSAutoLineLabelPositions _potatoHandlerInput_pFState sal+  fmapfn (pos,_,_) = RenderHandle {+      _renderHandle_box     = if offsetByLabelHeight+        then make_1area_lBox_from_XY (pos - (V2 0 1))+        else make_1area_lBox_from_XY pos+      , _renderHandle_char  = Just 'T'+      , _renderHandle_color = RHC_Default+    }+  r = fmap fmapfn labels+++data AutoLineHandler = AutoLineHandler {+    _autoLineHandler_isCreation         :: Bool+    , _autoLineHandler_mDownManipulator :: Maybe Int+    -- TODO who sets this?+    , _autoLineHandler_offsetAttach     :: Bool+  } deriving (Show)++instance Default AutoLineHandler where+  def = AutoLineHandler {+      _autoLineHandler_isCreation = False+      , _autoLineHandler_mDownManipulator = Nothing+      , _autoLineHandler_offsetAttach = True+    }++-- TODO instead of `LMP_Midpoint Int` consider using zipper+data LineManipulatorProxy = LMP_Endpoint Bool | LMP_Midpoint Int | LMP_Nothing++sAutoLineConstraint_handlerPosition :: SAutoLineConstraint -> XY+sAutoLineConstraint_handlerPosition slc = case slc of+  SAutoLineConstraintFixed xy -> xy++findFirstLineManipulator_NEW :: SAutoLine -> Bool -> OwlPFState -> RelMouseDrag-> LineManipulatorProxy+findFirstLineManipulator_NEW SAutoLine {..} offsetBorder pfs (RelMouseDrag MouseDrag {..})= r where+  start = fromMaybe _sAutoLine_start $ maybeLookupAttachment offsetBorder pfs _sAutoLine_attachStart+  end = fromMaybe _sAutoLine_end $ maybeLookupAttachment offsetBorder pfs _sAutoLine_attachEnd+  mmid = L.findIndex (\slc -> sAutoLineConstraint_handlerPosition slc == _mouseDrag_to) _sAutoLine_midpoints+  r = if _mouseDrag_to == start then LMP_Endpoint True+    else if _mouseDrag_to == end then LMP_Endpoint False+      else maybe LMP_Nothing LMP_Midpoint mmid++-- TODO use cache+-- |+-- IMPORTANT MIDPOINT INDEXING DETAILS+-- midpoint indexing for N midpoints looks like+-- S ... 0 ... 1 ... N ... E+-- a midpoint index of (-1) is the segment between S and 0+--+-- e.g.+-- S ...(x)... 0 ... 1 ...+-- returns -1+-- favors right side+--+-- e.g.+-- S ... (x) ... 1+-- returns 0+--+-- to convert to _autoLineMidPointHandler_midPointIndex index you need to MINUS 1+whichSubSegmentDidClick :: OwlTree -> SAutoLine -> XY -> Maybe Int+whichSubSegmentDidClick ot sline@SAutoLine {..} pos = r where+  lars = sAutoLine_to_lineAnchorsForRenderList ot sline+  r = fmap fst $ L.ifind (\_ lar -> isJust $ lineAnchorsForRender_findIntersectingSubsegment lar pos) lars++++getEndpointPosition ::  Bool -> OwlPFState -> SAutoLine -> Bool -> XY+getEndpointPosition offsetAttach pfs SAutoLine {..} isstart = if isstart+  then fromMaybe _sAutoLine_start $ maybeGetAttachmentPosition offsetAttach pfs =<< _sAutoLine_attachStart+  else fromMaybe _sAutoLine_end $ maybeGetAttachmentPosition offsetAttach pfs =<< _sAutoLine_attachEnd++++-- |+-- see indexing information in 'whichSubSegmentDidClick'+getAnchorPosition :: Bool -> OwlPFState -> SAutoLine -> Int -> XY+getAnchorPosition offsetAttach pfs sline@SAutoLine {..} anchorindex = r where+  mps = _sAutoLine_midpoints+  endindex = length mps + 1+  r = if anchorindex == 0+    then getEndpointPosition offsetAttach pfs sline True+    else if anchorindex == endindex+      then getEndpointPosition offsetAttach pfs sline False+      else if anchorindex > 0 && anchorindex < endindex+        then case mps L.!! (anchorindex-1) of+          SAutoLineConstraintFixed xy -> xy+        else error $ "out of bounds anchor index " <> show anchorindex++++instance PotatoHandler AutoLineHandler where+  pHandlerName _ = handlerName_simpleLine+  pHandleMouse slh@AutoLineHandler {..} phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let+    attachments = getAvailableAttachments False True _potatoHandlerInput_pFState _potatoHandlerInput_broadPhase _potatoHandlerInput_screenRegion+    mattachend = fmap fst . isOverAttachment _mouseDrag_to $ attachments++    in case _mouseDrag_state of++      MouseDragState_Down | _autoLineHandler_isCreation -> Just $ def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler AutoLineEndPointHandler {+              _autoLineEndPointHandler_isStart      = False+              , _autoLineEndPointHandler_undoFirst  = False+              , _autoLineEndPointHandler_isCreation = True+              , _autoLineEndPointHandler_offsetAttach = _autoLineHandler_offsetAttach+              , _autoLineEndPointHandler_attachStart = mattachend+              , _autoLineEndPointHandler_attachEnd = Nothing+            }+        }+      -- if shift is held down, ignore inputs, this allows us to shift + click to deselect+      -- TODO consider moving this into GoatWidget since it's needed by many manipulators+      MouseDragState_Down | elem KeyModifier_Shift _mouseDrag_modifiers -> Nothing+      MouseDragState_Down -> r where+        (_, sline) = fromJust $ maybeGetSLine _potatoHandlerInput_canvasSelection+++        labels = getSortedSAutoLineLabelPositions _potatoHandlerInput_pFState sline++        findlabelfn (pos, _, llabel) = pos == _mouseDrag_to || does_lBox_contains_XY (getSAutoLineLabelBox pos llabel) _mouseDrag_to+        mfirstlabel = L.find findlabelfn labels+        firstlm = findFirstLineManipulator_NEW sline _autoLineHandler_offsetAttach _potatoHandlerInput_pFState rmd++        -- TODO update cache someday+        mclickonline = whichSubSegmentDidClick (_owlPFState_owlTree _potatoHandlerInput_pFState) sline _mouseDrag_to++        r = case (firstlm, mfirstlabel) of++          -- if clicked on endpoint+          (LMP_Endpoint isstart, _) -> Just $ def {+              _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler AutoLineEndPointHandler {+                  _autoLineEndPointHandler_isStart      = isstart+                  , _autoLineEndPointHandler_undoFirst  = False+                  , _autoLineEndPointHandler_isCreation = False+                  , _autoLineEndPointHandler_offsetAttach = _autoLineHandler_offsetAttach+                  -- TODO I'm pretty sure you need to set these in order for things to be rendered correctly+                  , _autoLineEndPointHandler_attachStart = Nothing+                  , _autoLineEndPointHandler_attachEnd = Nothing+                }+            }++          -- click on line label or label anchor+          -- TODO right now clicking on line itself also allows you to move it (as oppose to just the anchor) is this what we want?+          (_, Just (_,index,_)) -> Just $+            def {+                _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler AutoLineLabelMoverHandler {+                  _autoLineLabelMoverHandler_anchorOffset  = 0+                  , _autoLineLabelMoverHandler_prevHandler = SomePotatoHandler slh+                  , _autoLineLabelMoverHandler_undoFirst   = False+                  , _autoLineLabelMoverHandler_labelIndex  = index+                }+              }++          -- if clicked on line but not on a handler, track the position+          (LMP_Nothing, _) | isJust mclickonline -> Just $ def {+              _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {+                  _autoLineHandler_mDownManipulator = mclickonline+                }+            }++          -- did not click on manipulator, no capture+          (LMP_Nothing, _) -> Nothing++          (LMP_Midpoint i, _) -> rslt where+            handler = AutoLineMidPointHandler {+                _autoLineMidPointHandler_midPointIndex = i+                , _autoLineMidPointHandler_isMidpointCreation = False+                , _autoLineMidPointHandler_undoFirst  = False+                , _autoLineMidPointHandler_offsetAttach = _autoLineHandler_offsetAttach+              }+            rslt = pHandleMouse handler phi rmd++      MouseDragState_Dragging -> case _autoLineHandler_mDownManipulator of+        -- TODO BUG how does this happen? This shouldn't happen as we must capture all dragging operations (I'm pretty sure you already fixed this by implementing the undo on cancel)+        -- this can happen if we cancel in the middle of a drag operation (say), it will recreate an AutoLineHandler from the selection+        Nothing -> Nothing+        Just i -> r where+          handler = AutoLineMidPointHandler {+              _autoLineMidPointHandler_midPointIndex = i+              , _autoLineMidPointHandler_isMidpointCreation = True+              , _autoLineMidPointHandler_undoFirst  = False+              , _autoLineMidPointHandler_offsetAttach = _autoLineHandler_offsetAttach+            }+          r = pHandleMouse handler phi rmd++      -- TODO if down and up on line manipulator (text portion and not the anchor portion)+++      -- if we click down and directly up in the same spot on the line, create a line label there and pass on input to AutoLineLabelHandler+      MouseDragState_Up -> case _autoLineHandler_mDownManipulator of+        Nothing -> Just def+        Just _ -> r where+          (rid, sal) = mustGetSLine _potatoHandlerInput_canvasSelection+          -- PERF cache someday...+          larlist = sAutoLine_to_lineAnchorsForRenderList _potatoHandlerInput_pFState sal+          (_, mpindex, reld) = getClosestPointOnLineFromLineAnchorsForRenderList larlist _mouseDrag_to+          newllabel = def {+              _sAutoLineLabel_index = mpindex+              , _sAutoLineLabel_position = SAutoLineLabelPositionRelative reld+            }+          r = Just def {+              _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler $ makeAutoLineLabelHandler_from_newLineLabel rid sal newllabel (SomePotatoHandler slh) phi rmd+            }+      -- TODO is this correct??+      MouseDragState_Cancelled -> Just def+  pHandleKeyboard _ PotatoHandlerInput {..} kbd = case kbd of+    -- TODO keyboard movement+    _                              -> Nothing+  pRenderHandler AutoLineHandler {..} phi@PotatoHandlerInput {..} = r where+    boxes = maybeRenderPoints (False, False) _autoLineHandler_offsetAttach (-1) phi+    -- TODO render attach endpoints from currently selected line (useful in the future when attach points aren't always in the middle)+      -- TODO don't render attachmentBoxes while dragging+    attachmentBoxes = renderAttachments phi (Nothing, Nothing)++    labels = renderLabels phi False++    r = if _autoLineHandler_isCreation+      -- creation handlers are rendered by AutoLineEndPointHandler once dragging starts+      then HandlerRenderOutput attachmentBoxes+      else HandlerRenderOutput (attachmentBoxes <> boxes <> labels)++  pIsHandlerActive _ = False+  pHandlerTool AutoLineHandler {..} = if _autoLineHandler_isCreation+    then Just Tool_Line+    else Nothing+++-- handles dragging endpoints (which can be attached) and creating new lines+data AutoLineEndPointHandler = AutoLineEndPointHandler {+  _autoLineEndPointHandler_isStart        :: Bool -- either we are manipulating start, or we are manipulating end++  , _autoLineEndPointHandler_undoFirst    :: Bool+  , _autoLineEndPointHandler_isCreation   :: Bool++  , _autoLineEndPointHandler_offsetAttach :: Bool -- who sets this?++  -- where the current modified line is attached to (_autoLineEndPointHandler_attachStart will differ from actual line in the case when we start creating a line on mouse down)+  , _autoLineEndPointHandler_attachStart  :: Maybe Attachment+  , _autoLineEndPointHandler_attachEnd    :: Maybe Attachment+}+++++instance PotatoHandler AutoLineEndPointHandler where+  pHandlerName _ = handlerName_simpleLine_endPoint+  pHandleMouse slh@AutoLineEndPointHandler {..} PotatoHandlerInput {..} (RelMouseDrag MouseDrag {..}) = let+      mridssline = maybeGetSLine _potatoHandlerInput_canvasSelection+      attachments = getAvailableAttachments False True _potatoHandlerInput_pFState _potatoHandlerInput_broadPhase _potatoHandlerInput_screenRegion++      -- TODO change this so it tracks box we were attached to at the beggining for the duration of the AutoLineEndPointHandler drag  such that you can detach and reattach+      -- if we attached to some box we weren't already attached to+      mnewattachend = fmap fst . isOverAttachment _mouseDrag_to $ attachments++      -- if we attached to the box we were already attached to+      mprojectattachend = case mridssline of+        Nothing -> Nothing+        Just (_, ssline) -> fmap fst $ do+          aend <- if _autoLineEndPointHandler_isStart then _sAutoLine_attachStart ssline else _sAutoLine_attachEnd ssline+          box <- maybeGetAttachmentBox _autoLineEndPointHandler_offsetAttach _potatoHandlerInput_pFState aend+          projectAttachment (_attachment_location aend) _mouseDrag_to (_attachment_target aend) box++      mattachend = msum [mprojectattachend, mnewattachend]++    in case _mouseDrag_state of+      MouseDragState_Down -> error "this should be handleed by AutoLineHandler"+      MouseDragState_Dragging -> Just r where+        rid = _superOwl_id $ selectionToSuperOwl _potatoHandlerInput_canvasSelection++        ssline = case mridssline of+          Just (_,x) -> x+          Nothing    -> def++        sslinestart = _sAutoLine_attachStart ssline+        sslineend = _sAutoLine_attachEnd ssline+++++        -- only attach on non trivial changes so we don't attach to our starting point+        nontrivialline = if _autoLineEndPointHandler_isStart+          then Just _mouseDrag_to /= (maybeGetAttachmentPosition _autoLineEndPointHandler_offsetAttach _potatoHandlerInput_pFState =<< sslineend)+          else Just _mouseDrag_to /= (maybeGetAttachmentPosition _autoLineEndPointHandler_offsetAttach _potatoHandlerInput_pFState =<< sslinestart)+        mattachendnontrivial = if nontrivialline+          then mattachend+          else Nothing++        -- for modifying an existing elt+        modifiedline = if _autoLineEndPointHandler_isStart+          then ssline {+              _sAutoLine_start       = _mouseDrag_to+              , _sAutoLine_attachStart = mattachendnontrivial+            }+          else ssline {+              _sAutoLine_end       = _mouseDrag_to+              , _sAutoLine_attachEnd = mattachendnontrivial+            }+        llama = makeSetLlama $ (rid, SEltLine modifiedline)++        -- for creating new elt+        newEltPos = lastPositionInSelection (_owlPFState_owlTree _potatoHandlerInput_pFState) _potatoHandlerInput_selection+        lineToAdd = def {+            _sAutoLine_start = _mouseDrag_from+            , _sAutoLine_end = _mouseDrag_to+            , _sAutoLine_superStyle = _potatoDefaultParameters_superStyle _potatoHandlerInput_potatoDefaultParameters+            , _sAutoLine_lineStyle = _potatoDefaultParameters_lineStyle _potatoHandlerInput_potatoDefaultParameters+            , _sAutoLine_lineStyleEnd =+            _potatoDefaultParameters_lineStyleEnd _potatoHandlerInput_potatoDefaultParameters+            , _sAutoLine_attachStart = _autoLineEndPointHandler_attachStart+            , _sAutoLine_attachEnd = mattachendnontrivial+          }++        op = if _autoLineEndPointHandler_isCreation+          then WSEAddElt (_autoLineEndPointHandler_undoFirst, newEltPos, OwlItem (OwlInfo "<line>") $ OwlSubItemLine lineToAdd)+          else WSEApplyLlama (_autoLineEndPointHandler_undoFirst, llama)++        r = def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {+                _autoLineEndPointHandler_undoFirst = True+                , _autoLineEndPointHandler_attachStart = if _autoLineEndPointHandler_isStart then mattachendnontrivial else _autoLineEndPointHandler_attachStart+                , _autoLineEndPointHandler_attachEnd = if not _autoLineEndPointHandler_isStart then mattachendnontrivial else _autoLineEndPointHandler_attachEnd+              }+            , _potatoHandlerOutput_pFEvent = Just op+          }+      -- no need to return AutoLineHandler, it will be recreated from selection by goat+      MouseDragState_Up -> Just def+      MouseDragState_Cancelled -> if _autoLineEndPointHandler_undoFirst then Just def { _potatoHandlerOutput_pFEvent = Just WSEUndo } else Just def++  pHandleKeyboard _ PotatoHandlerInput {..} _ = Nothing+  pRenderHandler AutoLineEndPointHandler {..} phi@PotatoHandlerInput {..} = r where+    boxes = maybeRenderPoints (_autoLineEndPointHandler_isStart, not _autoLineEndPointHandler_isStart) _autoLineEndPointHandler_offsetAttach (-1) phi+    attachmentBoxes = renderAttachments phi (_autoLineEndPointHandler_attachStart, _autoLineEndPointHandler_attachEnd)+    r = HandlerRenderOutput (attachmentBoxes <> boxes)+  pIsHandlerActive _ = True+  pHandlerTool AutoLineEndPointHandler {..} = if _autoLineEndPointHandler_isCreation+    then Just Tool_Line+    else Nothing+++-- TODO finish+adjustLineLabelPositionsAfterModifyingOrAddingMidpoint ::+  (HasOwlTree a)+  => a+  -> SAutoLine --  ^ the previous line+  -> SAutoLine -- ^ the new line+  -> Maybe (Either Int Int) -- ^ Nothing is modify case, Just Left is creat, Just Right is delete+  -> SAutoLine+adjustLineLabelPositionsAfterModifyingOrAddingMidpoint ot old new mempindex = r where++  -- TODO need more than just this, need to copmute position too+  indexAdjust i = case mempindex of+    Nothing             -> i+    -- advance indices after addmpi since we are adding a midpoint+    Just (Left addmpi)  -> if i > addmpi then i+1 else i+    -- go bacak indices before delmpi since we are deleting a midpoint+    Just (Right delmpi) -> if i >= delmpi then i-1 else i+++  oldlars = sAutoLine_to_lineAnchorsForRenderList ot old+  newlars = sAutoLine_to_lineAnchorsForRenderList ot new++  -- TODO+  -- compute previous LAR distances+  -- compute new LAR distances (after adjusting for midpoint index)+  -- adjust distance by the change in ratio++  r = undefined+++++sAutoLine_addMidpoint :: Int -> XY -> SAutoLine -> SAutoLine+sAutoLine_addMidpoint mpindex pos sline = r where+  newmidpoints =  L.insertAt mpindex (SAutoLineConstraintFixed pos) (_sAutoLine_midpoints sline)+++  -- TODO update line label position+++  fmapfn ll = if _sAutoLineLabel_index ll > mpindex+    then ll { _sAutoLineLabel_index = _sAutoLineLabel_index ll + 1}+    else ll+  newlabels = fmap fmapfn (_sAutoLine_labels sline)++  r = sline {+      _sAutoLine_midpoints = newmidpoints+      , _sAutoLine_labels = newlabels+    }++sAutoLine_modifyMidpoint :: Int -> XY -> SAutoLine -> SAutoLine+sAutoLine_modifyMidpoint mpindex pos sline = r where+  newmidpoints =  L.modifyAt mpindex (const $ SAutoLineConstraintFixed pos) (_sAutoLine_midpoints sline)+  -- TODO update line label position+  --fmapfn = undefined+  --newlabels = fmap fmapfn (_sAutoLine_labels sline)+  newlabels = _sAutoLine_labels sline++  r = sline {+      _sAutoLine_midpoints = newmidpoints+      , _sAutoLine_labels = newlabels+    }+++sAutoLine_deleteMidpoint :: Int -> SAutoLine -> SAutoLine+sAutoLine_deleteMidpoint mpindex sline = r where+  newmidpoints =  L.deleteAt mpindex (_sAutoLine_midpoints sline)+  -- TODO update line label position+  fmapfn ll = if _sAutoLineLabel_index ll >= mpindex+    then ll { _sAutoLineLabel_index = _sAutoLineLabel_index ll - 1}+    else ll+  newlabels = fmap fmapfn (_sAutoLine_labels sline)++  r = sline {+      _sAutoLine_midpoints = newmidpoints+      , _sAutoLine_labels = newlabels+    }++-- handles dragging and creating new midpoints+data AutoLineMidPointHandler = AutoLineMidPointHandler{+  _autoLineMidPointHandler_midPointIndex        :: Int+  , _autoLineMidPointHandler_isMidpointCreation :: Bool+  , _autoLineMidPointHandler_undoFirst          :: Bool+  , _autoLineMidPointHandler_offsetAttach       :: Bool+}++instance PotatoHandler AutoLineMidPointHandler where+  pHandlerName _ = handlerName_simpleLine_midPoint+  pHandleMouse slh@AutoLineMidPointHandler {..} PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = case _mouseDrag_state of+    -- this only happens in the click on existing midpoint case (creation case is handled by dragging)+    -- nothing to do here+    MouseDragState_Down -> assert (not _autoLineMidPointHandler_isMidpointCreation) $ Just $ captureWithNoChange slh+    MouseDragState_Dragging -> r where+      (rid, sline) = fromJust $ maybeGetSLine _potatoHandlerInput_canvasSelection++      -- TODO overlap adjacent issue, findFirstLineManipulator_NEW will midpoint instead of endpoint+      firstlm = findFirstLineManipulator_NEW sline _autoLineMidPointHandler_offsetAttach _potatoHandlerInput_pFState rmd++      -- index into _sAutoLine_midpoints+      -- in the '_autoLineMidPointHandler_isMidpointCreation' case, the midpoint index is AFTER the midpoint gets created+      -- `_autoLineMidPointHandler_midPointIndex == N` means we have `N-1 ... (x) ... N`+      -- so the new indexing is `N-1 ... N (x) ... N+1`+      mpindex = _autoLineMidPointHandler_midPointIndex++      -- TODO not working+      -- NOTE indexing of getAnchorPosition is offset from index into _autoLineMidPointHandler_midPointIndex+      ladjacentpos = getAnchorPosition _autoLineMidPointHandler_offsetAttach _potatoHandlerInput_pFState sline mpindex+      -- NOTE that this might be out of bounds in creation cases, but it won't get evaluated+      radjacentpos = getAnchorPosition _autoLineMidPointHandler_offsetAttach _potatoHandlerInput_pFState sline (mpindex+2)+      isoveradjacent = _mouseDrag_to == ladjacentpos || _mouseDrag_to == radjacentpos++      newsline = if _autoLineMidPointHandler_isMidpointCreation+        then sAutoLine_addMidpoint mpindex _mouseDrag_to sline+        else sAutoLine_modifyMidpoint mpindex _mouseDrag_to sline++      newslinedelete = sAutoLine_deleteMidpoint mpindex sline+++      (diddelete, event) = case firstlm of+        -- create the new midpoint if none existed+        _ | _autoLineMidPointHandler_isMidpointCreation -> (False,) $ WSEApplyLlama (_autoLineMidPointHandler_undoFirst, makeSetLlama $ (rid, SEltLine newsline))++        -- if overlapping existing ADJACENT endpoint do nothing (or undo if undo first)+        _ | isoveradjacent -> (True,) $ WSEApplyLlama (_autoLineMidPointHandler_undoFirst, makeSetLlama (rid, SEltLine newslinedelete))++        -- normal case, update the midpoint position+        _ -> (False,) $ WSEApplyLlama (_autoLineMidPointHandler_undoFirst, makeSetLlama $ (rid, SEltLine newsline))++      r = Just $ def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {+              -- go back to creation case IF we deleted a midpoint AND we weren't already in creation case (this can happen if you have two mid/endpoints right next to each other and you drag from one to the other)+              _autoLineMidPointHandler_isMidpointCreation = diddelete && not _autoLineMidPointHandler_isMidpointCreation+              , _autoLineMidPointHandler_undoFirst  = True+            }+          , _potatoHandlerOutput_pFEvent = Just event+        }+    -- no need to return AutoLineHandler, it will be recreated from selection by goat+    MouseDragState_Up -> Just def+    MouseDragState_Cancelled -> if _autoLineMidPointHandler_undoFirst then Just def { _potatoHandlerOutput_pFEvent = Just WSEUndo } else Just def+  pRenderHandler AutoLineMidPointHandler {..} phi@PotatoHandlerInput {..} = r where+    boxes = maybeRenderPoints (False, False) _autoLineMidPointHandler_offsetAttach _autoLineMidPointHandler_midPointIndex phi+    -- TODO render mouse position as there may not actually be a midpoint there+    r = HandlerRenderOutput boxes+  pIsHandlerActive _ = True+++-- WIP BELOW THIS LINE++-- handles creating and moving text labels+data AutoLineLabelMoverHandler = AutoLineLabelMoverHandler {+    _autoLineLabelMoverHandler_anchorOffset  :: XY+    , _autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler+    , _autoLineLabelMoverHandler_undoFirst   :: Bool+    , _autoLineLabelMoverHandler_labelIndex  :: Int+  }++-- TODO add support for moving line that does not exist yet+instance PotatoHandler AutoLineLabelMoverHandler where+  pHandlerName _ = handlerName_simpleLine_textLabelMover+  pHandleMouse slh@AutoLineLabelMoverHandler {..} phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let++      -- TODO move to helper+      (rid, sal) = mustGetSLine _potatoHandlerInput_canvasSelection+      llabel = _sAutoLine_labels sal `debugBangBang` _autoLineLabelMoverHandler_labelIndex+      -- PERF cache someday...+      larlist = sAutoLine_to_lineAnchorsForRenderList _potatoHandlerInput_pFState sal+      (_, index, reld) = getClosestPointOnLineFromLineAnchorsForRenderList larlist _mouseDrag_to+      newl = llabel {+          _sAutoLineLabel_index = index+          , _sAutoLineLabel_position = SAutoLineLabelPositionRelative reld+        }++    in case _mouseDrag_state of++      MouseDragState_Down -> Just $ captureWithNoChange slh++      MouseDragState_Dragging -> r where+        newsal = sal {+            _sAutoLine_labels = L.setAt _autoLineLabelMoverHandler_labelIndex newl (_sAutoLine_labels sal)+          }+        op = WSEApplyLlama (_autoLineLabelMoverHandler_undoFirst, makeSetLlama (rid, SEltLine newsal))+        r = Just def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {+                _autoLineLabelMoverHandler_undoFirst = True+              }+            , _potatoHandlerOutput_pFEvent = Just op+          }++      MouseDragState_Up -> Just def {+          -- go back to AutoLineLabelHandler on completion+          _potatoHandlerOutput_nextHandler = if not _autoLineLabelMoverHandler_undoFirst+            -- if _autoLineLabelMoverHandler_undoFirst is false, this means we didn't drag at all, in which case go to label edit handler+            then Just $ SomePotatoHandler $+              makeAutoLineLabelHandler_from_labelIndex _autoLineLabelMoverHandler_labelIndex _autoLineLabelMoverHandler_prevHandler phi rmd+            -- TODO consider also going into edit handler after dragging an endpoint, but for now, just go back to the previous handler (which will be AutoLineHandler)+            else Just (_autoLineLabelMoverHandler_prevHandler)+        }++      MouseDragState_Cancelled -> Just def {+          _potatoHandlerOutput_pFEvent = if _autoLineLabelMoverHandler_undoFirst then Just WSEUndo else Nothing+          -- go back to previous handler on cancel (could be AutoLineHandler or AutoLineLabelHandler)+          , _potatoHandlerOutput_nextHandler = Just (_autoLineLabelMoverHandler_prevHandler)+        }+++  pRenderHandler AutoLineLabelMoverHandler {..} phi@PotatoHandlerInput {..} =  r where+    labels = renderLabels phi False+    r = HandlerRenderOutput labels++  pIsHandlerActive _ = True++++sAutoLine_deleteLabel :: Int -> SAutoLine -> SAutoLine+sAutoLine_deleteLabel labelindex sline = r where+  newlabels =  L.deleteAt labelindex (_sAutoLine_labels sline)+  r = sline {+      _sAutoLine_labels = newlabels+    }++-- handles modifying text labels+data AutoLineLabelHandler = AutoLineLabelHandler {+    _autoLineLabelHandler_active        :: Bool+    , _autoLineLabelHandler_state       :: TextInputState+    , _autoLineLabelHandler_prevHandler :: SomePotatoHandler+    , _autoLineLabelHandler_undoFirst   :: Bool++    , _autoLineLabelHandler_labelIndex  :: Int+    , _autoLineLabelHandler_lineLabel   :: SAutoLineLabel++    -- this is needed to determine if erasing the last character in the label deletes the line label or undos the last operation+    , _autoLineLabelHandler_creation    :: Bool+  }+++getSAutoLineLabelBox :: XY -> SAutoLineLabel -> LBox+getSAutoLineLabelBox (V2 x y) llabel = r where+  w = T.length (_sAutoLineLabel_text llabel)+  r = LBox (V2 (x - w `div` 2) y) (V2 w 1)++updateAutoLineLabelHandlerState :: (HasOwlTree a) => a -> Bool -> CanvasSelection -> AutoLineLabelHandler -> AutoLineLabelHandler+updateAutoLineLabelHandlerState ot reset selection slh@AutoLineLabelHandler {..} = r where++  -- TODO move to helper+  (_, sal) = mustGetSLine selection+  llabel = if T.null (TZ.value (_textInputState_zipper _autoLineLabelHandler_state))+    then _autoLineLabelHandler_lineLabel+    -- if we are not creating a new label pull the SAutoLineLabel again because it might have changed+    else _sAutoLine_labels sal `debugBangBang` _autoLineLabelHandler_labelIndex+  newtext = _sAutoLineLabel_text llabel+  pos = getSAutoLineLabelPosition ot sal llabel+++  width = maxBound :: Int -- line label text always overflows+  box = getSAutoLineLabelBox pos llabel+++  r = slh {+    _autoLineLabelHandler_state = _autoLineLabelHandler_state {+          _textInputState_original = if reset then Just newtext else _textInputState_original _autoLineLabelHandler_state+          , _textInputState_displayLines = TZ.displayLinesWithAlignment TZ.TextAlignment_Left width () () (_textInputState_zipper _autoLineLabelHandler_state)+          , _textInputState_box = box+      }+    , _autoLineLabelHandler_undoFirst = if reset+      then False+      else _autoLineLabelHandler_undoFirst++    -- the previously stored label may have been modified so update it with the new one+    , _autoLineLabelHandler_lineLabel = llabel+  }++-- | make a TextInputState from a SAutoLineLabel on the SAutoLine+-- the SAutoLineLabel does not need to exist in the SAutoLine+makeAutoLineLabelInputState_from_lineLabel :: REltId -> SAutoLine -> SAutoLineLabel -> PotatoHandlerInput -> RelMouseDrag -> TextInputState+makeAutoLineLabelInputState_from_lineLabel rid sal llabel PotatoHandlerInput {..} rmd = r where+  ogtext = _sAutoLineLabel_text llabel+  pos = getSAutoLineLabelPosition _potatoHandlerInput_pFState sal llabel+  box = getSAutoLineLabelBox pos llabel++  width = maxBound :: Int -- line label text always overflows+  ogtz = TZ.fromText ogtext+  tis = TextInputState {+      _textInputState_rid = rid+      , _textInputState_original   = Just ogtext+      , _textInputState_zipper   = ogtz+      , _textInputState_box = box+      , _textInputState_displayLines = TZ.displayLinesWithAlignment TZ.TextAlignment_Left width () () ogtz+    }+  r = mouseText tis rmd++makeAutoLineLabelInputState_from_labelIndex :: REltId -> SAutoLine -> Int -> PotatoHandlerInput -> RelMouseDrag -> TextInputState+makeAutoLineLabelInputState_from_labelIndex rid sal labelindex phi@PotatoHandlerInput {..} rmd = r where+  llabel = _sAutoLine_labels sal `debugBangBang` labelindex+  r = makeAutoLineLabelInputState_from_lineLabel rid sal llabel phi rmd++makeAutoLineLabelHandler_from_newLineLabel :: REltId -> SAutoLine -> SAutoLineLabel -> SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> AutoLineLabelHandler+makeAutoLineLabelHandler_from_newLineLabel rid sal llabel prev phi rmd = AutoLineLabelHandler {+    _autoLineLabelHandler_active = False+    , _autoLineLabelHandler_state = (makeAutoLineLabelInputState_from_lineLabel rid sal llabel phi rmd)+    , _autoLineLabelHandler_prevHandler = prev+    , _autoLineLabelHandler_undoFirst = False+    , _autoLineLabelHandler_labelIndex = 0+    , _autoLineLabelHandler_lineLabel = llabel+    , _autoLineLabelHandler_creation = True+  }+++makeAutoLineLabelHandler_from_labelIndex :: Int -> SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> AutoLineLabelHandler+makeAutoLineLabelHandler_from_labelIndex labelindex prev phi@PotatoHandlerInput {..} rmd = r where+  (rid, sal) = mustGetSLine _potatoHandlerInput_canvasSelection+  llabel = _sAutoLine_labels sal `debugBangBang` labelindex+  r = AutoLineLabelHandler {+      _autoLineLabelHandler_active = False+      , _autoLineLabelHandler_state = moveToEol $ makeAutoLineLabelInputState_from_labelIndex rid sal labelindex phi rmd+      , _autoLineLabelHandler_prevHandler = prev+      , _autoLineLabelHandler_undoFirst = False+      , _autoLineLabelHandler_labelIndex = labelindex+      , _autoLineLabelHandler_lineLabel = llabel+      , _autoLineLabelHandler_creation = False+    }+++++-- TODO get rid of LBox arg, not used anymore+-- | just a helper for pHandleMouse+handleMouseDownOrFirstUpForAutoLineLabelHandler :: AutoLineLabelHandler -> PotatoHandlerInput -> RelMouseDrag -> Bool -> Maybe PotatoHandlerOutput+handleMouseDownOrFirstUpForAutoLineLabelHandler slh@AutoLineLabelHandler {..} phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) isdown = r where+  clickInside = does_lBox_contains_XY (_textInputState_box _autoLineLabelHandler_state) _mouseDrag_to+  newState = mouseText _autoLineLabelHandler_state rmd+  r = if clickInside+    then Just $ def {+        _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {+            _autoLineLabelHandler_active = isdown+            , _autoLineLabelHandler_state = newState+          }+      }+    -- pass the input on to the base handler (so that you can interact with BoxHandler mouse manipulators too)+    else pHandleMouse _autoLineLabelHandler_prevHandler phi rmd++instance PotatoHandler AutoLineLabelHandler where+  pHandlerName _ = handlerName_simpleLine_textLabel+  pHandleMouse slh' phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let+      slh = updateAutoLineLabelHandlerState _potatoHandlerInput_pFState False _potatoHandlerInput_canvasSelection slh'+    in case _mouseDrag_state of+      -- TODO if click on drag anchor modifier thingy+      --    in this case, don't forget to reset creation and undofirst states+      MouseDragState_Down -> handleMouseDownOrFirstUpForAutoLineLabelHandler slh phi rmd True+            -- TODO if click on handler, go into mover handler+            {- Just $ SomePotatoHandler AutoLineLabelMoverHandler {+                _autoLineLabelMoverHandler_prevHandler = SomePotatoHandler slh+                , _autoLineLabelMoverHandler_anchorOffset = 0+                , _autoLineLabelMoverHandler_undoFirst = True+                , _autoLineLabelMoverHandler_labelIndex = 0+              } -}++      -- TODO drag select text someday+      MouseDragState_Dragging -> Just $ captureWithNoChange slh+      MouseDragState_Up -> if not (_autoLineLabelHandler_active slh)+        then handleMouseDownOrFirstUpForAutoLineLabelHandler slh phi rmd False+        else Just $ def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {+                _autoLineLabelHandler_active = False+              }+          }+      MouseDragState_Cancelled -> Just $ captureWithNoChange slh++  pHandleKeyboard slh' PotatoHandlerInput {..} (KeyboardData k _) = let+      -- this regenerates displayLines unecessarily but who cares+      slh = updateAutoLineLabelHandlerState _potatoHandlerInput_pFState False _potatoHandlerInput_canvasSelection slh'+      -- TODO cache this in slh+      (rid, sal) = mustGetSLine _potatoHandlerInput_canvasSelection+    in case k of+      -- Escape or Return+      _ | k == KeyboardKey_Esc || k == KeyboardKey_Return -> Just $ def { _potatoHandlerOutput_nextHandler = Just (_autoLineLabelHandler_prevHandler slh) }++      -- TODO should only capture stuff caught by inputSingleLineZipper+      --  make sure pRefreshHandler clears the handler or sets it back to creation case in the event that an undo operation clears the handler+      _ -> Just r where++        -- TODO decide what to do with mods++        oldtais = _autoLineLabelHandler_state slh+        oldtextnull = T.null (TZ.value (_textInputState_zipper oldtais))++        -- if text was created, create the line label, you shouldn't need to but double check that there was no text before+        doescreate = oldtextnull+        (changed, newtais) = inputSingleLineZipper oldtais k+        newtext = TZ.value (_textInputState_zipper newtais)+        oldlabel = _autoLineLabelHandler_lineLabel slh+        newlabel = oldlabel {+            _sAutoLineLabel_text = newtext+          }+++        newsal_creation = sal {+            _sAutoLine_labels = newlabel : _sAutoLine_labels sal+          }++        newsal_update = sal {+            _sAutoLine_labels = L.setAt (_autoLineLabelHandler_labelIndex slh) newlabel (_sAutoLine_labels sal)+          }++        -- if all text was removed, delete the line label, you shouldn't need to but double check that there was actually a label to delete+        doesdelete = T.null newtext && not oldtextnull+        newsal_delete = sAutoLine_deleteLabel (_autoLineLabelHandler_labelIndex slh) sal++        newsal = if doesdelete+          then newsal_delete+          else if doescreate+            then newsal_creation+            else newsal_update++        mev = if not changed+          then Nothing+          else if doesdelete && _autoLineLabelHandler_creation slh+            -- if we deleted a newly created line just undo the last operation+            then Just WSEUndo+            else Just $ WSEApplyLlama (_autoLineLabelHandler_undoFirst slh, makeSetLlama (rid, SEltLine newsal))+++        r = def {+            _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {+                _autoLineLabelHandler_state  = newtais+                , _autoLineLabelHandler_undoFirst = case mev of+                  Nothing      -> _autoLineLabelHandler_undoFirst slh+                  Just WSEUndo -> False+                  _            -> True+              }+            , _potatoHandlerOutput_pFEvent = mev+          }++  pRefreshHandler slh PotatoHandlerInput {..} =  if Seq.null (unCanvasSelection _potatoHandlerInput_canvasSelection)+    then Nothing -- selection was deleted or something+    else if rid /= (_textInputState_rid $ _autoLineLabelHandler_state slh)+      then Nothing -- selection was change to something else+      else case selt of+        -- TODO proper regeneration of AutoLineLabelHandler (this is only needed when you support remote events)+        SEltLine _ -> Nothing+        _          -> Nothing+      where+        sowl = selectionToSuperOwl _potatoHandlerInput_canvasSelection+        rid = _superOwl_id sowl+        selt = superOwl_toSElt_hack sowl++  pRenderHandler slh' PotatoHandlerInput {..} = r where+    slh = updateAutoLineLabelHandlerState _potatoHandlerInput_pFState False _potatoHandlerInput_canvasSelection slh'++    -- consider rendering endpoints?++    -- TODO render label mover anchor with offset 1++    -- render the text cursor+    btis = _autoLineLabelHandler_state slh+    r = makeTextHandlerRenderOutput btis++  pIsHandlerActive = _autoLineLabelHandler_active
+ src/Potato/Flow/Controller/Manipulator/Pan.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.Pan (+  PanHandler(..)+) where++import           Relude++import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Types+import           Potato.Flow.Math++import           Data.Default+++data PanHandler = PanHandler {+    _panHandler_panDelta           :: XY+    , _panHandler_maybePrevHandler :: Maybe SomePotatoHandler+  }++instance Default PanHandler where+  def = PanHandler {+      _panHandler_panDelta = 0+      , _panHandler_maybePrevHandler = Nothing+    }++instance PotatoHandler PanHandler where+  pHandlerName _ = handlerName_pan+  pHandleMouse ph@PanHandler {..} PotatoHandlerInput {..} (RelMouseDrag MouseDrag {..}) = Just $ case _mouseDrag_state of+    MouseDragState_Cancelled -> def { _potatoHandlerOutput_pan = Just $ - _panHandler_panDelta }+    MouseDragState_Down -> def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler ph }+    _ -> def {+        _potatoHandlerOutput_nextHandler = case _mouseDrag_state of+          MouseDragState_Dragging -> Just $ SomePotatoHandler ph { _panHandler_panDelta = delta }+          MouseDragState_Up -> case _panHandler_maybePrevHandler of+            Nothing -> Just $ SomePotatoHandler (def :: PanHandler)+            Just x  -> Just x+          _ -> error "not posible"+        , _potatoHandlerOutput_pan = Just (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++  -- TODO keyboard pan+  pHandleKeyboard PanHandler {..} PotatoHandlerInput {..} _ = Nothing++  -- refresh the underlying handler if there is one+  pRefreshHandler ph@PanHandler {..} phi = Just $ SomePotatoHandler ph {+      _panHandler_maybePrevHandler = join $ fmap (flip pRefreshHandler phi) _panHandler_maybePrevHandler+    }++  -- render the underlying handler if there is one+  pRenderHandler PanHandler {..} phi = case _panHandler_maybePrevHandler of+    Nothing -> def+    Just x  -> pRenderHandler x phi++  -- always active so we never replace pan handler with new selection from changes (which should never happen anyways)+  pIsHandlerActive _ = True++  pHandlerTool _ = Just Tool_Pan
+ src/Potato/Flow/Controller/Manipulator/Select.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.Select (+  SelectHandler(..)+) where++import           Relude++import           Potato.Flow.BroadPhase+import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Manipulator.Box+import           Potato.Flow.Controller.OwlLayers+import           Potato.Flow.Methods.LineDrawer+import           Potato.Flow.Controller.Types+import           Potato.Flow.Math+import           Potato.Flow.Owl+import           Potato.Flow.OwlItem+import           Potato.Flow.OwlState+import           Potato.Flow.SEltMethods+import Potato.Flow.RenderCache+import           Potato.Flow.SElts++import           Control.Exception                      (assert)+import           Data.Default+import           Data.Foldable                          (maximumBy)+import qualified Data.IntMap                            as IM+import qualified Data.Sequence                          as Seq++selectBoxFromRelMouseDrag :: RelMouseDrag -> LBox+selectBoxFromRelMouseDrag (RelMouseDrag MouseDrag {..}) = r where+  LBox pos' sz' = make_lBox_from_XYs _mouseDrag_to _mouseDrag_from+  -- always expand selection by 1+  r = LBox pos' (sz' + V2 1 1)+++doesOwlSubItemIntersectBox :: OwlTree -> RenderCache -> LBox -> SuperOwl -> Bool+doesOwlSubItemIntersectBox ot rcache lbox sowl = case superOwl_owlSubItem sowl of+  OwlSubItemBox x -> does_lBox_intersect_include_zero_area lbox (_sBox_box x)+  OwlSubItemTextArea x -> does_lBox_intersect_include_zero_area lbox (_sTextArea_box x)+  OwlSubItemLine sline@SAutoLine {..} -> r where+    anchors = case renderCache_lookup rcache (_superOwl_id sowl) of+      Nothing -> sSimpleLineNewRenderFnComputeCache ot sline+      Just (OwlItemCache_Line lar _)  -> lar+      _ -> assert False (sSimpleLineNewRenderFnComputeCache ot sline)+    r = lineAnchorsForRender_doesIntersectBox anchors lbox+  _ -> False+++-- TODO ignore locked and hidden elements here+-- for now hidden + locked elements ARE inctluded in BroadPhaseState+selectMagic :: OwlPFState -> RenderCache -> LayerMetaMap -> BroadPhaseState -> RelMouseDrag -> Selection+selectMagic pfs rcache lmm bps rmd = r where+  selectBox = selectBoxFromRelMouseDrag rmd+  boxSize = lBox_area selectBox+  singleClick = boxSize == 1++  isboxshaped sowl = case _superOwl_elt sowl of+    OwlItem _ (OwlSubItemBox _)      -> True+    OwlItem _ (OwlSubItemTextArea _) -> True+    _                                -> False++  unculledrids = broadPhase_cull_includeZero selectBox (_broadPhaseState_bPTree bps)+  unculledsowls = fmap (\rid ->  owlTree_mustFindSuperOwl (_owlPFState_owlTree pfs) rid) unculledrids+  selectedsowls'' = flip filter unculledsowls $ \case+    -- if it's box shaped, there's no need to test for intersection as we already know it intersects based on broadphase+    sowl | isboxshaped sowl -> True+    sowl -> doesOwlSubItemIntersectBox (_owlPFState_owlTree pfs) rcache selectBox sowl++  -- remove lock and hidden stuff+  selectedsowls' = flip filter selectedsowls'' $ \sowl -> not (layerMetaMap_isInheritHiddenOrLocked (_owlPFState_owlTree pfs) (_superOwl_id sowl) lmm)++  -- TODO consider using makeSortedSuperOwlParliament instead (prob a little faster?)+  selectedsowls = if singleClick+    -- single click, select top elt only+    then case selectedsowls' of+      [] -> []+      _ ->  [maximumBy (\s1 s2 -> owlTree_superOwl_comparePosition (_owlPFState_owlTree pfs) s2 s1) selectedsowls']+    -- otherwise select everything+    else selectedsowls'++  r = makeSortedSuperOwlParliament (_owlPFState_owlTree pfs) $ Seq.fromList selectedsowls+++data SelectHandler = SelectHandler {+    _selectHandler_selectArea :: LBox+  }++instance Default SelectHandler where+  def = SelectHandler {+      _selectHandler_selectArea = LBox 0 0+    }++instance PotatoHandler SelectHandler where+  pHandlerName _ = handlerName_select+  pHandleMouse sh phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = Just $ case _mouseDrag_state of+    MouseDragState_Down -> r where++      nextSelection@(SuperOwlParliament sowls) = selectMagic _potatoHandlerInput_pFState _potatoHandlerInput_renderCache (_layersState_meta _potatoHandlerInput_layersState) _potatoHandlerInput_broadPhase rmd+      -- since selection came from canvas, it's definitely a valid CanvasSelection, no need to convert+      nextCanvasSelection = CanvasSelection sowls+      shiftClick = isJust $ find (==KeyModifier_Shift) _mouseDrag_modifiers++      r = if isParliament_null nextSelection || shiftClick+        then captureWithNoChange sh++        -- special select+drag case, override the selection+        -- NOTE BoxHandler here is used to move all SElt types, upon release, it will either return the correct handler type or not capture the input in which case Goat will set the correct handler type+        else case pHandleMouse (def { _boxHandler_creation = BoxCreationType_DragSelect }) (phi { _potatoHandlerInput_selection = nextSelection, _potatoHandlerInput_canvasSelection = nextCanvasSelection }) rmd of+          -- force the selection from outside the handler and ignore the new selection results returned by pho (which should always be Nothing)+          Just pho -> assert (isNothing . _potatoHandlerOutput_select $ pho)+            $ pho { _potatoHandlerOutput_select = Just (False, nextSelection) }+          Nothing -> error "handler was expected to capture this mouse state"+++    MouseDragState_Dragging -> setHandlerOnly sh {+        _selectHandler_selectArea = selectBoxFromRelMouseDrag rmd+      }+    MouseDragState_Up -> def { _potatoHandlerOutput_select = Just (shiftClick, newSelection) }  where+      shiftClick = isJust $ find (==KeyModifier_Shift) (_mouseDrag_modifiers)+      newSelection = selectMagic _potatoHandlerInput_pFState _potatoHandlerInput_renderCache (_layersState_meta _potatoHandlerInput_layersState) _potatoHandlerInput_broadPhase rmd+    MouseDragState_Cancelled -> def+  pHandleKeyboard _ PotatoHandlerInput {..} _ = Nothing+  pRenderHandler sh PotatoHandlerInput {..} = HandlerRenderOutput (fmap defaultRenderHandle $ substract_lBox full inside) where+    full@(LBox (V2 x y) (V2 w h)) = _selectHandler_selectArea sh+    inside = if w > 2 && h > 2+      then LBox (V2 (x+1) (y+1)) (V2 (w-2) (h-2))+      else LBox 0 0+  pIsHandlerActive _ = True+  pHandlerTool _ = Just Tool_Select
+ src/Potato/Flow/Controller/Manipulator/TextArea.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.TextArea (+  TextAreaHandler(..)+  , makeTextAreaHandler+) where++import           Relude++import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Manipulator.Common+import           Potato.Flow.Llama+import           Potato.Flow.Math+import           Potato.Flow.Owl+import           Potato.Flow.OwlWorkspace+import           Potato.Flow.SElts+import           Potato.Flow.Types++import           Data.Default+import           Data.Dependent.Sum                        (DSum ((:=>)))+import qualified Data.IntMap                               as IM+import qualified Data.Map                                  as Map+import qualified Data.Text                                 as T+++getSTextArea :: CanvasSelection -> (REltId, STextArea)+getSTextArea selection = case superOwl_toSElt_hack sowl of+  SEltTextArea stextarea -> (rid, stextarea)+  selt                   -> error $ "expected SBox, got " <> show selt+  where+    sowl = selectionToSuperOwl selection+    rid = _superOwl_id sowl++data TextAreaHandler = TextAreaHandler {+    _textAreaHandler_prevHandler :: SomePotatoHandler+    , _textAreaHandler_relCursor :: XY+  }++getCursorPosHelper :: CanvasSelection -> RelMouseDrag -> (XY, Bool)+getCursorPosHelper selection (RelMouseDrag MouseDrag {..}) = r where+  (_, STextArea {..}) = getSTextArea selection+  CanonicalLBox _ _ lbox@(LBox p (V2 _ _)) = canonicalLBox_from_lBox _sTextArea_box+  newrelpos = _mouseDrag_to - p+  clickinside = does_lBox_contains_XY lbox _mouseDrag_to+  r = (newrelpos, clickinside)++makeTextAreaHandler :: SomePotatoHandler -> CanvasSelection -> RelMouseDrag -> Bool -> TextAreaHandler+makeTextAreaHandler prev selection rmd creation = r where+  (newrelpos, _) = getCursorPosHelper selection rmd+  r = TextAreaHandler {+    _textAreaHandler_prevHandler = prev+    -- we want the cursor at the beginning if we are creating TextAreaHandler right after creating a new text area+    , _textAreaHandler_relCursor = if creation then 0 else newrelpos+  }++instance PotatoHandler TextAreaHandler where+  pHandlerName _ = handlerName_textArea+  pHandlerDebugShow tah = "TextAreaHandler, cursor: " <> show (_textAreaHandler_relCursor tah)+  pHandleMouse tah phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let+      (newrelpos, clickinside) = getCursorPosHelper _potatoHandlerInput_canvasSelection rmd+    in+      case _mouseDrag_state of+        MouseDragState_Down -> r where+          r = if clickinside+            then Just $ def {+                _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler tah {+                    _textAreaHandler_relCursor = newrelpos+                  }+              }+            -- pass the input on to the base handler (so that you can interact with BoxHandler mouse manipulators too)+            else pHandleMouse (_textAreaHandler_prevHandler tah) phi rmd++        -- TODO "painting" mode someday+        MouseDragState_Dragging -> Just $ captureWithNoChange tah+        MouseDragState_Up -> Just $ captureWithNoChange tah+        MouseDragState_Cancelled -> Just $ captureWithNoChange tah++  pHandleKeyboard tah PotatoHandlerInput {..} (KeyboardData k _) = let+      (rid, STextArea {..}) = getSTextArea _potatoHandlerInput_canvasSelection+      CanonicalLBox _ _ (LBox _ (V2 width height)) = canonicalLBox_from_lBox _sTextArea_box+      wrapBox (V2 x y) = V2 (x `mod` width) (y `mod` height)+++      getCursorChar h = Map.lookup (_textAreaHandler_relCursor h) _sTextArea_text+      -- combinators+      start = (Map.empty, tah)+      finish (mc, h) = Just $ def {+          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler h+          , _potatoHandlerOutput_pFEvent = if null mc+            then Nothing+            -- TODO if you store mc in TextAreaHandler you can continue to build on it which would allow you to set "undoFirst" paremeter to True+            else Just $ WSEApplyLlama (False, makePFCLlama . OwlPFCManipulate $ IM.singleton rid controller)+        } where+          controller = CTagTextArea :=> (Identity $ CTextArea (DeltaTextArea mc))+      moveAndWrap dp (mc, h) = (mc, h {+          _textAreaHandler_relCursor = wrapBox $ (_textAreaHandler_relCursor tah) + dp+        })+      -- TODO+      setChar c (mc, h) = (Map.insert (_textAreaHandler_relCursor h) (getCursorChar h, Just c) mc, h)+      deleteChar (mc, h) = (Map.insert (_textAreaHandler_relCursor h) (getCursorChar h, Nothing) mc, h)+++    in case k of+      KeyboardKey_Esc -> Just $ def { _potatoHandlerOutput_nextHandler = Just (_textAreaHandler_prevHandler tah) }+      KeyboardKey_Left -> finish . moveAndWrap (V2 (-1) 0) $ start+      KeyboardKey_Right -> finish .  moveAndWrap (V2 1 0) $ start+      KeyboardKey_Down -> finish . moveAndWrap (V2 0 1) $ start+      KeyboardKey_Up -> finish . moveAndWrap (V2 0 (-1)) $ start+      KeyboardKey_Return  -> finish . moveAndWrap (V2 0 1) $ start+      KeyboardKey_Space   -> finish . moveAndWrap (V2 1 0) . setChar ' ' $ start+      KeyboardKey_Delete  -> finish . deleteChar $ start+      KeyboardKey_Backspace -> finish . deleteChar . moveAndWrap (V2 (-1) 0) $ start+      KeyboardKey_Char c  -> finish . moveAndWrap (V2 1 0) . setChar c $ start+      KeyboardKey_Paste t -> finish $ foldl' (\acc c -> moveAndWrap (V2 1 0) . setChar c $ acc) start (T.unpack t)+      _ -> Nothing++  pRefreshHandler _ PotatoHandlerInput {..} = Nothing+  pRenderHandler tah phi@PotatoHandlerInput {..} = r where++    -- TODO maybe version of this++    -- TODO maybe store instead of pull from selection?+    (_, STextArea {..}) = getSTextArea _potatoHandlerInput_canvasSelection+    CanonicalLBox _ _ (LBox p (V2 _ _)) = canonicalLBox_from_lBox _sTextArea_box+    cursor = RenderHandle {+        _renderHandle_box = LBox (p + _textAreaHandler_relCursor tah) (V2 1 1)+        , _renderHandle_char = Map.lookup (_textAreaHandler_relCursor tah) _sTextArea_text+        , _renderHandle_color = RHC_Default+      }+    r = pRenderHandler (_textAreaHandler_prevHandler tah) phi <>  HandlerRenderOutput [cursor]+  pIsHandlerActive _ = False
+ src/Potato/Flow/Controller/Manipulator/TextInputState.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Manipulator.TextInputState where++import Relude++import           Potato.Flow.Math+import           Potato.Flow.SElts+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.Handler++import qualified Data.Text as T+import qualified Potato.Data.Text.Zipper                          as TZ+import qualified Data.Map as Map+++data TextInputState = TextInputState {+  _textInputState_rid            :: REltId+  , _textInputState_original     :: Maybe Text -- needed to properly create DeltaText for undo+  , _textInputState_box          :: LBox -- we can always pull this from selection, but may as well store it+  , _textInputState_zipper       :: TZ.TextZipper+  , _textInputState_displayLines :: TZ.DisplayLines ()+  --, _textInputState_selected :: Int -- WIP+} deriving (Show)+++moveToEol :: TextInputState -> TextInputState+moveToEol tais = tais { _textInputState_zipper = TZ.end (_textInputState_zipper tais) }++-- TODO support shift selecting someday+-- TODO define behavior for when you click outside box or assert+mouseText :: TextInputState -> RelMouseDrag -> TextInputState+mouseText tais rmd = r where+  lbox = _textInputState_box tais+  RelMouseDrag MouseDrag {..} = rmd+  ogtz = _textInputState_zipper tais+  CanonicalLBox _ _ (LBox (V2 x y) (V2 _ _)) = canonicalLBox_from_lBox lbox+  V2 mousex mousey = _mouseDrag_to+  newtz = TZ.goToDisplayLinePosition (mousex-x) (mousey-y) (_textInputState_displayLines tais) ogtz+  r = tais { _textInputState_zipper = newtz }++++-- TODO support shift selecting text someday meh+-- | returns zipper in TextInputState after keyboard input has been applied for single line entry (does not allow line breaks)+-- Bool indicates if there was any real input+inputSingleLineZipper :: TextInputState -> KeyboardKey -> (Bool, TextInputState)+inputSingleLineZipper tais kk = (changed, tais { _textInputState_zipper = newZip }) where++  oldZip = _textInputState_zipper tais+  (changed, newZip) = case kk of+    KeyboardKey_Left    -> (False, TZ.left oldZip)+    KeyboardKey_Right   -> (False, TZ.right oldZip)+    KeyboardKey_Home    -> (False, TZ.home oldZip)+    KeyboardKey_End -> (False, TZ.end oldZip)++    KeyboardKey_Space   -> (True, TZ.insertChar ' ' oldZip)+    KeyboardKey_Delete  -> (newtz /= oldZip, TZ.deleteRight oldZip) where newtz = TZ.deleteRight oldZip+    KeyboardKey_Backspace -> (newtz /= oldZip, newtz) where newtz = TZ.deleteLeft oldZip+    KeyboardKey_Char c  -> (True, TZ.insertChar c oldZip)++    -- TODO remove new line characters+    KeyboardKey_Paste t -> (True, TZ.insert t oldZip)++    _ -> (False, oldZip)+++makeTextHandlerRenderOutput :: TextInputState -> HandlerRenderOutput+makeTextHandlerRenderOutput btis = r where+  dls = _textInputState_displayLines btis+  origBox = _textInputState_box $ btis+  (x, y) = TZ._displayLines_cursorPos dls+  offsetMap = TZ._displayLines_offsetMap dls++  mCursorChar = (fmap fst) . T.uncons . TZ._textZipper_after . _textInputState_zipper $ btis++  mlbox = do+    -- empty boxes are used with line labels+    --guard $ lBox_area origBox > 0++    -- TODO would be nice to assert that this exists...+    (alignxoff,_) <- Map.lookup y offsetMap+    let+      LBox p _ = _textInputState_box $ btis+      cursorh = RenderHandle {+          _renderHandle_box = LBox (p + (V2 (x + alignxoff) y)) (V2 1 1)+          , _renderHandle_char = mCursorChar+          , _renderHandle_color = RHC_Default+        }+    return [cursorh]++  r = HandlerRenderOutput $ fromMaybe [] mlbox
+ src/Potato/Flow/Controller/OwlLayers.hs view
@@ -0,0 +1,319 @@++{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++-- TODO move to Potato.Flow.Controller+module Potato.Flow.Controller.OwlLayers where++import           Relude++import           Potato.Flow.Controller.Types+import           Potato.Flow.Types+import Potato.Flow.SElts+import           Potato.Flow.OwlItem+import Potato.Flow.Owl+import Potato.Flow.OwlState+import Potato.Flow.DebugHelpers++import           Control.Lens                 (over, _2)+import Data.Foldable (foldl)+import           Data.Default+import qualified Data.IntMap                  as IM+import qualified Data.IntSet as IS+import           Data.Sequence                ((><), (|>))+import qualified Data.Sequence                as Seq+import qualified Data.Text as T+import qualified Text.Show++data LockHiddenState = LHS_True | LHS_False | LHS_True_InheritTrue | LHS_False_InheritTrue deriving (Eq, Show)++lockHiddenStateToBool :: LockHiddenState -> Bool+lockHiddenStateToBool = \case+  LHS_False -> False+  _ -> True++toggleLockHiddenState :: LockHiddenState -> LockHiddenState+toggleLockHiddenState = \case+  LHS_True -> LHS_False+  LHS_False -> LHS_True+  LHS_True_InheritTrue -> LHS_False_InheritTrue+  LHS_False_InheritTrue -> LHS_True_InheritTrue++setLockHiddenStateInChildren :: LockHiddenState -> Bool -> LockHiddenState+setLockHiddenStateInChildren parentstate = \case+  False -> case parentstate of+    LHS_False -> LHS_False+    _         -> LHS_False_InheritTrue+  True -> case parentstate of+    LHS_False -> LHS_True+    _         -> LHS_True_InheritTrue++-- ancestor state got set, update the child+updateLockHiddenStateInChildren :: LockHiddenState -> LockHiddenState -> LockHiddenState+updateLockHiddenStateInChildren parentstate = \case+  LHS_False -> case parentstate of+    LHS_True  -> LHS_False_InheritTrue+    LHS_False -> LHS_False+    _         -> invalid+  LHS_True -> case parentstate of+    LHS_True  -> LHS_True_InheritTrue+    LHS_False -> LHS_True+    _         -> invalid+  LHS_True_InheritTrue -> case parentstate of+    LHS_False -> LHS_True+    LHS_True  -> LHS_True_InheritTrue+    _         -> invalid+  LHS_False_InheritTrue -> case parentstate of+    LHS_False -> LHS_False+    LHS_True  -> LHS_False_InheritTrue+    _         -> invalid+  where+    invalid = error "toggling of LHS_XXX_InheritTrue elements disallowed"++-- TODO be careful with hidden cost of Eq SuperOwl+-- this stores info just for what is displayed, Seq LayerEntry is uniquely generated from LayerMetaMap and PFState+data LayerEntry = LayerEntry {+  _layerEntry_lockState      :: LockHiddenState+  , _layerEntry_hideState      :: LockHiddenState+  , _layerEntry_isCollapsed    :: Bool -- this parameter is ignored if not a folder, Maybe Bool instead?+  , _layerEntry_superOwl :: SuperOwl+} deriving (Eq)++instance Show LayerEntry where+  show LayerEntry {..} = "LayerEntry (lhc: "+    <> show _layerEntry_lockState+    <> "," <> show _layerEntry_hideState+    <> "," <> show _layerEntry_isCollapsed+    <> "):\n" <> (T.unpack $ potatoShow _layerEntry_superOwl)++layerEntry_depth :: LayerEntry -> Int+layerEntry_depth LayerEntry {..} = _owlItemMeta_depth . _superOwl_meta $ _layerEntry_superOwl++layerEntry_display :: LayerEntry -> Text+layerEntry_display LayerEntry {..} = hasOwlItem_name _layerEntry_superOwl++layerEntry_isFolder :: LayerEntry -> Bool+layerEntry_isFolder LayerEntry {..} = mommyOwl_hasKiddos _layerEntry_superOwl++layerEntry_rEltId :: LayerEntry -> REltId+layerEntry_rEltId LayerEntry {..} = _superOwl_id _layerEntry_superOwl++-- index type into Seq LayerEntry+type LayerEntryPos = Int+type LayerEntries = Seq LayerEntry++layerEntriesToPrettyText :: LayerEntries -> Text+layerEntriesToPrettyText lentries = foldr foldrfn "" lentries where+  foldrfn le@LayerEntry {..} acc = r where+    collapseText = if layerEntry_isFolder le+      then if _layerEntry_isCollapsed+        then ">"+        else "v"+      else " "+    hideText = case _layerEntry_hideState of+      LHS_True              -> "▓"+      LHS_False             -> " "+      LHS_True_InheritTrue  -> "▓"+      LHS_False_InheritTrue -> "▒"+    lockText = case _layerEntry_lockState of+      LHS_True              -> "▓"+      LHS_False             -> " "+      LHS_True_InheritTrue  -> "▓"+      LHS_False_InheritTrue -> "▒"+    sowl = _layerEntry_superOwl+    r = T.replicate (layerEntry_depth le) " " <> collapseText <> hideText <> lockText <> " " <> hasOwlItem_name sowl <> "\n" <> acc++data LayersState = LayersState {+    -- mapping from REltId to element meta data+    _layersState_meta :: LayerMetaMap+    -- sequence of visible folders+    , _layersState_entries :: LayerEntries+    , _layersState_scrollPos :: Int+  } deriving (Show, Eq)++instance PotatoShow LayersState where+  potatoShow LayersState{..} = r where+    r = "LayersState: "+      <> show _layersState_meta+      <> "\nLayerEntries:\n"+      <> showFoldable _layersState_entries++data LockHideCollapseOp = LHCO_ToggleLock | LHCO_ToggleHide | LHCO_ToggleCollapse deriving (Show)++alterWithDefault :: (Eq a, Default a) => (a -> a) -> REltId -> REltIdMap a -> REltIdMap a+alterWithDefault f k m = IM.alter f' k m where+  apply x = if fx == def then Nothing else Just fx where+    fx = f x+  f' = \case+    Nothing -> apply def+    Just x -> apply x++lookupWithDefault :: (Default a) => REltId -> REltIdMap a -> a+lookupWithDefault rid ridm = case IM.lookup rid ridm of+  Nothing -> def+  Just x  -> x++++++-- TODO test+-- | assumes LayersState is after hide state of given lepos has just been toggled+changesFromToggleHide :: OwlPFState -> LayersState -> LayerEntryPos -> SuperOwlChanges+changesFromToggleHide OwlPFState {..} LayersState {..} lepos = r where+  le = Seq.index _layersState_entries lepos+  sowl = _layerEntry_superOwl le+  lerid = _superOwl_id sowl+  lm = lookupWithDefault lerid _layersState_meta+  isHidden = _layerMeta_isHidden lm++  -- find all children that weren't already hidden+  children = owliteratechildrenat _owlPFState_owlTree lerid+  isunhidden sowl' = not . _layerMeta_isHidden $ lookupWithDefault (_superOwl_id sowl') _layersState_meta+  unhiddenChildren = toList . fmap (\sowl' -> (_superOwl_id sowl', sowl')) $ Seq.filter isunhidden children++  r = if isHidden+    then IM.fromList $ (lerid, Nothing) : (fmap (over _2 (const Nothing)) unhiddenChildren)+    else IM.fromList $ (lerid,Just sowl) : (fmap (over _2 Just) unhiddenChildren)++-- iterates over LayerEntryPos, skipping all children of entries where skipfn evaluates to true+doChildrenRecursive :: (LayerEntry -> Bool) -> (LayerEntry -> LayerEntry) -> Seq LayerEntry -> Seq LayerEntry+doChildrenRecursive skipfn entryfn = snd . mapAccumL mapaccumlfn maxBound where+  mapaccumlfn skipdepth le = (newskipdepth, newle) where+    depth = layerEntry_depth le+    newskipdepth+      -- skip, so keep skipping+      | depth >= skipdepth = skipdepth+      -- skip all children+      -- note, no need to check for collapsed state because we are iterating over LayerEntry which do not include children of collapsed entries+      | skipfn le = depth + 1+      -- either we exited a skipped folder or aren't skipping, reset skip counter (since we skip subfolders of skipped entries, maximal skip stack depth is 1 so reset is OK)+      | otherwise = maxBound+    newle = if depth >= skipdepth+      then le -- no changes to skipped elts+      else entryfn le+++toggleLayerEntry :: OwlPFState -> LayersState -> LayerEntryPos -> LockHideCollapseOp -> LayersState+toggleLayerEntry OwlPFState {..} LayersState {..} lepos op = r where+  le = Seq.index _layersState_entries lepos+  lerid = layerEntry_rEltId le+  ledepth = layerEntry_depth le+  childFrom nextLayerEntry = layerEntry_depth nextLayerEntry /= ledepth+  -- visible children of le+  childles = Seq.takeWhileL childFrom . Seq.drop (lepos+1) $ _layersState_entries+  -- everything before le+  frontOfLe = Seq.take lepos _layersState_entries+  -- everything after childles+  backOfChildles = Seq.drop (lepos + 1 + Seq.length childles) _layersState_entries++  -- simple helper function for setting lock/hidden state+  togglefn fn setlmfn setlefn = (LayersState newlmm newlentries 0) where+    newlhsstate = toggleLockHiddenState $ fn le+    newlmm = alterWithDefault (\lm' -> setlmfn lm' (lockHiddenStateToBool newlhsstate)) lerid _layersState_meta+    entryfn childle = setlefn childle $ updateLockHiddenStateInChildren newlhsstate (fn childle)+    newchildles = doChildrenRecursive (lockHiddenStateToBool . fn) entryfn childles+    newle = setlefn le newlhsstate+    newlentries = (frontOfLe |> newle) >< newchildles >< backOfChildles++  r = case op of+    LHCO_ToggleCollapse -> (LayersState newlmm newlentries 0) where+      newcollapse = not $ _layerEntry_isCollapsed le+      newlmm = alterWithDefault (\le' -> le' { _layerMeta_isCollapsed = newcollapse }) lerid _layersState_meta+      newle = le { _layerEntry_isCollapsed = newcollapse }+      newchildles = buildLayerEntriesRecursive _owlPFState_owlTree _layersState_meta Seq.empty (Just newle)+      newlentries = if newcollapse+        then (frontOfLe |> newle) >< backOfChildles+        else (frontOfLe |> newle) >< newchildles >< backOfChildles++    LHCO_ToggleLock -> togglefn _layerEntry_lockState (\lm' x -> lm' { _layerMeta_isLocked = x }) (\le' x -> le' { _layerEntry_lockState = x })+    LHCO_ToggleHide -> togglefn _layerEntry_hideState (\lm' x -> lm' { _layerMeta_isHidden = x }) (\le' x -> le' { _layerEntry_hideState = x })++expandAllCollapsedParents :: Selection -> OwlPFState -> LayersState -> LayersState+expandAllCollapsedParents selection pfs ls = r where+  ops = owlParliamentSet_findParents (hasOwlTree_owlTree pfs) . superOwlParliament_toOwlParliamentSet $  selection+  oldlmm = _layersState_meta ls+  iscollapsedfilterfn rid = case IM.lookup rid oldlmm of+    Just lm -> _layerMeta_isCollapsed lm+    Nothing -> defaultFolderCollapseState+  collapsedParents = IS.filter iscollapsedfilterfn ops+  alterfn mlm = case mlm of+    Nothing -> Just (def { _layerMeta_isCollapsed = False })+    Just x -> Just (x { _layerMeta_isCollapsed = False })+  newlmm = IS.foldr (IM.alter alterfn) oldlmm collapsedParents+  r = if IS.null collapsedParents+    then ls+    -- can we do this more efficiently?+    else (makeLayersStateFromOwlPFState pfs newlmm) { _layersState_scrollPos = _layersState_scrollPos ls }++makeLayersStateFromOwlPFState :: OwlPFState -> LayerMetaMap -> LayersState+makeLayersStateFromOwlPFState pfs lmm = LayersState {+    _layersState_meta = lmm+    , _layersState_entries = generateLayersNew (_owlPFState_owlTree pfs) lmm+    , _layersState_scrollPos = 0+  }++updateLayers :: OwlPFState -> SuperOwlChanges -> LayersState -> LayersState+updateLayers pfs changes LayersState {..} = r where+  -- update _layersState_meta+  (deletestuff, maybenewstuff) = IM.partition isNothing changes++  maybenewstuffcollapsed = (fmap (const (def {_layerMeta_isCollapsed = True})) maybenewstuff)++  newlmm = IM.difference (IM.union _layersState_meta maybenewstuffcollapsed) deletestuff+++  -- keep deleted elts so that folder state is preserved after undos/redos+  --newlmm = IM.union _layersState_meta (fmap (const def) maybenewstuff)++  -- TODO incremental rather than regenerate...+  newlentries = generateLayersNew (_owlPFState_owlTree pfs) newlmm++  r = LayersState newlmm newlentries _layersState_scrollPos++buildLayerEntriesRecursive :: OwlTree -> LayerMetaMap -> Seq LayerEntry -> Maybe LayerEntry -> Seq LayerEntry+buildLayerEntriesRecursive ot lmm acc mparent = r where+  foldlfn acclentries rid = newacclentries where+    sowl = owlTree_mustFindSuperOwl ot rid+    lm = lookupWithDefault rid lmm+    -- add self+    lentry = case mparent of+      Nothing -> LayerEntry {+        _layerEntry_lockState =  if _layerMeta_isLocked lm then LHS_True else LHS_False+        , _layerEntry_hideState = if _layerMeta_isHidden lm then LHS_True else LHS_False+        , _layerEntry_isCollapsed = _layerMeta_isCollapsed lm+        , _layerEntry_superOwl = sowl+      }+      Just parent -> LayerEntry {+        _layerEntry_lockState = setLockHiddenStateInChildren (_layerEntry_lockState parent) $ _layerMeta_isLocked lm+        , _layerEntry_hideState = setLockHiddenStateInChildren (_layerEntry_hideState parent) $ _layerMeta_isHidden lm+        , _layerEntry_isCollapsed = _layerMeta_isCollapsed lm+        , _layerEntry_superOwl = sowl+      }+    newacclentries' = acclentries |> lentry+    -- recursively add children+    newacclentries = if _layerMeta_isCollapsed lm+      then newacclentries'+      else buildLayerEntriesRecursive ot lmm newacclentries' (Just lentry)+  r = foldl foldlfn acc $ fromMaybe Seq.empty $ case mparent of+    Nothing -> mommyOwl_kiddos ot+    Just lentry -> mommyOwl_kiddos (_layerEntry_superOwl lentry)++generateLayersNew :: OwlTree -> LayerMetaMap -> Seq LayerEntry+generateLayersNew ot lmm = buildLayerEntriesRecursive ot lmm Seq.empty Nothing+++layerMetaMap_isInheritHiddenOrLocked :: OwlTree -> REltId -> LayerMetaMap -> Bool+layerMetaMap_isInheritHiddenOrLocked ot rid lmm = case IM.lookup rid lmm of+  -- these may both be false, but it may inherit from a parent where these are true therefore we still need to walk up the tree if these are both false+  Just lm | _layerMeta_isLocked lm || _layerMeta_isHidden lm -> True+  _ -> case IM.lookup rid (_owlTree_mapping ot) of+    Nothing -> False+    Just (oem,_) -> layerMetaMap_isInheritHiddenOrLocked ot (_owlItemMeta_parent oem) lmm++layerMetaMap_isInheritHidden :: OwlTree -> REltId -> LayerMetaMap -> Bool+layerMetaMap_isInheritHidden ot rid lmm = case IM.lookup rid lmm of+  Just lm | _layerMeta_isHidden lm -> True+  _ -> case IM.lookup rid (_owlTree_mapping ot) of+    Nothing -> False+    Just (oem,_) -> layerMetaMap_isInheritHidden ot (_owlItemMeta_parent oem) lmm
+ src/Potato/Flow/Controller/Types.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Controller.Types (+  UnicodeWidthFn(..)+  , Tool(..)+  , tool_isCreate+  , PotatoDefaultParameters(..)+  , SetPotatoDefaultParameters(..)+  , potatoDefaultParameters_set+  , Selection+  , defaultFolderCollapseState+  , LayerMeta(..)+  , LayerMetaMap+  , layerMetaMap_isCollapsed+  , ControllerMeta(..)+  , emptyControllerMeta+  , EverythingLoadState+) where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.SElts+import           Potato.Flow.Types+import           Potato.Flow.OwlItem+import Potato.Flow.Owl++import           Data.Aeson+import           Data.Default+import qualified Data.IntMap            as IM+import qualified Text.Show+++-- someday it would be nice to support graphene clusters and RTL 😭+data UnicodeWidthFn = UnicodeWidthFn {+    unicodeWidth_wcwidth :: PChar -> Int+  }+++-- TOOL+data Tool = Tool_Select | Tool_Pan | Tool_Box | Tool_Line | Tool_Text | Tool_TextArea | Tool_CartLine deriving (Eq, Show, Enum)++tool_isCreate :: Tool -> Bool+tool_isCreate = \case+  Tool_Select -> False+  Tool_Pan -> False+  _ -> True++data PotatoDefaultParameters = PotatoDefaultParameters {+  _potatoDefaultParameters_sBoxType :: SBoxType -- currently not used as we have Tool_TextArea, consider using this instead+  , _potatoDefaultParameters_superStyle :: SuperStyle+  , _potatoDefaultParameters_lineStyle :: LineStyle+  , _potatoDefaultParameters_lineStyleEnd :: LineStyle+  , _potatoDefaultParameters_box_label_textAlign :: TextAlign+  , _potatoDefaultParameters_box_text_textAlign :: TextAlign+} deriving (Eq, Show)+++instance Default PotatoDefaultParameters where+  def = PotatoDefaultParameters {+      _potatoDefaultParameters_sBoxType = def+      , _potatoDefaultParameters_lineStyle = def+      , _potatoDefaultParameters_lineStyleEnd = def+      , _potatoDefaultParameters_superStyle = def+      , _potatoDefaultParameters_box_label_textAlign = def+      , _potatoDefaultParameters_box_text_textAlign = def+    }++data SetPotatoDefaultParameters = SetPotatoDefaultParameters {+  _setPotatoDefaultParameters_sBoxType :: Maybe SBoxType+  , _setPotatoDefaultParameters_lineStyle :: Maybe LineStyle+  , _setPotatoDefaultParameters_lineStyleEnd :: Maybe LineStyle+  , _setPotatoDefaultParameters_superStyle :: Maybe SuperStyle+  , _setPotatoDefaultParameters_box_label_textAlign :: Maybe TextAlign+  , _setPotatoDefaultParameters_box_text_textAlign :: Maybe TextAlign+} deriving (Eq, Show)++instance Default SetPotatoDefaultParameters where+  def = SetPotatoDefaultParameters {+      _setPotatoDefaultParameters_sBoxType = Nothing+      , _setPotatoDefaultParameters_lineStyle = Nothing+      , _setPotatoDefaultParameters_lineStyleEnd = Nothing+      , _setPotatoDefaultParameters_superStyle = Nothing+      , _setPotatoDefaultParameters_box_label_textAlign = Nothing+      , _setPotatoDefaultParameters_box_text_textAlign = Nothing+    }++potatoDefaultParameters_set :: PotatoDefaultParameters -> SetPotatoDefaultParameters -> PotatoDefaultParameters+potatoDefaultParameters_set PotatoDefaultParameters {..} SetPotatoDefaultParameters {..} = PotatoDefaultParameters {+    _potatoDefaultParameters_sBoxType = fromMaybe _potatoDefaultParameters_sBoxType _setPotatoDefaultParameters_sBoxType+    , _potatoDefaultParameters_lineStyle = fromMaybe _potatoDefaultParameters_lineStyle _setPotatoDefaultParameters_lineStyle+    , _potatoDefaultParameters_lineStyleEnd = fromMaybe _potatoDefaultParameters_lineStyleEnd _setPotatoDefaultParameters_lineStyleEnd+    , _potatoDefaultParameters_superStyle = fromMaybe _potatoDefaultParameters_superStyle _setPotatoDefaultParameters_superStyle+    , _potatoDefaultParameters_box_label_textAlign = fromMaybe _potatoDefaultParameters_box_label_textAlign _setPotatoDefaultParameters_box_label_textAlign+    , _potatoDefaultParameters_box_text_textAlign = fromMaybe _potatoDefaultParameters_box_text_textAlign _setPotatoDefaultParameters_box_text_textAlign++  }++type Selection = SuperOwlParliament++data LayerMeta = LayerMeta {+  -- if False, these will inherit from parent+  _layerMeta_isLocked      :: Bool+  , _layerMeta_isHidden    :: Bool+  , _layerMeta_isCollapsed :: Bool++} deriving (Eq, Generic)++instance Show LayerMeta where+  show LayerMeta {..} = "LayerMeta (l,h,c): " <> show _layerMeta_isLocked <> " " <> show _layerMeta_isHidden <> " " <> show _layerMeta_isCollapsed++instance FromJSON LayerMeta+instance ToJSON LayerMeta+instance NFData LayerMeta++-- Not sure which way I want to do it, so make it configurable for now.+defaultFolderCollapseState :: Bool+defaultFolderCollapseState = False++instance Default LayerMeta where+  def = LayerMeta {+      _layerMeta_isLocked = False+      , _layerMeta_isHidden = False+      , _layerMeta_isCollapsed = defaultFolderCollapseState+    }++type LayerMetaMap = REltIdMap LayerMeta++layerMetaMap_isCollapsed :: REltId -> LayerMetaMap -> Bool+layerMetaMap_isCollapsed rid lmm = case IM.lookup rid lmm of+  Nothing -> True+  Just lm -> _layerMeta_isCollapsed lm++{-+-- these aren't very useful because they won't tell you if it has inherited lock/hidden state+layerMetaMap_isHidden :: REltId -> LayerMetaMap -> Bool+layerMetaMap_isHidden rid lmm = case IM.lookup rid lmm of+  Nothing -> False+  Just lm -> _layerMeta_isHidden lm+layerMetaMap_isHiddenOrLocked :: REltId -> LayerMetaMap -> Bool+layerMetaMap_isHiddenOrLocked rid lmm = case IM.lookup rid lmm of+  Nothing -> False+  Just lm -> _layerMeta_isLocked lm || _layerMeta_isHidden lm+-}++data ControllerMeta = ControllerMeta {+  _controllerMeta_pan      :: XY -- do we really want this?+  , _controllerMeta_layers :: LayerMetaMap+} deriving (Show, Eq, Generic)++instance FromJSON ControllerMeta+instance ToJSON ControllerMeta++emptyControllerMeta :: ControllerMeta+emptyControllerMeta = ControllerMeta 0 IM.empty++instance Default ControllerMeta where+  def = emptyControllerMeta++type EverythingLoadState = (SPotatoFlow, ControllerMeta)
+ src/Potato/Flow/DebugHelpers.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+module Potato.Flow.DebugHelpers where++import           Relude+import Control.Monad.Writer++import qualified Data.List as L+import Control.Exception (assert)++-- prob just replace with show? Why do you ever want to not potato show?+-- the reason is becaues potatoShow doesn't show all information, but whatever it's fine+class PotatoShow a where+  potatoShow :: a -> Text++showFoldable :: (Foldable f, Show a) => f a -> Text+showFoldable = foldl' (\acc x -> acc <> show x <> "\n") ""++assertShowAndDump  :: (HasCallStack, Show a) => a -> Bool -> b -> b+assertShowAndDump a v b = if v+  then b+  else error $ "assert failed:\n" <> show a++assertPotatoShowAndDump :: (HasCallStack, PotatoShow a) => a -> Bool -> b -> b+assertPotatoShowAndDump a v b = if v+  then b+  else error $ "assert failed:\n" <> potatoShow a++traceWith :: (a -> String) -> a -> a+traceWith f x = trace (f x) x++traceShowIdWithLabel :: (Show a) => String -> a -> a+traceShowIdWithLabel label x = trace (label <> ": " <> show x) x+++-- TODO decide if we want to use this??? Too much???+data PotatoLoggerLevel = PLL_Debug | PLL_Info | PLL_Warn | PLL_Error+data PotatoLoggerComponent = PLC_None | PLC_Goat++class MonadPotatoLogger m where+  potatoLog :: PotatoLoggerLevel -> PotatoLoggerComponent -> Text -> m ()++data PotatoLoggerObject = PotatoLoggerObject PotatoLoggerLevel PotatoLoggerComponent Text++type PotatoLogger = Writer [PotatoLoggerObject]++instance MonadPotatoLogger PotatoLogger where+  potatoLog l c t = tell $ [PotatoLoggerObject l c t]+++debugBangBang :: (HasCallStack) => [a] -> Int -> a+debugBangBang l i = assert (i >=0 && i < length l) (l L.!! i)
+ src/Potato/Flow/Deprecated/Layers.hs view
@@ -0,0 +1,171 @@+-- DEPRECATED, we will switch to Owl :O++module Potato.Flow.Deprecated.Layers (+  reindexSEltLayerPosForRemoval+  , reindexSEltLayerPosForInsertion+  , hasScopingProperty+  , selectionHasScopingProperty+  , findMatchingScope+  , scopeSelection+  , insertElts+  , insertElt+  , removeElts+  , insertEltList_indexBeforeInsertion+  , insertEltList_indexAfterInsertion+  , removeEltList+  , moveEltList+  , undoMoveEltList+) where++import           Relude++import           Potato.Flow.Types++import           Control.Exception (assert)+import qualified Data.Bimap        as BM+import           Data.List.Ordered (isSorted)+import           Data.Sequence     ((><))+import qualified Data.Sequence     as Seq+import qualified Data.Set          as Set++-- copy pasta https://stackoverflow.com/questions/16108714/removing-duplicates-from-a-list-in-haskell-without-elem+sortUnique :: Ord a => [a] -> [a]+sortUnique = sort . rmdups' Set.empty where+  rmdups' _ [] = []+  rmdups' a (b : c) = if Set.member b a+    then rmdups' a c+    else b : rmdups' (Set.insert b a) c++-- | reindexes list of LayerPos such that each element is indexed as if all previous elements have been removed+-- O(n^2) lol+reindexSEltLayerPosForRemoval :: [LayerPos] -> [LayerPos]+reindexSEltLayerPosForRemoval [] = []+reindexSEltLayerPosForRemoval (r:xs) = r:reindexSEltLayerPosForRemoval rest where+  -- if this asserts that means you tried to remove the same index twice+  rest = map (\x -> assert (x /= r) $ if x > r then x-1 else x) xs++-- | inverse of reindexSEltLayerPosForRemoval+-- input indices are before any elements are inserted+-- O(n^2) lol+reindexSEltLayerPosForInsertion :: [LayerPos] -> [LayerPos]+reindexSEltLayerPosForInsertion = reverse . reindexSEltLayerPosForRemoval . reverse+++hasScopingProperty :: (a -> Maybe Bool) -> Seq a -> Bool+hasScopingProperty scopeTypeFn xs = not finalFail && finalScope == 0 where+  foldfn x (scopes, didFail) = case scopeTypeFn x of+    Nothing -> (scopes, didFail)+    Just f -> case f of+      True -> case scopes of+        0 -> (scopes, True)+        _ -> (scopes-1, didFail)+      False -> (scopes+1, didFail)+  (finalScope, finalFail) = foldr foldfn (0,False) xs++-- | assumes selection is ordered and is valid+selectionHasScopingProperty :: (a -> Maybe Bool) -> Seq a -> [Int] -> Bool+selectionHasScopingProperty scopeTypeFn xs is = hasScopingProperty scopeTypeFn subSeq where+  subSeq = Seq.fromList $ map (\i -> Seq.index xs i) is++makePairMap :: (a -> Maybe Bool) -> Seq a -> BM.Bimap Int Int+makePairMap scopeTypeFn xs = fst r where+  -- map folders from start to end index+  pairmapfoldfn i a (pairs, scopes) = case scopeTypeFn a of+    Nothing -> (pairs, scopes)+    Just True -> case scopes of+      []        -> error "mismatched scopes"+      x:scopes' -> (BM.insert i x pairs, scopes')+    Just False -> (pairs, i:scopes)+  r = Seq.foldrWithIndex pairmapfoldfn (BM.empty,[]) xs++-- assumes input sequence satisfies scoping property+-- assumes input index is actually a folder+findMatchingScope :: (a -> Maybe Bool) -> Seq a -> Int -> Int+findMatchingScope scopeTypeFn xs i = r where+  pairmap = makePairMap scopeTypeFn xs+  r = case scopeTypeFn (Seq.index xs i) of+    Nothing -> error "input index was not a folder"+    Just True -> case BM.lookup i pairmap of+      Nothing -> error "pairmap missing elements, this means scopes were mismatched"+      Just x -> x+    Just False -> case BM.lookupR i pairmap of+      Nothing -> error "pairmap missing elements, this means scopes were mismatched"+      Just x -> x++-- | converts selection so that it satisfies the scoping property by adding matching folders+-- assumes input sequence satisfies scoping property???+-- simple and inefficient implementation, do not use in prod+scopeSelection :: (a -> Maybe Bool) -> Seq a -> [Int] -> [Int]+scopeSelection scopeTypeFn xs is = r where+  pairmap = makePairMap scopeTypeFn xs+  -- go through and lookup matches+  foldfn i acc = case scopeTypeFn (Seq.index xs i) of+    Nothing -> acc+    Just True -> case BM.lookup i pairmap of+      Nothing -> error "pairmap missing elements, this means scopes were mismatched"+      Just x -> x:acc+    Just False -> case BM.lookupR i pairmap of+      Nothing -> error "pairmap missing elements, this means scopes were mismatched"+      Just x -> x:acc+  newElts = foldr foldfn [] is+  r = sortUnique (newElts <> is)+++-- | inserts ys at index i into xs+insertElts :: Int -> Seq a -> Seq a -> Seq a+insertElts i ys xs = newSeq where+  (l, r) = Seq.splitAt i xs+  newSeq = l >< ys >< r++-- | inserts y at index y into xs+insertElt :: Int -> a -> Seq a -> Seq a+insertElt i y xs = insertElts i (Seq.singleton y) xs++-- | removes n elts at index i from xs+removeElts :: Int -> Int -> Seq a -> Seq a+removeElts n i xs = newSeq where+  (keepl  , rs) = Seq.splitAt i xs+  (_, keepr) = Seq.splitAt n rs+  newSeq           = keepl >< keepr++-- | removes elt at index i from xs+removeElt :: Int -> Seq a -> Seq a+removeElt i xs = Seq.deleteAt i xs++-- | inserts ys into xs, positions are before insertion+insertEltList_indexBeforeInsertion :: [(Int, a)] -> Seq a -> Seq a+insertEltList_indexBeforeInsertion ys xs = assert (isSorted is') $ newSeq where+  is' = map fst ys+  elts = map snd ys+  is = reindexSEltLayerPosForInsertion is'+  newSeq = foldr (uncurry insertElt) xs (zip is elts)++-- | inserts ys into xs, positions are after insertion+insertEltList_indexAfterInsertion :: [(Int, a)] -> Seq a -> Seq a+insertEltList_indexAfterInsertion ys xs = assert (isSorted is) $ newSeq where+  is = map fst ys+  newSeq = foldl' (flip (uncurry insertElt)) xs ys++-- | removes is' from xs, positions are before removal+removeEltList :: [Int] -> Seq a -> Seq a+removeEltList is' xs = assert (isSorted is) $ newSeq where+  is = reindexSEltLayerPosForRemoval is'+  newSeq = foldl' (flip removeElt) xs is++-- | moves all elts, new position is before removal, ys must be sorted+moveEltList :: [Int] -> Int -> Seq a -> Seq a+moveEltList is i xs = assert (isSorted is) $ newSeq where+  nBefore = length . filter (< i) $ is+  ys = map (Seq.index xs) is+  newSeq' = removeEltList is xs+  newSeq = insertElts (i-nBefore) (Seq.fromList ys) newSeq'++-- inverse of `moveEltList`+undoMoveEltList :: [Int] -> Int -> Seq a -> Seq a+undoMoveEltList is i xs = assert (isSorted is) $ newSeq where+  nMoved = length is+  moveToIndex = i - (length (takeWhile (\x -> x < i) is))+  (leftL,rightL') = Seq.splitAt moveToIndex xs+  (toMove,rightL) = Seq.splitAt nMoved rightL'+  newSeq' = leftL >< rightL+  newSeq = insertEltList_indexAfterInsertion (zip is (toList toMove)) newSeq'
+ src/Potato/Flow/Deprecated/State.hs view
@@ -0,0 +1,233 @@+-- DEPRECATED+-- keeping around because we use the types for testing++{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Deprecated.State (+  PFState(..)+  , debugPrintPFState+  , pFState_isValid+  , pFState_selectionIsValid+  , pFState_copyElts+  , pFState_getSuperSEltByPos+  , pFState_getSEltLabels+  , pFState_maxID+  , pFState_getLayerPosMap+  , sPotatoFlow_to_pFState+  , pFState_to_sPotatoFlow+  , pFState_toCanvasCoordinates+  , pfState_layerPos_to_superSEltLabel+  , pFState_to_superSEltLabelSeq++  , emptyPFState+  , do_newElts+  , undo_newElts+  , do_deleteElts+  , undo_deleteElts++  -- TODO test+  , do_move+  , undo_move++  , do_resizeCanvas+  , undo_resizeCanvas+  , do_manipulate+  , undo_manipulate+) where++import           Relude+++import           Potato.Flow.Deprecated.Layers+import           Potato.Flow.Math+import           Potato.Flow.SEltMethods+import           Potato.Flow.SElts+import           Potato.Flow.Types++import           Control.Exception       (assert)+import           Data.Aeson+import qualified Data.IntMap.Strict      as IM+import           Data.List.Ordered       (isSorted)+import           Data.Maybe+import qualified Data.Sequence           as Seq+++data PFState = PFState {+  -- TODO someday change this to bimap so that we can get rid of _pfo_layerPosMap+  _pFState_layers      :: Seq REltId+  , _pFState_directory :: REltIdMap SEltLabel+  , _pFState_canvas    :: SCanvas+} deriving (Eq, Show, Generic)++instance FromJSON PFState+instance ToJSON PFState+instance NFData PFState++debugPrintPFState :: (IsString a) => PFState -> a+debugPrintPFState PFState {..} = fromString $ "PFState:\n" <> show _pFState_layers <> "\n" <> show (IM.keys _pFState_directory) <> "\n"++pFState_isValid :: PFState -> Bool+pFState_isValid pfs@PFState {..} = pFState_selectionIsValid pfs ([0..Seq.length _pFState_layers - 1])+{-validElts && validScope where+  validElts = all isJust . toList $ fmap ((IM.!?) _pFState_directory) _pFState_layers+  validScope = hasScopingProperty scopeFn _pFState_layers+  scopeFn x = case IM.lookup x _pFState_directory of+    Nothing                            -> Nothing -- this will fail in vaildElts case so it doesn't matter what we do here+    Just (SEltLabel _ SEltFolderStart) -> Just True+    Just (SEltLabel _ SEltFolderEnd)   -> Just False+    _                                  -> Nothing+-}++pFState_selectionIsValid :: PFState -> [LayerPos] -> Bool+pFState_selectionIsValid PFState {..} lps = validElts && validScope && sorted where+  validElts = all isJust . toList $ fmap ((IM.!?) _pFState_directory) _pFState_layers+  validScope = selectionHasScopingProperty scopeFn _pFState_layers lps+  sorted = isSorted lps+  scopeFn x = case IM.lookup x _pFState_directory of+    Nothing                            -> Nothing -- this will fail in vaildElts case so it doesn't matter what we do here+    Just (SEltLabel _ SEltFolderStart) -> Just True+    Just (SEltLabel _ SEltFolderEnd)   -> Just False+    _                                  -> Nothing++-- TODO SOMETHING BROKEN HERE+-- lps must be valid+pFState_copyElts :: PFState -> [LayerPos] -> [SEltLabel]+pFState_copyElts PFState {..} lps = r where+  ridfn lp = Seq.index _pFState_layers lp+  seltlfn rid = fromJust $ IM.lookup rid _pFState_directory+  r = map (seltlfn . ridfn) lps++pFState_getSuperSEltByPos :: PFState -> LayerPos -> Maybe SuperSEltLabel+pFState_getSuperSEltByPos PFState {..} lp = do+  rid <- Seq.lookup lp _pFState_layers+  seltl <- IM.lookup rid _pFState_directory+  return (rid, lp, seltl)++pFState_getSEltLabels :: PFState -> [REltId] -> REltIdMap (Maybe SEltLabel)+pFState_getSEltLabels PFState {..} rids = foldr (\rid acc -> IM.insert rid (IM.lookup rid _pFState_directory) acc) IM.empty rids++pFState_maxID :: PFState -> REltId+pFState_maxID s = maybe 0 fst (IM.lookupMax (_pFState_directory s))++pFState_getLayerPosMap :: PFState -> LayerPosMap+pFState_getLayerPosMap pfs = Seq.foldrWithIndex (\lp rid acc -> IM.insert rid lp acc) IM.empty (_pFState_layers pfs)++emptyPFState :: PFState+emptyPFState = PFState Seq.empty IM.empty (SCanvas (LBox 0 0))++sPotatoFlow_to_pFState :: SPotatoFlow -> PFState+sPotatoFlow_to_pFState SPotatoFlow {..} = r where+  elts = _sPotatoFlow_sEltTree+  dir = foldr (\(rid, e) acc -> IM.insert rid e acc) IM.empty elts+  layers = Seq.fromList (map fst elts)+  r = PFState layers dir _sPotatoFlow_sCanvas++pFState_to_sPotatoFlow :: PFState -> SPotatoFlow+pFState_to_sPotatoFlow PFState {..} = r where+  selttree = toList . fmap (\rid -> (rid, _pFState_directory IM.! rid)) $ _pFState_layers+  r = SPotatoFlow _pFState_canvas selttree++pFState_toCanvasCoordinates :: PFState -> XY -> XY+pFState_toCanvasCoordinates PFState {..} (V2 x y) = V2 (x-sx) (y-sy) where+  LBox (V2 sx sy) _ = _sCanvas_box _pFState_canvas++-- expects LayerPos to be valid in PFState+pfState_layerPos_to_superSEltLabel :: PFState -> LayerPos -> SuperSEltLabel+pfState_layerPos_to_superSEltLabel PFState {..} lp = (rid, lp, seltl) where+  rid = Seq.index _pFState_layers lp+  seltl = (IM.!) _pFState_directory rid++-- i.e. select all+pFState_to_superSEltLabelSeq :: PFState -> Seq SuperSEltLabel+pFState_to_superSEltLabelSeq PFState {..} = Seq.mapWithIndex (\lp rid -> (rid, lp, fromJust $ IM.lookup rid _pFState_directory)) $ _pFState_layers++-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)+do_newElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)+do_newElts seltls PFState {..} = (r, fmap Just changes) where+  poss = map (\(x,y,_) -> (y,x)) seltls+  els = map (\(x,_,z) -> (x,z)) seltls+  changes = IM.fromList els+  newLayers = insertEltList_indexAfterInsertion poss _pFState_layers+  newDir = changes `IM.union` _pFState_directory+  r = PFState newLayers newDir _pFState_canvas++-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)+undo_newElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)+undo_newElts seltls PFState {..} = (r, changes) where+  poss = map (\(_,y,_) -> y) seltls+  els = map (\(x,_,z) -> (x,z)) seltls+  newLayers = removeEltList poss _pFState_layers+  newDir = _pFState_directory `IM.difference` IM.fromList els+  r = PFState newLayers newDir _pFState_canvas+  changes = IM.fromList $ map (\(x,y)->(x,Nothing)) els++-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)+do_deleteElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)+do_deleteElts = undo_newElts++-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)+undo_deleteElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)+undo_deleteElts = do_newElts++--+-- CHANGE+-- | (list of parents (assert no repeats), target (placed after or as first child if top owl (no parent)))+--do_move :: ([REltId], Maybe REltId) -> PFState  -> (PFState, SEltLabelChanges)+-- TODO assert selection has all children+do_move :: ([LayerPos], LayerPos) -> PFState -> (PFState, SEltLabelChanges)+do_move (lps, dst) pfs@PFState {..} = assert (pFState_selectionIsValid pfs lps) (r, changes) where+  -- TODO something like this+  --lps' = addChildren lps pfs+  r = PFState (moveEltList lps dst _pFState_layers) _pFState_directory _pFState_canvas+  changes = pFState_getSEltLabels pfs (fmap (Seq.index _pFState_layers) lps)+{--+  rids = foldr (\l acc -> Seq.index _pFState_layers l : acc) [] lps+  newLayers' = assert (isSorted lps) $ foldr (\l acc -> Seq.deleteAt l acc) _pFState_layers lps+  moveToIndex = dst - (length (takeWhile (\x -> x < dst) lps))+  (leftL, rightL) = Seq.splitAt moveToIndex newLayers'+  newLayers = leftL >< fromList rids >< rightL+  r = PFState newLayers _pFState_directory _pFState_canvas+--}++undo_move :: ([LayerPos], LayerPos) -> PFState -> (PFState, SEltLabelChanges)+undo_move (lps, dst) pfs@PFState {..} =  (r, changes) where+  -- TODO something like this+  --lps' = addChildren lps pfs+  r = PFState (undoMoveEltList lps dst _pFState_layers) _pFState_directory _pFState_canvas+  changes = pFState_getSEltLabels pfs (fmap (Seq.index _pFState_layers) lps)+{--+  --assert (isSorted lps)+  nMoved = length lps+  moveToIndex = dst - (length (takeWhile (\x -> x < dst) lps))+  (leftL,rightL') = Seq.splitAt moveToIndex _pFState_layers+  (toMove,rightL) = Seq.splitAt nMoved rightL'+  newLayers' = leftL >< rightL+  newLayers = insertEltList (zip lps (toList toMove)) newLayers'+  r = PFState newLayers _pFState_directory _pFState_canvas+--}++-- | check if the SCanvas is valid or not+-- for now, canvas offset must always be 0, I forget why it's even an option to offset the SCanvas, probably potatoes.+isValidCanvas :: SCanvas -> Bool+isValidCanvas (SCanvas (LBox p (V2 w h))) = p == 0 && w > 0 && h > 0++do_resizeCanvas :: DeltaLBox -> PFState -> PFState+do_resizeCanvas d pfs = assert (isValidCanvas newCanvas) $ pfs { _pFState_canvas = newCanvas } where+  newCanvas = SCanvas $ plusDelta (_sCanvas_box (_pFState_canvas pfs)) d++undo_resizeCanvas :: DeltaLBox -> PFState -> PFState+undo_resizeCanvas d pfs = assert (isValidCanvas newCanvas) $ pfs { _pFState_canvas = newCanvas } where+  newCanvas = SCanvas $ minusDelta (_sCanvas_box (_pFState_canvas pfs)) d++manipulate :: Bool -> ControllersWithId -> PFState -> (PFState, SEltLabelChanges)+manipulate isDo cs pfs = (r, fmap Just changes) where+  dir = _pFState_directory pfs+  changes = IM.intersectionWith (updateFnFromController isDo) cs dir+  newDir = IM.union changes dir+  r = pfs { _pFState_directory = newDir }++do_manipulate :: ControllersWithId -> PFState -> (PFState, SEltLabelChanges)+do_manipulate = manipulate True++undo_manipulate :: ControllersWithId -> PFState -> (PFState, SEltLabelChanges)+undo_manipulate = manipulate False
+ src/Potato/Flow/Deprecated/TestStates.hs view
@@ -0,0 +1,335 @@+-- DEPRECATED+-- keeping around because we use the types for testing++{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module Potato.Flow.Deprecated.TestStates (+  folderStart+  , folderEnd+  , someSEltLabel+  , someSCanvas+  , defaultCanvasLBox+  , pFState_fromSElts+  , pfstate_someValidState1+  , pfstate_someInvalidState1+  , pfstate_someInvalidState2+  , pfstate_basic0+  , pfstate_basic1+  , pfstate_basic2+  , pfstate_attachments1+  , pfstate_attachments2+  , pfstate_zero+) where++import           Relude++import           Data.Default+import qualified Data.IntMap   as IM+import qualified Data.Sequence as Seq+import           Potato.Flow+import           Potato.Flow.Deprecated.State+--import           Potato.Flow.OwlItem+import Potato.Flow.OwlState+--import           Potato.Flow.OwlItem+import Potato.Flow.Owl++folderStart :: SEltLabel+folderStart = SEltLabel "folder" SEltFolderStart++folderEnd :: SEltLabel+folderEnd = SEltLabel "folder (end)" SEltFolderEnd++someSEltLabel :: SEltLabel+someSEltLabel = SEltLabel "some elt" SEltNone++defaultCanvasLBox :: LBox+defaultCanvasLBox = LBox (V2 0 0) (V2 50 25)++someSCanvas :: SCanvas+someSCanvas = SCanvas  defaultCanvasLBox++pFState_fromSElts :: [SElt] -> LBox -> PFState+pFState_fromSElts selts lbox = PFState {+    _pFState_layers = Seq.fromList [1..length selts]+    , _pFState_directory = IM.fromList $ fmap (\(i,selt) -> (i, SEltLabel (show i) selt)) $ zip [1..] selts+    , _pFState_canvas = SCanvas lbox+  }++pfstate_someValidState1 :: PFState+pfstate_someValidState1 = PFState {+      _pFState_layers = Seq.fromList [0..5]+      , _pFState_directory = IM.fromList [(0, folderStart), (1, folderEnd), (2, someSEltLabel), (3, someSEltLabel), (4, someSEltLabel), (5, someSEltLabel)]+      , _pFState_canvas = SCanvas defaultCanvasLBox+  }++pfstate_someInvalidState1 :: PFState+pfstate_someInvalidState1 = PFState {+      _pFState_layers = Seq.fromList [0..5]+      -- missing REltId 5+      , _pFState_directory = IM.fromList [(0, folderStart), (1, folderEnd), (2, someSEltLabel), (3, someSEltLabel), (4, someSEltLabel)]+      , _pFState_canvas = SCanvas defaultCanvasLBox+  }++pfstate_someInvalidState2 :: PFState+pfstate_someInvalidState2 = PFState {+      -- folder mismatch+      _pFState_layers = Seq.fromList [0..5]+      , _pFState_directory = IM.fromList [(0, folderStart), (1, folderStart), (2, someSEltLabel), (3, someSEltLabel), (4, someSEltLabel)]+      , _pFState_canvas = SCanvas defaultCanvasLBox+  }++pfstate_basic0 :: PFState+pfstate_basic0 = PFState {+    _pFState_layers = Seq.fromList [0..2]+    , _pFState_directory = IM.fromList [+        (0, SEltLabel "box" (SEltBox def {+            _sBox_box = LBox (V2 1 1) (V2 5 5)+          }))+        , (1, SEltLabel "line" (SEltLine def {+            _sAutoLine_start = V2 7 2+            , _sAutoLine_end = V2 20 18+          }))+        , (2, SEltLabel "text" (SEltBox def {+            _sBox_box = LBox (V2 0 10) (V2 15 5)+            , _sBox_boxType = SBoxType_NoBoxText+          }))+      ]+    , _pFState_canvas = SCanvas defaultCanvasLBox+  }++pfstate_basic1 :: PFState+pfstate_basic1 = PFState {+    _pFState_layers = Seq.fromList [0..5]+    , _pFState_directory = IM.fromList [+        -- 4 boxes in a grid+        (0, SEltLabel "b1" (SEltBox def {+            _sBox_box = LBox (V2 0 0) (V2 5 5)+          }))+        , (1, SEltLabel "b2" (SEltBox def {+            _sBox_box = LBox (V2 10 10) (V2 5 5)+          }))+        , (2, SEltLabel "b3" (SEltBox def {+            _sBox_box = LBox (V2 0 10) (V2 5 5)+          }))+        , (3, SEltLabel "b4" (SEltBox def {+            _sBox_box = LBox (V2 10 0) (V2 5 5)+          }))++        -- 2 lines sharing a start point at (0,100)+        , (4, SEltLabel "sl1" (SEltLine def {+            _sAutoLine_start = V2 0 100+            , _sAutoLine_end = V2 0 110+          }))+        , (5, SEltLabel "sl2" (SEltLine def {+            _sAutoLine_start = V2 0 100+            , _sAutoLine_end = V2 10 100+          }))++      ]+    , _pFState_canvas = SCanvas defaultCanvasLBox+  }++-- | same as pfstate_basic1 except with folders+pfstate_basic2 :: PFState+pfstate_basic2 = PFState {+    _pFState_layers = Seq.fromList [0..11]+    , _pFState_directory = IM.fromList [+        (0, SEltLabel "fstart1" SEltFolderStart)+          , (1, SEltLabel "fstart2" SEltFolderStart)+            -- 4 boxes in a grid+            , (2, SEltLabel "b1" (SEltBox def {+                _sBox_box = LBox (V2 0 0) (V2 5 5)+              }))+            , (3, SEltLabel "b2" (SEltBox def {+                _sBox_box = LBox (V2 10 10) (V2 5 5)+              }))+            , (4, SEltLabel "b3" (SEltBox def {+                _sBox_box = LBox (V2 0 10) (V2 5 5)+              }))+            , (5, SEltLabel "b4" (SEltBox def {+                _sBox_box = LBox (V2 10 0) (V2 5 5)+              }))+            , (6, SEltLabel "fend2" SEltFolderEnd)+        , (7, SEltLabel "fstart3" SEltFolderStart)+          -- 2 lines sharing a start point at (0,100)+          , (8, SEltLabel "sl1" (SEltLine def {+              _sAutoLine_start = V2 0 100+              , _sAutoLine_end = V2 0 110+            }))+          , (9, SEltLabel "sl2" (SEltLine def {+              _sAutoLine_start = V2 0 100+              , _sAutoLine_end = V2 10 100+            }))+          , (10, SEltLabel "fend3" SEltFolderEnd)+        , (11, SEltLabel "fend1" SEltFolderEnd)+      ]+    , _pFState_canvas = SCanvas defaultCanvasLBox+  }++pfstate_attachments1 :: PFState+pfstate_attachments1 = PFState {+    _pFState_layers = Seq.fromList [0..5]+    , _pFState_directory = IM.fromList [+      -- 4 boxes in a grid+      (0, SEltLabel "b1" (SEltBox def {+          _sBox_box = LBox (V2 0 0) (V2 5 5)+        }))+      , (1, SEltLabel "b2" (SEltBox def {+          _sBox_box = LBox (V2 10 10) (V2 5 5)+        }))+      , (2, SEltLabel "b3" (SEltBox def {+          _sBox_box = LBox (V2 0 10) (V2 5 5)+        }))+      , (3, SEltLabel "b4" (SEltBox def {+          _sBox_box = LBox (V2 10 0) (V2 5 5)+        }))++      -- 2 lines sharing a start point at (0,100)+      , (4, SEltLabel "b1-> <-b3" (SEltLine def {+          _sAutoLine_start = V2 0 100+          , _sAutoLine_end = V2 0 110+          , _sAutoLine_attachStart = Just (Attachment {+              _attachment_target = 0+              , _attachment_location = AL_Right+            })+          , _sAutoLine_attachEnd = Just (Attachment {+              _attachment_target = 2+              , _attachment_location = AL_Left+            })+        }))+      , (5, SEltLabel "b2v ^b4" (SEltLine def {+          _sAutoLine_start = V2 0 100+          , _sAutoLine_end = V2 0 110+          , _sAutoLine_attachStart = Just (Attachment {+              _attachment_target = 2+              , _attachment_location = AL_Bot+            })++          , _sAutoLine_attachEnd = Just (Attachment {+              _attachment_target = 3+              , _attachment_location = AL_Top+            })+        }))+      ]+    , _pFState_canvas = SCanvas defaultCanvasLBox+  }++-- TODO DELETE ME+pfstate_attachments2 :: PFState+pfstate_attachments2 = PFState {+    _pFState_layers = Seq.fromList [0..9]+    , _pFState_directory = IM.fromList [+      -- 4 boxes in a grid+      (0, SEltLabel "b1" (SEltBox def {+          _sBox_box = LBox (V2 0 0) (V2 5 5)+        }))+      , (1, SEltLabel "b2" (SEltBox def {+          _sBox_box = LBox (V2 10 0) (V2 5 5)+        }))+      , (2, SEltLabel "b3" (SEltBox def {+          _sBox_box = LBox (V2 0 10) (V2 5 5)+        }))+      , (3, SEltLabel "b4" (SEltBox def {+          _sBox_box = LBox (V2 10 10) (V2 5 5)+        }))++++      -- 2 lines sharing a start point at (0,100)+      , (4, SEltLabel "b1-> <-b4" (SEltLine def {+          _sAutoLine_start = V2 0 100+          , _sAutoLine_end = V2 0 110+          , _sAutoLine_attachStart = Just (Attachment {+              _attachment_target = 0+              , _attachment_location = AL_Right+            })+          , _sAutoLine_attachEnd = Just (Attachment {+              _attachment_target = 3+              , _attachment_location = AL_Left+            })+        }))+      , (5, SEltLabel "<-b1 b2->" (SEltLine def {+          _sAutoLine_start = V2 0 100+          , _sAutoLine_end = V2 0 110+          , _sAutoLine_attachStart = Just (Attachment {+              _attachment_target = 0+              , _attachment_location = AL_Left+            })++          , _sAutoLine_attachEnd = Just (Attachment {+              _attachment_target = 1+              , _attachment_location = AL_Right+            })+        }))+      , (6, SEltLabel "<-b1 b4->" (SEltLine def {+          _sAutoLine_start = V2 0 100+          , _sAutoLine_end = V2 0 110+          , _sAutoLine_attachStart = Just (Attachment {+              _attachment_target = 0+              , _attachment_location = AL_Left+            })++          , _sAutoLine_attachEnd = Just (Attachment {+              _attachment_target = 3+              , _attachment_location = AL_Right+            })+        }))+      , (7, SEltLabel "b1-> b4->" (SEltLine def {+          _sAutoLine_start = V2 0 100+          , _sAutoLine_end = V2 0 110+          , _sAutoLine_attachStart = Just (Attachment {+              _attachment_target = 0+              , _attachment_location = AL_Right+            })++          , _sAutoLine_attachEnd = Just (Attachment {+              _attachment_target = 3+              , _attachment_location = AL_Right+            })+        }))+        , (8, SEltLabel "b1-> b2->" (SEltLine def {+            _sAutoLine_start = V2 0 100+            , _sAutoLine_end = V2 0 110+            , _sAutoLine_attachStart = Just (Attachment {+                _attachment_target = 0+                , _attachment_location = AL_Right+              })++            , _sAutoLine_attachEnd = Just (Attachment {+                _attachment_target = 1+                , _attachment_location = AL_Right+              })+          }))+      , (9, SEltLabel "b1v ^b3" (SEltLine def {+          _sAutoLine_start = V2 0 100+          , _sAutoLine_end = V2 0 110+          , _sAutoLine_attachStart = Just (Attachment {+              _attachment_target = 0+              , _attachment_location = AL_Bot+            })++          , _sAutoLine_attachEnd = Just (Attachment {+              _attachment_target = 2+              , _attachment_location = AL_Top+            })+        }))+      ]+    , _pFState_canvas = SCanvas defaultCanvasLBox+  }+++-- contains SElts of size 0+pfstate_zero :: PFState+pfstate_zero = PFState {+    _pFState_layers = Seq.fromList [0..1]+    , _pFState_directory = IM.fromList [+        (0, SEltLabel "b1" (SEltBox def {+            _sBox_box = LBox (V2 0 0) (V2 0 0)+          }))+        , (1, SEltLabel "sl1" (SEltLine def {+            _sAutoLine_start = V2 10 10+            , _sAutoLine_end = V2 10 10+          }))+      ]+    , _pFState_canvas = SCanvas defaultCanvasLBox+  }
+ src/Potato/Flow/Deprecated/Workspace.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Deprecated.Workspace (+  PFWorkspace(..)+  , emptyWorkspace+  , emptyActionStack+  , loadPFStateIntoWorkspace+  , undoWorkspace+  , redoWorkspace+  , undoPermanentWorkspace+  , doCmdWorkspace+  , pfc_addElt_to_newElts+  , pfc_addFolder_to_newElts+  , pfc_removeElt_to_deleteElts+  , pfc_paste_to_newElts+  , WSEvent(..)+  , updatePFWorkspace+) where++import           Relude++import           Potato.Flow.Cmd+import           Potato.Flow.Deprecated.Layers+import           Potato.Flow.Math+import           Potato.Flow.SElts+import           Potato.Flow.Deprecated.State+import           Potato.Flow.Types++import           Control.Exception  (assert)+import           Data.Dependent.Sum (DSum ((:=>)), (==>))+import qualified Data.IntMap.Strict as IM+import qualified Data.Sequence      as Seq++-- TODO move this into a diff file+data ActionStack = ActionStack {+  doStack     :: [PFCmd] -- maybe just do something lke [PFCmd, Maybe PFState] here for state based undo+  , undoStack :: [PFCmd]+} deriving (Show, Eq, Generic)++instance NFData ActionStack++emptyActionStack :: ActionStack+emptyActionStack = ActionStack [] []++data PFWorkspace = PFWorkspace {+  _pFWorkspace_pFState       :: PFState+  , _pFWorkspace_lastChanges :: SEltLabelChanges+  , _pFWorkspace_actionStack :: ActionStack+} deriving (Show, Eq, Generic)++instance NFData PFWorkspace++loadPFStateIntoWorkspace :: PFState -> PFWorkspace -> PFWorkspace+loadPFStateIntoWorkspace pfs ws = r where+  removeOld = fmap (const Nothing) (_pFState_directory . _pFWorkspace_pFState $ ws)+  addNew = fmap Just (_pFState_directory pfs)+  changes = IM.union addNew removeOld+  r = PFWorkspace pfs changes emptyActionStack++emptyWorkspace :: PFWorkspace+emptyWorkspace = PFWorkspace emptyPFState IM.empty emptyActionStack++undoWorkspace :: PFWorkspace -> PFWorkspace+undoWorkspace pfw =  r where+  ActionStack {..} = _pFWorkspace_actionStack pfw+  r = case doStack of+    c : cs -> uncurry PFWorkspace (undoCmdState c (_pFWorkspace_pFState pfw)) (ActionStack cs (c:undoStack))+    _ -> pfw++redoWorkspace :: PFWorkspace -> PFWorkspace+redoWorkspace pfw = r where+  ActionStack {..} = _pFWorkspace_actionStack pfw+  r = case undoStack of+    c : cs -> uncurry PFWorkspace (doCmdState c (_pFWorkspace_pFState pfw)) (ActionStack (c:doStack) cs)+    _ -> pfw++undoPermanentWorkspace :: PFWorkspace -> PFWorkspace+undoPermanentWorkspace pfw =  r where+  ActionStack {..} = _pFWorkspace_actionStack pfw+  r = case doStack of+    c : cs -> uncurry PFWorkspace (undoCmdState c (_pFWorkspace_pFState pfw)) (ActionStack cs undoStack)+    _ -> pfw++doCmdWorkspace :: PFCmd -> PFWorkspace -> PFWorkspace+-- deepseq here to force evaluation of workspace and prevent leaks+doCmdWorkspace cmd pfw = force r where+  newState = doCmdState cmd (_pFWorkspace_pFState pfw)+  ActionStack {..} = (_pFWorkspace_actionStack pfw)+  newStack = ActionStack (cmd:doStack) []+  --newMaxId = pFState_maxID _pFWorkspace_pFState+  r = uncurry PFWorkspace newState newStack++doCmdState :: PFCmd -> PFState -> (PFState, SEltLabelChanges)+doCmdState cmd s = assert (pFState_isValid newState) (newState, changes) where+  (newState, changes) = case cmd of+    (PFCNewElts :=> Identity x)      ->  do_newElts x s+    (PFCDeleteElts :=> Identity x)   ->  do_deleteElts x s+    (PFCManipulate :=> Identity x)   ->  do_manipulate x s+    (PFCMove :=> Identity x)         -> do_move x s+    (PFCResizeCanvas :=> Identity x) -> (do_resizeCanvas x s, IM.empty)++undoCmdState :: PFCmd -> PFState -> (PFState, SEltLabelChanges)+undoCmdState cmd s = assert (pFState_isValid newState) (newState, changes) where+  (newState, changes) =  case cmd of+    (PFCNewElts :=> Identity x)      ->  undo_newElts x s+    (PFCDeleteElts :=> Identity x)   ->  undo_deleteElts x s+    (PFCManipulate :=> Identity x)   ->  undo_manipulate x s+    (PFCMove :=> Identity x)         -> undo_move x s+    (PFCResizeCanvas :=> Identity x) -> (undo_resizeCanvas x s, IM.empty)++------ helpers for converting events to cmds+-- TODO move these to a different file prob+pfc_addElt_to_newElts :: PFState -> (LayerPos, SEltLabel) -> PFCmd+pfc_addElt_to_newElts pfs (lp,seltl) = r where+  rid = pFState_maxID pfs + 1+  r = PFCNewElts ==> [(rid,lp,seltl)]++pfc_addFolder_to_newElts :: PFState -> (LayerPos, Text) -> PFCmd+pfc_addFolder_to_newElts pfs (lp, name) = r where+  ridStart = pFState_maxID pfs + 1+  ridEnd = ridStart + 1+  seltlStart = SEltLabel name SEltFolderStart+  seltlEnd = SEltLabel (name <> " (end)") SEltFolderEnd+  r = PFCNewElts ==> [(ridStart, lp, seltlStart), (ridEnd, lp+1, seltlEnd)]++debugPrintLayerPoss :: (IsString a) => PFState -> [LayerPos] -> a+debugPrintLayerPoss PFState {..} lps = fromString msg where+  rids = map (Seq.index _pFState_layers) lps+  seltls = map ((IM.!) _pFState_directory) rids+  msg = show $ (zip3 rids lps (map _sEltLabel_sElt seltls))++-- TODO consider including folder end to selecetion if not included+-- or at least assert to ensure it's correct+pfc_removeElt_to_deleteElts :: PFState -> [LayerPos] -> PFCmd+--pfc_removeElt_to_deleteElts pfs@PFState {..} lps = if length lps > 1 then trace (debugPrintLayerPoss pfs lps) r else r where+pfc_removeElt_to_deleteElts PFState {..} lps = r where+  rids = map (Seq.index _pFState_layers) lps+  seltls = map ((IM.!) _pFState_directory) rids+  r = PFCDeleteElts ==> (zip3 rids lps seltls)++-- TODO DELETE+pfc_paste_to_newElts :: PFState -> ([SEltLabel], LayerPos) -> PFCmd+pfc_paste_to_newElts pfs (seltls, lp) = r where+  rid = pFState_maxID pfs + 1+  r = PFCNewElts ==> zip3 [rid..] [lp..] seltls++pfc_addRelative_to_newElts :: PFState -> (LayerPos, SEltTree) -> PFCmd+pfc_addRelative_to_newElts pfs (lp, stree) = assert validScope $ r where+  validScope = selectionHasScopingProperty scopeFn (Seq.fromList stree) [0..length stree - 1]+  scopeFn (_,seltl) = case seltl of+    (SEltLabel _ SEltFolderStart) -> Just True+    (SEltLabel _ SEltFolderEnd)   -> Just False+    _                             -> Nothing+  -- TODO reposition/offset (could just offset by 1? or maybe need to add new arg)+  -- TODO reindex SEltTree maintaing connections+  rid = pFState_maxID pfs + 1+  r = PFCNewElts ==> zip3 [rid..] [lp..] (fmap snd stree)++--pfc_duplicate_to_duplicate :: PFState -> [LayerPos] -> PFCmd+--pfc_duplicate_to_duplicate pfs lps = r where+--  rids = map (Seq.index _pFState_layers) lps+--  r = PFCFDuplicate ==> rids++------ update functions via commands+data WSEvent =+  -- CHANGE TODO FIGURE IT OUT+  --WSEAddElt (Bool, OwlSpot, OwlItem)+  -- | WSEAddRelative (OwlSpot, Seq OwlItem)+  -- | WSEAddFolder (OwlSpot, Text)+  -- | WSERemoveElt [REltId] -- removed kiddos get adopted by grandparents or w/e?+  -- | WSEMoveElt (OwlSpot, [REltId]) -- also moves kiddos?+  -- | WSEDuplicate [REltId] -- kiddos get duplicated??+++  WSEAddElt (Bool, (LayerPos, SEltLabel))+  | WSEAddRelative (LayerPos, SEltTree)+  | WSEAddFolder (LayerPos, Text)+  | WSERemoveElt [LayerPos]+  | WSEMoveElt ([LayerPos], LayerPos)+  -- | WSEDuplicate [LayerPos]+  | WSEManipulate (Bool, ControllersWithId)+  | WSEResizeCanvas DeltaLBox+  | WSEUndo+  | WSERedo+  | WSELoad SPotatoFlow+  deriving (Show, Eq)++debugPrintBeforeAfterState :: (IsString a) => PFState -> PFState -> a+debugPrintBeforeAfterState stateBefore stateAfter = fromString $ "BEFORE: " <> debugPrintPFState stateBefore <> "\nAFTER: " <> debugPrintPFState stateAfter++doCmdPFWorkspaceUndoPermanentFirst :: (PFState -> PFCmd) -> PFWorkspace -> PFWorkspace+doCmdPFWorkspaceUndoPermanentFirst cmdFn ws = r where+  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways+  undoedws = undoPermanentWorkspace ws+  undoedpfs = _pFWorkspace_pFState undoedws+  cmd = cmdFn undoedpfs+  r = doCmdWorkspace cmd undoedws++updatePFWorkspace :: WSEvent -> PFWorkspace -> PFWorkspace+updatePFWorkspace evt ws = let+  lastState = _pFWorkspace_pFState ws+  r = case evt of+    WSEAddElt (undo, x) -> if undo+      then doCmdPFWorkspaceUndoPermanentFirst (\pfs -> pfc_addElt_to_newElts pfs x) ws+      else doCmdWorkspace (pfc_addElt_to_newElts lastState x) ws+    WSEAddRelative x -> doCmdWorkspace (pfc_addRelative_to_newElts lastState x) ws+    WSEAddFolder x -> doCmdWorkspace (pfc_addFolder_to_newElts lastState x) ws+    WSERemoveElt x -> doCmdWorkspace (pfc_removeElt_to_deleteElts lastState x) ws+    WSEManipulate (undo, x) -> if undo+      then doCmdPFWorkspaceUndoPermanentFirst (const (PFCManipulate ==> x)) ws+      else doCmdWorkspace (PFCManipulate ==> x) ws+    -- TODO add children to selection before moving+    WSEMoveElt x -> doCmdWorkspace (PFCMove ==> x) ws+    WSEResizeCanvas x -> doCmdWorkspace (PFCResizeCanvas ==> x) ws+    WSEUndo -> undoWorkspace ws+    WSERedo -> redoWorkspace ws+    WSELoad x -> loadPFStateIntoWorkspace (sPotatoFlow_to_pFState x) ws+  afterState = _pFWorkspace_pFState r+  isValidAfter = pFState_isValid afterState+  in+    if isValidAfter then r else+      error ("INVALID " <> show evt <> "\n" <> debugPrintBeforeAfterState lastState afterState)
+ src/Potato/Flow/Llama.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE RecordWildCards #-}+++module Potato.Flow.Llama where++import           Relude                   hiding (state)++import           Potato.Flow.DebugHelpers+import           Potato.Flow.Math+import           Potato.Flow.Owl+import           Potato.Flow.OwlItem+import           Potato.Flow.OwlState+import           Potato.Flow.SElts+import           Potato.Flow.Types+++import           Control.Exception        (assert)+import qualified Data.IntMap              as IM+import qualified Data.Text                as T+import qualified Text.Show+++-- TODO rename+-- TODO this is a carryover from a refactor, it would be good to combine this with SLlama but I won't bother.+data OwlPFCmd =+  OwlPFCNewElts [(REltId, OwlSpot, OwlItem)]+  | OwlPFCDeleteElts [(REltId, OwlSpot, OwlItem)]++  | OwlPFCNewTree (MiniOwlTree, OwlSpot)+  | OwlPFCDeleteTree (MiniOwlTree, OwlSpot)++  -- DEPRECATE+  | OwlPFCManipulate ControllersWithId++  -- we need SuperOwlParliament for undo+  | OwlPFCMove (OwlSpot, SuperOwlParliament)++  | OwlPFCResizeCanvas DeltaLBox+  --  | OwlPFCSnap (OwlPFState, OwlPFState) --(before, after)+  deriving (Show, Generic)++instance NFData OwlPFCmd++doCmdState :: OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)+doCmdState cmd s = assert (owlPFState_isValid newState) (newState, changes) where+  (newState, changes) = case cmd of++    OwlPFCNewElts x      ->  do_newElts x s+    OwlPFCDeleteElts x   ->  do_deleteElts x s++    OwlPFCNewTree x      -> do_newMiniOwlTree x s+    OwlPFCDeleteTree x   -> do_deleteMiniOwlTree x s++    OwlPFCManipulate x   ->  do_manipulate x s++    OwlPFCMove x         -> do_move x s+    OwlPFCResizeCanvas x -> (do_resizeCanvas x s, IM.empty)++undoCmdState :: OwlPFCmd -> OwlPFState -> (OwlPFState, SuperOwlChanges)+undoCmdState cmd s = assert (owlPFState_isValid newState) (newState, changes) where+  (newState, changes) =  case cmd of++    OwlPFCNewElts x      ->  undo_newElts x s+    OwlPFCDeleteElts x   ->  undo_deleteElts x s++    OwlPFCNewTree x      -> undo_newMiniOwlTree x s+    OwlPFCDeleteTree x   -> undo_deleteMiniOwlTree x s++    OwlPFCManipulate x   ->  undo_manipulate x s++    OwlPFCMove x         -> undo_move x s+    OwlPFCResizeCanvas x -> (undo_resizeCanvas x s, IM.empty)++++data SLlama =+  SLlama_Set [(REltId, SElt)]+  | SLlama_Rename (REltId, Text)+  | SLlama_Compose [SLlama]+  -- TODO OwlItem contains caches which we don't want to so serialize with Llama so ideally there should be a mirrored type to remove the cache, should be able to use SElt equivalents here instead?+  | SLlama_OwlPFCmd OwlPFCmd Bool+  deriving (Show, Generic)++instance NFData SLlama++data ApplyLlamaError = ApplyLlamaError_Generic Text deriving (Show)++data Llama = Llama {+  _llama_apply :: OwlPFState -> Either ApplyLlamaError (OwlPFState, SuperOwlChanges, Llama)+  , _llama_serialize :: SLlama+  , _llama_describe :: Text+} deriving (Generic)++instance NFData Llama++instance Show Llama where+  show = show . _llama_serialize++data LlamaStack = LlamaStack {+  _llamaStack_done        :: [Llama] -- stuff we've done, applying these Llamas will *undo* the operation that put them on the stack!+  , _llamaStack_undone    :: [Llama] -- stuff we've undone, applying these Llamas will *redo* the operation that put them on the stack!+  , _llamaStack_lastSaved :: Maybe Int -- size of do stacks on last save+} deriving (Show, Generic)++instance NFData LlamaStack++emptyLlamaStack :: LlamaStack+emptyLlamaStack = LlamaStack [] [] (Just 0)+++-- UNTESTED+llamaStack_hasUnsavedChanges :: LlamaStack -> Bool+llamaStack_hasUnsavedChanges LlamaStack {..} = case _llamaStack_lastSaved of+  Nothing -> True+  Just x  -> x /= length _llamaStack_done++makeRenameLlama :: (REltId, Text) -> Llama+makeRenameLlama (rid, newname) = r where++  apply pfs = let+      mapping = _owlTree_mapping . _owlPFState_owlTree $ pfs+    in case IM.lookup rid mapping of+        Nothing -> Left $ ApplyLlamaError_Generic $ "Element to rename does not exist " <> show rid+        Just (oldoem, oldoitem) -> let+            (newoitem, oldname) = (owlItem_setName oldoitem newname, owlItem_name oldoitem)+            newsowl = SuperOwl rid oldoem newoitem+            newMapping = IM.insert rid (oldoem, newoitem) mapping+            changes = IM.singleton rid (Just newsowl)+            unset = makeRenameLlama (rid, oldname)+            newState = pfs { _owlPFState_owlTree = (_owlPFState_owlTree pfs) { _owlTree_mapping = newMapping } }+          in+            Right $ (newState, changes, unset)+++  serialize = SLlama_Rename (rid, newname)+  r = Llama {+      _llama_apply = apply+      , _llama_serialize = serialize+      , _llama_describe = "rename " <> show rid <> " to " <> newname+    }++makeSetLlama :: (REltId, SElt) -> Llama+makeSetLlama (rid, selt) = r where+  apply pfs = let+      mapping = _owlTree_mapping . _owlPFState_owlTree $ pfs+    in case IM.lookup rid mapping of+        Nothing -> Left $ ApplyLlamaError_Generic $ "Element to modify does not exist " <> show rid <> " " <> potatoShow (_owlPFState_owlTree $ pfs)+        Just (_, OwlItem _ (OwlSubItemFolder _)) -> Left $ ApplyLlamaError_Generic $ "Element to modify is a folder " <> show rid+        Just (oldoem, OwlItem oinfo oldsubitem) -> let+            -- this will clear the cache in OwlItem+            newoitem = OwlItem oinfo $ sElt_to_owlSubItem selt+            newsowl = SuperOwl rid oldoem newoitem+            newMapping = IM.insert rid (oldoem, newoitem) mapping+            changes = IM.singleton rid (Just newsowl)+            unset = makeSetLlama (rid, owlSubItem_to_sElt_hack oldsubitem)+            newState = pfs { _owlPFState_owlTree = (_owlPFState_owlTree pfs) { _owlTree_mapping = newMapping } }+          in+            Right $ (newState, changes, unset)+++  serialize = SLlama_Set [(rid, selt)]+  r = Llama {+      _llama_apply = apply+      , _llama_serialize = serialize+      , _llama_describe = "set " <> show rid <> " to " <> show selt+    }+++makePFCLlama' :: Bool -> OwlPFCmd -> Llama+makePFCLlama' isDo cmd = r where+  apply pfs = let+      unset = makePFCLlama' (not isDo) cmd+      (newState, changes) = if isDo then doCmdState cmd pfs else undoCmdState cmd pfs+    in Right $ (newState, changes, unset)++  serialize = SLlama_OwlPFCmd cmd isDo+  r = Llama {+      _llama_apply = apply+      , _llama_serialize = serialize+      , _llama_describe = "PFC " <> show cmd+    }++makePFCLlama :: OwlPFCmd -> Llama+makePFCLlama = makePFCLlama' True++-- UNTESTED+makeCompositionLlama :: [Llama] -> Llama+makeCompositionLlama llamas = r where++  apply pfs = go llamas (pfs, IM.empty, []) where+    go [] (state, changes, undollamas) = Right (state, changes, makeCompositionLlama undollamas)+    go (llama:rest) (state, changes, undollamas) = case _llama_apply llama state of+      Right newoutput@(newstate, newchanges, newundollama) -> go rest (newstate, IM.union newchanges changes, newundollama:undollamas)+      e -> e+++  serialize = SLlama_Compose $ fmap _llama_serialize llamas+  r = Llama {+      _llama_apply = apply+      , _llama_serialize = serialize+      , _llama_describe = T.concat $ fmap _llama_describe llamas+    }+++sLlama_deserialize :: OwlPFState -> SLlama -> Llama+sLlama_deserialize pfs sllama = case sllama of+  SLlama_Set pairs -> makeCompositionLlama (fmap makeSetLlama pairs)+  SLlama_Rename x -> makeRenameLlama x+  SLlama_Compose x -> makeCompositionLlama $ fmap (sLlama_deserialize pfs) x+  SLlama_OwlPFCmd pfc isDo -> makePFCLlama' isDo pfc
+ src/Potato/Flow/Math.hs view
@@ -0,0 +1,340 @@+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Potato.Flow.Math (+  XY+  , LBox(..)+  , nilLBox++  , make_0area_lBox_from_XY+  , make_1area_lBox_from_XY+  , make_lBox_from_XYs+  , make_lBox_from_XYlist+  , does_lBox_contains_XY+  , lBox_tl+  , lBox_area+  , lBox_to_axis+  , translate_lBox+  , add_XY_to_lBox++  , make_lBox_from_axis+  , union_lBox+  , lBox_expand+  , intersect_lBox+  , intersect_lBox_include_zero_area+  , does_lBox_intersect+  , does_lBox_intersect_include_zero_area+  , substract_lBox++  -- these helpers maybe belong in a different file, they have very specific usages+  , CanonicalLBox(..)+  , canonicalLBox_from_lBox+  , canonicalLBox_from_lBox_+  , lBox_from_canonicalLBox+  , deltaLBox_via_canonicalLBox+  , lBox_isCanonicalLBox++  , Delta(..)+  , DeltaXY(..)+  , DeltaLBox(..)++  , module Linear.V2+) where++import           Relude++import           Data.Aeson+import           Data.Binary+import           Linear.V2+import qualified Text.Show++import Control.Exception (assert)++{-+ CORDINATE SYSTEM+ UPPER LEFT CORNER is 0 0+ (0,0)--- +x+  |+  |+  +y+-}++type XY = V2 Int+instance FromJSON XY+instance ToJSON XY+instance FromJSONKey XY+instance ToJSONKey XY++-- | a point in screen space+-- should only be used by VC, so does not belong here+--newtype VPoint = VPoint (Int, Int) deriving (Generic, Show, FromJSON, ToJSON)++-- | a box in logical space+-- note size is non inclusive+-- e.g. an LBox with size (1,1) is exactly 1 point at ul+-- e.g. an LBox with size (0,0) contains nothing+data LBox = LBox {+  _lBox_tl     :: XY+  , _lBox_size :: XY+} deriving (Eq, Generic)++instance Show LBox where+  show (LBox (V2 x y) (V2 w h)) = "LBox: " <> show x <> " " <> show y <> " " <> show w <> " " <> show h++instance FromJSON LBox+instance ToJSON LBox+instance Binary LBox+instance NFData LBox++nilLBox :: LBox+nilLBox = LBox 0 0++lBox_area :: LBox -> Int+lBox_area (LBox _ (V2 w h)) = w*h++lBox_tl :: LBox -> XY+lBox_tl (LBox p _) = p++translate_lBox :: XY -> LBox -> LBox+translate_lBox pan (LBox p s) = LBox (p+pan) s+++-- | returns a 0 area LBox+make_0area_lBox_from_XY :: XY -> LBox+make_0area_lBox_from_XY p = LBox p 0++-- | returns a 1 area LBox+make_1area_lBox_from_XY :: XY -> LBox+make_1area_lBox_from_XY p = LBox p 1++-- TODO rename to make_lBox_from_XY_XY+-- | always returns a canonical LBox+make_lBox_from_XYs :: XY -> XY -> LBox+make_lBox_from_XYs (V2 x1 y1) (V2 x2 y2) =+  LBox {+    _lBox_tl= V2 (min x1 x2) (min y1 y2)+    , _lBox_size  = V2 (abs (x1 - x2)) (abs (y1 - y2))+  }++-- TODO rename to make_lBox_from_XYs+-- | always returns a canonical LBox+make_lBox_from_XYlist :: [XY] -> LBox+make_lBox_from_XYlist [] = nilLBox+make_lBox_from_XYlist (x:xs) = foldr add_XY_to_lBox (make_0area_lBox_from_XY x) xs+++-- | always returns a canonical LBox+-- bottom/right XYs cells are not included in+add_XY_to_lBox :: XY -> LBox -> LBox+add_XY_to_lBox (V2 px py) lbox = r where+  (LBox (V2 bx by) (V2 bw bh)) = canonicalLBox_from_lBox_ lbox+  r = LBox {+    _lBox_tl = V2 (min px bx) (min py by)+    , _lBox_size  = V2 (max bw $ max (abs (px-bx)) (abs (px-(bx+bw)))) (max bh $ max (abs (py-by)) (abs (py-(by+bh))))+  }++-- specifically `make_1area_lBox_from_XY pos` must be contained in lbox+-- so XYs on the bottom/right border are not included+does_lBox_contains_XY :: LBox -> XY -> Bool+does_lBox_contains_XY (LBox (V2 bx by) (V2 bw bh)) (V2 px py) =+  px >= bx && py >= by && px < (bx + bw) && py < (by + bh)++-- | right and bottom axis are non-inclusive+make_lBox_from_axis :: (Int, Int, Int, Int) -> LBox+make_lBox_from_axis (x1,x2,y1,y2) = LBox (V2 rx ry) (V2 rw rh) where+  rx = min x1 x2+  ry = min y1 y2+  rw = abs (x1-x2)+  rh = abs (y1-y2)++-- | (left, right, top, bottom)+-- right and bottom are non-inclusive+lBox_to_axis :: LBox -> (Int, Int, Int, Int)+lBox_to_axis (LBox (V2 x y) (V2 w h)) = (min x (x+w), max x (x+w), min y (y+h), max y (y+h))++min4 :: (Ord a) => a -> a -> a -> a -> a+min4 a1 a2 a3 a4 = min (min (min a1 a2) a3) a4++max4 :: (Ord a) => a -> a -> a -> a -> a+max4 a1 a2 a3 a4 = max (max (max a1 a2) a3) a4++-- | inverted LBox are treated as if not inverted+union_lBox :: LBox -> LBox -> LBox+union_lBox (LBox (V2 x1 y1) (V2 w1 h1)) (LBox (V2 x2 y2) (V2 w2 h2)) = combined where+  cx1 = x1 + w1+  cy1 = y1 + h1+  cx2 = x2 + w2+  cy2 = y2 + h2+  combined = make_lBox_from_axis (min4 x1 cx1 x2 cx2, max4 x1 cx1 x2 cx2, min4 y1 cy1 y2 cy2, max4 y1 cy1 y2 cy2)++-- assumes lbox is canonical+lBox_expand :: LBox -> (Int, Int, Int, Int) -> LBox+lBox_expand (LBox (V2 x y) (V2 w h)) (l, r, u, d) = LBox (V2 (x-l) (y-u)) (V2 (w+l+r) (h+u+d))++-- | inverted LBox are treated as if not inverted+intersect_lBox :: LBox -> LBox -> Maybe LBox+intersect_lBox lb1@(LBox (V2 x1 y1) (V2 w1 h1)) lb2@(LBox (V2 x2 y2) (V2 w2 h2)) = r where+  cx1 = x1 + w1+  cy1 = y1 + h1+  cx2 = x2 + w2+  cy2 = y2 + h2+  l1 = min cx1 x1+  l2 = min cx2 x2+  r1 = max cx1 x1+  r2 = max cx2 x2+  t1 = min cy1 y1+  t2 = min cy2 y2+  b1 = max cy1 y1+  b2 = max cy2 y2+  r = if does_lBox_intersect lb1 lb2+    then Just $ make_lBox_from_axis (max l1 l2, min r1 r2, max t1 t2, min b1 b2)+    else Nothing++intersect_lBox_include_zero_area :: LBox -> LBox -> Maybe LBox+intersect_lBox_include_zero_area lb1@(LBox (V2 x1 y1) (V2 w1 h1)) lb2@(LBox (V2 x2 y2) (V2 w2 h2)) = r where+  cx1 = x1 + w1+  cy1 = y1 + h1+  cx2 = x2 + w2+  cy2 = y2 + h2+  l1 = min cx1 x1+  l2 = min cx2 x2+  r1 = max cx1 x1+  r2 = max cx2 x2+  t1 = min cy1 y1+  t2 = min cy2 y2+  b1 = max cy1 y1+  b2 = max cy2 y2+  r = if does_lBox_intersect_include_zero_area lb1 lb2+    then Just $ make_lBox_from_axis (max l1 l2, min r1 r2, max t1 t2, min b1 b2)+    else Nothing+++does_lBox_intersect :: LBox -> LBox -> Bool+does_lBox_intersect lb1 lb2 = r where+  (l1,r1,t1,b1) = lBox_to_axis lb1+  (l2,r2,t2,b2) = lBox_to_axis lb2+  r | lBox_area lb1 == 0 = False+    | lBox_area lb2 == 0 = False+    | l1 >= r2 = False+    | l2 >= r1 = False+    | t1 >= b2 = False+    | t2 >= b1 = False+    | otherwise = True++does_lBox_intersect_include_zero_area :: LBox -> LBox -> Bool+does_lBox_intersect_include_zero_area lb1 lb2 = r where+  (l1,r1,t1,b1) = lBox_to_axis lb1+  (l2,r2,t2,b2) = lBox_to_axis lb2+  r | lb1 == lb2 = True -- this covers the case of 2 0 area boxes over each other+    | l1 >= r2 = False+    | l2 >= r1 = False+    | t1 >= b2 = False+    | t2 >= b1 = False+    | otherwise = True+++-- | substract lb2 from lb1 and return [LBox] representing the difference+substract_lBox :: LBox -> LBox -> [LBox]+substract_lBox lb1@(LBox _ (V2 w1 h1)) lb2 = r where+  (l1,r1,t1,b1) = lBox_to_axis lb1+  (l2,r2,t2,b2) = lBox_to_axis lb2+  mleft = if l1 < l2+    then Just $ LBox (V2 l1 t1) (V2 (min (l2-l1) w1) h1)+    else Nothing+  mright = if r1 > r2+    then Just $ LBox (V2 (max r2 l1) t1) (V2 (min (r1-r2) w1) h1)+    else Nothing+  mtop' =  if t1 < t2+    then Just $ LBox (V2 l1 t1) (V2 w1 (min (t2-t1) h1))+    else Nothing+  mbot' = if b1 > b2+    then Just $ LBox (V2 l1 (max b2 t1)) (V2 w1 (min (b1-b2) h1))+    else Nothing+  -- TODO crop away mleft/mright from mtop'/mbot'+  mtop = mtop'+  mbot = mbot'+  r = catMaybes [mleft,mright,mtop, mbot]+++-- | CanonicalLBox is always has non-negative width/height+-- and tracks which axis are flipped to return back to original LBox+-- first Bool is if x values are flipped, second is for y+data CanonicalLBox = CanonicalLBox Bool Bool LBox++canonicalLBox_from_lBox :: LBox -> CanonicalLBox+canonicalLBox_from_lBox (LBox (V2 x y) (V2 w h)) = r where+  fx = w < 0+  fy = h < 0+  r = CanonicalLBox fx fy $ make_lBox_from_axis (x, x+w, y, y+h)++-- | same as canonicalLBox_from_lBox but returns just the canonical LBox+canonicalLBox_from_lBox_ :: LBox -> LBox+canonicalLBox_from_lBox_ lbox = r where+  (CanonicalLBox _ _ r) = canonicalLBox_from_lBox lbox++lBox_from_canonicalLBox :: CanonicalLBox -> LBox+lBox_from_canonicalLBox (CanonicalLBox fx fy (LBox (V2 x y) (V2 w h))) = LBox (V2 x' y') (V2 w' h') where+  x' = if fx then x+w else x+  y' = if fy then y+h else y+  w' = if fx then -w else w+  h' = if fy then -h else h++deltaLBox_via_canonicalLBox :: CanonicalLBox -> DeltaLBox -> DeltaLBox+deltaLBox_via_canonicalLBox (CanonicalLBox fx fy _) DeltaLBox {..} = r where+  V2 tx ty = _deltaLBox_translate+  V2 sx sy = _deltaLBox_resizeBy+  (rtx, rsx) = if fx then (sx, tx) else (tx, sx)+  (rty, rsy) = if fy then (sy, ty) else (ty, sy)+  r = DeltaLBox (V2 rtx rty) (V2 rsx rsy)++lBox_isCanonicalLBox :: LBox -> Bool+lBox_isCanonicalLBox lbx = canonicalLBox_from_lBox_ lbx == lbx++++++-- TODO maybe DELETE?+class Delta x dx where+  plusDelta :: x -> dx -> x+  minusDelta :: x -> dx -> x++instance Delta XY XY where+  plusDelta = (+)+  minusDelta = (-)++instance (Show a, Eq a) => Delta a (a,a) where+  plusDelta s (b, a) = if b /= s+    then error $ show s <> " " <> show b <> " " <> show a+    else a+  minusDelta s (b, a) = assert (a == s) b++newtype DeltaXY = DeltaXY XY deriving (Eq, Generic, Show)++instance NFData DeltaXY++instance Delta XY DeltaXY where+  plusDelta xy (DeltaXY dxy) = xy + dxy+  minusDelta xy (DeltaXY dxy) = xy - dxy++instance (Delta a c, Delta b d) => Delta (a,b) (c,d) where+  plusDelta (a,b) (c,d) = (plusDelta a c, plusDelta b d)+  minusDelta (a,b) (c,d) = (minusDelta a c, minusDelta b d)++data DeltaLBox = DeltaLBox {+  _deltaLBox_translate  :: XY+  , _deltaLBox_resizeBy :: XY+}  deriving (Eq, Generic, Show)++instance NFData DeltaLBox++instance Delta LBox DeltaLBox where+  plusDelta LBox {..} DeltaLBox {..} = LBox {+      _lBox_tl = plusDelta _lBox_tl _deltaLBox_translate+      , _lBox_size = plusDelta _lBox_size _deltaLBox_resizeBy+    }+  minusDelta LBox {..} DeltaLBox {..} =  LBox {+      _lBox_tl = minusDelta _lBox_tl _deltaLBox_translate+      , _lBox_size = minusDelta _lBox_size _deltaLBox_resizeBy+    }
+ src/Potato/Flow/Methods/LineDrawer.hs view
@@ -0,0 +1,787 @@++{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Methods.LineDrawer (+  LineAnchorsForRender(..)+  , lineAnchorsForRender_doesIntersectPoint+  , lineAnchorsForRender_doesIntersectBox+  , lineAnchorsForRender_findIntersectingSubsegment+  , lineAnchorsForRender_length++  , sAutoLine_to_lineAnchorsForRenderList+  , sSimpleLineNewRenderFn+  , sSimpleLineNewRenderFnComputeCache++  , getSAutoLineLabelPosition+  , getSAutoLineLabelPositionFromLineAnchorsForRender+  , getSortedSAutoLineLabelPositions+  , getClosestPointOnLineFromLineAnchorsForRenderList++++  -- * exposed for testing+  , CartDir(..)+  , TransformMe(..)+  , determineSeparation+  , lineAnchorsForRender_simplify+  , internal_getSAutoLineLabelPosition_walk+) where+++import           Relude                         hiding (tail)+import           Relude.Unsafe                  (tail)++import           Potato.Flow.Attachments+import           Potato.Flow.Math+import           Potato.Flow.Methods.LineTypes+import           Potato.Flow.Methods.TextCommon+import           Potato.Flow.Methods.Types+import           Potato.Flow.Owl+import           Potato.Flow.OwlItem+import           Potato.Flow.SElts++import qualified Data.List                      as L+import qualified Data.List.Index                as L+import qualified Data.Text                      as T+import           Data.Tuple.Extra+import qualified Potato.Data.Text.Zipper        as TZ+++import           Linear.Metric                  (norm)+import           Linear.Vector                  ((^*))++import           Control.Exception              (assert)++-- TODO I think you need notion of half separation?+determineSeparation :: (LBox, (Int, Int, Int, Int)) -> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)+determineSeparation (lbx1, p1) (lbx2, p2) = r where+  (l1,r1,t1,b1) = lBox_to_axis $ lBox_expand lbx1 p1+  (l2,r2,t2,b2) = lBox_to_axis $ lBox_expand lbx2 p2+  hsep = l1 >= r2 || l2 >= r1+  vsep = t1 >= b2 || t2 >= b1+  r = (hsep, vsep)++determineSeparationForAttachment_custom :: (LBox, (Int, Int, Int, Int)) -> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)+determineSeparationForAttachment_custom = determineSeparation+++-- TODO DELETE this version was to help support arrows very close to each other but not in one line (see diagram), however it causes undesireable behavior in other cases so we don't use it anymore, it needs to be fixed on an ad-hoc bases+-- in order to be separated for attachment, there must be space for a line in between the two boxes+-- e.g. both ends are offset by 2 but they only need a space of 3 between them+--   +-*+--   |+-- *-++--determineSeparationForAttachment_custom :: (LBox, (Int, Int, Int, Int)) -> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)+--determineSeparationForAttachment_custom (lbx1, p1) (lbx2, p2) = r where+--  (l1,r1,t1,b1) = lBox_to_axis $ lBox_expand lbx1 p1+--  (l2,r2,t2,b2) = lBox_to_axis $ lBox_expand lbx2 p2+--  hsep = l1 >= r2+1 || l2 >= r1+1+--  vsep = t1 >= b2+1 || t2 >= b1+1+--  r = (hsep, vsep)+++determineSeparationForAttachment :: (LBox, Int) -> (LBox, Int) -> (Bool, Bool)+determineSeparationForAttachment (lbx1, amt1') (lbx2, amt2') = determineSeparationForAttachment_custom (lbx1, amt1) (lbx2, amt2) where+  amt1 = (amt1',amt1',amt1',amt1')+  amt2 = (amt2',amt2',amt2',amt2')++++maybeIndex :: Text -> Int -> Maybe MPChar+maybeIndex t i = if i < T.length t+  then Just $ (Just $ T.index t i)+  else Nothing++renderLine :: SuperStyle -> CartDir -> MPChar+renderLine SuperStyle {..} cd = case cd of+  CD_Up    -> _superStyle_vertical+  CD_Down  -> _superStyle_vertical+  CD_Left  -> _superStyle_horizontal+  CD_Right -> _superStyle_horizontal++renderLineEnd :: SuperStyle -> LineStyle -> CartDir -> Int -> MPChar+renderLineEnd SuperStyle {..} LineStyle {..} cd distancefromend = r where+  r = case cd of+    CD_Up -> fromMaybe _superStyle_vertical $ maybeIndex _lineStyle_upArrows distancefromend+    CD_Down -> fromMaybe _superStyle_vertical $ maybeIndex (T.reverse _lineStyle_downArrows) distancefromend+    CD_Left -> fromMaybe _superStyle_horizontal $ maybeIndex _lineStyle_leftArrows distancefromend+    CD_Right -> fromMaybe _superStyle_horizontal $ maybeIndex (T.reverse _lineStyle_rightArrows) distancefromend+++renderAnchorType :: SuperStyle -> LineStyle -> AnchorType -> MPChar+renderAnchorType ss@SuperStyle {..} ls at = r where+  r = case at of+    AT_End_Up        -> renderLineEnd ss ls CD_Up 0+    AT_End_Down      -> renderLineEnd ss ls CD_Down 0+    AT_End_Left      -> renderLineEnd ss ls CD_Left 0+    AT_End_Right     -> renderLineEnd ss ls CD_Right 0+    AT_Elbow_TL      -> _superStyle_tl+    AT_Elbow_TR      -> _superStyle_tr+    AT_Elbow_BR      -> _superStyle_br+    AT_Elbow_BL      -> _superStyle_bl+    AT_Elbow_Invalid -> Just '?'+++lineAnchorsForRender_simplify :: LineAnchorsForRender -> LineAnchorsForRender+lineAnchorsForRender_simplify LineAnchorsForRender {..} = r where+  -- remove 0 distance lines except at front and back+  withoutzeros = case _lineAnchorsForRender_rest of+    []   -> []+    x:xs -> x:withoutzerosback xs+    where+      withoutzerosback = \case+        [] -> []+        x:[] -> [x]+        (_, 0, False):xs -> xs+        -- this can happen now in a few cases, I don't think it's a big deal+        -- it does mess up our subsegmenting starting flags but I think in that case the midpoint probably got removed entirely due to it being too close to another one maybe??+        --(_, 0, True):_ -> error "unexpected 0 length subsegment starting anchor"+        (_, 0, True):xs -> xs+        x:xs -> x:withoutzerosback xs++  foldrfn (cd, d, s) [] = [(cd, d, s)]+  foldrfn (cd, d, firstisstart) ((cd',d', nextisstart):xs) = if cd == cd'+    then (cd, d+d', firstisstart):xs+    else (cd,d,firstisstart):(cd',d',nextisstart):xs+  withoutdoubles = foldr foldrfn [] withoutzeros+  r = LineAnchorsForRender {+      _lineAnchorsForRender_start = _lineAnchorsForRender_start+      , _lineAnchorsForRender_rest = withoutdoubles+    }++lineAnchorsForRender_end :: LineAnchorsForRender -> XY+lineAnchorsForRender_end LineAnchorsForRender {..} = foldl' (\p cdd -> p + cartDirWithDistanceToV2 cdd) _lineAnchorsForRender_start _lineAnchorsForRender_rest++lineAnchorsForRender_reverse :: LineAnchorsForRender -> LineAnchorsForRender+lineAnchorsForRender_reverse lafr@LineAnchorsForRender {..} = r where+  end = lineAnchorsForRender_end lafr+  revgo acc [] = acc+  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 acc ((_,_,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"+  r = LineAnchorsForRender {+      _lineAnchorsForRender_start = end+      , _lineAnchorsForRender_rest = revgostart _lineAnchorsForRender_rest+    }++lineAnchorsForRender_toPointList :: LineAnchorsForRender -> [XY]+lineAnchorsForRender_toPointList LineAnchorsForRender {..} = r where+  scanlfn pos (cd,d,_) = pos + (cartDirToUnit cd) ^* d+  r = scanl scanlfn _lineAnchorsForRender_start _lineAnchorsForRender_rest++data SimpleLineSolverParameters_NEW = SimpleLineSolverParameters_NEW {+  _simpleLineSolverParameters_NEW_attachOffset :: Int -- cells to offset attach to box by+}++instance TransformMe SimpleLineSolverParameters_NEW where+  transformMe_rotateLeft = id+  transformMe_rotateRight = id+  transformMe_reflectHorizontally = id+++restify :: [(CartDir, Int)] -> [(CartDir, Int, Bool)]+restify []          = []+restify ((cd,d):xs) = (cd,d,True):fmap (\(a,b) -> (a,b,False)) xs++-- used to convert AL_ANY at (ax, ay) to an AttachmentLocation based on target position (tx, ty)+-- TODO test that this function is rotationally/reflectively symmetric (although it doesn't really matter if it isn't, however due to recursive implementation of sSimpleLineSolver it's kind of awkward if it's not)+makeAL :: XY -> XY -> AttachmentLocation+makeAL (V2 ax ay) (V2 tx ty) = r where+  dx = tx - ax+  dy = ty - ay+  r = if abs dx > abs dy+    then if dx > 0+      then AL_Right+      else AL_Left+    else if dy > 0+      then AL_Bot+      else AL_Top++-- | configuration to determine whether the attachment point is offest by the border of the box+newtype OffsetBorder = OffsetBorder { unOffsetBorder :: Bool } deriving (Show)++instance TransformMe OffsetBorder where+  transformMe_rotateLeft = id+  transformMe_rotateRight = id+  transformMe_reflectHorizontally = id+++-- 🙈🙈🙈+-- TODO update to be (LBox, AttachmentLocation, AttachmentOffsetRatio, OffsetBorder)+sSimpleLineSolver_NEW :: (Text, Int) -> CartRotationReflection -> SimpleLineSolverParameters_NEW -> (BoxWithAttachmentLocation, OffsetBorder) -> (BoxWithAttachmentLocation, OffsetBorder) -> LineAnchorsForRender+sSimpleLineSolver_NEW (errormsg, depth) crr sls ((lbx1, al1_, af1), offb1) ((lbx2, al2_, af2), offb2) =  finaloutput where+  --LBox (V2 x1 y1) (V2 w1 h1) = lbx1+  LBox (V2 _ y2) (V2 _ h2) = lbx2++  attachoffset = _simpleLineSolverParameters_NEW_attachOffset sls++  al1 = case al1_ of+    AL_Any -> assert (af1 == attachment_offset_rel_default) $ makeAL (_lBox_tl lbx1) $ case al2_ of+      AL_Any -> _lBox_tl lbx2+      _      -> end+    x -> x+  al2 = case al2_ of+    AL_Any -> assert (af2 == attachment_offset_rel_default) $ makeAL (_lBox_tl lbx2) $ case al1_ of+      AL_Any -> _lBox_tl lbx1+      _      -> start+    x -> x++  lbal1 = ((lbx1, al1, af1), offb1)+  lbal2 = ((lbx2, al2, af2), offb2)++  start@(V2 ax1 ay1) = attachLocationFromLBox_conjugateCartRotationReflection crr (unOffsetBorder offb1) (lbx1, al1, af1)+  end@(V2 ax2 ay2) = attachLocationFromLBox_conjugateCartRotationReflection crr (unOffsetBorder offb2) (lbx2, al2, af2)+++  -- TODO need to selectively remove offset border based on whether there is an arrow or not (you need to set sSimpleLineSolver_NEW OffsetBorder parameter, issue isn't here)+  -- this causes stuff like this right now+              -- ╔═════════════╗+              -- ║╔GoatState═══║═══════════╗+              -- ║║            ║           ║+              -- ║║            ║           ║+              -- ║║            ║           ║+              -- ║║            ║           ║+              -- ║╚════════════║═══════════╝+              -- ║            ║║+              -- ║            ║v+              -- ║╔OwlPFWorksp║ce══════════╗+              -- ║║           ║            ║+              -- ║║           ║            ║+              -- ║║           ║            ║+              -- ║║           ║            ║+              -- ║╚═══════════║════════════╝+              -- ╚════════════╝+  (hsep, vsep) = determineSeparationForAttachment (lbx1, if unOffsetBorder offb1 then 1 else 0) (lbx2, if unOffsetBorder offb2 then 1 else 0)++  lbx1isstrictlyleft = ax1 < ax2+  lbx1isleft = ax1 <= ax2+  lbx1isstrictlyabove = ay1 < ay2+  ay1isvsepfromlbx2 = ay1 < y2 || ay1 >= y2 + h2++  --traceStep = trace+  traceStep _ x = x+  stepdetail = show lbal1 <> " | " <> show lbal2 <> "\n"+  nextmsg step = (errormsg <> " " <> step <> ": " <> stepdetail, depth+1)++  (l1_inc,r1,t1_inc,b1) = lBox_to_axis lbx1+  (l2_inc,r2,t2_inc,b2) = lBox_to_axis lbx2++  -- TODO offset by boundaryoffset from parameters+  l = min (l1_inc-1) (l2_inc-1)+  t = min (t1_inc-1) (t2_inc-1)+  b = max b1 b2++  anchors = case al1 of+    -- WORKING+    -- degenerate case+    AL_Right | ax1 == ax2 && ay1 == ay2 -> LineAnchorsForRender {+        _lineAnchorsForRender_start = start+        , _lineAnchorsForRender_rest = []+      }+    -- WORKING+    -- 1->  <-2+    AL_Right | al2 == AL_Left && lbx1isstrictlyleft && hsep -> traceStep "case 1" $ r where++      halfway = (ax2+ax1) `div` 2+      lb1_to_center = (CD_Right, (halfway-ax1))+      centerverticalline = if ay1 < ay2+        then (CD_Down, ay2-ay1)+        else (CD_Up, ay1-ay2)+      center_to_lb2 = (CD_Right, (ax2-halfway))+      r = LineAnchorsForRender {+          _lineAnchorsForRender_start = start+          , _lineAnchorsForRender_rest = restify [lb1_to_center, centerverticalline, center_to_lb2]+        }++    -- WORKING+    -- <-2  1->+    AL_Right | al2 == AL_Left && not vsep -> traceStep "case 2" $ r where++      goup = (ay1-t)+(ay2-t) < (b-ay1)+(b-ay2)++      rightedge = if (not goup && b2 < ay1) || (goup && ay1 < t2_inc)+        then r1 + attachoffset+        else (max (r1+attachoffset) r2)++      lb1_to_right = (CD_Right, rightedge-ax1)+      right_to_torb = if goup+        then (CD_Up, ay1-t)+        else (CD_Down, b-ay1)++      leftedge = if (goup && t2_inc <= t1_inc) || (not goup && b2 > b1)+        then ax2-attachoffset+        else min (ax2-attachoffset) (l1_inc-attachoffset)++      torb = (CD_Left, rightedge - leftedge)++      torb_to_left = if goup+        then (CD_Down, ay2-t)+        else (CD_Up, b-ay2)+      left_to_lb2 = (CD_Right, ax2-leftedge)+      r = LineAnchorsForRender {+          _lineAnchorsForRender_start = start+          , _lineAnchorsForRender_rest = restify [lb1_to_right, right_to_torb, torb, torb_to_left, left_to_lb2]+        }++    -- WORKING+    -- <-2+    --      1->+    AL_Right | al2 == AL_Left && vsep -> traceStep "case 3" $ r where+      halfway = if b1 < t2_inc+        then (b1+t2_inc) `div` 2+        else (b2+t1_inc) `div` 2+      lb1_to_right = (CD_Right, attachoffset)+      right_to_center = if lbx1isstrictlyabove+        then (CD_Down, halfway-ay1)+        else (CD_Up, ay1-halfway)+      center = (CD_Left, attachoffset*2 + (ax1-ax2))+      center_to_left = if lbx1isstrictlyabove+        then (CD_Down, ay2-halfway)+        else (CD_Up, halfway-ay2)+      left_to_lb2 = (CD_Right, attachoffset)+      r = LineAnchorsForRender {+          _lineAnchorsForRender_start = start+          , _lineAnchorsForRender_rest = restify [lb1_to_right, right_to_center, center, center_to_left, left_to_lb2]+        }++    -- WORKING+    --+    -- 1->+    --     2->+    -- ay1isvsepfromlbx2 (different boxes)+    --+    -- OR+    --+    -- ->1+    -- ->2+    -- r1 == r2 (special case when the 2 boxes are the same)+    AL_Right | al2 == AL_Right && (ay1isvsepfromlbx2 || r1 == r2) -> traceStep "case 4" $ answer where+      rightedge = max r1 r2 + attachoffset+      lb1_to_right1 = (CD_Right, rightedge-r1)+      right1_to_right2 = if lbx1isstrictlyabove+        then (CD_Down, ay2-ay1)+        else (CD_Up, ay1-ay2)+      right2_to_lb2 = (CD_Left, rightedge-r2)+      answer = LineAnchorsForRender {+          _lineAnchorsForRender_start = start+          , _lineAnchorsForRender_rest = restify [lb1_to_right1, right1_to_right2, right2_to_lb2]+        }++    -- WORKING+    -- ->1 ->2+    AL_Right | al2 == AL_Right && lbx1isleft && not ay1isvsepfromlbx2 -> traceStep "case 5b" $  answer where+++      goupordown = (ay1-t)+(ay2-t) < (b-ay1)+(b-ay2)++      -- TODO maybe it would be nice if this traveled a little further right+      lb1_to_right1 = (CD_Right, attachoffset)++      right1_to_torb = if goupordown+        then (CD_Up, ay1-t)+        else (CD_Down, b-ay1)+      torb = (CD_Right, r2-r1)+      torb_to_right2 = if goupordown+        then (CD_Down, ay2-t)+        else (CD_Up, b-ay2)+      right2_to_lb2 = (CD_Left, attachoffset)+      answer = LineAnchorsForRender {+          _lineAnchorsForRender_start = start+          , _lineAnchorsForRender_rest = restify [lb1_to_right1, right1_to_torb, torb, torb_to_right2, right2_to_lb2]+        }++    -- ->2 ->1 (will not get covered by rotation)+    AL_Right | al2 == AL_Right && not ay1isvsepfromlbx2 -> traceStep "case 6 (reverse)" $ lineAnchorsForRender_reverse $ sSimpleLineSolver_NEW (nextmsg "case 6") crr sls lbal2 lbal1++    --     2->+    --  ^+    --  |+    --  1+    --     2->+    AL_Top | al2 == AL_Right && lbx1isleft -> traceStep "case 7" $ r where+      upd = if vsep+        then attachoffset+        else ay1-t + attachoffset+      topline = ay1-upd+      lb1_to_up = (CD_Up, upd)+      right = if topline < ay2+        then (max ax2 r1) + attachoffset+        else ax2 + attachoffset+      up_to_right1 =  (CD_Right, right-ax1)+      right1_to_right2 = if topline < ay2+        then (CD_Down, ay2-topline)+        else (CD_Up, topline-ay2)+      right2_to_lb2 = (CD_Left, right-ax2)+      r = LineAnchorsForRender {+          _lineAnchorsForRender_start = start+          , _lineAnchorsForRender_rest = restify [lb1_to_up,up_to_right1,right1_to_right2,right2_to_lb2]+        }+    --     <-2+    --  ^+    --  |+    --  1   <-2 (this one handles both vsep cases)+    AL_Top | al2 == AL_Left && lbx1isleft -> traceStep "case 9" $ r where+      topedge = min (ay1 - attachoffset) ay2+      leftedge = l+      halfway = (ax1 + ax2) `div` 2++      lb1_to_up = (CD_Up, ay1-topedge)+      (up_to_over, up_to_over_xpos) = if lbx1isstrictlyabove && not hsep+        -- go around from the left+        then ((CD_Left, ax1-leftedge), leftedge)+        else ((CD_Right, halfway-ax1), halfway)+      over_to_down = (CD_Down, ay2-topedge)+      down_to_lb2 = (CD_Right, ax2-up_to_over_xpos)+      r = LineAnchorsForRender {+          _lineAnchorsForRender_start = start+          , _lineAnchorsForRender_rest = restify [lb1_to_up, up_to_over,over_to_down,down_to_lb2]+        }++    --        ^+    --        |+    -- <-2->  1 (will not get covered by rotation)+    AL_Top | al2 == AL_Left || al2 == AL_Right -> traceStep "case 10 (flip)" $  transformMe_reflectHorizontally $ sSimpleLineSolver_NEW (nextmsg "case 10") (transformMe_reflectHorizontally crr) (transformMe_reflectHorizontally sls) (transformMe_reflectHorizontally lbal1) (transformMe_reflectHorizontally lbal2)++    AL_Top | al2 == AL_Any -> error "should have been handled by earlier substitution"+    AL_Any | al2 == AL_Top -> error "should have been handled by earlier substitution"+    AL_Any | al2 == AL_Any -> error "should have been handled by earlier substitution"++    _ -> traceStep "case 14 (rotate)" $ transformMe_rotateRight $ sSimpleLineSolver_NEW (nextmsg "case 14") (transformMe_rotateLeft crr) (transformMe_rotateLeft sls) (transformMe_rotateLeft lbal1) (transformMe_rotateLeft lbal2)++  finaloutput = if depth > 10+    then error errormsg+    else lineAnchorsForRender_simplify anchors++doesLineContain :: XY -> XY -> (CartDir, Int, Bool) -> Maybe Int+doesLineContain (V2 px py) (V2 sx sy) (tcd, tl, _) = case tcd of+  CD_Left | py == sy -> if px <= sx && px >= sx-tl then Just (sx-px) else Nothing+  CD_Right | py == sy -> if px >= sx && px <= sx+tl then Just (px-sx) else Nothing+  CD_Up | px == sx -> if py <= sy && py >= sy-tl then Just (sy-py) else Nothing+  CD_Down | px == sx -> if py >= sy && py <= sy+tl then Just (py-sy) else Nothing+  _ -> Nothing++-- TODO test+doesLineContainBox :: LBox -> XY -> (CartDir, Int, Bool) -> Bool+doesLineContainBox lbox (V2 sx sy) (tcd, tl, _) = r where+  (x,y, w,h) = case tcd of+    CD_Left  -> (sx-tl, sy, tl+1, 1)+    CD_Right -> (sx, sy, tl+1, 1)+    CD_Up    -> (sx, sy-tl, 1, tl+1)+    CD_Down  -> (sx, sy, 1, tl+1)+  lbox2 = LBox (V2 x y) (V2 w h)+  r = does_lBox_intersect lbox lbox2+++walkToRender :: SuperStyle -> LineStyle -> LineStyle -> Bool -> XY -> (CartDir, Int, Bool) -> Maybe (CartDir, Int, Bool) -> Int -> (XY, MPChar)+walkToRender ss@SuperStyle {..} ls lse isstart begin (tcd, tl, _) mnext d = r where+  currentpos = begin + (cartDirToUnit tcd) ^* d++  endorelbow = renderAnchorType ss lse $ cartDirToAnchor tcd (fmap fst3 mnext)+  startorregular = if isstart+    then if d <= tl `div` 2+      -- if we are at the start and near the beginning then render start of line+      then renderLineEnd ss ls (flipCartDir tcd) d+      else if isNothing mnext+        -- if we are not at the start and at the end then render end of line+        then renderLineEnd ss ls tcd (tl-d)+        -- otherwise render line as usual+        else renderLine ss tcd+    else renderLine ss tcd+  r = if d == tl+    then (currentpos, endorelbow)+    else (currentpos, startorregular)++lineAnchorsForRender_length :: LineAnchorsForRender -> Int+lineAnchorsForRender_length LineAnchorsForRender {..} = r where+  foldfn (_,d,_) acc = acc + d+  r = foldr foldfn 1 _lineAnchorsForRender_rest++lineAnchorsForRender_renderAt :: SuperStyle -> LineStyle -> LineStyle -> LineAnchorsForRender -> XY -> MPChar+lineAnchorsForRender_renderAt ss ls lse LineAnchorsForRender {..} pos = r where+  walk (isstart, curbegin) a = case a of+    [] -> Nothing+    x:xs -> case doesLineContain pos curbegin x of+      Nothing ->  walk (False, nextbegin) xs+      Just d -> Just $ case xs of+        []  -> walkToRender ss ls lse isstart curbegin x Nothing d+        y:_ -> walkToRender ss ls lse isstart curbegin x (Just y) d+      where+        nextbegin = curbegin + cartDirWithDistanceToV2 x++  manswer = walk (True, _lineAnchorsForRender_start) _lineAnchorsForRender_rest+  r = case manswer of+    Nothing             -> Nothing+    Just (pos', mpchar) -> assert (pos == pos') mpchar++-- UNTESTED+-- returns index of subsegment that intersects with pos+-- e.g.+--      0 ---(x)-- 1 ------ 2+-- returns Just 0+lineAnchorsForRender_findIntersectingSubsegment :: LineAnchorsForRender -> XY -> Maybe Int+lineAnchorsForRender_findIntersectingSubsegment  LineAnchorsForRender {..} pos = r where+  walk i curbegin a = case a of+    [] -> Nothing+    x@(_,_,s):xs -> case doesLineContain pos curbegin x of+      Nothing ->  walk new_i (curbegin + cartDirWithDistanceToV2 x) xs+      Just _  -> Just new_i+      where new_i = if s then i+1 else i+  r = walk (-1) _lineAnchorsForRender_start _lineAnchorsForRender_rest++lineAnchorsForRender_doesIntersectPoint :: LineAnchorsForRender -> XY -> Bool+lineAnchorsForRender_doesIntersectPoint LineAnchorsForRender {..} pos = r where+  walk curbegin a = case a of+    [] -> False+    x:xs -> case doesLineContain pos curbegin x of+      Nothing ->  walk (curbegin + cartDirWithDistanceToV2 x) xs++      Just _  -> True+  r = walk _lineAnchorsForRender_start _lineAnchorsForRender_rest+++lineAnchorsForRender_doesIntersectBox :: LineAnchorsForRender -> LBox -> Bool+lineAnchorsForRender_doesIntersectBox LineAnchorsForRender {..} lbox = r where+  walk curbegin a = case a of+    [] -> False+    x:xs -> if doesLineContainBox lbox curbegin x+      then True+      else walk (curbegin + cartDirWithDistanceToV2 x) xs+  r = walk _lineAnchorsForRender_start _lineAnchorsForRender_rest++++renderLabelFn :: (XY, SAutoLineLabel) -> XY -> MPChar+renderLabelFn (V2 llx lly, llabel) (V2 x y) = r where+  text = _sAutoLineLabel_text llabel+  tz = TZ.top (TZ.fromText text)+  dl = TZ.displayLinesWithAlignment TZ.TextAlignment_Left maxBound 0 1 tz+  offset = (- (T.length text) `div` 2, 0)+  r = join $ displayLinesToChar (llx, lly) dl (x,y) offset++++-- TODO also render labels+sSimpleLineNewRenderFn :: SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer+sSimpleLineNewRenderFn ssline@SAutoLine {..} mcache = drawer where++  getAnchors :: (HasOwlTree a) => a -> LineAnchorsForRender+  getAnchors ot = case mcache of+    Just x  -> x+    Nothing -> sSimpleLineNewRenderFnComputeCache ot ssline++  renderfn :: SEltDrawerRenderFn+  renderfn ot xy = r where+    anchors = getAnchors ot+++    -- m1 takes priority over m2+    mergeMaybe :: MPChar -> MPChar -> MPChar+    mergeMaybe m1 m2 = maybe m2 Just m1++    -- TODO someday cache this too+    llabels = getSortedSAutoLineLabelPositions ot ssline+    llabelsrendered = fmap (\(pos,_,llabel) -> renderLabelFn (pos, llabel) xy) llabels+    mlabelchar = foldr mergeMaybe Nothing llabelsrendered+    mlinechar = lineAnchorsForRender_renderAt _sAutoLine_superStyle _sAutoLine_lineStyle _sAutoLine_lineStyleEnd anchors xy++    -- render label over lines+    r = mergeMaybe mlabelchar mlinechar++  boxfn :: SEltDrawerBoxFn+  boxfn ot = r where+    anchorbox = case nonEmpty (lineAnchorsForRender_toPointList (getAnchors ot)) of+      Nothing -> LBox 0 0+      -- add_XY_to_lBox is non-inclusive with bottom/right so we expand by 1 to make it inclusive+      Just (x :| xs) -> lBox_expand (foldl' (flip add_XY_to_lBox) (make_0area_lBox_from_XY x) xs) (0,1,0,1)++    -- UNTESTED+    -- TODO someday cache this too+    llabels = getSortedSAutoLineLabelPositions ot ssline+    llabelbox (V2 x y) llabel = LBox (V2 (x - wover2) y) (V2 w 1) where+      w = T.length $ _sAutoLineLabel_text llabel+      wover2 = (w+1) `div` 2+    mlabelbox = foldr (\(pos, _, llabel) mbox -> maybe (Just $ llabelbox pos llabel) (\box -> Just $ box `union_lBox` llabelbox pos llabel) mbox) Nothing llabels++    r = case mlabelbox of+      Nothing       -> anchorbox+      Just labelbox -> union_lBox anchorbox labelbox++++  drawer = SEltDrawer {+      _sEltDrawer_box = boxfn+      , _sEltDrawer_renderFn = renderfn++      -- TODO+      , _sEltDrawer_maxCharWidth = 1+    }++lineAnchorsForRender_concat :: [LineAnchorsForRender] -> LineAnchorsForRender+lineAnchorsForRender_concat [] = error "expected at least one LineAnchorsForRender"+lineAnchorsForRender_concat (x:xs) = foldl' foldfn x xs where+  -- TODO re-enable assert when it gets fixed+  foldfn h c = --assert (lineAnchorsForRender_end h == _lineAnchorsForRender_start c) $+    h { _lineAnchorsForRender_rest = _lineAnchorsForRender_rest h <> _lineAnchorsForRender_rest c }+++pairs :: [a] -> [(a, a)]+pairs [] = []+pairs xs = zip xs (tail xs)+++-- DELETE+maybeGetAttachBox :: (HasOwlTree a) => a -> Maybe Attachment -> Maybe (LBox, AttachmentLocation)+maybeGetAttachBox ot mattachment = do+  Attachment rid al _ <- mattachment+  sowl <- hasOwlTree_findSuperOwl ot rid+  sbox <- getSEltBox_naive $ hasOwlItem_toSElt_hack sowl+  return (sbox, al)+++maybeGetAttachBox_NEW2 :: (HasOwlTree a) => a -> Maybe Attachment -> Maybe BoxWithAttachmentLocation+maybeGetAttachBox_NEW2 ot mattachment = do+  Attachment rid al ratio <- mattachment+  sowl <- hasOwlTree_findSuperOwl ot rid+  sbox <- getSEltBox_naive $ hasOwlItem_toSElt_hack sowl+  return (sbox, al, ratio)++-- returns a list of LineAnchorsForRender, one for each segment separated by midpoints+sAutoLine_to_lineAnchorsForRenderList :: (HasOwlTree a) => a -> SAutoLine -> [LineAnchorsForRender]+sAutoLine_to_lineAnchorsForRenderList ot SAutoLine {..} = anchorss where++  -- TODO set properly+  params = SimpleLineSolverParameters_NEW {+      -- TODO maybe set this based on arrow head size (will differ for each end so you need 4x)+      _simpleLineSolverParameters_NEW_attachOffset = 1+    }++++  offsetBorder x (a,b,c) = ((a,b,c), OffsetBorder x)+  startlbal = case maybeGetAttachBox_NEW2 ot _sAutoLine_attachStart of+    Nothing    -> ((LBox _sAutoLine_start 1, AL_Any, attachment_offset_rel_default), OffsetBorder False)+    Just bal -> (bal, OffsetBorder True)+  endlbal = case maybeGetAttachBox_NEW2 ot _sAutoLine_attachEnd of+    Nothing    -> ((LBox _sAutoLine_end 1, AL_Any, attachment_offset_rel_default), OffsetBorder False)+    Just bal -> (bal, OffsetBorder True)+  midlbals = fmap (\(SAutoLineConstraintFixed xy) ->   ((LBox xy 1, AL_Any, attachment_offset_rel_default), OffsetBorder False)) _sAutoLine_midpoints++  -- ???? TODO BUG this is a problem, you need selective offsetting for each side of the box, in particular, midpoints can't offset and the point needs to land exactly on the midpoint+  -- NOTE for some reason sticking trace statements in sSimpleLineSolver will causes regenanchors to get called infinite times :(+  anchorss = fmap (\(lbal1, lbal2) -> sSimpleLineSolver_NEW ("",0) cartRotationReflection_identity params lbal1 lbal2) $ pairs ((startlbal : midlbals) <> [endlbal])++sSimpleLineNewRenderFnComputeCache :: (HasOwlTree a) => a -> SAutoLine -> LineAnchorsForRender+sSimpleLineNewRenderFnComputeCache ot sline = anchors where+  anchors = lineAnchorsForRender_simplify . lineAnchorsForRender_concat $ sAutoLine_to_lineAnchorsForRenderList ot sline++internal_getSAutoLineLabelPosition_walk :: LineAnchorsForRender -> Int -> XY+internal_getSAutoLineLabelPosition_walk lar targetd = r where+  walk [] curbegin _ = curbegin+  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)+      else walk rest nextbegin (traveld + d)+  r = walk (_lineAnchorsForRender_rest lar) (_lineAnchorsForRender_start lar) 0+++internal_getSAutoLineLabelPosition :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY+internal_getSAutoLineLabelPosition lar SAutoLine {..} SAutoLineLabel {..} = r where+  totall = lineAnchorsForRender_length lar+  targetd = case _sAutoLineLabel_position of+    SAutoLineLabelPositionRelative rp -> max 0 . floor $ (fromIntegral totall * rp)+  r = internal_getSAutoLineLabelPosition_walk lar targetd++getSAutoLineLabelPositionFromLineAnchorsForRender :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY+getSAutoLineLabelPositionFromLineAnchorsForRender lar sal sall = internal_getSAutoLineLabelPosition lar sal sall++-- the SAutoLineLabel does not have to be one of labels contained in the SAutoLine _sAutoLine_labels+-- which is useful for positioning SAutoLineLabel before adding them to SAutoLine+-- however the midpoint index in SAutoLineLabel is expected to map correctly to the SAutoLine+getSAutoLineLabelPosition :: (HasOwlTree a) => a -> SAutoLine -> SAutoLineLabel -> XY+getSAutoLineLabelPosition ot sal sall = getSAutoLineLabelPositionFromLineAnchorsForRender lar sal sall where+  lar = sAutoLine_to_lineAnchorsForRenderList ot sal L.!! (_sAutoLineLabel_index sall)++-- get SAutoLineLabel positions in visual order (which may not be the same as logical order)+-- return includes SAutoLineLabel and its original logical index for convenience+getSortedSAutoLineLabelPositions :: (HasOwlTree a) => a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]+getSortedSAutoLineLabelPositions ot sal@SAutoLine {..} = r where+  sortfn (_,a) (_,b) = case compare (_sAutoLineLabel_index a) (_sAutoLineLabel_index b) of+    EQ -> case _sAutoLineLabel_position a of+      SAutoLineLabelPositionRelative x -> case _sAutoLineLabel_position b of+        SAutoLineLabelPositionRelative y -> compare x y+    x -> x+  sortedlls = sortBy sortfn $ L.indexed _sAutoLine_labels++  larlist = sAutoLine_to_lineAnchorsForRenderList ot sal++  r = fmap (\(i, sall) -> (internal_getSAutoLineLabelPosition (larlist L.!! _sAutoLineLabel_index sall) sal sall, i, sall)) sortedlls+++-- takes a list of line anchors as returned by sAutoLine_to_lineAnchorsForRenderList and a position+-- returns closest orthognally projected point on the line as a tuple (projected position, index into larlist, relative distance along the LineAnchorsForRender that the point is on)+getClosestPointOnLineFromLineAnchorsForRenderList :: [LineAnchorsForRender] -> XY -> (XY, Int, Float)+getClosestPointOnLineFromLineAnchorsForRenderList larlist pos@(V2 posx posy) = r where++  foldlfn ::+    (Int, (XY, Int, Float), Int) -- (previous closest distance to line, (prev closest position, index into larlist, rel distance on segment))+    -> LineAnchorsForRender+    -> (Int, (XY, Int, Float), Int)+  foldlfn (closestd, closestp, curindex) lar = r2 where+++    foldlfn2 ::+      (Int, XY, Int, Maybe (Int, XY)) -- (total distance we traveled so far, current anchor position, prev closest distance to line (includes second fold results up until now), Maybe (how far we traveled to new closest point on line, new closest point))+      -> (CartDir, Int, Bool)+      -> (Int, XY, Int, Maybe (Int, XY))+    foldlfn2 (traveld, curp@(V2 curx cury), closestd2, mnewclosestpos2) cdwd@(cd,d,_) = r3 where++      between :: Int -> Int -> Int -> Bool+      between p a b = (p >= a && p <= b) || (p <= a && p >= b)++      xydistance :: XY -> XY -> Float+      xydistance (V2 ax ay) (V2 bx by) = norm (V2 (fromIntegral ax - fromIntegral bx) (fromIntegral ay - fromIntegral by))+++      endp@(V2 endx endy) = curp + cartDirWithDistanceToV2  cdwd++      dtoend = (xydistance pos endp)+      dtocur = (xydistance pos curp)++      dandpostostartorend = if dtocur < dtoend+        then (dtocur, curp)+        else (dtoend, endp)++      -- project pos onto each segment+      (projd, projp) = if cd == CD_Up || cd == CD_Down+        -- project horizontally+        then if between posy cury endy+          -- if projection in bounds+          then (fromIntegral $ abs (curx - posx), V2 curx posy)+          else  dandpostostartorend+        -- project vertically+        else if between posx curx endx+          -- if projection in bounds+          then (fromIntegral $ abs (cury - posy), V2 posx cury)+          else dandpostostartorend++      -- if we are closer than previous closest point+      r3 = if projd < fromIntegral closestd2+        -- update the new closest point+        then (traveld + d, endp, ceiling projd, Just (traveld + floor (xydistance curp projp), projp))+        -- same as before, keep going+        else (traveld + d, endp, closestd2, mnewclosestpos2)++    -- walk through each segment in lar+    (totald, _, newclosestd, mnewclosestpos) = L.foldl foldlfn2 (0, _lineAnchorsForRender_start lar, closestd, Nothing) (_lineAnchorsForRender_rest lar)++    r2 = case mnewclosestpos of+      -- did not find a closer point on lar+      Nothing -> (closestd, closestp, curindex+1)+      Just (newclosesttraveld, newclosestp) -> (newclosestd, (newclosestp, curindex, fromIntegral newclosesttraveld / fromIntegral totald), curindex+1)++  (_,r,_) = L.foldl foldlfn (maxBound :: Int, (0,0,0), 0) larlist
+ src/Potato/Flow/Methods/LineTypes.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Methods.LineTypes where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.SElts+++import Data.Default++import Linear.Vector ((^*))+import Linear.Matrix (M22, (!*))+import Data.Ratio++import Control.Exception (assert)+++data CartDir = CD_Up | CD_Down | CD_Left | CD_Right deriving (Eq, Generic, Show)+instance NFData CartDir+++data AnchorType = AT_End_Up | AT_End_Down | AT_End_Left | AT_End_Right | AT_Elbow_TL | AT_Elbow_TR | AT_Elbow_BR | AT_Elbow_BL | AT_Elbow_Invalid deriving (Eq, Show)++flipCartDir :: CartDir -> CartDir+flipCartDir = \case+  CD_Up -> CD_Down+  CD_Down -> CD_Up+  CD_Left -> CD_Right+  CD_Right -> CD_Left++cartDirToUnit :: CartDir -> XY+cartDirToUnit = \case+  CD_Up -> V2 0 (-1)+  CD_Down -> V2 0 1+  CD_Left -> V2 (-1) 0+  CD_Right -> V2 1 0++cartDirToAnchor :: CartDir -> Maybe CartDir -> AnchorType+cartDirToAnchor start mnext = case mnext of+  Nothing -> case start of+    CD_Up -> AT_End_Up+    CD_Down -> AT_End_Down+    CD_Left -> AT_End_Left+    CD_Right -> AT_End_Right+  Just next -> case start of+    CD_Up -> case next of+      CD_Left -> AT_Elbow_TR+      CD_Right -> AT_Elbow_TL+      _ -> AT_Elbow_Invalid+    CD_Down -> case next of+      CD_Left -> AT_Elbow_BR+      CD_Right -> AT_Elbow_BL+      _ -> AT_Elbow_Invalid+    CD_Left -> case next of+      CD_Up -> AT_Elbow_BL+      CD_Down -> AT_Elbow_TL+      _ -> AT_Elbow_Invalid+    CD_Right -> case next of+      CD_Up -> AT_Elbow_BR+      CD_Down -> AT_Elbow_TR+      _ -> AT_Elbow_Invalid++cartDirWithDistanceToV2 :: (CartDir, Int, Bool) -> V2 Int+cartDirWithDistanceToV2 (cd, d, _) = cartDirToUnit cd ^* d+++data LineAnchorsForRender = LineAnchorsForRender {+  _lineAnchorsForRender_start :: XY+  -- `Bool` parameter is whether we are at the start of a subsegment (i.e. a midpoint or endpoint)+  , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]+} deriving (Show, Generic, Eq)++instance NFData LineAnchorsForRender+++instance TransformMe LineAnchorsForRender where+  transformMe_rotateLeft LineAnchorsForRender {..} = LineAnchorsForRender {+      _lineAnchorsForRender_start = transformMe_rotateLeft _lineAnchorsForRender_start+      ,_lineAnchorsForRender_rest = fmap (\(cd,d,s) -> (transformMe_rotateLeft cd, d, s)) _lineAnchorsForRender_rest+    }+  transformMe_rotateRight LineAnchorsForRender {..} = LineAnchorsForRender {+      _lineAnchorsForRender_start = transformMe_rotateRight _lineAnchorsForRender_start+      ,_lineAnchorsForRender_rest = fmap (\(cd,d,s) -> (transformMe_rotateRight cd, d, s)) _lineAnchorsForRender_rest+    }+  transformMe_reflectHorizontally LineAnchorsForRender {..} = LineAnchorsForRender {+      _lineAnchorsForRender_start = transformMe_reflectHorizontally _lineAnchorsForRender_start+      ,_lineAnchorsForRender_rest = fmap (\(cd,d,s) -> (transformMe_reflectHorizontally cd, d, s)) _lineAnchorsForRender_rest+    }+++-- NOTE our coordinate system is LEFT HANDED+--  --> +x+-- |+-- v+-- +y+matrix_cw_90 :: M22 Int+matrix_cw_90 = V2 (V2 0 (-1)) (V2 1 0)+matrix_ccw_90 :: M22 Int+matrix_ccw_90 = V2 (V2 0 1) (V2 (-1) 0)++-- TODO rename me so it include reflection+-- TODO rename so it's lower case+class TransformMe a where+  -- CCW+  transformMe_rotateLeft :: a -> a+  transformMe_rotateLeft = transformMe_rotateRight . transformMe_rotateRight . transformMe_rotateRight+  -- CW+  transformMe_rotateRight :: a -> a+  transformMe_rotateRight = transformMe_rotateLeft . transformMe_rotateLeft . transformMe_rotateLeft++  transformMe_reflectHorizontally :: a -> a+  transformMe_reflectHorizontally = transformMe_rotateLeft . transformMe_rotateLeft . transformMe_reflectVertically++  transformMe_reflectVertically :: a -> a+  transformMe_reflectVertically = transformMe_rotateLeft . transformMe_rotateLeft . transformMe_reflectHorizontally++instance TransformMe AttachmentLocation where+  transformMe_rotateLeft = \case+    AL_Top -> AL_Left+    AL_Bot -> AL_Right+    AL_Left -> AL_Bot+    AL_Right -> AL_Top+    AL_Any -> AL_Any+  transformMe_rotateRight = \case+    AL_Top -> AL_Right+    AL_Bot -> AL_Left+    AL_Left -> AL_Top+    AL_Right -> AL_Bot+    AL_Any -> AL_Any+  transformMe_reflectHorizontally = \case+    AL_Left -> AL_Right+    AL_Right -> AL_Left+    x -> x+++instance TransformMe CartDir where+  transformMe_rotateLeft = \case+    CD_Up -> CD_Left+    CD_Down -> CD_Right+    CD_Left -> CD_Down+    CD_Right -> CD_Up+  transformMe_rotateRight = \case+    CD_Up -> CD_Right+    CD_Down -> CD_Left+    CD_Left -> CD_Up+    CD_Right -> CD_Down+  transformMe_reflectHorizontally = \case+    CD_Right -> CD_Left+    CD_Left -> CD_Right+    x -> x++instance TransformMe AnchorType where+  transformMe_rotateLeft = \case+    AT_End_Up -> AT_End_Left+    AT_End_Down -> AT_End_Right+    AT_End_Left -> AT_End_Down+    AT_End_Right -> AT_End_Up+    AT_Elbow_TL -> AT_Elbow_BL+    AT_Elbow_TR -> AT_Elbow_TL+    AT_Elbow_BR -> AT_Elbow_TR+    AT_Elbow_BL -> AT_Elbow_BR+    AT_Elbow_Invalid -> AT_Elbow_Invalid+  transformMe_rotateRight = \case+    AT_End_Up -> AT_End_Right+    AT_End_Down -> AT_End_Left+    AT_End_Left -> AT_End_Up+    AT_End_Right -> AT_End_Down+    AT_Elbow_TL -> AT_Elbow_TR+    AT_Elbow_TR -> AT_Elbow_BR+    AT_Elbow_BR -> AT_Elbow_BL+    AT_Elbow_BL -> AT_Elbow_TL+    AT_Elbow_Invalid -> AT_Elbow_Invalid+  transformMe_reflectHorizontally = \case+    AT_End_Left -> AT_End_Right+    AT_End_Right -> AT_End_Left+    AT_Elbow_TL -> AT_Elbow_TR+    AT_Elbow_TR -> AT_Elbow_TL+    AT_Elbow_BR -> AT_Elbow_BL+    AT_Elbow_BL -> AT_Elbow_BR+    AT_Elbow_Invalid -> AT_Elbow_Invalid++instance TransformMe XY where+  transformMe_rotateLeft p = (!*) matrix_ccw_90 p - (V2 0 1)+  transformMe_rotateRight p = (!*) matrix_cw_90 p - (V2 1 0)+  transformMe_reflectHorizontally (V2 x y) = V2 (-(x+1)) y++instance (TransformMe a, TransformMe b) => TransformMe (a,b) where+  transformMe_rotateLeft (a,b) = (transformMe_rotateLeft a, transformMe_rotateLeft b)+  transformMe_rotateRight (a,b) = (transformMe_rotateRight a, transformMe_rotateRight b)+  transformMe_reflectHorizontally (a,b) = (transformMe_reflectHorizontally a, transformMe_reflectHorizontally b)++instance (TransformMe a, TransformMe b, TransformMe c) => TransformMe (a,b,c) where+  transformMe_rotateLeft (a,b,c) = (transformMe_rotateLeft a, transformMe_rotateLeft b, transformMe_rotateLeft c)+  transformMe_rotateRight (a,b,c) = (transformMe_rotateRight a, transformMe_rotateRight b, transformMe_rotateRight c)+  transformMe_reflectHorizontally (a,b,c) = (transformMe_reflectHorizontally a, transformMe_reflectHorizontally b, transformMe_reflectHorizontally c)+++-- NOTE assumes LBox is Canonical+instance TransformMe LBox where+  transformMe_rotateLeft lbox@(LBox tl (V2 w h)) = assert (lBox_isCanonicalLBox lbox) r where+    V2 blx bly = (!*) matrix_ccw_90 tl+    r = LBox (V2 blx (bly - w)) (V2 h w)+  transformMe_rotateRight lbox@(LBox tl (V2 w h)) = assert (lBox_isCanonicalLBox lbox) r where+    V2 trx try = (!*) matrix_cw_90 tl+    r = LBox (V2 (trx-h) try) (V2 h w)+  transformMe_reflectHorizontally lbox@(LBox (V2 x y) (V2 w h)) = assert (lBox_isCanonicalLBox lbox) r where+    r = LBox (V2 (-(x+w)) y) (V2 w h)++++-- very specific to the way AttachmentOffsetRatio is associated with a certain side of a box+instance TransformMe AttachmentOffsetRatio where+  transformMe_rotateLeft = id+  transformMe_rotateRight = id+  transformMe_reflectHorizontally r = (d-n) % d where+    n = numerator r+    d = denominator r+++-- TODO UTs for CartRotationReflection stuff+-- apply rotation first, then apply reflections+data CartRotationReflection = CartRotationReflection {+  _cartRotationReflection_rotateLeftTimes :: Int -- number of times we rotated left+  , _cartRotationReflection_reflectVertical :: Bool -- did we reflect accross vertical axis+}++instance TransformMe CartRotationReflection where+  transformMe_rotateLeft x@CartRotationReflection {..} = if _cartRotationReflection_reflectVertical+    then x { _cartRotationReflection_rotateLeftTimes = (_cartRotationReflection_rotateLeftTimes + 3) `mod` 4 }+    else x { _cartRotationReflection_rotateLeftTimes = (_cartRotationReflection_rotateLeftTimes + 1) `mod` 4 }+  transformMe_reflectHorizontally x@CartRotationReflection {..} = x { _cartRotationReflection_reflectVertical = not _cartRotationReflection_reflectVertical }++cartRotationReflection_identity :: CartRotationReflection+cartRotationReflection_identity = CartRotationReflection {+    _cartRotationReflection_rotateLeftTimes = 0+    , _cartRotationReflection_reflectVertical = False+  }+cartRotationReflection_invert :: CartRotationReflection -> CartRotationReflection+cartRotationReflection_invert x@CartRotationReflection {..} = if _cartRotationReflection_reflectVertical+  then x+  else x { _cartRotationReflection_rotateLeftTimes = (_cartRotationReflection_rotateLeftTimes + 3) `mod` 4 }++cartRotationReflection_invert_apply :: (TransformMe a) => CartRotationReflection -> a -> a+cartRotationReflection_invert_apply crr a = cartRotationReflection_apply (cartRotationReflection_invert crr) a++-- | Apply a function @n@ times to a given value.+nTimes :: Int -> (a -> a) -> (a -> a)+nTimes 0 _ = id+nTimes 1 f = f+nTimes n f = f . nTimes (n-1) f++cartRotationReflection_apply :: (TransformMe a) => CartRotationReflection -> a -> a+cartRotationReflection_apply CartRotationReflection {..} a = r where+  nrl = _cartRotationReflection_rotateLeftTimes `mod` 4+  r' = nTimes nrl transformMe_rotateLeft a+  r = if _cartRotationReflection_reflectVertical then transformMe_reflectVertically a else a
+ src/Potato/Flow/Methods/TextCommon.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Methods.TextCommon (+  displayLinesToChar+) where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.SElts+++import qualified Data.Map as Map+import qualified Data.Text                      as T+import qualified Potato.Data.Text.Zipper        as TZ+++++concatSpans :: [TZ.Span a] -> Text+concatSpans spans = mconcat $ fmap (\(TZ.Span _ t) -> t) spans++subWidth :: Text -> [Maybe Char]+subWidth t = join . fmap fn . T.unpack $ t where+  fn c = case TZ.charWidth c of+    1 -> [Just c]+    2 -> [Just c, Nothing]+    n -> trace ("unexpected char " <> [c] <> " of width " <> show n) [Nothing]+++displayLinesToChar ::+  (Int, Int) -- ^ the upper left corner of the box containing the text we want to render+  -> TZ.DisplayLines Int -- ^ pre-generated displaylines+  -> (Int, Int) -- ^ the point we want to render+  -> (Int, Int) -- ^ how much text is offest by+  -> Maybe MPChar+displayLinesToChar (x, y) dl (x',y') (xoff, yoff) = outputChar where+  spans = TZ._displayLines_spans dl+  offsetMap = TZ._displayLines_offsetMap dl+  yidx = y' - y - yoff+  xalignoffset = case Map.lookup yidx offsetMap of+    Nothing -> error $ "should not happen. got " <> show yidx <> " in\n" <> show dl <> "\n" <> show spans+    Just (offset,_) -> offset+  outputChar = case spans !!? yidx of+    Nothing -> Nothing+    Just row -> outputChar' where+      rowText = subWidth $ concatSpans row+      xidx = x' - x - xoff - xalignoffset+      outputChar' = case rowText !!? xidx of+        Nothing   -> Nothing+        Just cell -> Just cell
+ src/Potato/Flow/Methods/Types.hs view
@@ -0,0 +1,87 @@++-- TODO DEPRECATE this file++{-# LANGUAGE RecordWildCards #-}++-- TODO rename to common+module Potato.Flow.Methods.Types where+++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.Owl+import           Potato.Flow.SElts++import qualified Data.Text         as T+++-- TODO get rid of (HasOwlTree a) arg, this can be passed in at the getDrawer level instead!+type SEltDrawerRenderFn = forall a. (HasOwlTree a) => a -> XY -> Maybe PChar+-- returns minimal bounding LBox. Does NOT include expanded box due to wide chars+type SEltDrawerBoxFn = forall a. (HasOwlTree a) => a -> LBox+++makePotatoRenderer :: LBox -> SEltDrawerRenderFn+makePotatoRenderer lbox _ pt = if does_lBox_contains_XY lbox pt+  then Just '#'+  else Nothing+++data SEltDrawer = SEltDrawer {++  -- TODO renameto boxFn+  _sEltDrawer_box        :: SEltDrawerBoxFn++  , _sEltDrawer_renderFn :: SEltDrawerRenderFn++  , _sEltDrawer_maxCharWidth :: Int++  --, _sEltDrawer_renderToBoxFn :: LBox -> Vector PChar -- consider this version for better performance+}++nilDrawer :: SEltDrawer+nilDrawer = SEltDrawer {+    -- maybe retun type of _sEltDrawer_box should be Maybe LBox?+    _sEltDrawer_box = const nilLBox+    , _sEltDrawer_renderFn = \_ _ -> Nothing+    , _sEltDrawer_maxCharWidth = 1+  }++sEltDrawer_renderToLines :: (HasOwlTree a) => SEltDrawer -> a -> [Text]+sEltDrawer_renderToLines SEltDrawer {..} ot = r where+  LBox (V2 sx sy) (V2 w h) = _sEltDrawer_box ot+  pts = [[(x,y) | x <- [0..w-1]]| y <- [0..h-1]]+  r' = fmap (fmap (\(x,y) -> fromMaybe ' ' (_sEltDrawer_renderFn ot (V2 (sx+x) (sy+y))))) pts+  r = fmap T.pack r'++++{-+TODO something like this+data CachedAreaDrawer = CachedAreaDrawer {+  _cachedAreaDrawer_box :: LBox+  , _cachedAreaDrawer_cache :: V.Vector (Maybe PChar) -- ^ row major+}-}++++-- TODO DEPRECATE doesn't account for attached stuff+-- TODO rename to getSEltBoundingBox or something+-- | gets an 'LBox' that contains the entire RElt+getSEltBox_naive :: SElt -> Maybe LBox+getSEltBox_naive selt = case selt of+  SEltNone        -> Nothing+  SEltFolderStart -> Nothing+  SEltFolderEnd   -> Nothing+  SEltBox x       -> Just $ canonicalLBox_from_lBox_ $ _sBox_box x++  -- UNTESTED+  SEltLine x      -> Just r where+    midpoints = fmap (\(SAutoLineConstraintFixed c) -> c) (_sAutoLine_midpoints x)+    r = make_lBox_from_XYlist $ (_sAutoLine_start x) : (_sAutoLine_end x) : (_sAutoLine_start x + 1) : (_sAutoLine_end x + 1) : midpoints++  SEltTextArea x      -> Just $ canonicalLBox_from_lBox_ $ _sTextArea_box x++getSEltLabelBox :: SEltLabel -> Maybe LBox+getSEltLabelBox (SEltLabel _ x) = getSEltBox_naive x
+ src/Potato/Flow/Owl.hs view
@@ -0,0 +1,1129 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Owl where++import Relude+import qualified Relude.Unsafe as Unsafe++import Control.Exception (assert)+import Data.Foldable (foldl)+import qualified Data.IntMap as IM+import qualified Data.List as L+import Data.Maybe (fromJust)+import Data.Sequence ((><), (|>), (<|))+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.IntSet as IS+import qualified Data.Text as T+import Potato.Flow.OwlItem+import Potato.Flow.SElts+import Potato.Flow.Types+import Potato.Flow.DebugHelpers++errorMsg_owlTree_lookupFail :: OwlTree -> REltId -> Text+errorMsg_owlTree_lookupFail OwlTree {..} rid = errorMsg_owlMapping_lookupFail _owlTree_mapping rid++errorMsg_owlMapping_lookupFail :: OwlMapping -> REltId -> Text+errorMsg_owlMapping_lookupFail _ rid = "expected to find REltId " <> show rid <> " in OwlMapping"++type OwlMapping = REltIdMap (OwlItemMeta, OwlItem)++-- | update attachments based on remap+owlItem_updateAttachments :: Bool -> REltIdMap REltId -> OwlItem -> OwlItem+owlItem_updateAttachments breakNonExistng ridremap oitem = case oitem of+  OwlItem oinfo (OwlSubItemLine sline) -> OwlItem oinfo $ OwlSubItemLine (sline {+      _sAutoLine_attachStart = remapAttachment $ _sAutoLine_attachStart sline+      , _sAutoLine_attachEnd = remapAttachment $ _sAutoLine_attachEnd sline+    })+    where+      remapAttachment ma = case ma of+        Nothing -> Nothing+        Just a -> case IM.lookup (_attachment_target a) ridremap of+          -- could not find attachment, break it+          Nothing -> if breakNonExistng then Nothing else Just a+          Just t -> Just $ a { _attachment_target = t }+  x -> 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 _ s sp = case sp of+  0 -> Nothing+  x -> case Seq.lookup (x - 1) s of+    Nothing -> error $ "expected to find index " <> show (x - 1) <> " in seq"+    Just r -> Just r++ +-- TODO+--isAncestorOf++isDescendentOf :: (HasCallStack) => OwlMapping -> REltId -> REltId -> Bool+isDescendentOf om parent child+  | child == noOwl = False+  | otherwise = r+  where+    parent' = case IM.lookup child om of+      Just (oem, _) -> _owlItemMeta_parent oem+      Nothing -> error $ errorMsg_owlMapping_lookupFail om child+    r = case parent' of+      x | x == noOwl -> False+      x | x == parent -> True+      x -> isDescendentOf om parent x++data OwlItemMeta = OwlItemMeta+  { _owlItemMeta_parent :: REltId+    , _owlItemMeta_depth :: Int+    , _owlItemMeta_position :: SiblingPosition+  }+  deriving (Eq, Show, Generic)++instance NFData OwlItemMeta++instance PotatoShow OwlItemMeta where+  potatoShow OwlItemMeta {..} = "(meta: " <> show _owlItemMeta_parent <> " " <> show _owlItemMeta_depth <> " " <> show _owlItemMeta_position <> ")"++-- 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_parent :: REltId,+    _owlSpot_leftSibling :: Maybe REltId+  }+  deriving (Show, Generic)++instance NFData OwlSpot++topSpot :: OwlSpot+topSpot = OwlSpot noOwl Nothing++-- TODO try and get rid of deriving Eq+data SuperOwl = SuperOwl+  { _superOwl_id :: REltId,+    _superOwl_meta :: OwlItemMeta,+    _superOwl_elt :: OwlItem+  }+  deriving (Eq, Show, 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 sowl = mommyOwl_kiddos (_superOwl_elt sowl)++instance HasOwlItem SuperOwl where+  hasOwlItem_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' filterfn sowls am = r where+  foldrfn sowl m = newmap where+    --find all targets we are attached to+    attachedstuff = filter filterfn (hasOwlItem_attachments sowl)+    alterfn stuff ms = Just $ case ms of+      Nothing -> (IS.singleton stuff)+      Just s -> IS.insert stuff s+    innerfoldrfn target m' = IM.alter (alterfn (_superOwl_id sowl)) target m'+    newmap = foldr innerfoldrfn m (fmap _attachment_target attachedstuff)+  r = foldr foldrfn am sowls++attachmentMap_addSuperOwls :: (Foldable f) => f SuperOwl -> AttachmentMap -> AttachmentMap+attachmentMap_addSuperOwls = attachmentMap_addSuperOwls' (const 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 changes am = 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 = 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 = IM.keysSet changes+  newam_2 = IM.filter (not . IS.null) $ fmap (\s -> IS.difference s setToRemove) newam_1++  -- add attachment targets of changed elems to value sets of those targets+  justChanges = catMaybes . IM.elems $ changes+  newam_3 = attachmentMap_addSuperOwls justChanges 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 = newam_3++-- | update SuperOwlChanges to include stuff attached to stuff that changed (call before rendering)+getChangesFromAttachmentMap :: OwlTree -> AttachmentMap -> SuperOwlChanges -> SuperOwlChanges+getChangesFromAttachmentMap owltreeafterchanges@OwlTree {..} am changes = r where+  -- collect all stuff attaching to changed stuff+  changeset = IS.unions . catMaybes $ foldr (\k acc -> IM.lookup k am : acc) [] (IM.keys 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 = IM.fromList . filter (\(_,x) -> isJust x) . fmap (\rid -> (rid, owlTree_findSuperOwl owltreeafterchanges rid)) .  IS.toList $ changeset++instance PotatoShow SuperOwl where+  potatoShow SuperOwl {..} = show _superOwl_id <> " " <> potatoShow _superOwl_meta <> " " <> elt+    where+      elt = potatoShow _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 f sowl = fmap (\rid -> sowl {_superOwl_id = rid}) (f (_superOwl_id sowl))++-- TODO rest of lenses++superOwl_isTopOwl :: SuperOwl -> Bool+superOwl_isTopOwl SuperOwl {..} = _owlItemMeta_depth _superOwl_meta == 0++-- | same as superOwl_isTopOwl except checks all conditions, intended to be used in asserts+superOwl_isTopOwlSurely :: SuperOwl -> Bool+superOwl_isTopOwlSurely SuperOwl {..} = _owlItemMeta_depth _superOwl_meta == 0 && _owlItemMeta_parent _superOwl_meta == noOwl++noOwl :: REltId+noOwl = -1++superOwl_parentId :: SuperOwl -> REltId+superOwl_parentId SuperOwl {..} = _owlItemMeta_parent _superOwl_meta++superOwl_depth :: SuperOwl -> Int+superOwl_depth SuperOwl {..} = _owlItemMeta_depth _superOwl_meta++superOwl_owlSubItem :: SuperOwl -> OwlSubItem+superOwl_owlSubItem sowl = case _superOwl_elt sowl of+  OwlItem _ x -> x+++owlTree_superOwlNthParentId :: OwlTree -> SuperOwl -> Int -> REltId+owlTree_superOwlNthParentId _ sowl 0 = _superOwl_id sowl+owlTree_superOwlNthParentId od sowl n+  | superOwl_parentId sowl == noOwl = noOwl+  | otherwise = owlTree_superOwlNthParentId od (owlTree_mustFindSuperOwl od (superOwl_parentId sowl)) (n-1)++-- if parent is selected, then kiddos must not be directly included in the parliament+newtype OwlParliament = OwlParliament {unOwlParliament :: Seq REltId} deriving (Show, 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 {unSuperOwlParliament :: Seq SuperOwl} deriving (Eq, Show, Generic)++instance NFData SuperOwlParliament++instance PotatoShow SuperOwlParliament where+  potatoShow (SuperOwlParliament sowls) = T.intercalate "\n" . toList $ fmap potatoShow 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 a b = L.union a b L.\\ L.intersect a b++instance IsParliament OwlParliament where+  isParliament_disjointUnion (OwlParliament s1) (OwlParliament s2) = OwlParliament $ Seq.fromList $ disjointUnion (toList s1) (toList s2)+  isParliament_null = Seq.null . unOwlParliament+  isParliament_empty = OwlParliament Seq.empty+  isParliament_length (OwlParliament x) = Seq.length x+++instance IsParliament SuperOwlParliament where+  isParliament_disjointUnion (SuperOwlParliament s1) (SuperOwlParliament s2) = SuperOwlParliament $ Seq.fromList $ disjointUnion (toList s1) (toList s2)+  isParliament_null = Seq.null . unSuperOwlParliament+  isParliament_empty = SuperOwlParliament Seq.empty+  isParliament_length (SuperOwlParliament x) = Seq.length x++owlParliament_toSuperOwlParliament :: OwlTree -> OwlParliament -> SuperOwlParliament+owlParliament_toSuperOwlParliament od@OwlTree {..} op = SuperOwlParliament $ fmap f (unOwlParliament op)+  where+    f rid = case IM.lookup rid _owlTree_mapping of+      Nothing -> error $ errorMsg_owlTree_lookupFail od rid+      Just (oem, oe) -> SuperOwl rid oem oe++superOwlParliament_toOwlParliament :: SuperOwlParliament -> OwlParliament+superOwlParliament_toOwlParliament = OwlParliament . fmap _superOwl_id . unSuperOwlParliament+++-- | partition a list into groups based on int pairings+partitionN :: (a -> Int) -> Seq a -> IM.IntMap (Seq a)+partitionN f as = r where+  alterfn x ml = case ml of+    Nothing -> Just (Seq.singleton x)+    Just xs -> Just (x<|xs)+  foldfn a acc = IM.alter (alterfn a) (f a) acc+  r = foldr foldfn IM.empty 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 od sowls = r where++  -- attach parents (at front of list, last elt is child and actuall part of original selection)+  makeParentChain :: SuperOwl -> [SuperOwl]+  makeParentChain sowl = done where+    makeParentChain' sowl' acc = case superOwl_parentId sowl' of+      x | x == noOwl -> acc+      x -> makeParentChain' parentsowl (parentsowl:acc) where+        parentsowl = owlTree_mustFindSuperOwl od x+    done = makeParentChain' sowl (sowl:[])++  parentChains = fmap makeParentChain sowls++  -- this function is sketch af D:+  sortrec :: Seq [SuperOwl] -> Seq SuperOwl+  sortrec chains = done where+    frontid (x:_) = _superOwl_id x+    frontid _ = error "should never happen"++    groupedParentChains = partitionN frontid chains++    removeFront (_:xs) = xs+    removeFront [] = error "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 = fmap (\(rid,x) -> (owlTree_mustFindSuperOwl od rid, x)) . Seq.fromList . IM.toList $ groupedParentChains+    cfn = _owlItemMeta_position . _superOwl_meta . fst+    sortedPairs = Seq.sortOn cfn $ groupedParentChains2++    -- sketchy logic here reliant on assumptions carried over from previous iteration... TODO rewrite this so it's not so weird+    fmapfn (_, chains') = if Seq.length chains' == 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 join $ fmap (Seq.singleton . Unsafe.last) 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 sortrec (fmap removeFront chains')+++    done = join . fmap fmapfn  $ sortedPairs++  r = SuperOwlParliament $ sortrec parentChains++-- TODO test+-- assumes s1 is and s2 are valid+superOwlParliament_disjointUnionAndCorrect :: OwlTree -> SuperOwlParliament -> SuperOwlParliament -> SuperOwlParliament+superOwlParliament_disjointUnionAndCorrect od (SuperOwlParliament s1) (SuperOwlParliament s2) = r where++  -- first convert s1 into a map+  mapsop0 :: IM.IntMap SuperOwl+  mapsop0 = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, sowl)) $ s1++  addToSelection :: SuperOwl -> IM.IntMap SuperOwl -> IM.IntMap SuperOwl+  addToSelection sowl mapsop = rslt where+    rid = _superOwl_id sowl++    -- add self to map+    rslt' = IM.insert rid sowl mapsop++    -- check if any children are selected and remove them from selection+    children = owliteratechildrenat od rid+    rslt = foldr (\x acc -> IM.delete (_superOwl_id x) acc) rslt' 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 sowl mapsop = rslt where+    prid = superOwl_parentId sowl+    -- the parent is guaranteed to exist because we only call this on elements who inheritSelected+    mommy = owlTree_mustFindSuperOwl od prid+    newkiddos = Seq.deleteAt (_owlItemMeta_position . _superOwl_meta $ sowl) (fromJust $ mommyOwl_kiddos mommy)+    -- add siblings to selection (guaranteed that none of their children are selected by assumption)+    mapsop' = foldr (\rid acc -> IM.insert rid (owlTree_mustFindSuperOwl od rid) acc) mapsop newkiddos+    rslt = if IM.member prid mapsop'+      -- we've reached the selected parent, deselect it and return our new selection+      then IM.delete prid mapsop'+      -- recursively deselect the parent+      else removeFromInheritSelection (owlTree_mustFindSuperOwl od prid) mapsop'++  isDescendentOfOwlMap :: REltId -> IM.IntMap SuperOwl -> Bool+  isDescendentOfOwlMap rid mapsop = if IM.member rid mapsop+    then True+    else case owlTree_findSuperOwl od rid of+      Nothing -> False+      Just x -> isDescendentOfOwlMap (superOwl_parentId x) mapsop++  foldfn sowl acc = if IM.member rid acc+    -- we are selected, remove self from selection+    then IM.delete rid acc+    -- we are not selected+    else if isDescendentOfOwlMap rid acc+      -- parent selected+      then removeFromInheritSelection sowl acc+      -- parent not selected, add self to selection+      else addToSelection sowl acc+    where+      rid = _superOwl_id sowl++  mapsop1 = foldr foldfn mapsop0 s2+  unsortedSeq = Seq.fromList (IM.elems mapsop1)++  r = makeSortedSuperOwlParliament od unsortedSeq++superOwlParliament_isValid :: OwlTree -> SuperOwlParliament -> Bool+superOwlParliament_isValid od sop@(SuperOwlParliament owls) = r+  where+    om = _owlTree_mapping od++    -- check if a mommy owl is selected, that no descendant of that mommy owl is selected+    kiddosFirst = Seq.sortBy (\a b -> flip compare (_owlItemMeta_depth (_superOwl_meta a)) (_owlItemMeta_depth (_superOwl_meta b))) owls+    acc0 = (Set.empty, Set.fromList . toList . fmap _superOwl_id $ owls, True)+    foldlfn (visited, mommies', passing) sowl = (nextVisited, mommies, passMommyCheck && 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.delete (_superOwl_id sowl) mommies'++        checkMommyRec rid toVisit = case rid of+          -- made it to the top+          x | x == noOwl -> (toVisit, True)+          _ -> case Set.member rid visited of+            -- we've been here before, must be OK+            True -> (toVisit, True)+            False -> case Set.member rid mommies of+              -- one of our mommies, not OK+              True -> (toVisit, False)+              False -> case IM.lookup rid om of+                Nothing -> error $ errorMsg_owlMapping_lookupFail om rid+                -- add self to list of mommies to visit and recurse+                Just (oem, _) -> checkMommyRec (_owlItemMeta_parent oem) (Set.insert rid toVisit)+        (visitedMommies, passMommyCheck) = checkMommyRec (_owlItemMeta_parent (_superOwl_meta sowl)) Set.empty+        nextVisited =+          if passMommyCheck+            then Set.union visited visitedMommies+            else visited++    (_, _, r1) = foldl foldlfn acc0 kiddosFirst++    -- check that parliament is in fact ordered correctly (inefficiently 😭)+    r2 = makeSortedSuperOwlParliament od owls == sop++    r = r1 && r2++superOwlParliament_toSEltTree :: OwlTree -> SuperOwlParliament -> SEltTree+superOwlParliament_toSEltTree od@OwlTree {..} (SuperOwlParliament sowls) = toList $ join r+  where+    makeSElt :: REltId -> SuperOwl -> (REltId, Seq (REltId, SEltLabel))+    makeSElt maxid sowl = case _superOwl_elt sowl of+      OwlItem oinfo (OwlSubItemFolder kiddos) -> (newmaxid,+          Seq.singleton (_superOwl_id sowl, SEltLabel (_owlInfo_name oinfo) SEltFolderStart)+            >< (join childSElts)+            >< Seq.singleton (maxid + 1, SEltLabel (_owlInfo_name oinfo <> "(end)") SEltFolderEnd)+        )+        where+          kiddoS = (unSuperOwlParliament . owlParliament_toSuperOwlParliament od . OwlParliament $ kiddos)+          (newmaxid, childSElts) = mapAccumL makeSElt (maxid + 1) kiddoS+      _ -> (maxid, Seq.singleton $ (_superOwl_id sowl, hasOwlItem_toSEltLabel_hack (_superOwl_elt sowl)))+    (_, r) = mapAccumL makeSElt (owlTree_maxId od) sowls+++newtype CanvasSelection = CanvasSelection { unCanvasSelection :: Seq SuperOwl } deriving (Show, 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 od@OwlTree {..} filterfn (SuperOwlParliament sowls) = r where+  filtered = Seq.filter filterfn sowls+  sopify children = owlParliament_toSuperOwlParliament od (OwlParliament children)+  -- if folder then recursively include children otherwise include self+  mapfn sowl = case _superOwl_elt sowl of+    OwlItem _ (OwlSubItemFolder kiddos) -> unCanvasSelection $ superOwlParliament_convertToCanvasSelection od filterfn (sopify kiddos)+    _ -> Seq.singleton sowl+  r = CanvasSelection . join . fmap mapfn $ filtered++-- converts a SuperOwlParliament to its ordered Seq of SuperOwls including its children+superOwlParliament_convertToSeqWithChildren :: OwlTree -> SuperOwlParliament -> Seq SuperOwl+superOwlParliament_convertToSeqWithChildren od@OwlTree {..} (SuperOwlParliament sowls) = r where+  sopify children = owlParliament_toSuperOwlParliament od (OwlParliament children)+  -- if folder then recursively include children otherwise include self+  mapfn sowl = case _superOwl_elt sowl of+    OwlItem _ (OwlSubItemFolder kiddos) -> sowl <| (superOwlParliament_convertToSeqWithChildren od (sopify kiddos))+    _ -> Seq.singleton sowl+  r = join . fmap mapfn $ 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 od@OwlTree {..} op@(OwlParliament owls) = assert valid r where+  valid = superOwlParliament_isValid od $ owlParliament_toSuperOwlParliament od op++  addOwl :: REltId -> REltId -> Seq REltId -> (OwlMapping, IM.IntMap REltId, REltId, SiblingPosition) -> (OwlMapping, IM.IntMap REltId, REltId)+  addOwl newprid rid newchildrids (om, ridremap, nrid, pos) = (newom, newridremap, nrid+1) where+    sowl = owlTree_mustFindSuperOwl od rid+    newoem = OwlItemMeta {+        _owlItemMeta_parent = newprid+        , _owlItemMeta_depth = 0+        , _owlItemMeta_position = pos -- relies on OwlParliament being correctly ordered+      }+    newoe = case _superOwl_elt sowl of+      OwlItem oinfo (OwlSubItemFolder _) -> OwlItem oinfo (OwlSubItemFolder newchildrids)+      x -> x+    newom = IM.insert nrid (newoem, newoe) om+    newridremap = IM.insert rid nrid 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 depth prid rid (om, ridremap, nrid, pos) = rslt where++    newprid = if prid == noOwl then noOwl else ridremap IM.! prid++    -- add self (note that nrid is the new rid of the owl we just added)+    (newom', newridremap', newnrid') = addOwl newprid rid (newchildrids) (om, ridremap, nrid, pos)++    children = fromMaybe Seq.empty $ mommyOwl_kiddos $ owlTree_mustFindSuperOwl od rid++    -- recursively add children+    ((newom, newridremap, newnrid, _), newchildrids) = mapAccumL (\acc crid -> addOwlRecursive (depth+1) rid crid acc) (newom', newridremap', newnrid', 0) children++    rslt = ((newom, newridremap, newnrid, pos+1), nrid)+++  -- recursively add all children to owltree and reindex+  ((om1, _, _, _), newtopowls) = mapAccumL (\acc rid -> addOwlRecursive 0 noOwl rid acc) (IM.empty, IM.empty, owlTree_maxId od + 1, 0) owls++  r = OwlTree {+      _owlTree_mapping = om1+      , _owlTree_topOwls = newtopowls+    }+++type OwlParliamentSet = IS.IntSet++superOwlParliament_toOwlParliamentSet :: SuperOwlParliament -> OwlParliamentSet+superOwlParliament_toOwlParliamentSet (SuperOwlParliament sowls) = IS.fromList . toList . fmap _superOwl_id $ sowls++owlParliamentSet_member :: REltId -> OwlParliamentSet -> Bool+owlParliamentSet_member = 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 ot rid sset = if owlParliamentSet_member rid sset+  then True+  else case owlTree_findSuperOwl ot rid of+    Nothing -> False+    Just x -> owlParliamentSet_descendent ot (superOwl_parentId x) sset++-- UNTESTED+owlParliamentSet_findParents :: OwlTree -> OwlParliamentSet -> OwlParliamentSet+owlParliamentSet_findParents od ops = r where+  foldrfn rid acc = case owlTree_findSuperOwl od rid of+    Nothing -> acc+    Just sowl -> let+        prid = _owlItemMeta_parent (_superOwl_meta sowl)+      in if prid == noOwl+        then acc+        else IS.insert prid acc+  parents = IS.foldr foldrfn IS.empty ops+  superparents = if IS.null parents then IS.empty else owlParliamentSet_findParents od parents+  r = IS.union parents superparents+++++-- |+data OwlTree = OwlTree+  { _owlTree_mapping :: OwlMapping,+    _owlTree_topOwls :: Seq REltId+  }+  deriving (Show, Eq, Generic)++instance NFData OwlTree++instance MommyOwl OwlTree where+  mommyOwl_kiddos o = Just $ _owlTree_topOwls 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 ota otb = r+  where+    mustFind rid ot = case IM.lookup rid (_owlTree_mapping ot) of+      Nothing -> error $ errorMsg_owlTree_lookupFail ot rid+      Just x -> x++    kiddos_equivalent kiddosa kiddosb =+      Seq.length kiddosa == Seq.length kiddosb+        && all id (Seq.zipWith (owl_equivalent') kiddosa kiddosb)++    owl_equivalent' rida ridb = owl_equivalent a' b'+      where+        (_, a') = mustFind rida ota+        (_, b') = mustFind ridb otb++    owl_equivalent (OwlItem oia (OwlSubItemFolder kiddosa)) (OwlItem oib (OwlSubItemFolder kiddosb)) = oia == oib && kiddos_equivalent kiddosa kiddosb+    owl_equivalent (OwlItem oia osia) (OwlItem oib osib) = oia == oib && owlSubItem_equivalent osia osib++    r = kiddos_equivalent (_owlTree_topOwls ota) (_owlTree_topOwls otb)++instance PotatoShow OwlTree where+  potatoShow od@OwlTree {..} = r where+    foldlfn acc rid =+      let sowl = owlTree_mustFindSuperOwl od rid+          selfEntry' = T.replicate (_owlItemMeta_depth . _superOwl_meta $ sowl) " " <> potatoShow sowl+          selfEntry = selfEntry' <> "\n"+       in acc <> case mommyOwl_kiddos sowl of+            Nothing -> selfEntry+            Just kiddos -> selfEntry <> printKiddos kiddos+    printKiddos :: Seq REltId -> Text+    printKiddos kiddos = foldl foldlfn "" kiddos+    r = printKiddos (fromJust $ mommyOwl_kiddos od)++owlTree_validate :: OwlTree -> (Bool, Text)+owlTree_validate od = checkRecursive "" noOwl 0 (_owlTree_topOwls od)+  where+    checkRecursive msg0 parentrid depth kiddos = r+      where+        foldfn (pass', msg') i rid = case owlTree_findSuperOwl od rid of+          Nothing -> (False, msg' <> "\nmissing REltId " <> show rid)+          Just x -> (rpass, rmsg)+            where+              expected =+                OwlItemMeta+                  { _owlItemMeta_parent = parentrid,+                    _owlItemMeta_depth = depth,+                    _owlItemMeta_position = i+                  }+              rpass1 = pass' && expected == _superOwl_meta x+              rmsg1 = if rpass1 then msg' else msg' <> "\nbad meta at " <> show rid <> " got " <> show (_superOwl_meta x) <> " expected " <> show expected+              (rpass2, rmsg2) = case (mommyOwl_kiddos x) of+                Nothing -> (rpass1, rmsg1)+                Just kiddos' -> checkRecursive msg0 (_superOwl_id x) (depth + 1) kiddos'+              (rpass, rmsg) = (rpass1 && rpass2, rmsg2)+        r = Seq.foldlWithIndex foldfn (True, msg0) kiddos++owlTree_maxId :: OwlTree -> REltId+owlTree_maxId s = maybe 0 fst (IM.lookupMax (_owlTree_mapping 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 od prid = od {_owlTree_mapping = om}+  where+    childrenToUpdate = fromJust $ owlTree_findKiddos od prid+    setRelPos i (oem, oe) = (oem {_owlItemMeta_position = i}, oe)+    om = Seq.foldlWithIndex (\om' i x -> IM.adjust (setRelPos i) x om') (_owlTree_mapping od) childrenToUpdate++emptyOwlTree :: OwlTree+emptyOwlTree =+  OwlTree+    { _owlTree_mapping = IM.empty,+      _owlTree_topOwls = Seq.empty+    }++owlTree_exists :: OwlTree -> REltId -> Bool+owlTree_exists OwlTree {..} rid = IM.member rid _owlTree_mapping++owlTree_findSuperOwl :: OwlTree -> REltId -> Maybe SuperOwl+owlTree_findSuperOwl OwlTree {..} rid = do+  (meta, elt) <- IM.lookup rid _owlTree_mapping+  return $ SuperOwl rid meta elt++owlTree_mustFindSuperOwl :: HasCallStack => OwlTree -> REltId -> SuperOwl+owlTree_mustFindSuperOwl od rid = case owlTree_findSuperOwl od rid of+  Nothing -> error $ errorMsg_owlTree_lookupFail od rid+  Just x -> x++owlTree_findKiddos :: OwlTree -> REltId -> Maybe (Seq REltId)+owlTree_findKiddos OwlTree {..} rid = case rid of+  x | x == noOwl -> return _owlTree_topOwls+  x -> do+    (_, oelt) <- IM.lookup x _owlTree_mapping+    mommyOwl_kiddos oelt++owlTree_findSuperOwlAtOwlSpot :: OwlTree -> OwlSpot -> Maybe SuperOwl+owlTree_findSuperOwlAtOwlSpot od@OwlTree {..} OwlSpot {..} = do+  kiddos <- owlTree_findKiddos od _owlSpot_parent+  kid <- case _owlSpot_leftSibling of+    Nothing -> Seq.lookup 0 kiddos+    -- take until we reach the point and return one to the right+    Just rid -> Seq.lookup 0 . Seq.drop 1 . Seq.dropWhileL (\rid' -> rid' /= rid) $ kiddos+  owlTree_findSuperOwl od kid++-- move one spot to the left, returns Nothing if not possible+owlTree_goRightFromOwlSpot :: OwlTree -> OwlSpot -> Maybe OwlSpot+owlTree_goRightFromOwlSpot od@OwlTree {..} ospot = do+  sowl <- owlTree_findSuperOwlAtOwlSpot od ospot+  return $ 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 {..} = r+  where+    msiblings = case _owlItemMeta_parent of+      x | x == noOwl -> return _owlTree_topOwls+      x -> do+        (_, oelt) <- IM.lookup x _owlTree_mapping+        mommyOwl_kiddos oelt++    siblings = fromJust msiblings+    r =+      OwlSpot+        { _owlSpot_parent = _owlItemMeta_parent,+          _owlSpot_leftSibling = locateLeftSiblingIdFromSiblingPosition _owlTree_mapping siblings _owlItemMeta_position+        }+++-- |+-- throws if REltId is invalid in OwlTree+owlTree_rEltId_toOwlSpot :: (HasCallStack) => OwlTree -> REltId -> OwlSpot+owlTree_rEltId_toOwlSpot od@OwlTree {..} rid = r+  where+    (oem, _) = fromJust $ IM.lookup rid _owlTree_mapping+    r = owlTree_owlItemMeta_toOwlSpot od oem++-- |+-- super inefficient implementation for testing only+owlTree_rEltId_toFlattenedIndex_debug :: OwlTree -> REltId -> Int+owlTree_rEltId_toFlattenedIndex_debug od@OwlTree {..} rid = r+  where+    sowls = owliterateall od+    r = fromMaybe (-1) $ Seq.findIndexL (\sowl -> _superOwl_id sowl == rid) sowls++-- |+-- NOTE this will return an AttachmentMap containing targets that have since been deleted+owlTree_makeAttachmentMap :: OwlTree -> AttachmentMap+owlTree_makeAttachmentMap od = attachmentMap_addSuperOwls (owliterateall od) 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 od@OwlTree {..} = not $ all (\sowl -> all (\x -> IM.member x (_owlTree_mapping)) (fmap _attachment_target $ hasOwlItem_attachments sowl)) (owliterateall od)++owlTree_topSuperOwls :: OwlTree -> Seq SuperOwl+owlTree_topSuperOwls od = r+  where+    sowls = fmap (owlTree_mustFindSuperOwl od) (_owlTree_topOwls od)+    areOwlsInFactSuper = all superOwl_isTopOwl sowls+    r = assert areOwlsInFactSuper sowls++owlTree_foldAt' :: (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a+owlTree_foldAt' f acc od sowl = case _superOwl_elt sowl of+  OwlItem _ (OwlSubItemFolder kiddos) -> foldl (\acc' rid' -> owlTree_foldAt' f acc' od (owlTree_mustFindSuperOwl od rid')) (f acc sowl) kiddos+  _ -> f acc sowl++-- | fold over an element in the tree and all its children+owlTree_foldAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a+owlTree_foldAt f acc od rid = owlTree_foldAt' f acc od (owlTree_mustFindSuperOwl od rid)++owlTree_foldChildrenAt' :: (a -> SuperOwl -> a) -> a -> OwlTree -> SuperOwl -> a+owlTree_foldChildrenAt' f acc od sowl = case _superOwl_elt sowl of+  OwlItem _ (OwlSubItemFolder kiddos) -> foldl (\acc' rid' -> owlTree_foldAt' f acc' od (owlTree_mustFindSuperOwl od rid')) acc kiddos+  _ -> acc++-- | same as owlTree_foldAt but excludes parent+owlTree_foldChildrenAt :: (a -> SuperOwl -> a) -> a -> OwlTree -> REltId -> a+owlTree_foldChildrenAt f acc od rid = owlTree_foldChildrenAt' f acc od (owlTree_mustFindSuperOwl od rid)++owlTree_fold :: (a -> SuperOwl -> a) -> a -> OwlTree -> a+owlTree_fold f acc0 od = foldl (\acc rid -> owlTree_foldAt f acc od rid) acc0 $ _owlTree_topOwls od++owlTree_owlCount :: OwlTree -> Int+owlTree_owlCount od = owlTree_fold (\acc _ -> acc + 1) 0 od++-- | iterates an element and all its children+owliterateat :: OwlTree -> REltId -> Seq SuperOwl+owliterateat od rid = owlTree_foldAt (|>) Seq.empty od rid where++-- | iterates an element's children (excluding self)+owliteratechildrenat :: OwlTree -> REltId -> Seq SuperOwl+owliteratechildrenat od rid = owlTree_foldChildrenAt (|>) Seq.empty od rid where++-- | iterates everything in the directory+owliterateall :: OwlTree -> Seq SuperOwl+owliterateall od = owlTree_fold (|>) Seq.empty od++class HasOwlTree o where+  hasOwlTree_owlTree :: o -> OwlTree+  hasOwlTree_exists :: o -> REltId -> Bool+  hasOwlTree_exists o rid = hasOwlTree_exists (hasOwlTree_owlTree o) rid+  hasOwlTree_findSuperOwl :: o -> REltId -> Maybe SuperOwl+  hasOwlTree_findSuperOwl o rid = hasOwlTree_findSuperOwl (hasOwlTree_owlTree o) rid+  hasOwlTree_mustFindSuperOwl :: HasCallStack => o -> REltId -> SuperOwl+  hasOwlTree_mustFindSuperOwl o rid = hasOwlTree_mustFindSuperOwl (hasOwlTree_owlTree o) rid++  -- only intended for use in tests+  hasOwlTree_test_findFirstSuperOwlByName :: o -> Text -> Maybe SuperOwl+  hasOwlTree_test_findFirstSuperOwlByName o t = hasOwlTree_test_findFirstSuperOwlByName (hasOwlTree_owlTree o) t+  hasOwlTree_test_mustFindFirstSuperOwlByName :: o -> Text -> SuperOwl+  hasOwlTree_test_mustFindFirstSuperOwlByName o t = fromJust (hasOwlTree_test_findFirstSuperOwlByName o t)++instance HasOwlTree OwlTree where+  hasOwlTree_owlTree = id+  hasOwlTree_exists = owlTree_exists+  hasOwlTree_findSuperOwl = owlTree_findSuperOwl+  hasOwlTree_mustFindSuperOwl = owlTree_mustFindSuperOwl+  hasOwlTree_test_findFirstSuperOwlByName ot label = find (\sowl -> hasOwlItem_name sowl == label) . toList $ owliterateall ot++-- | select everything in the OwlTree+owlTree_toSuperOwlParliament :: OwlTree -> SuperOwlParliament+owlTree_toSuperOwlParliament od@OwlTree {..} = r+  where+    r = owlParliament_toSuperOwlParliament od . OwlParliament $ _owlTree_topOwls++owlTree_removeREltId :: REltId -> OwlTree -> OwlTree+owlTree_removeREltId rid od = owlTree_removeSuperOwl (owlTree_mustFindSuperOwl od rid) od++owlTree_removeSuperOwl :: SuperOwl -> OwlTree -> OwlTree+owlTree_removeSuperOwl sowl OwlTree {..} = r+  where+    -- remove the element itself+    newMapping'' = IM.delete (_superOwl_id sowl) _owlTree_mapping++    -- remove all children recursively+    removeEltWithoutAdjustMommyFn rid mapping = case IM.lookup rid mapping of+      Nothing -> error $ errorMsg_owlMapping_lookupFail mapping rid+      Just (_, OwlItem _ (OwlSubItemFolder kiddos)) -> foldr removeEltWithoutAdjustMommyFn (IM.delete rid mapping) kiddos+      Just _ -> IM.delete rid mapping+    newMapping' = case _superOwl_elt sowl of+      OwlItem _ (OwlSubItemFolder kiddos) -> foldr removeEltWithoutAdjustMommyFn newMapping'' kiddos+      _ -> newMapping''++    removeSuperOwlFromSeq :: Seq REltId -> SuperOwl -> Seq REltId+    removeSuperOwlFromSeq s so = assert (Seq.length s == Seq.length deletedSeq + 1) deletedSeq+      where+        -- sowl meta may be incorrect at this point so we do linear search to remove the elt+        deletedSeq = Seq.deleteAt (fromJust (Seq.elemIndexL (_superOwl_id so) s)) 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 parent = case parent of+      (oem, OwlItem oinfo (OwlSubItemFolder kiddos)) -> (oem, OwlItem oinfo (OwlSubItemFolder (removeSuperOwlFromSeq kiddos sowl)))+      _ -> error "expected parent to be a folder"+    newMapping = case _owlItemMeta_parent (_superOwl_meta sowl) of+      x | x == noOwl -> newMapping'+      rid -> IM.adjust removeChildFn rid newMapping'++    -- remove from top owls if needed+    newTopOwls =+      if superOwl_isTopOwl sowl+        then removeSuperOwlFromSeq _owlTree_topOwls sowl+        else _owlTree_topOwls++    r' =+      OwlTree+        { _owlTree_mapping = newMapping,+          _owlTree_topOwls = newTopOwls+        }++    r = internal_owlTree_reorgKiddos r' (_owlItemMeta_parent (_superOwl_meta sowl))++owlTree_moveOwlParliament :: OwlParliament -> OwlSpot -> OwlTree -> (OwlTree, [SuperOwl])+owlTree_moveOwlParliament op spot@OwlSpot {..} od@OwlTree {..} = assert isValid r+  where+    sop@(SuperOwlParliament sowls) = owlParliament_toSuperOwlParliament od op++    -- check that we aren't doing circular parenting 😱+    isValid = not $ any (\x -> isDescendentOf _owlTree_mapping x _owlSpot_parent) (fmap _superOwl_id 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 = foldl (\acc sowl -> owlTree_removeSuperOwl sowl acc) od 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 = fmap _superOwl_id+      . sortOn (_owlItemMeta_position . _superOwl_meta)+      . filter ((== _owlSpot_parent) . _owlItemMeta_parent . _superOwl_meta)+      . toList+      $ sowls+    -- list of all siblings on the spot we are dragging to+    origSiblings = fromMaybe (error "expected siblings") $ if _owlSpot_parent == noOwl+      then mommyOwl_kiddos $ od+      else mommyOwl_kiddos $ owlTree_mustFindSuperOwl od _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 _ _ [] _ = Nothing+    findPos targetrid [] (y:ys) past = if past+      then Just y+      else if y == targetrid+        then Just y+        else findPos targetrid [] ys past+    findPos targetrid (x:xs) (y:ys) past = if past || (y == targetrid)+      then if x == y+        then findPos targetrid xs ys True+        else Just y+      else if x == y+        then findPos targetrid xs ys past+        else findPos targetrid (x:xs) ys past+    newLeftSibling = case _owlSpot_leftSibling of+      Nothing -> Nothing+      Just target -> findPos target (reverse $ toList removed) (reverse $ toList origSiblings) False+    correctedSpot = spot { _owlSpot_leftSibling = newLeftSibling}++    selttree = superOwlParliament_toSEltTree od sop+    r = owlTree_addSEltTree correctedSpot selttree removedOd++-- |+-- assumes SEltTree REltIds do not collide with OwlTree+owlTree_addSEltTree :: OwlSpot -> SEltTree -> OwlTree -> (OwlTree, [SuperOwl])+owlTree_addSEltTree spot selttree od = r where+  -- convert to OwlDirectory+  otherod = owlTree_fromSEltTree selttree+  r = owlTree_addMiniOwlTree spot otherod od++owlTree_reindex :: Int -> OwlTree -> OwlTree+owlTree_reindex start ot = assert valid r where+  valid = owlTree_maxId ot < 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 k = if k == noOwl then noOwl else k + start+  -- adjust keys to their new ones+  oldmap = _owlTree_mapping ot+  newMap' = IM.mapKeysMonotonic adjustkeyfn oldmap+  -- next adjust children and attachments to the new ids+  ridremap = IM.mapWithKey (\rid _ -> adjustkeyfn rid) oldmap+  mapoem oem = oem { _owlItemMeta_parent = adjustkeyfn (_owlItemMeta_parent oem) }+  mapoe oe =+    -- remap attachments+    owlItem_updateAttachments True ridremap+    -- remap kiddos+    $ (case oe of+      OwlItem oinfo (OwlSubItemFolder kiddos) -> OwlItem oinfo (OwlSubItemFolder (fmap adjustkeyfn kiddos))+      x -> x)+  mapowlfn (oem, oe) = (mapoem oem, mapoe oe)+  newMap = fmap mapowlfn newMap'+  newTopOwls = fmap adjustkeyfn (_owlTree_topOwls ot)+  r = OwlTree newMap 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 targetspot miniot od0 = assert (collisions == 0) $ r where+  od1indices = Set.fromList $ IM.keys (_owlTree_mapping od0)+  od2indices = Set.fromList $ IM.keys (_owlTree_mapping miniot)+  collisions = Set.size $ Set.intersection od1indices od2indices++  mapaccumlfn od (spot, sowl) = internal_owlTree_addOwlItem ospot rid oeltmodded od where+    rid = _superOwl_id sowl+    meta = _superOwl_meta sowl+    ospot = if _owlItemMeta_parent meta == noOwl && _owlItemMeta_position meta == 0+      -- first element goes to target spot+      then targetspot+      else if _owlItemMeta_parent meta == noOwl+        -- top level elements share the parent of the target spot+        then spot { _owlSpot_parent = _owlSpot_parent targetspot}+        -- everything else has a valid spot from previous tree+        else spot++    oeltmodded = case _superOwl_elt sowl of+      -- temp remove kiddos from parent as needed by internal_owlTree_addOwlItem+      OwlItem oinfo (OwlSubItemFolder _) -> OwlItem oinfo (OwlSubItemFolder Seq.empty)+      x -> x++  -- go from left to right such that parents/left siblings are added first+  r = mapAccumL mapaccumlfn od0 $ toList $ fmap (\sowl -> (owlTree_owlItemMeta_toOwlSpot miniot (_superOwl_meta sowl), sowl)) (owliterateall miniot)++-- parents NOT allowed :O+internal_owlTree_addOwlItem :: OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)+internal_owlTree_addOwlItem OwlSpot {..} rid oitem OwlTree {..} = assert nochildrenifaddingfolder r+  where+    -- if we're adding a folder (in the normal case), ensure it has no children+    nochildrenifaddingfolder = case oitem of+      OwlItem _ (OwlSubItemFolder kiddos) -> Seq.null kiddos+      _ -> True++    -- first add the OwlItem to the mapping+    meta =+      OwlItemMeta+        { _owlItemMeta_parent = _owlSpot_parent,+          _owlItemMeta_depth = case _owlSpot_parent of+            x | x == noOwl -> 0+            _ -> case IM.lookup _owlSpot_parent _owlTree_mapping of+              Nothing -> error $ errorMsg_owlMapping_lookupFail _owlTree_mapping _owlSpot_parent+              Just (x, _) -> _owlItemMeta_depth x + 1,+          -- this will get set correctly when we call internal_owlTree_reorgKiddos later+          _owlItemMeta_position = error "this thunk should never get evaluated"+        }++    newMapping' = IM.insertWithKey (\k _ ov -> error ("key " <> show k <> " already exists with value " <> show ov)) rid (meta, oitem) _owlTree_mapping++    -- modify kiddos of the parent we are adding to+    modifyKiddos kiddos = Seq.insertAt position rid kiddos+      where+        position = case _owlSpot_leftSibling of+          Nothing -> 0+          Just leftsibrid -> case Seq.elemIndexL leftsibrid kiddos of+            Nothing -> error $ "expected to find leftmost sibling " <> show leftsibrid <> " in " <> show kiddos+            Just x -> x + 1+    adjustfn (oem, oitem') = case oitem' of+      OwlItem oinfo (OwlSubItemFolder kiddos) -> (oem, OwlItem oinfo (OwlSubItemFolder (modifyKiddos kiddos)))+      _ -> error $ "expected OwlItemFolder"+    newMapping = case _owlSpot_parent of+      x | x == noOwl -> newMapping'+      _ -> IM.adjust adjustfn _owlSpot_parent newMapping'+    -- or top owls if there is no parent+    newTopOwls = case _owlSpot_parent of+      x | x == noOwl -> modifyKiddos _owlTree_topOwls+      _ -> _owlTree_topOwls++    r' =+      OwlTree+        { _owlTree_mapping = newMapping,+          _owlTree_topOwls = newTopOwls+        }++    newtree = internal_owlTree_reorgKiddos r' _owlSpot_parent++    newsowl = owlTree_mustFindSuperOwl newtree rid++    r = (newtree, newsowl)++-- OwlItem must not be a parent+owlTree_addOwlItem :: OwlSpot -> REltId -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)+owlTree_addOwlItem = internal_owlTree_addOwlItem++-- this method works for parents IF all children are included in the list and sorted from left to right+owlTree_addOwlItemList :: [(REltId, OwlSpot, OwlItem)] -> OwlTree -> (OwlTree, [SuperOwl])+owlTree_addOwlItemList seltls od0 = r where++  -- TODO test that seltls are valid... (easier said than done)++  mapaccumlfn od (rid,ospot,oitem) = internal_owlTree_addOwlItem ospot rid oitemmodded od where+    osubitemmodded = case _owlItem_subItem oitem of+      -- temp remove kiddos from parent as needed by internal_owlTree_addOwlItem+      OwlSubItemFolder _ -> OwlSubItemFolder Seq.empty+      x -> x+    oitemmodded = OwlItem (_owlItem_info oitem) osubitemmodded++  -- go from left to right such that parents are added first+  (newot, changes) = mapAccumL mapaccumlfn od0 seltls++  r = (newot, changes)+++-- TODO TEST+owlTree_superOwl_comparePosition :: OwlTree -> SuperOwl -> SuperOwl -> Ordering+owlTree_superOwl_comparePosition ot sowl1 sowl2 = r where+  m1 = _superOwl_meta sowl1+  m2 = _superOwl_meta sowl2+  d1 = _owlItemMeta_depth m1+  d2 = _owlItemMeta_depth m2+  p1 = _owlItemMeta_parent m1+  p2 = _owlItemMeta_parent m2+  s1 = _owlItemMeta_position m1+  s2 = _owlItemMeta_position m2+  psowl1 = owlTree_mustFindSuperOwl ot p1+  psowl2 = owlTree_mustFindSuperOwl ot p2+  r = if d1 == d2+    then if p1 == p2+      then compare s1 s2+      else owlTree_superOwl_comparePosition ot psowl1 psowl2+    else if d1 > d2+      then owlTree_superOwl_comparePosition ot psowl1 sowl2+      else owlTree_superOwl_comparePosition ot sowl1 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 oldDir oldLayers lp parent depth accDir accSiblings =+  let recurfn = internal_addUntilFolderEndRecursive oldDir oldLayers+      -- the elt we want to add+      rid = Seq.index oldLayers lp+      SEltLabel name selt = oldDir IM.! rid+      selfMeta = OwlItemMeta parent depth (Seq.length accSiblings)+      newSiblings = accSiblings |> rid+   in if lp >= Seq.length oldLayers+        then -- this means we've reached the end of layers, nothing to do+          (lp + 1, accDir, accSiblings)+        else -- normal case+        case selt of+          SEltFolderStart -> r+            where+              (lp', accDir', accSiblings') = recurfn (lp + 1) rid (depth + 1) accDir Seq.empty+              selfOwl = OwlItem (OwlInfo name) (OwlSubItemFolder accSiblings')+              r = recurfn lp' parent depth (IM.insert rid (selfMeta, selfOwl) accDir') newSiblings+          -- we're done! throw out this elt+          SEltFolderEnd -> (lp + 1, accDir, accSiblings)+          -- nothing special, keep going+          _ -> recurfn (lp + 1) parent depth (IM.insert rid (selfMeta, (OwlItem (OwlInfo name) (sElt_to_owlSubItem selt))) accDir) newSiblings++owlTree_fromSEltTree :: SEltTree -> OwlTree+owlTree_fromSEltTree selttree = r+  where+    seltmap = IM.fromList selttree+    layers = fmap fst selttree+    r = owlTree_fromOldState seltmap (Seq.fromList layers)++owlTree_fromOldState :: REltIdMap SEltLabel -> Seq REltId -> OwlTree+owlTree_fromOldState oldDir oldLayers = r+  where+    (_, newDir, topOwls) = internal_addUntilFolderEndRecursive oldDir oldLayers 0 noOwl 0 IM.empty Seq.empty+    r =+      OwlTree+        { _owlTree_mapping = newDir,+          _owlTree_topOwls = topOwls+        }++owlTree_toSEltTree :: OwlTree -> SEltTree+owlTree_toSEltTree od@OwlTree {..} = superOwlParliament_toSEltTree od (owlTree_toSuperOwlParliament od)++-- DELETE use hasOwlElt variant+superOwl_toSElt_hack :: SuperOwl -> SElt+superOwl_toSElt_hack = hasOwlItem_toSElt_hack . _superOwl_elt++-- DELETE use hasOwlElt variant+superOwl_toSEltLabel_hack :: SuperOwl -> SEltLabel+superOwl_toSEltLabel_hack = hasOwlItem_toSEltLabel_hack . _superOwl_elt
+ src/Potato/Flow/OwlHelpers.hs view
@@ -0,0 +1,52 @@+module Potato.Flow.OwlHelpers where+++import Relude++import Potato.Flow.SElts+import Potato.Flow.Owl+import Potato.Flow.OwlItem+import Potato.Flow.Llama+import Potato.Flow.SEltMethods++superOwl_mustGetSLine :: SuperOwl -> SAutoLine+superOwl_mustGetSLine sowl = case _owlItem_subItem$ _superOwl_elt sowl of+  OwlSubItemLine sline -> sline+  x -> error $ "expected SAutoLine, got " <> show x <> " instead"++data SetLineStyleEnd = SetLineStyleEnd_Start | SetLineStyleEnd_End | SetLineStyleEnd_Both++setLineStyleEnd_setStart :: SetLineStyleEnd -> Bool+setLineStyleEnd_setStart SetLineStyleEnd_End = False+setLineStyleEnd_setStart _ = True++setLineStyleEnd_setEnd :: SetLineStyleEnd -> Bool+setLineStyleEnd_setEnd SetLineStyleEnd_Start = False+setLineStyleEnd_setEnd _ = True+++-- TODO move into Llama/Helpers.hs or something+makeLlamaForLineStyle :: SuperOwl -> SetLineStyleEnd -> LineStyle -> Llama+makeLlamaForLineStyle sowl end newstyle = r where+  rid = _superOwl_id sowl+  sline = superOwl_mustGetSLine sowl+  newsline = sline {+      _sAutoLine_lineStyle = if setLineStyleEnd_setStart end then newstyle else _sAutoLine_lineStyle sline+      , _sAutoLine_lineStyleEnd = if setLineStyleEnd_setEnd end then newstyle else _sAutoLine_lineStyleEnd sline+    }+  r = makeSetLlama (rid, SEltLine newsline)++makeLlamaForFlipLineStyle :: SuperOwl -> Maybe Llama+makeLlamaForFlipLineStyle sowl = r where+  seltl = superOwl_toSEltLabel_hack sowl+  startStyle = getSEltLabelLineStyle seltl+  endStyle = getSEltLabelLineStyleEnd seltl+  rid = _superOwl_id sowl+  sline = superOwl_mustGetSLine sowl+  newsline = sline {+      _sAutoLine_lineStyle = _sAutoLine_lineStyleEnd sline+      , _sAutoLine_lineStyleEnd = _sAutoLine_lineStyle sline+    }+  r = if startStyle == endStyle+    then Nothing+    else Just $ makeSetLlama (rid, SEltLine newsline)
+ src/Potato/Flow/OwlItem.hs view
@@ -0,0 +1,112 @@+module Potato.Flow.OwlItem where++++import Relude++import Potato.Flow.SElts+import Potato.Flow.Types+import Potato.Flow.Methods.LineTypes+import Potato.Flow.DebugHelpers++data OwlInfo = OwlInfo {+    _owlInfo_name :: Text+  } deriving (Show, Eq, Generic)++instance NFData OwlInfo++data OwlSubItem =+  OwlSubItemNone+  | OwlSubItemFolder (Seq REltId)+  | OwlSubItemBox SBox+  | OwlSubItemLine SAutoLine+  | OwlSubItemTextArea STextArea+  deriving (Generic, Show, Eq)++instance NFData OwlSubItem++owlSubItem_equivalent :: OwlSubItem -> OwlSubItem -> Bool+owlSubItem_equivalent (OwlSubItemLine slinea) (OwlSubItemLine slineb) = slinea == slineb+owlSubItem_equivalent a b = a == b++data OwlItem = OwlItem {+  _owlItem_info :: OwlInfo+  , _owlItem_subItem :: OwlSubItem+} deriving (Show, Eq, Generic)++instance NFData OwlItem++instance PotatoShow OwlItem where+  potatoShow = \case+    OwlItem oinfo (OwlSubItemFolder kiddos) -> "folder: " <> (_owlInfo_name oinfo) <> ": " <> show kiddos+    OwlItem oinfo subitem -> "elt: " <> (_owlInfo_name oinfo) <> ": " <> case subitem of+        OwlSubItemNone -> "none"+        OwlSubItemBox sbox -> show sbox+        OwlSubItemLine sline -> show sline+        OwlSubItemTextArea stextarea -> show stextarea++class MommyOwl o where+  mommyOwl_kiddos :: o -> Maybe (Seq REltId)+  mommyOwl_hasKiddos :: o -> Bool+  mommyOwl_hasKiddos = isJust . mommyOwl_kiddos++class HasOwlItem o where+  hasOwlItem_owlItem :: o -> OwlItem+  hasOwlItem_name :: o -> Text+  hasOwlItem_name = hasOwlItem_name . hasOwlItem_owlItem+  hasOwlItem_isFolder :: o -> Bool+  hasOwlItem_isFolder = hasOwlItem_isFolder . hasOwlItem_owlItem+  hasOwlItem_attachments :: o -> [Attachment]+  hasOwlItem_attachments = hasOwlItem_attachments . hasOwlItem_owlItem+  hasOwlItem_toSElt_hack :: o -> SElt+  hasOwlItem_toSElt_hack = hasOwlItem_toSElt_hack . hasOwlItem_owlItem+  hasOwlItem_toSEltLabel_hack :: o -> SEltLabel+  hasOwlItem_toSEltLabel_hack = hasOwlItem_toSEltLabel_hack . hasOwlItem_owlItem+  hasOwlItem_toOwlSubItem :: o -> OwlSubItem+  hasOwlItem_toOwlSubItem = _owlItem_subItem . hasOwlItem_owlItem+++owlItem_name :: OwlItem -> Text+owlItem_name = _owlInfo_name . _owlItem_info++owlItem_setName :: OwlItem -> Text -> OwlItem+owlItem_setName (OwlItem oi x) n = OwlItem (oi { _owlInfo_name = n}) x++instance MommyOwl OwlItem where+  mommyOwl_kiddos o = case _owlItem_subItem o of+    OwlSubItemFolder kiddos -> Just kiddos+    _ -> Nothing++++owlSubItem_to_sElt_hack :: OwlSubItem -> SElt+owlSubItem_to_sElt_hack = \case+  OwlSubItemFolder _ -> SEltFolderStart+  OwlSubItemBox sbox -> SEltBox sbox+  OwlSubItemLine sline -> SEltLine sline+  OwlSubItemTextArea stextarea -> SEltTextArea stextarea+  OwlSubItemNone -> SEltNone++instance HasOwlItem OwlItem where+  hasOwlItem_owlItem = id+  hasOwlItem_name = owlItem_name+  hasOwlItem_isFolder o = case _owlItem_subItem o of+    OwlSubItemFolder _ -> True+    _ -> False+  hasOwlItem_attachments o = case _owlItem_subItem o of+    OwlSubItemLine sline -> catMaybes [_sAutoLine_attachStart sline, _sAutoLine_attachEnd sline]+    _ -> []+  hasOwlItem_toSElt_hack = owlSubItem_to_sElt_hack . _owlItem_subItem+  hasOwlItem_toSEltLabel_hack o = SEltLabel (hasOwlItem_name o) (hasOwlItem_toSElt_hack o)++-- DELETE use hasOwlItem variant instead+owlItem_toSElt_hack :: OwlItem -> SElt+owlItem_toSElt_hack = hasOwlItem_toSElt_hack++sElt_to_owlSubItem :: SElt -> OwlSubItem+sElt_to_owlSubItem s = case s of+  SEltBox x -> OwlSubItemBox x+  SEltLine x -> OwlSubItemLine x+  SEltTextArea x -> OwlSubItemTextArea x+  SEltNone -> OwlSubItemNone+  _ -> error $ "cannot convert " <> show s
+ src/Potato/Flow/OwlState.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.OwlState where++import           Relude++import Potato.Flow.Owl+import Potato.Flow.Attachments+import Potato.Flow.OwlItem+import           Potato.Flow.Math+import           Potato.Flow.SElts+import           Potato.Flow.SEltMethods+import           Potato.Flow.Types+import Potato.Flow.DebugHelpers++import           Control.Exception       (assert)+import qualified Data.IntMap.Strict      as IM+import           Data.List.Ordered       (isSortedBy)+import           Data.Maybe+import qualified Data.Text as T++++-- prob not the best place for these...+maybeGetAttachmentPosition :: (HasCallStack) => Bool -> OwlPFState -> Attachment -> Maybe XY+maybeGetAttachmentPosition offsetBorder pfs a = do+  target <- hasOwlTree_findSuperOwl pfs (_attachment_target a)+  return $ case hasOwlItem_owlItem target of+    OwlItem _ (OwlSubItemBox sbox) -> attachLocationFromLBox offsetBorder (_sBox_box sbox, _attachment_location a, _attachment_offset_rel a)+    x -> error ("expecteed OwlSubItemBox, got: " <> show x)++maybeGetAttachmentBox :: Bool -> OwlPFState -> Attachment -> Maybe LBox+maybeGetAttachmentBox offsetBorder pfs a = do+  target <- hasOwlTree_findSuperOwl pfs (_attachment_target a)+  return $ case hasOwlItem_owlItem target of+    OwlItem _ (OwlSubItemBox sbox) -> if offsetBorder then lBox_expand (_sBox_box sbox) (1,1,1,1) else _sBox_box sbox+    x -> error ("expecteed OwlSubItemBox, got: " <> show x)++maybeLookupAttachment :: (HasCallStack) => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY+maybeLookupAttachment offsetBorder pfs matt = maybeGetAttachmentPosition offsetBorder pfs =<< matt++++-- TODO rename+data OwlPFState = OwlPFState {+  _owlPFState_owlTree :: OwlTree+  , _owlPFState_canvas    :: SCanvas+} deriving (Show, Eq, Generic)++instance HasOwlTree OwlPFState where+  hasOwlTree_owlTree = _owlPFState_owlTree++-- TODO delete replace with PotatoShow+owlPFState_prettyPrintForDebugging :: OwlPFState -> Text+owlPFState_prettyPrintForDebugging OwlPFState {..} = potatoShow _owlPFState_owlTree <> show _owlPFState_canvas++instance PotatoShow OwlPFState where+  potatoShow = owlPFState_prettyPrintForDebugging++instance NFData OwlPFState++owlPFState_nextId :: OwlPFState -> REltId+owlPFState_nextId pfs = (+1) . owlTree_maxId . _owlPFState_owlTree $ pfs++owlPFState_lastId :: OwlPFState -> REltId+owlPFState_lastId pfs = owlTree_maxId . _owlPFState_owlTree $ pfs++owlPFState_numElts :: OwlPFState -> Int+owlPFState_numElts pfs = IM.size . _owlTree_mapping . _owlPFState_owlTree $ pfs++-- TODO DELETE replace with potatoShow+debugPrintOwlPFState :: (IsString a) => OwlPFState -> a+debugPrintOwlPFState OwlPFState {..} = fromString . T.unpack $ potatoShow _owlPFState_owlTree++-- TODO owlPFState_selectionIsValid pfs OwlParliament $ Seq.fromList [0..Seq.length _owlPFState_layers - 1]+owlPFState_isValid :: OwlPFState -> Bool+owlPFState_isValid OwlPFState {..} = True++owlPFState_selectionIsValid :: OwlPFState -> OwlParliament -> Bool+owlPFState_selectionIsValid OwlPFState {..} (OwlParliament op) = validElts where+  OwlTree {..} = _owlPFState_owlTree+  validElts = all isJust . toList $ fmap ((IM.!?) _owlTree_mapping) op++-- TODO replace with superOwlParliament_toSEltTree+owlPFState_copyElts :: OwlPFState -> OwlParliament -> [SEltLabel]+owlPFState_copyElts OwlPFState {..} op = r where+  sop = owlParliament_toSuperOwlParliament _owlPFState_owlTree op+  r = fmap snd $ superOwlParliament_toSEltTree _owlPFState_owlTree sop++-- TODO replace with owlTree_findSuperOwl+owlPFState_getSuperOwls :: OwlPFState -> [REltId] -> REltIdMap (Maybe SuperOwl)+owlPFState_getSuperOwls OwlPFState {..} rids = foldr (\rid acc -> IM.insert rid (owlTree_findSuperOwl _owlPFState_owlTree rid) acc) IM.empty rids++emptyOwlPFState :: OwlPFState+emptyOwlPFState = OwlPFState emptyOwlTree (SCanvas (LBox 0 1))++sPotatoFlow_to_owlPFState :: SPotatoFlow -> OwlPFState+sPotatoFlow_to_owlPFState SPotatoFlow {..} = r where+  r = OwlPFState (owlTree_fromSEltTree _sPotatoFlow_sEltTree) _sPotatoFlow_sCanvas++owlPFState_to_sPotatoFlow :: OwlPFState -> SPotatoFlow+owlPFState_to_sPotatoFlow OwlPFState {..} = r where+  selttree = owlTree_toSEltTree _owlPFState_owlTree+  r = SPotatoFlow _owlPFState_canvas selttree++owlPFState_toCanvasCoordinates :: OwlPFState -> XY -> XY+owlPFState_toCanvasCoordinates OwlPFState {..} (V2 x y) = V2 (x-sx) (y-sy) where+  LBox (V2 sx sy) _ = _sCanvas_box _owlPFState_canvas++owlPFState_fromCanvasCoordinates :: OwlPFState -> XY -> XY+owlPFState_fromCanvasCoordinates OwlPFState {..} (V2 x y) = V2 (x+sx) (y+sy) where+  LBox (V2 sx sy) _ = _sCanvas_box _owlPFState_canvas++owlPFState_to_SuperOwlParliament :: OwlPFState -> SuperOwlParliament+owlPFState_to_SuperOwlParliament OwlPFState {..} = owlParliament_toSuperOwlParliament _owlPFState_owlTree $ OwlParliament $ _owlTree_topOwls _owlPFState_owlTree++do_newElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)+do_newElts seltls pfs@OwlPFState {..} = r where++  -- parents are allowed, but seltls must be sortefd from left -> right such that leftmost sibling/parent of OwlSpot exists (assuming elts are added to the tree from left to right)+  (newot, changes') = owlTree_addOwlItemList seltls _owlPFState_owlTree++  changes = IM.fromList $ fmap (\sowl -> (_superOwl_id sowl, Just sowl)) changes'+  r = (pfs { _owlPFState_owlTree = newot}, changes)++undo_newElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)+undo_newElts seltls pfs@OwlPFState {..} = r where+  foldfn (rid,_,_) od = owlTree_removeREltId rid od+  -- assumes seltls sorted from left to right so that no parent is deleted before its child+  newot = foldr foldfn _owlPFState_owlTree seltls+  changes = IM.fromList $ fmap (\(rid,_,_) -> (rid, Nothing)) seltls+  r = (pfs { _owlPFState_owlTree = newot}, changes)++do_deleteElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)+do_deleteElts = undo_newElts++undo_deleteElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)+undo_deleteElts = do_newElts++do_newMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)+do_newMiniOwlTree (mot, ospot) pfs@OwlPFState {..} = r where+  (newot, changes') = owlTree_addMiniOwlTree ospot mot _owlPFState_owlTree+  changes = IM.fromList $ fmap (\sowl -> (_superOwl_id sowl, Just sowl)) changes'+  r = (pfs { _owlPFState_owlTree = newot}, changes)++undo_newMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)+undo_newMiniOwlTree (mot, _) pfs@OwlPFState {..} = r where+  foldfn rid od = owlTree_removeREltId rid od+  newot = foldr foldfn _owlPFState_owlTree (_owlTree_topOwls mot)+  changes = IM.fromList $ fmap (\sowl -> (_superOwl_id sowl, Nothing)) $ toList $ owliterateall mot+  r = (pfs { _owlPFState_owlTree = newot}, changes)++do_deleteMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)+do_deleteMiniOwlTree = undo_newMiniOwlTree++undo_deleteMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)+undo_deleteMiniOwlTree = do_newMiniOwlTree++++isSuperOwlParliamentUndoFriendly :: SuperOwlParliament -> Bool+isSuperOwlParliamentUndoFriendly sop = r where+  rp = _owlItemMeta_position . _superOwl_meta+  sameparent sowl1 sowl2 = _owlItemMeta_parent ( _superOwl_meta sowl1) == _owlItemMeta_parent ( _superOwl_meta sowl2)+  -- this is a hack use of isSortedBy and assumes parliament is ordered correctly+  r = isSortedBy (\sowl1 sowl2 -> if sameparent sowl1 sowl2 then (rp sowl1) < (rp sowl2) else True) . toList . unSuperOwlParliament $ sop++do_move :: (OwlSpot, SuperOwlParliament) -> OwlPFState -> (OwlPFState, SuperOwlChanges)+do_move (os, sop) pfs@OwlPFState {..} = assert isUndoFriendly r where++  -- make sure SuperOwlParliament is ordered in an undo-friendly way+  isUndoFriendly = isSuperOwlParliamentUndoFriendly sop++  op = superOwlParliament_toOwlParliament sop+  (newot, changes') = owlTree_moveOwlParliament op os _owlPFState_owlTree+  changes = IM.fromList $ fmap (\sowl -> (_superOwl_id sowl, Just sowl)) changes'+  r = (pfs { _owlPFState_owlTree = newot}, changes)++undo_move :: (OwlSpot, SuperOwlParliament) -> OwlPFState -> (OwlPFState, SuperOwlChanges)+undo_move (_, sop) pfs@OwlPFState {..} = assert isUndoFriendly r where++  -- NOTE that sop is likely invalid in pfs at this point++  -- make sure SuperOwlParliament is ordered in an undo-friendly way+  isUndoFriendly = isSuperOwlParliamentUndoFriendly sop++  -- first remove all elements we moved+  removefoldfn tree' so = owlTree_removeREltId (_superOwl_id so) tree'+  removedTree = foldl' removefoldfn _owlPFState_owlTree (unSuperOwlParliament sop)++  -- then add them back in in order+  addmapaccumlfn tree' so = owlTree_addOwlItem ospot (_superOwl_id so) (_superOwl_elt so) tree' where+    -- NOTE that because we are ordered from left to right, _superOwl_meta so is valid in tree'+    ospot = owlTree_owlItemMeta_toOwlSpot tree' $ _superOwl_meta so+  (addedTree, changes') = mapAccumL addmapaccumlfn removedTree (unSuperOwlParliament sop)++  changes = IM.fromList $ fmap (\sowl -> (_superOwl_id sowl, Just sowl)) (toList changes')+  r = (pfs { _owlPFState_owlTree = addedTree}, changes)+++-- OwlItem compatible variant of updateFnFromController+updateFnFromControllerOwl :: Bool -> Controller -> ((OwlItemMeta, OwlItem)->(OwlItemMeta, OwlItem))+updateFnFromControllerOwl isDo controller = r where+  f = updateFnFromController isDo controller+  -- 😱😱😱+  rewrap oem mkiddos (SEltLabel name elt) = case elt of+    SEltFolderStart -> (oem, OwlItem (OwlInfo name) (OwlSubItemFolder (fromJust mkiddos)))+    s -> (oem, OwlItem (OwlInfo name) (sElt_to_owlSubItem s))+  r (oem, oitem) = case _owlItem_subItem oitem of+    OwlSubItemFolder kiddos -> rewrap oem (Just kiddos) $ f (SEltLabel (owlItem_name oitem) SEltFolderStart)+    _ -> rewrap oem Nothing $ f (hasOwlItem_toSEltLabel_hack oitem)++manipulate :: Bool -> ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)+manipulate isDo cs pfs = (r, fmap Just changes) where+  mapping = _owlTree_mapping . _owlPFState_owlTree $ pfs+  changes' = IM.intersectionWith (updateFnFromControllerOwl isDo) cs mapping+  newMapping = IM.union changes' mapping+  changes = IM.mapWithKey (\k (oem, oe) -> SuperOwl k oem oe) changes'+  r = pfs { _owlPFState_owlTree = (_owlPFState_owlTree pfs) { _owlTree_mapping = newMapping } }++do_manipulate :: ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)+do_manipulate = manipulate True++undo_manipulate :: ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)+undo_manipulate = manipulate False++-- | check if the SCanvas is valid or not+-- for now, canvas offset must always be 0, I forget why it's even an option to offset the SCanvas, probably potatoes.+isValidCanvas :: SCanvas -> Bool+isValidCanvas (SCanvas (LBox p (V2 w h))) = p == 0 && w > 0 && h > 0++do_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState+do_resizeCanvas d pfs = assert (isValidCanvas newCanvas) $ pfs { _owlPFState_canvas = newCanvas } where+  newCanvas = SCanvas $ plusDelta (_sCanvas_box (_owlPFState_canvas pfs)) d++undo_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState+undo_resizeCanvas d pfs = assert (isValidCanvas newCanvas) $ pfs { _owlPFState_canvas = newCanvas } where+  newCanvas = SCanvas $ minusDelta (_sCanvas_box (_owlPFState_canvas pfs)) d
+ src/Potato/Flow/OwlWorkspace.hs view
@@ -0,0 +1,268 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.OwlWorkspace (+  OwlPFWorkspace(..)+  , emptyWorkspace+  , markWorkspaceSaved+  , undoWorkspace+  , redoWorkspace+  , undoPermanentWorkspace+  , doCmdWorkspace+  , WSEvent(..)+  , updateOwlPFWorkspace+  , loadOwlPFStateIntoWorkspace+) where++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.SElts+import           Potato.Flow.Types++import           Control.Exception    (assert)+import qualified Data.IntMap.Strict   as IM+import qualified Data.IntSet          as IS+import qualified Data.Sequence        as Seq++-- TODO rename+data OwlPFWorkspace = OwlPFWorkspace {+  _owlPFWorkspace_owlPFState    :: OwlPFState++  -- this is updated after each call to updateOwlPFWorkspace and is only guaranteed to be valid at that point+  -- TODO better to have methods return (OwlPFWorkspace, SuperOwlChanges) instead of embedding in OwlPFWorkspace+  , _owlPFWorkspace_lastChanges :: SuperOwlChanges++  , _owlPFWorkspace_llamaStack  :: LlamaStack+} deriving (Show, Generic)++instance NFData OwlPFWorkspace++loadOwlPFStateIntoWorkspace :: OwlPFState -> OwlPFWorkspace -> OwlPFWorkspace+loadOwlPFStateIntoWorkspace pfs ws = r where+  removeOld = fmap (const Nothing) (_owlTree_mapping . _owlPFState_owlTree . _owlPFWorkspace_owlPFState $ ws)+  addNew = IM.mapWithKey (\rid (oem,oe) -> Just (SuperOwl rid oem oe)) (_owlTree_mapping . _owlPFState_owlTree $ pfs)+  changes = IM.union addNew removeOld+  r = OwlPFWorkspace pfs changes emptyLlamaStack++emptyWorkspace :: OwlPFWorkspace+emptyWorkspace = OwlPFWorkspace emptyOwlPFState IM.empty emptyLlamaStack++-- UNTESTED+markWorkspaceSaved :: OwlPFWorkspace -> OwlPFWorkspace+markWorkspaceSaved pfw = r where+  as@LlamaStack {..} = _owlPFWorkspace_llamaStack pfw+  newas = as { _llamaStack_lastSaved = Just (length _llamaStack_done) }+  r = pfw { _owlPFWorkspace_llamaStack = newas }++undoWorkspace :: OwlPFWorkspace -> OwlPFWorkspace+undoWorkspace pfw =  r where+  LlamaStack {..} = _owlPFWorkspace_llamaStack pfw+  r = case _llamaStack_done of+    c : cs -> OwlPFWorkspace newpfs changes (LlamaStack cs (undollama:_llamaStack_undone) _llamaStack_lastSaved) where+      (newpfs, changes, undollama) = case _llama_apply c (_owlPFWorkspace_owlPFState pfw) of+        Left e  -> error $ show e+        Right x -> x+    _ -> pfw++redoWorkspace :: OwlPFWorkspace -> OwlPFWorkspace+redoWorkspace pfw = r where+  LlamaStack {..} = _owlPFWorkspace_llamaStack pfw+  r = case _llamaStack_undone of+    c : cs -> OwlPFWorkspace newpfs changes (LlamaStack (dollama:_llamaStack_done) cs _llamaStack_lastSaved) where+      (newpfs, changes, dollama) = case _llama_apply c (_owlPFWorkspace_owlPFState pfw) of+        Left e  -> error $ show e+        Right x -> x+    _ -> pfw++undoPermanentWorkspace :: OwlPFWorkspace -> OwlPFWorkspace+undoPermanentWorkspace pfw =  r where+  LlamaStack {..} = _owlPFWorkspace_llamaStack pfw+  -- NOTE this step is rather unecessary as this is always followed by a doCmdWorkspace but it's best to keep the state correct in between in case anything changes in the future+  newLastSaved = case _llamaStack_lastSaved of+    Nothing -> Nothing+    Just x -> if length _llamaStack_done > x+      -- we are undoing a change that came after last save+      then Just x+      -- we are permanently undoing a change from last saved+      else Nothing+  r = case _llamaStack_done of+    c : cs -> OwlPFWorkspace newpfs changes (LlamaStack cs _llamaStack_undone newLastSaved) where+      (newpfs, changes, _) = case _llama_apply c (_owlPFWorkspace_owlPFState pfw) of+        Left e  -> error $ show e+        Right x -> x+    _ -> pfw++doLlamaWorkspace :: Llama -> OwlPFWorkspace -> OwlPFWorkspace+doLlamaWorkspace llama pfw = r where+  (newpfs, changes, undollama) = case _llama_apply llama (_owlPFWorkspace_owlPFState pfw) of+    Left e  -> error $ show e+    Right x -> x+  LlamaStack {..} = (_owlPFWorkspace_llamaStack pfw)+  newLastSaved = case _llamaStack_lastSaved of+    Nothing -> Nothing+    Just x -> if length _llamaStack_done < x+      -- we "did" something when last save is still on undo stack, so we can never recover to last saved+      then Nothing+      -- we can still undo back to last save state+      else Just x+  r = OwlPFWorkspace {+      _owlPFWorkspace_owlPFState       = newpfs+      , _owlPFWorkspace_lastChanges = changes+      , _owlPFWorkspace_llamaStack  = LlamaStack {+          _llamaStack_done = undollama : _llamaStack_done+          , _llamaStack_undone = _llamaStack_undone+          , _llamaStack_lastSaved = newLastSaved+        }+    }++doLlamaWorkspaceUndoPermanentFirst :: Llama -> OwlPFWorkspace -> OwlPFWorkspace+doLlamaWorkspaceUndoPermanentFirst llama ws = r where+  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways+  undoedws = undoPermanentWorkspace ws+  r = doLlamaWorkspace llama undoedws++doCmdWorkspace :: OwlPFCmd -> OwlPFWorkspace -> OwlPFWorkspace+doCmdWorkspace cmd pfw = force r where+  r = doLlamaWorkspace (makePFCLlama cmd) pfw++doCmdOwlPFWorkspaceUndoPermanentFirst :: (OwlPFState -> OwlPFCmd) -> OwlPFWorkspace -> OwlPFWorkspace+doCmdOwlPFWorkspaceUndoPermanentFirst cmdFn ws = r where+  -- undoPermanent is actually not necessary as the next action clears the redo stack anyways+  undoedws = undoPermanentWorkspace ws+  undoedpfs = _owlPFWorkspace_owlPFState undoedws+  cmd = cmdFn undoedpfs+  r = doLlamaWorkspace (makePFCLlama cmd) undoedws++------ update functions via commands+data WSEvent =+  WSEAddElt (Bool, OwlSpot, OwlItem)+  | WSEAddTree (OwlSpot, MiniOwlTree)+  | WSEAddFolder (OwlSpot, Text)++  -- DELETE+  | WSERemoveElt OwlParliament++  -- WIP+  | WSERemoveEltAndUpdateAttachments OwlParliament AttachmentMap+++  | WSEMoveElt (OwlSpot, OwlParliament)+  -- | WSEDuplicate OwlParliament -- kiddos get duplicated??+  | WSEApplyLlama (Bool, Llama)+  | WSEResizeCanvas DeltaLBox+  | WSEUndo+  | WSERedo+  | WSELoad SPotatoFlow+  deriving (Show)++debugPrintBeforeAfterState :: (IsString a) => OwlPFState -> OwlPFState -> a+debugPrintBeforeAfterState stateBefore stateAfter = fromString $ "BEFORE: " <> debugPrintOwlPFState stateBefore <> "\nAFTER: " <> debugPrintOwlPFState stateAfter+++------ helpers for converting events to cmds+-- TODO assert elts are valid+pfc_addElt_to_newElts :: OwlPFState -> OwlSpot -> OwlItem -> OwlPFCmd+pfc_addElt_to_newElts pfs spot oelt = OwlPFCNewElts [(owlPFState_nextId pfs, spot, oelt)]++--TODO need to reorder so it becomes undo friendly here I think? (uhh, pretty sure it's ok to delete this TODO? should be ordered by assumption)+-- TODO assert elts are valid+pfc_moveElt_to_move :: OwlPFState -> (OwlSpot, OwlParliament) -> OwlPFCmd+pfc_moveElt_to_move pfs (ospot, op) = OwlPFCMove (ospot, owlParliament_toSuperOwlParliament (_owlPFState_owlTree pfs) op)++pfc_removeElt_to_deleteElts :: OwlPFState -> OwlParliament -> OwlPFCmd+pfc_removeElt_to_deleteElts pfs owlp = assert valid r where+  od = _owlPFState_owlTree pfs+  valid = superOwlParliament_isValid od $ owlParliament_toSuperOwlParliament od owlp+  sop = owlParliament_toSuperOwlParliament od owlp+  sowlswithchildren = superOwlParliament_convertToSeqWithChildren od sop+  r = OwlPFCDeleteElts $ toList (fmap (\SuperOwl {..} -> (_superOwl_id, owlTree_owlItemMeta_toOwlSpot od _superOwl_meta, _superOwl_elt)) sowlswithchildren)++pfc_addFolder_to_newElts :: OwlPFState -> (OwlSpot, Text) -> OwlPFCmd+pfc_addFolder_to_newElts pfs (spot, name) = OwlPFCNewElts [(owlPFState_nextId pfs, spot, OwlItem (OwlInfo name) (OwlSubItemFolder Seq.empty))]++-- UNTESTED+makeLlamaToSetAttachedLinesToCurrentPosition :: OwlPFState -> AttachmentMap -> REltId -> [Llama]+makeLlamaToSetAttachedLinesToCurrentPosition pfs am target = case IM.lookup target am of+    Nothing       -> []+    Just attached -> fmap makeLlama . IS.toList $ attached+  where+    makeLlama :: REltId -> Llama+    makeLlama rid = case _superOwl_elt (hasOwlTree_mustFindSuperOwl pfs rid) of+        OwlItem _ (OwlSubItemLine sline) -> r where+          startAttachment = _sAutoLine_attachStart sline+          endAttachment = _sAutoLine_attachEnd sline+          affectstart = fmap _attachment_target startAttachment == Just target+          affectend = fmap _attachment_target endAttachment == Just target+          newstartpos = case maybeLookupAttachment False pfs startAttachment of+            Nothing -> error $ "expected to find attachment " <> show startAttachment+            Just x -> x+          newendpos = case maybeLookupAttachment False pfs endAttachment of+            Nothing -> error $ "expected to find attachment " <> show endAttachment+            Just x -> x+          newsline = sline {+              -- disconnect from target if it was deleted+              -- NOTE strictly speaking necessary! Not sure which way is better in multi-user mode+              _sAutoLine_attachStart = if affectstart then Nothing else _sAutoLine_attachStart sline+              , _sAutoLine_attachEnd = if affectend  then Nothing else _sAutoLine_attachEnd sline++              -- place endpoints in new place+              , _sAutoLine_start = if affectstart then newstartpos else _sAutoLine_start sline+              , _sAutoLine_end = if affectend then newendpos else _sAutoLine_end sline++            }+          r = makeSetLlama (rid, SEltLine newsline)+        _ -> error $ "found non-line element in attachment list"++-- TODO rename to removeElts+removeEltAndUpdateAttachments_to_llama :: OwlPFState -> AttachmentMap -> OwlParliament -> Llama+removeEltAndUpdateAttachments_to_llama pfs am op@(OwlParliament rids) = r where+  removellama = makePFCLlama$  pfc_removeElt_to_deleteElts pfs op+  resetattachllamas = join $ fmap (makeLlamaToSetAttachedLinesToCurrentPosition pfs am) (toList rids)+  -- seems more correct to detach lines first and then delete the target so that undo operation is more sensible+  r = makeCompositionLlama $ resetattachllamas <> [removellama]++-- TODO take PotatoConfiguration here???+updateOwlPFWorkspace :: WSEvent -> OwlPFWorkspace -> OwlPFWorkspace+updateOwlPFWorkspace evt ws = let+  lastState = _owlPFWorkspace_owlPFState ws+  r = case evt of+    WSEAddElt (undo, spot, oelt) -> if undo+      then doCmdOwlPFWorkspaceUndoPermanentFirst (\pfs -> pfc_addElt_to_newElts pfs spot oelt) ws+      else doCmdWorkspace (pfc_addElt_to_newElts lastState spot oelt) ws+    WSEAddTree x -> doCmdWorkspace (OwlPFCNewTree (swap x)) ws+    WSEAddFolder x -> doCmdWorkspace (pfc_addFolder_to_newElts lastState x) ws++    -- DELETE+    WSERemoveElt x -> doCmdWorkspace (pfc_removeElt_to_deleteElts lastState x) ws++    WSERemoveEltAndUpdateAttachments x am -> doLlamaWorkspace (removeEltAndUpdateAttachments_to_llama lastState am x) ws++    WSEApplyLlama (undo, x) -> if undo+      then doLlamaWorkspaceUndoPermanentFirst x ws+      else doLlamaWorkspace x ws+    WSEMoveElt x -> doCmdWorkspace (pfc_moveElt_to_move lastState x) ws+    -- ignore invalid canvas resize events+    WSEResizeCanvas x -> if validateCanvasSizeOperation x ws+      then doCmdWorkspace (OwlPFCResizeCanvas x) ws+      else ws+    WSEUndo -> undoWorkspace ws+    WSERedo -> redoWorkspace ws+    WSELoad x -> loadOwlPFStateIntoWorkspace (sPotatoFlow_to_owlPFState x) ws+  afterState = _owlPFWorkspace_owlPFState r+  isValidAfter = owlPFState_isValid afterState+  in if isValidAfter+    then r+    else error ("INVALID " <> show evt <> "\n" <> debugPrintBeforeAfterState lastState afterState)+++-- | returns true if the applying `OwlPFCResizeCanvas lbox` results in a valid canvas size+validateCanvasSizeOperation :: DeltaLBox -> OwlPFWorkspace -> Bool+validateCanvasSizeOperation lbox ws = r where+  pfs = _owlPFWorkspace_owlPFState ws+  oldcanvas = _sCanvas_box $ _owlPFState_canvas pfs+  newcanvas = plusDelta oldcanvas lbox+  r = isValidCanvas (SCanvas newcanvas)
+ src/Potato/Flow/Reflex.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Reflex(+  module Potato.Flow.Reflex.GoatWidget+  , module Potato.Flow.Reflex.GoatSwitcher++) where++import           Potato.Flow.Reflex.GoatWidget+import Potato.Flow.Reflex.GoatSwitcher
+ src/Potato/Flow/Reflex/GoatSwitcher.hs view
@@ -0,0 +1,6 @@+-- TODO multi doc stuff in here+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Reflex.GoatSwitcher(+) where
+ src/Potato/Flow/Reflex/GoatWidget.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Reflex.GoatWidget (+  GoatWidgetConfig(..)+  , emptyGoatWidgetConfig+  , GoatWidget(..)+  , holdGoatWidget+) where++import           Relude++import           Reflex++import           Potato.Flow.BroadPhase+import           Potato.Flow.Controller.Goat+import           Potato.Flow.Controller.Handler+import           Potato.Flow.Controller.Input+import           Potato.Flow.Controller.OwlLayers+import           Potato.Flow.Controller.Types+import           Potato.Flow.Llama+import           Potato.Flow.Math+import           Potato.Flow.OwlState+import           Potato.Flow.OwlWorkspace+import           Potato.Flow.Render+import           Potato.Flow.Types++import           Control.Monad.Fix+import           Data.Default++++-- | invariants+-- * TODO mouse input type can only change after a `_lMouseData_isRelease == True`+-- * TODO non-mouse inputs can only happen after a `_lMouseData_isRelease == True` except for cancel+data GoatWidgetConfig t = GoatWidgetConfig {++  -- initialization parameters+  _goatWidgetConfig_initialState     :: (OwlPFState, ControllerMeta)+  , _goatWidgetConfig_unicodeWidthFn :: Maybe UnicodeWidthFn++  -- canvas direct input+  , _goatWidgetConfig_mouse          :: Event t LMouseData+  , _goatWidgetConfig_keyboard       :: Event t KeyboardData++  -- other canvas stuff+  , _goatWidgetConfig_canvasRegionDim     :: Event t XY++  -- command based+  , _goatWidgetConfig_selectTool     :: Event t Tool+  , _goatWidgetConfig_load           :: Event t EverythingLoadState+  -- only intended for setting params+  , _goatWidgetConfig_paramsEvent    :: Event t Llama+  , _goatWidgetConfig_canvasSize     :: Event t XY+  , _goatWidgetConfig_newFolder :: Event t ()++  -- command based (via new endo style)+  , _goatWidgetConfig_setPotatoDefaultParameters :: Event t SetPotatoDefaultParameters+  , _goatWidgetConfig_markSaved :: Event t ()+  , _goatWidgetConfig_setFocusedArea :: Event t GoatFocusedArea+++  -- debugging+  , _goatWidgetConfig_setDebugLabel  :: Event t Text+  , _goatWidgetConfig_bypassEvent :: Event t WSEvent+}++emptyGoatWidgetConfig :: (Reflex t) => GoatWidgetConfig t+emptyGoatWidgetConfig = GoatWidgetConfig {+    _goatWidgetConfig_initialState = (emptyOwlPFState, emptyControllerMeta)+    , _goatWidgetConfig_selectTool  = never+    , _goatWidgetConfig_load = never+    , _goatWidgetConfig_mouse     = never+    , _goatWidgetConfig_keyboard = never+    , _goatWidgetConfig_paramsEvent = never+    , _goatWidgetConfig_unicodeWidthFn = Nothing+    , _goatWidgetConfig_canvasRegionDim = never+    , _goatWidgetConfig_canvasSize = never+    , _goatWidgetConfig_newFolder = never+    , _goatWidgetConfig_setPotatoDefaultParameters = never+    , _goatWidgetConfig_markSaved = never+    , _goatWidgetConfig_setFocusedArea = never+    , _goatWidgetConfig_setDebugLabel = never+    , _goatWidgetConfig_bypassEvent = never+  }+++data GoatWidget t = GoatWidget {+  _goatWidget_tool                  :: Dynamic t Tool+++  , _goatWidget_selection           :: Dynamic t Selection+  , _goatWidget_potatoDefaultParameters :: Dynamic t PotatoDefaultParameters++  , _goatWidget_layers              :: Dynamic t LayersState -- do I even need this?++  , _goatWidget_pan                 :: Dynamic t XY+  , _goatWidget_broadPhase          :: Dynamic t BroadPhaseState+  , _goatWidget_handlerRenderOutput :: Dynamic t HandlerRenderOutput+  , _goatWidget_layersHandlerRenderOutput :: Dynamic t LayersViewHandlerRenderOutput+  , _goatWidget_canvas              :: Dynamic t SCanvas -- TODO DELETE just use OwlPFState+  , _goatWidget_renderedCanvas      :: Dynamic t RenderedCanvasRegion+  , _goatWidget_renderedSelection      :: Dynamic t RenderedCanvasRegion+  , _goatWidget_unsavedChanges     :: Dynamic t Bool++  -- TODO this is no longer debug (or maybe expose just OwlPFState part)+  -- debug stuff prob+  , _goatWidget_DEBUG_goatState     :: Dynamic t GoatState+}++foldGoatCmdSetDefaultParams :: SetPotatoDefaultParameters -> GoatState -> GoatState+foldGoatCmdSetDefaultParams spdp gs = gs {+    _goatState_potatoDefaultParameters = potatoDefaultParameters_set (_goatState_potatoDefaultParameters gs) spdp+  }++foldGoatCmdMarkSaved :: () -> GoatState -> GoatState+foldGoatCmdMarkSaved _ gs = gs {+    _goatState_workspace = markWorkspaceSaved (_goatState_workspace gs)+  }+++holdGoatWidget :: forall t m. (Adjustable t m, MonadHold t m, MonadFix m)+  => GoatWidgetConfig t+  -> m (GoatWidget t)+holdGoatWidget GoatWidgetConfig {..} = mdo++  let+    initialscreensize = 0 -- we can't know this at initialization time without causing an infinite loop so it is expected that the app sends this information immediately after initializing (i.e. during postBuild)+    initialgoat = makeGoatState initialscreensize _goatWidgetConfig_initialState++    -- old command style+    goatEvent = [+        GoatCmdTool <$> _goatWidgetConfig_selectTool+        , GoatCmdLoad <$> _goatWidgetConfig_load+        , GoatCmdMouse <$> _goatWidgetConfig_mouse+        , GoatCmdKeyboard <$> _goatWidgetConfig_keyboard+        , GoatCmdSetDebugLabel <$> _goatWidgetConfig_setDebugLabel+        , GoatCmdNewFolder "folder" <$ _goatWidgetConfig_newFolder+        , ffor _goatWidgetConfig_bypassEvent GoatCmdWSEvent+        , ffor _goatWidgetConfig_canvasRegionDim GoatCmdSetCanvasRegionDim++        -- these two need to be run before _goatWidgetConfig_mouse because sometimes we want to set params/change focus and input a mouse at the same time (i.e. clicking away from params widget to canvas widget causing params to send an update)+        , ffor _goatWidgetConfig_paramsEvent $ \llama -> (GoatCmdWSEvent (WSEApplyLlama (False, llama)))+        , ffor _goatWidgetConfig_canvasSize $ \xy -> GoatCmdWSEvent (WSEResizeCanvas (DeltaLBox 0 xy))+        , ffor _goatWidgetConfig_setFocusedArea $ \fa -> GoatCmdSetFocusedArea fa+      ]++    -- TODO split up foldGoatFn to be endo style+    goatEndoEvent = foldGoatFn <<$>> goatEvent++    -- new Endo folding+    setDefaultParamsEndoEvent = fmap foldGoatCmdSetDefaultParams _goatWidgetConfig_setPotatoDefaultParameters+    markSavedEvent = fmap foldGoatCmdMarkSaved _goatWidgetConfig_markSaved++  -- DELETE+  --goatDyn' :: Dynamic t GoatState <- foldDyn foldGoatFn initialgoat goatEvent++  goatDyn' :: Dynamic t GoatState+    <- foldDyn ($) initialgoat $ mergeWith (.) ([setDefaultParamsEndoEvent, markSavedEvent] <> goatEndoEvent)++  -- reduces # of calls to foldGoatFn to 2 :\+  let goatDyn = fmap id goatDyn'++  -- TODO make sure holdUniqDyn actually does what you think it does+  -- I think it does, but it will prob still do full equality check after changes in goatDyn :(+  -- TODO maybe you need to have special signals to control firing of each sub event instead+  -- I guess the good news is that you can still do this without changing the interface+  -- i.e. OwlPFStateChangeFlag and have each OwlPFState operation return a change flag as well+  r_tool <- holdUniqDyn $ fmap goatState_selectedTool goatDyn+  r_selection <- holdUniqDyn $ fmap _goatState_selection goatDyn+  r_potatoDefaultParams <- holdUniqDyn $ fmap _goatState_potatoDefaultParameters goatDyn+  r_broadphase <- holdUniqDyn $ fmap _goatState_broadPhaseState goatDyn+  r_pan <- holdUniqDyn $ fmap _goatState_pan goatDyn+  r_layers <- holdUniqDyn $ fmap _goatState_layersState goatDyn+  -- TODO flip order of render and holdUniqDyn+  r_handlerRenderOutput <- holdUniqDyn $ fmap (\gs -> pRenderHandler (_goatState_handler gs) (potatoHandlerInputFromGoatState gs)) goatDyn+  r_layersHandlerRenderOutput <- holdUniqDyn $ fmap (\gs -> pRenderLayersHandler (_goatState_layersHandler gs) (potatoHandlerInputFromGoatState gs)) goatDyn+  r_canvas <- holdUniqDyn $ fmap (_owlPFState_canvas . _owlPFWorkspace_owlPFState . _goatState_workspace) goatDyn+  r_unsavedChanges <- holdUniqDyn $ fmap (goatState_hasUnsavedChanges) goatDyn++  {- this causes 4 calls to foldGoatFn per tick :(+  let+    r_selection = fmap _goatState_selection goatDyn+    r_selection_converted = fmap (\gs -> superOwlParliament_convertToCanvasSelection (_owlPFState_owlTree . _owlPFWorkspace_owlPFState . _goatState_workspace $ gs) (const True) (_goatState_selection gs)) goatDyn+    r_broadphase = fmap _goatState_broadPhaseState goatDyn+    r_pan = fmap _goatState_pan goatDyn+    r_layers = fmap _goatState_layersState goatDyn+    -- TODO flip order of render and holdUniqDyn+    r_handlerRenderOutput = fmap (\gs -> pRenderHandler (_goatState_handler gs) (potatoHandlerInputFromGoatState gs)) goatDyn+    r_layersHandlerRenderOutput = fmap (\gs -> pRenderLayersHandler (_goatState_layersHandler gs) (potatoHandlerInputFromGoatState gs)) goatDyn+    r_canvas = fmap (_owlPFState_canvas . _owlPFWorkspace_owlPFState . _goatState_workspace) goatDyn+  -}++  let+    --why is this not holdUniqDyn? Is this why I'm getting extra ticks?+    r_renderedCanvas = fmap _goatState_renderedCanvas goatDyn+    r_renderedSelection = fmap _goatState_renderedSelection goatDyn++  return GoatWidget+    {+      _goatWidget_tool           = r_tool+      , _goatWidget_selection    = r_selection+      , _goatWidget_potatoDefaultParameters = r_potatoDefaultParams+      , _goatWidget_layers       = r_layers+      , _goatWidget_pan          = r_pan+      , _goatWidget_broadPhase   = r_broadphase+      , _goatWidget_canvas = r_canvas+      , _goatWidget_renderedCanvas = r_renderedCanvas+      , _goatWidget_renderedSelection = r_renderedSelection+      , _goatWidget_handlerRenderOutput =  r_handlerRenderOutput+      , _goatWidget_layersHandlerRenderOutput = r_layersHandlerRenderOutput+      , _goatWidget_unsavedChanges = r_unsavedChanges+      , _goatWidget_DEBUG_goatState = goatDyn+    }
+ src/Potato/Flow/Render.hs view
@@ -0,0 +1,339 @@++{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Render (+  RenderCache(..)+  , RenderContext(..)+  , emptyRenderContext+  , emptyRenderCache+  , renderCache_clearAtKeys+  , renderCache_lookup+  , render -- TODO DELETE use render_new instead because it uses cache+  , render_new++  , RenderedCanvasRegion(..)+  , renderedCanvas_box+  , renderedCanvasRegion_nonEmptyCount+  , emptyRenderedCanvasRegion+  , printRenderedCanvasRegion+  , potatoRenderWithOwlTree+  , potatoRenderPFState+  , renderedCanvasToText+  , renderedCanvasRegionToText++  , renderWithBroadPhase+  , moveRenderedCanvasRegion+  , updateCanvas++  -- exposed for testing+  , moveRenderedCanvasRegionNoReRender+) where++import           Relude++import           Potato.Flow.RenderCache+import           Potato.Flow.BroadPhase+import           Potato.Flow.Math+import           Potato.Flow.SEltMethods+import           Potato.Flow.Methods.Types+import           Potato.Flow.SElts+import Potato.Flow.Types+import Potato.Flow.OwlState+import           Potato.Flow.OwlItem+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+import qualified Data.Text               as T+import qualified Data.Text.IO as T+import qualified Data.Vector.Unboxed     as V+import qualified Data.Sequence as Seq+import Control.Exception (assert)++-- rather pointless abstraction but it's useful to have during refactors such that I don't ned to provide an explicit LayerMetaMap+class OwlRenderSet a where+  findSuperOwl :: a -> REltId -> Maybe (SuperOwl, Bool)+  sortForRendering :: a -> Seq.Seq SuperOwl -> Seq.Seq SuperOwl+  findSuperOwlForRendering :: a -> REltId -> Maybe SuperOwl+  findSuperOwlForRendering ors rid = case findSuperOwl ors rid of+    Nothing -> Nothing+    Just (sowl, b) -> if b then Nothing else Just sowl++instance OwlRenderSet OwlTree where+  findSuperOwl ot = fmap (,False) . owlTree_findSuperOwl ot+  sortForRendering a sowls = unSuperOwlParliament $ makeSortedSuperOwlParliament a sowls++instance OwlRenderSet (OwlTree, LayerMetaMap) where+  findSuperOwl (ot,lmm) rid = r where+    hidden = layerMetaMap_isInheritHidden ot rid lmm+    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+  , _renderContext_owlTree :: OwlTree -- r+  , _renderContext_layerMetaMap :: LayerMetaMap -- r+  , _renderContext_broadPhase :: BroadPhaseState -- r+  , _renderContext_renderedCanvasRegion :: RenderedCanvasRegion -- r/w+}++emptyRenderContext :: LBox -> RenderContext+emptyRenderContext lbox = RenderContext {+    _renderContext_cache = emptyRenderCache+    , _renderContext_owlTree = emptyOwlTree+    , _renderContext_layerMetaMap = IM.empty+    , _renderContext_broadPhase = emptyBroadPhaseState+    , _renderContext_renderedCanvasRegion = emptyRenderedCanvasRegion lbox+  }+++instance HasOwlTree RenderContext where+  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 = ' '+++-- TODO for selection rendering you want to make it V.Vector (Maybe PChar) or maybe you can just use a map?+{-+class IsRenderedCanvasRegion rc where+  isRenderedCanvasRegion_area :: LBox+  isRenderedCanvasRegion_generateMaybe :: (Int, Int) -> ((Int, Int) -> Maybe PChar) -> rc+-}++-- A rendered region in Canvas space+data RenderedCanvasRegion = RenderedCanvasRegion {+  _renderedCanvasRegion_box        :: LBox+  , _renderedCanvasRegion_contents :: V.Vector MWidePChar -- ^ row major+} deriving (Eq, Show)++renderedCanvas_box :: RenderedCanvasRegion -> LBox+renderedCanvas_box = _renderedCanvasRegion_box++emptyRenderedCanvasRegion :: LBox -> RenderedCanvasRegion+emptyRenderedCanvasRegion lb@(LBox _ (V2 w h)) = RenderedCanvasRegion {+    _renderedCanvasRegion_box = lb+    , _renderedCanvasRegion_contents = V.replicate (w*h) emptyMWidePChar+  }++-- empty spaces due to wide chars to the left are not counted+renderedCanvasRegion_nonEmptyCount :: RenderedCanvasRegion -> Int+renderedCanvasRegion_nonEmptyCount = V.length . V.filter (\x -> x /= emptyMWidePChar) . _renderedCanvasRegion_contents++-- | brute force renders a RenderedCanvasRegion (ignores broadphase)+potatoRenderWithOwlTree :: OwlTree -> [OwlSubItem] -> RenderedCanvasRegion -> RenderedCanvasRegion+potatoRenderWithOwlTree ot osubitems prevrcr = r where+  drawerswithcache = fmap (\osubitem -> (getDrawerWithCache osubitem Nothing, Nothing)) osubitems +  llbx = _renderedCanvasRegion_box prevrcr+  r = render_withCache ot llbx drawerswithcache prevrcr++potatoRenderPFState :: OwlPFState -> RenderedCanvasRegion+potatoRenderPFState OwlPFState {..} = potatoRenderWithOwlTree _owlPFState_owlTree (fmap _owlItem_subItem . fmap snd . toList . _owlTree_mapping $ _owlPFState_owlTree) (emptyRenderedCanvasRegion (_sCanvas_box _owlPFState_canvas))+++render_withCache :: (HasOwlTree a) => a -> LBox -> [(SEltDrawer, Maybe OwlItemCache)] -> RenderedCanvasRegion -> RenderedCanvasRegion+render_withCache ot llbx drawerswithcache prevrcr = r where++  genfn i = newc' where+    -- construct parent point and index+    pt = toPoint llbx i+    pindex = toIndex (_renderedCanvasRegion_box prevrcr) pt++    -- go through drawers in reverse order until you find a match+    --mdrawn = join . find isJust $ (fmap (\d -> _sEltDrawer_renderFn d _renderContext_owlTree pt) drawers)+    -- go through caches (they should have all been updated in the previous step) until you find a match+    drawfn (drawer, mcache) = case mcache of+      Nothing -> drawnocache+      --Just _ -> drawnocache+      Just cache -> case owlItemCache_preRender cache of+        Nothing -> drawnocache+        Just pr -> case preRender_lookup pr pt of+          (-1, _) -> Nothing+          x       -> Just x+      where+        drawnocache = case _sEltDrawer_renderFn drawer ot pt of+          Nothing -> Nothing+          Just x  -> Just (0, x)+    mdrawn = join . find isJust $ fmap drawfn drawerswithcache++    -- render what we found or empty otherwise+    newc' = case mdrawn of+      Just c  -> (pindex, c)+      Nothing -> (pindex, emptyMWidePChar)++  -- go through each point in target LBox and render it+  newc = V.generate (lBox_area llbx) genfn+  r = prevrcr {+      _renderedCanvasRegion_contents = V.update (_renderedCanvasRegion_contents prevrcr) newc+    }+++-- TODO DELETE use render_new instead+-- | renders just a portion of the RenderedCanvasRegion+-- caller is expected to provide all SElts that intersect the rendered LBox (broadphase is ignored)+-- SElts are rendered in ORDER+render :: LBox -> [OwlSubItem] -> RenderContext -> RenderContext+render llbx osubitems rctx@RenderContext {..} = r where+  drawerswithcache = fmap (\osubitem -> (getDrawerWithCache osubitem Nothing, Nothing)) osubitems +  prevrcr = _renderContext_renderedCanvasRegion+  r = rctx {+      _renderContext_renderedCanvasRegion = render_withCache _renderContext_owlTree llbx drawerswithcache prevrcr+    }++mapREltIdToCaches :: OwlTree -> [REltId] -> RenderCache -> (RenderCache, [(OwlSubItem, Maybe OwlItemCache)])+mapREltIdToCaches ot rids rcache = r where++  mapaccumlfn cacheacc rid = r where+    -- see if it was in the previous cache+    mprevcache = IM.lookup rid (unRenderCache rcache)+    sowl = owlTree_mustFindSuperOwl ot rid+    OwlItem _ osubitem = _superOwl_elt sowl+    mupdatedcache = updateOwlSubItemCache ot osubitem+    r = case mprevcache of+      Just c -> (cacheacc, (osubitem, Just c))+      Nothing -> case mupdatedcache of+        Just c  -> (IM.insert rid c cacheacc, (osubitem, Just c))+        Nothing -> (cacheacc, (osubitem, Nothing))+  (newcache, owlswithcache) = mapAccumL mapaccumlfn (unRenderCache rcache) rids+  r = (RenderCache newcache, owlswithcache)++++-- | renders just a portion of the RenderedCanvasRegion+-- updates cache as appropriate+-- caller is expected to provide all REltIds that intersect the rendered LBox (broadphase is ignored)+-- REltIds are rendered in ORDER+render_new :: LBox -> [REltId] -> RenderContext -> RenderContext+render_new llbx rids rctx@RenderContext {..} = rctxout where+  (newcache, owlswithcache) = mapREltIdToCaches _renderContext_owlTree rids _renderContext_cache+  drawerswithcache = map (\(x, c)-> (getDrawerWithCache x c, c)) owlswithcache +  rctxout = rctx {+      _renderContext_cache = newcache+      , _renderContext_renderedCanvasRegion = render_withCache _renderContext_owlTree llbx drawerswithcache _renderContext_renderedCanvasRegion+    }+++renderedCanvasToText :: RenderedCanvasRegion -> Text+renderedCanvasToText rcr = renderedCanvasRegionToText (_renderedCanvasRegion_box rcr) rcr+++-- TODO this does not handle wide chars at all fack+-- | assumes region LBox is strictly contained in _renderedCanvasRegion_box+renderedCanvasRegionToText :: LBox -> RenderedCanvasRegion -> Text+renderedCanvasRegionToText lbx RenderedCanvasRegion {..} = if not validBoxes +  then error ("render region outside canvas:\n" <> show lbx <> "\n" <> show _renderedCanvasRegion_box)+  else r +  where+    validBoxes = intersect_lBox_include_zero_area lbx _renderedCanvasRegion_box == Just lbx+    -- TODO preloop and include widechars++    l = lBox_area lbx+    (LBox _ (V2 lw _)) = lbx+    unfoldfn (i, eol, waseol) = if i == l+      then Nothing+      else if eol+        -- use -2 to indicate eol+        then Just $ (eolchar, (i, False, newwaseol))+        else Just $ (regchar, (i+1, neweol, newwaseol))+        where+          neweol = (i+1) `mod` lw == 0+          -- maintain waseol status if there is offset+          newwaseol = eol || (waseol && ofs > 0)+          (ofs, pch) = _renderedCanvasRegion_contents V.! pindex+          eolchar = Just '\n'+          regchar = if waseol && ofs > 0+            -- TODO is this what we want? Will this overwrite the previous wide char? Also this should never happen as broadphase should have included the widechar at bol+            -- if we were at eol and there is offset then use ' ' padding character+            then Just ' '+            else if ofs > 0+              -- if there is offset, skip the character+              then Nothing+              else Just pch+          pt = toPoint lbx i+          pindex = toIndex _renderedCanvasRegion_box pt+    +    -- TODO use something more efficient than a string+    r' = unfoldr unfoldfn (0, False, True)+    r = T.pack $ mapMaybe id r' +  ++printRenderedCanvasRegion :: RenderedCanvasRegion -> IO ()+printRenderedCanvasRegion rc@RenderedCanvasRegion {..} = T.putStrLn $ renderedCanvasRegionToText _renderedCanvasRegion_box rc++renderWithBroadPhase :: LBox -> RenderContext -> RenderContext+renderWithBroadPhase  lbx rctx@RenderContext {..} = r where+  bpt = (_broadPhaseState_bPTree _renderContext_broadPhase)+  rids = broadPhase_cull lbx bpt++  -- TODO I THINK THIS IS INCORRECT DELETE, specifically, broadPhase_cull will give hidden elements that we can't find with findSuperOwlForRendering+  {-sowls' = flip fmap rids $ \rid -> case findSuperOwlForRendering ot rid of+      Nothing -> error "this should never happen, because broadPhase_cull should only give existing seltls"+      Just sowl -> sowl-}++  sowls' = catMaybes $ fmap (\rid -> findSuperOwlForRendering _renderContext_owlTree rid) rids++  sowls = sortForRendering _renderContext_owlTree $ Seq.fromList sowls'+  sortedrids = fmap _superOwl_id $ toList sowls++  r = render_new lbx sortedrids rctx++moveRenderedCanvasRegionNoReRender :: LBox -> RenderedCanvasRegion -> RenderedCanvasRegion+moveRenderedCanvasRegionNoReRender lbx RenderedCanvasRegion {..} = assert (area >= 0) outrcr where+  -- unnecessary to init with empty vector as moveRenderedCanvasRegion will re-render those areas+  -- but it's still nice to do and makes testing easier+  area = lBox_area lbx+  emptyv = V.replicate area emptyMWidePChar+  newv = case intersect_lBox lbx _renderedCanvasRegion_box of+    Just intersectlbx -> copiedv where+      (l,r,t,b) = lBox_to_axis intersectlbx+      -- [(newIndex, oldIndex)]+      indices' = [toIndexSafe _renderedCanvasRegion_box (V2 x y) >>= return . (toIndex lbx (V2 x y),) | x <- [l..(r-1)], y <- [t..(b-1)]]+      indices = catMaybes indices'+      indexedValues = fmap (\(idx, oldidx) -> (idx, _renderedCanvasRegion_contents V.! oldidx)) indices+      copiedv = (V.//) emptyv indexedValues+    Nothing -> emptyv++  outrcr = RenderedCanvasRegion {+      _renderedCanvasRegion_box = lbx+      , _renderedCanvasRegion_contents = newv+    }++moveRenderedCanvasRegion ::  LBox -> RenderContext -> RenderContext+moveRenderedCanvasRegion lbx rctx@RenderContext {..} = r where+  prevrc = _renderContext_renderedCanvasRegion+  rctx1 = rctx {+      _renderContext_renderedCanvasRegion = moveRenderedCanvasRegionNoReRender lbx prevrc+    }+  r = foldr renderWithBroadPhase rctx1 (substract_lBox lbx (_renderedCanvasRegion_box prevrc))++updateCanvas :: SuperOwlChanges -> NeedsUpdateSet -> RenderContext -> RenderContext+updateCanvas cslmap needsupdateaabbs rctx@RenderContext {..} = case needsupdateaabbs of+  [] -> rctx+  -- TODO create disjoint union of all boxes and render than one at a time instead union_lBoxing them all+  --aoeu@(b:bs) -> trace "UPDATE CANVAS" $ traceShow aoeu $ case intersect_lBox (renderedCanvas_box _renderContext_renderedCanvasRegion) (foldl' union_lBox b bs) of+  (b:bs) -> case intersect_lBox (renderedCanvas_box _renderContext_renderedCanvasRegion) (foldl' union_lBox b bs) of+    Nothing -> rctx+    Just aabb -> r where+      rids = broadPhase_cull aabb (_broadPhaseState_bPTree _renderContext_broadPhase)++      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+        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+      sowls = sortForRendering _renderContext_owlTree $ Seq.fromList (catMaybes msowls)+      sortedrids = fmap _superOwl_id $ toList sowls+      r = render_new aabb sortedrids rctx
+ src/Potato/Flow/RenderCache.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.RenderCache where++import           Relude++import Potato.Data.Text.Unicode+import           Potato.Flow.Math+import           Potato.Flow.Methods.Types+import           Potato.Flow.SElts+import Potato.Flow.Types+import           Potato.Flow.OwlItem+import Potato.Flow.Owl+import           Potato.Flow.Controller.Types+import           Potato.Flow.Methods.LineTypes+++import qualified Data.IntMap             as IM+import qualified Data.Text               as T+import qualified Data.Text.IO as T+import qualified Data.Vector.Unboxed     as V+import qualified Data.Sequence as Seq+import Control.Exception (assert)++-- TODO move these methods to Math+-- | input index must be contained in the box+toPoint :: LBox -> Int -> XY+toPoint (LBox (V2 x y) (V2 w _)) i = V2 (i `mod` w + x) (i `div` w + y)++-- | input XY point must be contained in the box+toIndex :: LBox -> XY -> Int+toIndex (LBox (V2 x y) (V2 w _)) (V2 px py) = (py-y)*w+(px-x)++-- | same as above but does bounds checking+toIndexSafe :: LBox -> XY -> Maybe Int+toIndexSafe lbx xy = if does_lBox_contains_XY lbx xy+  then Just $ toIndex lbx xy+  else Nothing++++-- | WidePChar represents part of a PChar that+-- the Int8 parameter is offset from where the PChar originates from, so for example+-- '😱' <- PChar+--  01 <- Int8 offset parameter+--+-- -1 value for offset means there is no character in the space, the PChar value is ignored in this case+type MWidePChar = (Int8, PChar)++emptyMWidePChar :: MWidePChar +emptyMWidePChar = (-1, ' ') -- ' ' is a dummy character needed to pad the unboxed vector++-- TODO consider making sparse variant+-- | the LBox may exceed the logical bounding box of the object that is being represented if that object contains wide chars+data PreRender = PreRender (V.Vector (MWidePChar)) LBox deriving (Show)++emptyPreRender :: PreRender+emptyPreRender = PreRender V.empty (LBox 0 0)++preRender_lookup :: (HasCallStack) => PreRender -> XY -> MWidePChar+preRender_lookup (PreRender v lbox) pos = r where+  -- we still have to do this check here since toIndex expects point to be contained in box+  r = if does_lBox_contains_XY lbox pos +    then case v V.!? (toIndex lbox pos) of+      Nothing -> assert False emptyMWidePChar+      Just x -> x+    else emptyMWidePChar+++-- NOTE OwlIteCache is intended to be used at several stages in the event loop+-- it can be used in Handlers, it can be used when generating SEltDrawers and it can be used for rendering itself+data OwlItemCache =+  -- TODO change to LineAnchorsForRenderList prob+  OwlItemCache_Line LineAnchorsForRender PreRender+  | OwlItemCache_Generic PreRender deriving (Show)++owlItemCache_preRender :: OwlItemCache -> Maybe PreRender+owlItemCache_preRender = \case+  OwlItemCache_Line _ x -> Just x+  OwlItemCache_Generic x -> Just x++newtype RenderCache = RenderCache {+    -- map for REltId to cache for each owl+    unRenderCache :: REltIdMap OwlItemCache+  } deriving (Show)++emptyRenderCache :: RenderCache+emptyRenderCache = RenderCache IM.empty++renderCache_clearAtKeys :: RenderCache -> [REltId] -> RenderCache+renderCache_clearAtKeys rcache rids = RenderCache $ foldr IM.delete (unRenderCache rcache) rids++renderCache_lookup :: RenderCache -> REltId -> Maybe OwlItemCache+renderCache_lookup rcache rid = IM.lookup rid (unRenderCache rcache)+++-- UNTESTED+makePreRender :: forall a. (HasOwlTree a) => a -> SEltDrawer -> PreRender+makePreRender ot SEltDrawer {..} = r where+  +  lbox' = _sEltDrawer_box ot +  lbox@(LBox _ (V2 w _)) = lBox_expand lbox' (0, _sEltDrawer_maxCharWidth-1, 0, 0)+  area = lBox_area lbox++  -- the (Int8, Int8, PChar) is (distance from prev wide pchar, width of prev wide pchar, wide pchar)+  -- width of prev wide pchar could be determined from wide pchar of course but may as well cache it+  unfoldrfn :: (Int, Maybe (Int8, Int8, PChar)) -> Maybe (MWidePChar, (Int, Maybe (Int8, Int8, PChar)))+  unfoldrfn (i, mprevwidechar) = r2 where+    pt = toPoint lbox i+    mchar = _sEltDrawer_renderFn ot pt+    mcharwithwidth = fmap (\pch -> (pch, getPCharWidth pch)) mchar+    eol = (i+1) `mod` w == 0++    moutputchar = case mprevwidechar of+      Nothing        -> case mchar of  +        Just pch -> (0, pch)+        Nothing -> emptyMWidePChar +      Just (a,_,pch) -> (a, pch)++    mnextwidechar = if eol +      then Nothing +      else case mprevwidechar of +        Nothing -> case mcharwithwidth of +          Nothing -> Nothing+          Just (pch, width) -> if width > 1+            then Just (1,width,pch)+            else Nothing+        Just (a,b,_) | a == b-1 -> Nothing+        Just (a,b,pch) -> Just (a+1, b, pch)++    r2 = if i == area +      then Nothing+      else Just (moutputchar, (i+1, mnextwidechar))++  r = PreRender (V.unfoldr unfoldrfn (0,Nothing)) lbox++
+ src/Potato/Flow/SEltMethods.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.SEltMethods where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.Methods.LineDrawer+import           Potato.Flow.Methods.TextCommon+import           Potato.Flow.Methods.Types+import           Potato.Flow.Owl+import Potato.Flow.RenderCache+import           Potato.Flow.OwlItem+import           Potato.Flow.SElts+import           Potato.Flow.Types++import           Data.Dependent.Sum             (DSum ((:=>)))+import qualified Data.Map                       as Map+import           Data.Maybe                     (fromJust)+import qualified Data.Text                      as T+import qualified Potato.Data.Text.Zipper        as TZ+import Control.Exception (assert)+++-- DisplayLines tag is Int, 0 for no cursor 1 for cursor+noTrailngCursorDisplayLines :: Int -> TextAlign -> T.Text -> TZ.DisplayLines Int+noTrailngCursorDisplayLines width alignment text = r where+  -- force TZ to top so that displayLinesWithAlignment doesn't create trailing space for cursor+  tz = TZ.top (TZ.fromText text)++  -- hack to get rid of trailing cursor if text is ""+  r = if T.null text+    then TZ.DisplayLines {+        _displayLines_spans = []+        , _displayLines_offsetMap = Map.empty+        , _displayLines_cursorPos   = (0,0)+      }+    else TZ.displayLinesWithAlignment (convertTextAlignToTextZipperTextAlignment alignment) width 0 1 tz++makeDisplayLinesFromSBox :: SBox -> TZ.DisplayLines Int+makeDisplayLinesFromSBox sbox = r where+  alignment = _textStyle_alignment . _sBoxText_style . _sBox_text $ sbox+  text = _sBoxText_text . _sBox_text $ sbox+  LBox _ (V2 width' _) = _sBox_box sbox+  width = case _sBox_boxType sbox of+    SBoxType_BoxText   -> max 0 (width'-2)+    SBoxType_NoBoxText -> width'+    _                  -> error "wrong type"+  r = noTrailngCursorDisplayLines width alignment text++++-- TODO DELETE use doesOwlSubItemIntersectBox instead+doesSEltIntersectBox_DEPRECATED :: LBox -> SElt -> Bool+doesSEltIntersectBox_DEPRECATED lbox selt = case selt of+  SEltNone                     -> False+  SEltFolderStart              -> False+  SEltFolderEnd                -> False+  SEltBox x                    -> does_lBox_intersect_include_zero_area lbox (_sBox_box x)+  SEltTextArea x                   -> does_lBox_intersect_include_zero_area lbox (_sTextArea_box x)+  -- TODO this is wrong, do it correctly...+  -- we use does_lBox_intersect since it's impossible for a SAutoLine to have zero sized box+  SEltLine sline@SAutoLine {..} -> does_lBox_intersect lbox (fromJust $ getSEltBox_naive (SEltLine sline))++doesSEltIntersectPoint :: XY -> SElt -> Bool+doesSEltIntersectPoint pos selt = doesSEltIntersectBox_DEPRECATED (LBox pos (V2 1 1)) selt++getSEltSuperStyle :: SElt -> Maybe SuperStyle+getSEltSuperStyle selt = case selt of+  SEltBox SBox {..}       -> Just _sBox_superStyle+  SEltLine SAutoLine {..} -> Just _sAutoLine_superStyle+  _                       -> Nothing++getSEltLabelSuperStyle :: SEltLabel -> Maybe SuperStyle+getSEltLabelSuperStyle (SEltLabel _ x) = getSEltSuperStyle x++getSEltLineStyle :: SElt -> Maybe LineStyle+getSEltLineStyle selt = case selt of+  SEltLine SAutoLine {..} -> Just _sAutoLine_lineStyle+  _                       -> Nothing++getSEltLineStyleEnd :: SElt -> Maybe LineStyle+getSEltLineStyleEnd selt = case selt of+  SEltLine SAutoLine {..} -> Just _sAutoLine_lineStyleEnd+  _                       -> Nothing++getSEltLabelLineStyle :: SEltLabel -> Maybe LineStyle+getSEltLabelLineStyle (SEltLabel _ x) = getSEltLineStyle x++getSEltLabelLineStyleEnd :: SEltLabel -> Maybe LineStyle+getSEltLabelLineStyleEnd (SEltLabel _ x) = getSEltLineStyleEnd x+++getSEltBoxTextStyle :: SElt -> Maybe TextStyle+getSEltBoxTextStyle = \case+  SEltBox SBox {..}         -> Just . _sBoxText_style $ _sBox_text+  _ -> Nothing++getSEltLabelBoxTextStyle :: SEltLabel -> Maybe TextStyle+getSEltLabelBoxTextStyle (SEltLabel _ x) = getSEltBoxTextStyle x++getSEltBoxType :: SElt -> Maybe SBoxType+getSEltBoxType = \case+  SEltBox SBox {..} -> Just _sBox_boxType+  _ -> Nothing++getSEltLabelBoxType :: SEltLabel -> Maybe SBoxType+getSEltLabelBoxType (SEltLabel _ x) = getSEltBoxType x++sBox_drawer :: SBox -> SEltDrawer+sBox_drawer sbox@SBox {..} = r where+  CanonicalLBox _ _ lbox@(LBox (V2 x y) (V2 w h)) = canonicalLBox_from_lBox _sBox_box++  titlewidth = max 0 (w-2)++  fillfn _ = case _superStyle_fill _sBox_superStyle of+    FillStyle_Simple c -> Just c+    FillStyle_Blank    -> Nothing++  rfntext (V2 x' y') = case _sBox_boxType of+    SBoxType_Box -> Nothing+    SBoxType_NoBox -> Nothing+    _ -> outputChar where++      -- 😰😰😰 for now we just do the below for every cell+      dl = makeDisplayLinesFromSBox sbox++      offs = case _sBox_boxType of+        SBoxType_NoBoxText -> (0,0)+        _                  -> (1,1)++      outputChar = displayLinesToChar (x, y) dl (x', y') offs++  -- TODO test+  rfnlabel (V2 x' y') = case _sBoxTitle_title _sBox_title of+    Nothing -> Nothing+    Just title -> outputChar where+      -- TODO we want to crop instead of wrap here+      -- however using infinite width trick will break AlignRight :(+      dl = noTrailngCursorDisplayLines titlewidth (_sBoxTitle_align _sBox_title) title+      -- note that y' will ultimately resolve to a yindex of 0 inside of displayLinesToChar+      outputChar = displayLinesToChar (x, y) dl (x', y') (1,0)++  rfnnoborder pt+    | not (does_lBox_contains_XY lbox pt) = Nothing+    | otherwise = case rfntext pt of+      -- 'Just Nothing' means don't use fill char (this happens when there are wide chars)+      Just mx -> mx+      Nothing -> fillfn pt++  rfnborder pt@(V2 x' y')+    | not (does_lBox_contains_XY lbox pt) = Nothing+    | w == 1 && h == 1 = _superStyle_point _sBox_superStyle+    | w == 1 = _superStyle_vertical _sBox_superStyle+    | h == 1 = _superStyle_horizontal _sBox_superStyle+    | x' == x && y' == y = _superStyle_tl _sBox_superStyle+    | x' == x && y' == y+h-1 = _superStyle_bl _sBox_superStyle+    | x' == x+w-1 && y' == y = _superStyle_tr _sBox_superStyle+    | x' == x+w-1 && y' == y+h-1 = _superStyle_br _sBox_superStyle+    | x' == x || x' == x+w-1 = _superStyle_vertical _sBox_superStyle+    -- label shows up at top horizontal portion+    | y' == y = case rfnlabel pt of+      Nothing    -> _superStyle_horizontal _sBox_superStyle+      Just pchar -> pchar+    | y' == y+h-1 = _superStyle_horizontal _sBox_superStyle+    | otherwise = rfnnoborder pt++  r = SEltDrawer {+      _sEltDrawer_box = const lbox+      , _sEltDrawer_renderFn = \_ -> case _sBox_boxType of+        SBoxType_NoBoxText -> rfnnoborder+        SBoxType_NoBox     -> rfnnoborder+        _                  -> rfnborder+      +      -- TODO +      , _sEltDrawer_maxCharWidth = 1+    }++sTextArea_drawer :: STextArea -> SEltDrawer+sTextArea_drawer STextArea {..} = r where++  lbox@(LBox p _) = _sTextArea_box++  renderfn p' = outputChar where+    inbounds = does_lBox_contains_XY lbox p'+    outputChar = if inbounds+      then case Map.lookup (p' - p) _sTextArea_text of+        Nothing -> if _sTextArea_transparent+          then Nothing+          else Just ' '+        Just c -> Just c+      else Nothing++  r = SEltDrawer {+      _sEltDrawer_box = const lbox+      , _sEltDrawer_renderFn = \_ -> renderfn++      -- TODO+      , _sEltDrawer_maxCharWidth = 1+    }++-- NOTE that there is not a 1-1 mapping between `OwlSubItem` and `OwlItemCache` as the `OwlItemCache` is dependent on the OwlTree+-- this function assumes that you are requesting the drawer with the intent of passing in an OwlTree+-- TODO it would have been better for SEltDrawer to be created based on an OwlTree rather than return a function that takes an OwlTree+getDrawerWithCache :: OwlSubItem -> Maybe OwlItemCache -> SEltDrawer+getDrawerWithCache osubitem mcache = case osubitem of +  OwlSubItemNone        -> nilDrawer+  OwlSubItemFolder _ -> nilDrawer+  OwlSubItemBox sbox    -> sBox_drawer sbox+  OwlSubItemLine sline -> case mcache of +    Just (OwlItemCache_Line lars _) -> sSimpleLineNewRenderFn sline (Just lars)+    Nothing -> sSimpleLineNewRenderFn sline Nothing+    _ -> assert False (sSimpleLineNewRenderFn sline Nothing)+  OwlSubItemTextArea stextarea  -> sTextArea_drawer stextarea++-- TODO pass in cache here+getDrawer :: OwlSubItem -> SEltDrawer+getDrawer = \case+  OwlSubItemNone        -> nilDrawer+  OwlSubItemFolder _ -> nilDrawer+  OwlSubItemBox sbox    -> sBox_drawer sbox+  OwlSubItemLine sline -> sSimpleLineNewRenderFn sline Nothing+  OwlSubItemTextArea stextarea  -> sTextArea_drawer stextarea+  {-+  where+    potatoDrawer = SEltDrawer {+        _sEltDrawer_box = const $ fromJust (getSEltBox_naive selt)+        , _sEltDrawer_renderFn =  makePotatoRenderer $ fromJust (getSEltBox_naive selt)+      }+  -}++getDrawerFromSEltForTest :: SElt -> SEltDrawer+getDrawerFromSEltForTest = getDrawer . sElt_to_owlSubItem++updateOwlSubItemCache :: (HasOwlTree a) => a -> OwlSubItem -> Maybe OwlItemCache+updateOwlSubItemCache ot x = r where+  r = case x of+    -- TODO use sAutoLine_to_lineAnchorsForRenderList here instead+    (OwlSubItemLine sline) -> cache where+      cache = Just $ OwlItemCache_Line (sSimpleLineNewRenderFnComputeCache ot sline) prerender+      seltdrawer = getDrawerWithCache x cache+      prerender = makePreRender ot seltdrawer +    _ -> Just $ OwlItemCache_Generic prerender where+      seltdrawer = getDrawerWithCache x Nothing+      prerender = makePreRender ot seltdrawer +++-- TODO move modify methods to another file++modify_sAutoLineConstraint_with_cBoundingBox :: Bool -> SAutoLineConstraint -> CBoundingBox -> SAutoLineConstraint+modify_sAutoLineConstraint_with_cBoundingBox isDo constraint CBoundingBox {..} = case constraint of+  SAutoLineConstraintFixed xy -> SAutoLineConstraintFixed $ modifyDelta isDo xy (_deltaLBox_translate _cBoundingBox_deltaBox)++modify_sElt_with_cBoundingBox :: Bool -> SElt -> CBoundingBox -> SElt+modify_sElt_with_cBoundingBox isDo selt cbb@CBoundingBox {..} = case selt of+  SEltBox sbox  -> SEltBox $ sbox {+      _sBox_box = modifyDelta isDo (_sBox_box sbox) _cBoundingBox_deltaBox+    }+  -- TODO handle resize parameter+  SEltLine sline@SAutoLine {..} -> SEltLine $ sline {+      _sAutoLine_start = modifyDelta isDo _sAutoLine_start+        (_deltaLBox_translate _cBoundingBox_deltaBox)+      , _sAutoLine_end = modifyDelta isDo _sAutoLine_end+        (_deltaLBox_translate _cBoundingBox_deltaBox)+      , _sAutoLine_midpoints = fmap (\slc -> modify_sAutoLineConstraint_with_cBoundingBox isDo slc cbb) _sAutoLine_midpoints+    }+  SEltTextArea stext -> SEltTextArea $ stext {+      _sTextArea_box     = modifyDelta isDo (_sTextArea_box stext) _cBoundingBox_deltaBox+    }+  x          -> x++modify_sElt_with_cSuperStyle :: Bool -> SElt -> CSuperStyle -> SElt+modify_sElt_with_cSuperStyle isDo selt (CSuperStyle style) = case selt of+  SEltBox sbox -> SEltBox $ sbox {+      _sBox_superStyle = modifyDelta isDo (_sBox_superStyle sbox) style+    }+  -- TODO handle resize parameter+  SEltLine sline -> SEltLine $ sline {+      _sAutoLine_superStyle = modifyDelta isDo (_sAutoLine_superStyle sline) style+    }+  _ -> error $ "Controller - SElt type mismatch: CTagSuperStyle - " <> show selt+  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk+  --x -> x++-- TODO DELETE use llama instead+modify_sElt_with_cLineStyle :: Bool -> SElt -> CLineStyle -> SElt+modify_sElt_with_cLineStyle isDo selt (CLineStyle style) = case selt of+  SEltLine sline -> SEltLine $ sline {+      _sAutoLine_lineStyle = modifyDelta isDo (_sAutoLine_lineStyle sline) style+    }+  _ -> error $ "Controller - SElt type mismatch: CTagLineStyle - " <> show selt+  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk+  --x -> x++modify_sElt_with_cTextStyle :: Bool -> SElt -> CTextStyle -> SElt+modify_sElt_with_cTextStyle isDo selt (CTextStyle style) = case selt of+  SEltBox sbox -> SEltBox $ sbox {+      _sBox_text = (_sBox_text sbox) {+          _sBoxText_style = modifyDelta isDo (_sBoxText_style . _sBox_text $ sbox) style+        }+    }+  _ -> error $ "Controller - SElt type mismatch: CTagBoxTextStyle - " <> show selt+  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk+  --x -> x++modify_sEltBox_label_with_cTextAlign :: Bool -> SElt -> CTextAlign -> SElt+modify_sEltBox_label_with_cTextAlign isDo selt (CTextAlign align) = case selt of+  SEltBox sbox -> SEltBox $ sbox {+      _sBox_title = sboxtitle {+          _sBoxTitle_align = modifyDelta isDo (_sBoxTitle_align sboxtitle) align+        }+    } where+      sboxtitle = _sBox_title sbox+  _ -> error $ "Controller - SElt type mismatch: CTagBoxLabelAlignment - " <> show selt+  -- maybe we want silent failure case in the future, so you can easily restyle a big selection in bulk+  --x -> x++modify_sEltBox_label_with_cMaybeText :: Bool -> SElt -> CMaybeText -> SElt+modify_sEltBox_label_with_cMaybeText isDo selt (CMaybeText text) = case selt of+  SEltBox sbox -> SEltBox $ sbox {+      _sBox_title = sboxtitle {+          _sBoxTitle_title = modifyDelta isDo (_sBoxTitle_title sboxtitle) text+        }+    } where+      sboxtitle = _sBox_title sbox+  _ -> error $ "Controller - SElt type mismatch: CTagBoxLabelAlignment - " <> show selt++modify_sEltTextArea_with_cTextArea :: Bool -> SElt -> CTextArea -> SElt+modify_sEltTextArea_with_cTextArea isDo selt (CTextArea dt) = case selt of+  SEltTextArea stextarea -> SEltTextArea $ stextarea {+      _sTextArea_text = modifyDelta isDo (_sTextArea_text stextarea) dt+    }+  _ -> error $ "Controller - SElt type mismatch: CTagTextArea - " <> show selt++modify_sEltTextArea_with_cTextAreaToggle :: Bool -> SElt -> CTextAreaToggle -> SElt+modify_sEltTextArea_with_cTextAreaToggle isDo selt (CTextAreaToggle toggle) = case selt of+  -- double toggle is idempotent but we disallow it for now+  SEltTextArea _ -> error $ "Controller - SElt type mismatch: CTagTextAreaToggle - " <> show selt+  x -> modifyDelta isDo x toggle+++modifyDelta :: (Delta x dx) => Bool -> x ->  dx -> x+modifyDelta isDo x dx = if isDo+  then plusDelta x dx+  else minusDelta x dx++updateFnFromController :: Bool -> Controller -> (SEltLabel -> SEltLabel)+updateFnFromController isDo = \case+  (CTagRename :=> Identity d) -> \seltl -> modifyDelta isDo seltl d+  (CTagLine :=> Identity d) -> \(SEltLabel sname selt) -> case selt of+    SEltLine s -> SEltLabel sname (SEltLine $ modifyDelta isDo s d)+    _ -> error $ "Controller - SElt type mismatch: CTagLine - " <> show selt+  (CTagBoxText :=> Identity d) -> \(SEltLabel sname selt) -> case selt of+    SEltBox s -> SEltLabel sname (SEltBox $ modifyDelta isDo s d)+    _ -> error $ "Controller - SElt type mismatch: CTagBoxText - " <> show selt+  (CTagBoxType :=> Identity d) -> \(SEltLabel sname selt) -> case selt of+    SEltBox s -> SEltLabel sname (SEltBox $ modifyDelta isDo s d)+    _ -> error $ "Controller - SElt type mismatch: CTagBoxText - " <> show selt+  (CTagBoundingBox :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sElt_with_cBoundingBox isDo selt d)+  (CTagSuperStyle :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sElt_with_cSuperStyle isDo selt d)+  (CTagLineStyle :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sElt_with_cLineStyle isDo selt d)+  (CTagBoxTextStyle :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sElt_with_cTextStyle isDo selt d)++  (CTagBoxLabelAlignment :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sEltBox_label_with_cTextAlign isDo selt d)+  (CTagBoxLabelText :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sEltBox_label_with_cMaybeText isDo selt d)++  (CTagTextArea :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sEltTextArea_with_cTextArea isDo selt d)+  (CTagTextAreaToggle :=> Identity d) -> \(SEltLabel sname selt) ->+    SEltLabel sname (modify_sEltTextArea_with_cTextAreaToggle isDo selt d)+++-- | helper method used in copy pasta+offsetSEltTree :: XY -> SEltTree -> SEltTree+offsetSEltTree offset stree = r where+  op = CBoundingBox (DeltaLBox offset 0)+  offsetfn (rid, seltl) = (rid, updateFnFromController True (CTagBoundingBox :=> Identity op) seltl)+  r = fmap offsetfn stree
+ src/Potato/Flow/SElts.hs view
@@ -0,0 +1,471 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.SElts where++import           Relude++import           Potato.Flow.Math+import Potato.Data.Text.Unicode++import           Control.Exception (assert)+import           Data.Aeson+import           Data.Binary+import           Data.Default+import qualified Text.Show+import qualified Data.Text as T+import qualified Data.List         as L+import qualified Data.Map as Map+import qualified Potato.Data.Text.Zipper as TZ+import Data.Ratio+++type REltId = Int+type PChar = Char+type MPChar = Maybe PChar++getPCharWidth :: Char -> Int8+getPCharWidth = getCharWidth+++data FillStyle = FillStyle_Blank | FillStyle_Simple PChar deriving (Eq, Generic, Show)++instance FromJSON FillStyle+instance ToJSON FillStyle+instance Binary FillStyle+instance NFData FillStyle++instance Default FillStyle where+  def = FillStyle_Simple ' '++-- TODO add line ends?+-- TODO add line thickness?+-- TODO add line fill?+data SuperStyle = SuperStyle {+  _superStyle_tl           :: MPChar+  , _superStyle_tr         :: MPChar+  , _superStyle_bl         :: MPChar+  , _superStyle_br         :: MPChar+  , _superStyle_vertical   :: MPChar+  , _superStyle_horizontal :: MPChar+  , _superStyle_point      :: MPChar -- used for 1x1 boxes and 1x lines+  , _superStyle_fill       :: FillStyle+} deriving (Eq, Generic)++instance FromJSON SuperStyle+instance ToJSON SuperStyle+instance Binary SuperStyle+instance NFData SuperStyle++instance Default SuperStyle where+  def = SuperStyle {+    _superStyle_tl = Just '╔'+    , _superStyle_tr = Just '╗'+    , _superStyle_bl = Just '╚'+    , _superStyle_br = Just '╝'+    , _superStyle_vertical   = Just '║'+    , _superStyle_horizontal = Just '═'+    , _superStyle_point = Just '█'+    , _superStyle_fill = def+  }++instance Show SuperStyle where+  show = superStyle_toListFormat++superStyle_fromListFormat :: [PChar] -> SuperStyle+superStyle_fromListFormat chars = assert (l == 7 || l == 8) $ r where+  l = length chars+  r = SuperStyle {+    _superStyle_tl = Just $ chars L.!! 0+    , _superStyle_tr = Just $ chars L.!! 1+    , _superStyle_bl = Just $ chars L.!! 2+    , _superStyle_br = Just $ chars L.!! 3+    , _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 L.!! 7)+  }++-- superStyle_fromListFormat "╔╗╚╝║═█" `shouldBe` def+-- empty styles are converted to space character+superStyle_toListFormat :: SuperStyle -> [PChar]+superStyle_toListFormat SuperStyle {..} = r where+  mfill = case _superStyle_fill of+    FillStyle_Blank    -> []+    FillStyle_Simple c -> [c]+  r = [+      fromMaybe ' ' _superStyle_tl+      ,fromMaybe ' ' _superStyle_tr+      ,fromMaybe ' ' _superStyle_bl+      ,fromMaybe ' ' _superStyle_br+      ,fromMaybe ' ' _superStyle_vertical+      ,fromMaybe ' ' _superStyle_horizontal+      ,fromMaybe ' ' _superStyle_point+    ] <> mfill++-- |+data TextAlign = TextAlign_Left | TextAlign_Right | TextAlign_Center deriving (Eq, Generic, Show)++instance FromJSON TextAlign+instance ToJSON TextAlign+instance Binary TextAlign+instance NFData TextAlign++instance Default TextAlign where+  def = TextAlign_Left++convertTextAlignToTextZipperTextAlignment :: TextAlign -> TZ.TextAlignment+convertTextAlignToTextZipperTextAlignment = \case+  TextAlign_Left -> TZ.TextAlignment_Left+  TextAlign_Right -> TZ.TextAlignment_Right+  TextAlign_Center -> TZ.TextAlignment_Center++-- |+data TextStyle = TextStyle {+  -- margins+  _textStyle_alignment :: TextAlign+} deriving (Eq, Generic)++instance FromJSON TextStyle+instance ToJSON TextStyle+instance Binary TextStyle+instance NFData TextStyle++instance Default TextStyle where+  def = TextStyle { _textStyle_alignment = def }++instance Show TextStyle where+  show TextStyle {..} = show _textStyle_alignment+++-- TODO you need support for AL_Any and maybe AL_Center+-- TODO lowercase plz+data AttachmentLocation = AL_Top | AL_Bot | AL_Left | AL_Right | AL_Any deriving (Eq, Generic, Show)++instance FromJSON AttachmentLocation+instance ToJSON AttachmentLocation+instance Binary AttachmentLocation+instance NFData AttachmentLocation++type AttachmentOffsetRatio = Ratio Int++data Attachment = Attachment {+  _attachment_target :: REltId+  , _attachment_location :: AttachmentLocation+  -- you can prob just delete these, don't think we need them.+  -- 1 is right/down most, 0 is left/top most, `1 % 2` is the middle+  , _attachment_offset_rel :: AttachmentOffsetRatio+} deriving (Eq, Generic, Show)++instance FromJSON Attachment+instance ToJSON Attachment+instance Binary Attachment+instance NFData Attachment+++attachment_offset_rel_default :: Ratio Int+attachment_offset_rel_default =  1 % 2++attachment_create_default :: REltId -> AttachmentLocation -> Attachment+attachment_create_default rid al = Attachment {+    _attachment_target = rid+    , _attachment_location = al+    , _attachment_offset_rel = attachment_offset_rel_default+  }++-- |+data SBoxTitle = SBoxTitle {+  _sBoxTitle_title   :: Maybe Text+  , _sBoxTitle_align :: TextAlign+} deriving (Eq, Generic)++instance FromJSON SBoxTitle+instance ToJSON SBoxTitle+instance Binary SBoxTitle+instance NFData SBoxTitle++instance Default SBoxTitle where+  def = SBoxTitle {+      _sBoxTitle_title = Nothing+      , _sBoxTitle_align = def+    }++instance Show SBoxTitle where+  show SBoxTitle {..} = "SBoxTitle: " <> show _sBoxTitle_align <> " " <> show _sBoxTitle_title++-- |+data SBoxText = SBoxText {+  _sBoxText_text    :: Text+  , _sBoxText_style :: TextStyle+} deriving (Eq, Generic)++instance FromJSON SBoxText+instance ToJSON SBoxText+instance Binary SBoxText+instance NFData SBoxText++instance Default SBoxText where+  def = SBoxText {+      _sBoxText_text = ""+      , _sBoxText_style = def+    }++instance Show SBoxText where+  show SBoxText {..} = "SBoxText: " <> T.unpack _sBoxText_text <> " " <> show _sBoxText_style+++data SBoxType = SBoxType_Box | SBoxType_NoBox | SBoxType_BoxText | SBoxType_NoBoxText deriving (Eq, Generic, Show)++instance FromJSON SBoxType+instance ToJSON SBoxType+instance Binary SBoxType+instance NFData SBoxType++instance Default SBoxType where+  def = SBoxType_Box++sBoxType_isText :: SBoxType -> Bool+sBoxType_isText sbt = sbt == SBoxType_BoxText || sbt == SBoxType_NoBoxText++sBoxType_hasBorder :: SBoxType -> Bool+sBoxType_hasBorder sbt = sbt == SBoxType_Box || sbt == SBoxType_BoxText++make_sBoxType :: Bool -> Bool -> SBoxType+make_sBoxType border text = if border+  then if text+    then SBoxType_BoxText+    else SBoxType_Box+  else if text+    then SBoxType_NoBoxText+    else SBoxType_NoBox++-- |+data SBox = SBox {+  _sBox_box       :: LBox+  , _sBox_superStyle   :: SuperStyle+  , _sBox_title   :: SBoxTitle+  , _sBox_text    :: SBoxText+  , _sBox_boxType :: SBoxType+} deriving (Eq, Generic)++instance FromJSON SBox+instance ToJSON SBox+instance Binary SBox+instance NFData SBox++instance Default SBox where+  def = SBox {+      _sBox_box     = LBox 0 0+      , _sBox_superStyle = def+      , _sBox_title = def+      , _sBox_text  = def+      , _sBox_boxType = SBoxType_Box+    }++instance Show SBox where+  show SBox {..} = "SBox: " <> show _sBox_box <> " " <> show _sBox_title <> " " <> show _sBox_text <> " " <> show _sBox_boxType <> " " <> show _sBox_superStyle++sBox_hasLabel :: SBox -> Bool+sBox_hasLabel sbox = sBoxType_hasBorder (_sBox_boxType sbox) && (isJust . _sBoxTitle_title ._sBox_title $ sbox)++-- TODO DELETE no longer used with SAutoLine+data LineAutoStyle =+  LineAutoStyle_Auto+  | LineAutoStyle_AutoStraight+  | LineAutoStyle_StraightAlwaysHorizontal+  | LineAutoStyle_StraightAlwaysVertical+  deriving (Eq, Generic, Show)++instance FromJSON LineAutoStyle+instance ToJSON LineAutoStyle+instance Binary LineAutoStyle+instance NFData LineAutoStyle++instance Default LineAutoStyle where+  def = LineAutoStyle_AutoStraight+++data LineStyle = LineStyle {+  _lineStyle_leftArrows    :: Text+  , _lineStyle_rightArrows :: Text+  , _lineStyle_upArrows    :: Text+  , _lineStyle_downArrows  :: Text+} deriving (Eq, Generic)++instance FromJSON LineStyle+instance ToJSON LineStyle+instance Binary LineStyle+instance NFData LineStyle++instance Default LineStyle where+  def = LineStyle {+      _lineStyle_leftArrows    = "<"+      , _lineStyle_rightArrows = ">"+      , _lineStyle_upArrows    = "^"+      , _lineStyle_downArrows  = "v"+    }++lineStyle_fromListFormat :: ([PChar], [PChar], [PChar], [PChar]) -> LineStyle+lineStyle_fromListFormat (l,r,u,d) = LineStyle {+    _lineStyle_leftArrows    = T.pack l+    , _lineStyle_rightArrows = T.pack r+    , _lineStyle_upArrows    = T.pack u+    , _lineStyle_downArrows  = T.pack d+  }++lineStyle_toListFormat :: LineStyle -> ([PChar], [PChar], [PChar], [PChar])+lineStyle_toListFormat LineStyle {..} = (T.unpack _lineStyle_leftArrows, T.unpack _lineStyle_rightArrows, T.unpack _lineStyle_upArrows, T.unpack _lineStyle_downArrows)+++instance Show LineStyle where+  show ls = r where+    (a, b, c, d) = lineStyle_toListFormat ls+    r = "LineStyle: " <> a <> " " <> b <> " " <> c <> " " <> d++-- someday we might have more than one constraint...+data SAutoLineConstraint = SAutoLineConstraintFixed XY deriving (Eq, Generic, Show)++instance FromJSON SAutoLineConstraint+instance ToJSON SAutoLineConstraint+instance Binary SAutoLineConstraint+instance NFData SAutoLineConstraint++-- TODO provide absolute and relative positioning args+data SAutoLineLabelPosition =+  SAutoLineLabelPositionRelative Float -- 0 is at "left" anchor point and 1 is at "right" anchor point+  deriving (Eq, Generic, Show)++instance FromJSON SAutoLineLabelPosition+instance ToJSON SAutoLineLabelPosition+instance Binary SAutoLineLabelPosition+instance NFData SAutoLineLabelPosition++data SAutoLineLabel = SAutoLineLabel {+  _sAutoLineLabel_index :: Int -- index relative to _sAutoLine_midpoints for where the midpoint lives+  , _sAutoLineLabel_position :: SAutoLineLabelPosition+  , _sAutoLineLabel_text :: Text+  --, _sAutoLineLabel_vertical :: Bool -- WIP true if vertically oriented+} deriving (Eq, Generic)++instance Show SAutoLineLabel where+  show SAutoLineLabel {..} = "SAutoLineLabel: " <> show _sAutoLineLabel_index <> " " <> show _sAutoLineLabel_position <> " " <> show _sAutoLineLabel_text++instance FromJSON SAutoLineLabel+instance ToJSON SAutoLineLabel+instance Binary SAutoLineLabel+instance NFData SAutoLineLabel++instance Default SAutoLineLabel where+  def = SAutoLineLabel {+      -- anchor index, text shows AFTER index+      _sAutoLineLabel_index = 0+      , _sAutoLineLabel_position = SAutoLineLabelPositionRelative 0+      , _sAutoLineLabel_text = ""+      --, _sAutoLineLabel_vertical = False+    }+++-- |+data SAutoLine = SAutoLine {+  _sAutoLine_start       :: XY+  , _sAutoLine_end       :: XY+  , _sAutoLine_superStyle     :: SuperStyle++  -- TODO you need one for start/end of line (LineStyle, LineStyle)+  , _sAutoLine_lineStyle :: LineStyle+  , _sAutoLine_lineStyleEnd :: LineStyle++  -- NOTE attachments currently are not guaranteed to exist+  -- in particular, if you copy a line, delete its target and paste, it will be attached to something that doesn't exist+  -- tinytools will attempt to correct attachment in some cases but don't get too cozy about it!+  , _sAutoLine_attachStart :: Maybe Attachment+  , _sAutoLine_attachEnd :: Maybe Attachment++  , _sAutoLine_midpoints :: [SAutoLineConstraint]+  , _sAutoLine_labels :: [SAutoLineLabel] -- WIP currently does nothing+} deriving (Eq, Generic)++instance FromJSON SAutoLine+instance ToJSON SAutoLine+instance Binary SAutoLine+instance NFData SAutoLine++instance Show SAutoLine where+  show SAutoLine {..} = r where+    start = maybe (show _sAutoLine_start) show _sAutoLine_attachStart+    end = maybe (show _sAutoLine_end) show _sAutoLine_attachEnd+    r = "SAutoLine: " <> start <> " " <> end <> " " <> show _sAutoLine_midpoints <> " " <> show _sAutoLine_labels++-- makes writing tests easier...+instance Default SAutoLine where+  def = SAutoLine {+      _sAutoLine_start       = 0+      , _sAutoLine_end       = 0+      , _sAutoLine_superStyle     = def+      , _sAutoLine_lineStyle = def+      , _sAutoLine_lineStyleEnd = def+      , _sAutoLine_attachStart = Nothing+      , _sAutoLine_attachEnd = Nothing+      , _sAutoLine_midpoints = []+      , _sAutoLine_labels = []+    }++-- TODO DELETE+-- |+data SCartLines = SCartLines {+  _sCartLines_start   :: XY+  , _sCartLines_ends  :: NonEmpty (Either Int Int)+  , _sCartLines_style :: SuperStyle+} deriving (Eq, Generic, Show)++instance FromJSON SCartLines+instance ToJSON SCartLines+instance Binary SCartLines+instance NFData SCartLines++type TextAreaMapping = Map XY PChar++-- | abitrary text confined to a box+data STextArea = STextArea {+  _sTextArea_box           :: LBox+  , _sTextArea_text        :: TextAreaMapping+  -- TODO consider using SuperStyle here instead and using Fill property only+  , _sTextArea_transparent :: Bool+} deriving (Eq, Generic, Show)++instance Default STextArea where+  def = STextArea {+      _sTextArea_box   =        LBox 0 0+      , _sTextArea_text        = Map.empty+      , _sTextArea_transparent = True+    }++instance FromJSON STextArea+instance ToJSON STextArea+instance Binary STextArea+instance NFData STextArea++-- TODO consider removing this all together and serializing Owl stuff directly+data SElt =+  SEltNone+  | SEltFolderStart+  | SEltFolderEnd+  | SEltBox SBox+  | SEltLine SAutoLine+  | SEltTextArea STextArea+  deriving (Eq, Generic, Show)++instance FromJSON SElt+instance ToJSON SElt+instance Binary SElt+instance NFData SElt++-- TODO consider removing this all together and serializing Owl stuff directly+data SEltLabel = SEltLabel {+ _sEltLabel_name   :: Text+ , _sEltLabel_sElt :: SElt+} deriving (Eq, Generic, Show)++instance FromJSON SEltLabel+instance ToJSON SEltLabel+instance Binary SEltLabel+instance NFData SEltLabel
+ src/Potato/Flow/TestStates.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module Potato.Flow.TestStates (+  folderStart+  , folderEnd+  , someSEltLabel+  , someSCanvas+  , defaultCanvasLBox+  , someOwlItem+  , pFState_to_owlPFState+  , owlPFState_fromSElts+  , owlpfstate_someValidState1+  , owlpfstate_someInvalidState1+  , owlpfstate_someInvalidState2+  , owlpfstate_basic0+  , owlpfstate_basic1+  , controllermeta_basic1_lockandhidestuff1+  , controllermeta_basic2_expandEverything+  , owlpfstate_basic2+  , owlpfstate_attachments1+  , owlpfstate_attachments2+  , owlpfstate_zero+  , owlpfstate_newProject+) where++import           Relude++import           Potato.Flow+import           Potato.Flow.Deprecated.TestStates+import           Potato.Flow.Deprecated.State++import qualified Data.IntMap as IM++someOwlItem :: OwlItem+someOwlItem = OwlItem (OwlInfo "some elt") OwlSubItemNone+++makeLayerMeta :: Bool -> Bool -> Bool -> LayerMeta+makeLayerMeta isLocked isHidden isCollapsed = LayerMeta {+    _layerMeta_isLocked      = isLocked+    , _layerMeta_isHidden    = isHidden+    , _layerMeta_isCollapsed = isCollapsed+  }++pFState_to_owlPFState :: PFState -> OwlPFState+pFState_to_owlPFState pfs@PFState {..} = OwlPFState {+  _owlPFState_owlTree = owlTree_fromSEltTree . _sPotatoFlow_sEltTree . pFState_to_sPotatoFlow $ pfs+  , _owlPFState_canvas    = _pFState_canvas+}++owlPFState_fromSElts :: [SElt] -> LBox -> OwlPFState+owlPFState_fromSElts selts lbox = pFState_to_owlPFState $ pFState_fromSElts selts lbox++owlpfstate_someValidState1 :: OwlPFState+owlpfstate_someValidState1 = pFState_to_owlPFState pfstate_someValidState1++owlpfstate_someInvalidState1 :: OwlPFState+owlpfstate_someInvalidState1 = pFState_to_owlPFState pfstate_someInvalidState1++owlpfstate_someInvalidState2 :: OwlPFState+owlpfstate_someInvalidState2 = pFState_to_owlPFState pfstate_someInvalidState2++owlpfstate_basic0 :: OwlPFState+owlpfstate_basic0 = pFState_to_owlPFState pfstate_basic0++owlpfstate_basic1 :: OwlPFState+owlpfstate_basic1 = pFState_to_owlPFState pfstate_basic1++controllermeta_basic1_lockandhidestuff1 :: ControllerMeta+controllermeta_basic1_lockandhidestuff1 = ControllerMeta {+    _controllerMeta_pan = 0+    , _controllerMeta_layers = IM.fromList [+        (0, makeLayerMeta True False False) -- b1  is locked+        , (2, makeLayerMeta False True False) -- b3 is hidden+      ]+  }++-- | same as owlpfstate_basic1 except with folders+owlpfstate_basic2 :: OwlPFState+owlpfstate_basic2 = pFState_to_owlPFState pfstate_basic2+++controllermeta_basic2_expandEverything :: ControllerMeta+controllermeta_basic2_expandEverything = ControllerMeta {+    _controllerMeta_pan = 0+    , _controllerMeta_layers = IM.fromList [+        (0, makeLayerMeta False False False) -- fstart1 is expanded+        , (1, makeLayerMeta False False False) -- fstart2 is expanded+        , (7, makeLayerMeta False False False) -- fstart3 is expanded+      ]+  }++owlpfstate_attachments1 :: OwlPFState+owlpfstate_attachments1 = pFState_to_owlPFState pfstate_attachments1++owlpfstate_attachments2 :: OwlPFState+owlpfstate_attachments2 = pFState_to_owlPFState pfstate_attachments2++-- contains SElts of size 0+owlpfstate_zero :: OwlPFState+owlpfstate_zero = pFState_to_owlPFState pfstate_zero++owlpfstate_newProject :: OwlPFState+owlpfstate_newProject =  OwlPFState {+    _owlPFState_owlTree = emptyOwlTree+    , _owlPFState_canvas    = SCanvas (LBox 0 (V2 50 20))+  }
+ src/Potato/Flow/Types.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module Potato.Flow.Types (+  REltIdMap+  , ControllersWithId+  , controllerWithId_isParams+  , AttachmentMap++  -- DELETE+  , LayerPos+  , SuperSEltLabel+  , SEltLabelChanges+  , SEltLabelChangesWithLayerPos+  , LayerPosMap++  -- * controllers+  , CRename(..)+  , CLine(..)+  , CBoxText(..)+  , CBoxType(..)+  , CBoundingBox(..)+  , CTag(..)+  , CTextStyle(..)+  , CSuperStyle(..)+  , CLineStyle(..)+  , CTextAlign(..)+  , CMaybeText(..)+  , CTextArea(..)+  , CTextAreaToggle(..)++  , Controller++  -- * delta types+  , DeltaText+  , DeltaSuperStyle(..)+  , DeltaLineStyle(..)+  , DeltaTextStyle(..)+  , DeltaTextAlign(..)+  , DeltaMaybeText(..)+  , DeltaTextArea(..)+  , DeltaTextAreaToggle(..)++  -- * serialized types+  , SEltTree+  , SCanvas(..)+  , SPotatoFlow(..)+) where++import           Relude++import           Potato.Flow.Math+import           Potato.Flow.SElts++import           Control.Exception         (assert)+import           Data.Aeson+import           Data.Binary+import           Data.Constraint.Extras.TH+import           Data.Default+import qualified Data.Dependent.Sum        as DS+import qualified Data.IntSet as IS+import           Data.GADT.Compare.TH+import           Data.GADT.Show.TH+import qualified Data.IntMap.Strict        as IM+import qualified Data.Map as Map+import qualified Text.Show++++type LayerPos = Int+type REltIdMap a = IM.IntMap a+type SuperSEltLabel = (REltId, LayerPos, SEltLabel)+type AttachmentMap = REltIdMap (IS.IntSet) -- key is target, value is set of things attaching to target++-- TODO ugg, pretty sure this could just be SElt instead of SEltLabel+type SEltLabelChanges = REltIdMap (Maybe SEltLabel)+type SEltLabelChangesWithLayerPos = REltIdMap (Maybe (LayerPos, SEltLabel))+type LayerPosMap = REltIdMap LayerPos+++type SEltTree = [(REltId,SEltLabel)]++data SCanvas = SCanvas {+  _sCanvas_box :: LBox+} deriving (Eq, Generic)++instance Show SCanvas where+  show s = "SCanvas " <> show (_sCanvas_box s)++instance FromJSON SCanvas+instance ToJSON SCanvas+instance Binary SCanvas+instance NFData SCanvas++-- TODO serialize PFState instead+data SPotatoFlow = SPotatoFlow {+  _sPotatoFlow_sCanvas    :: SCanvas+  , _sPotatoFlow_sEltTree :: SEltTree+} deriving (Eq, Generic, Show)++instance FromJSON SPotatoFlow+instance ToJSON SPotatoFlow+instance Binary SPotatoFlow+instance NFData SPotatoFlow+++++++++++-- TODO DELETE ALL CONTROLLER STUFF++-- | (old text, new text)++type DeltaText = (Text,Text)++{-+-- TODO more efficient to do this with zippers prob?+-- is there a way to make this more generic?+instance Delta Text DeltaText where+  plusDelta s (b, a) = assert (b == s) a+  minusDelta s (b, a) = assert (a == s) b+-}++data DeltaTextAlign = DeltaTextAlign (TextAlign, TextAlign) deriving (Eq, Generic, Show)+instance NFData DeltaTextAlign+instance Delta TextAlign DeltaTextAlign where+  plusDelta ta (DeltaTextAlign d) = plusDelta ta d+  minusDelta ta (DeltaTextAlign d) = minusDelta ta d++data DeltaSuperStyle = DeltaSuperStyle (SuperStyle, SuperStyle) deriving (Eq, Generic, Show)+instance NFData DeltaSuperStyle+instance Delta SuperStyle DeltaSuperStyle where+  plusDelta ss (DeltaSuperStyle d) = plusDelta ss d+  minusDelta ss (DeltaSuperStyle d) = minusDelta ss d++data DeltaLineStyle = DeltaLineStyle (LineStyle, LineStyle) deriving (Eq, Generic, Show)+instance NFData DeltaLineStyle+instance Delta LineStyle DeltaLineStyle where+  plusDelta ss (DeltaLineStyle d) = plusDelta ss d+  minusDelta ss (DeltaLineStyle d) = minusDelta ss d++data DeltaTextStyle = DeltaTextStyle (TextStyle, TextStyle) deriving (Eq, Generic, Show)+instance NFData DeltaTextStyle+instance Delta TextStyle DeltaTextStyle where+  plusDelta ts (DeltaTextStyle d) = plusDelta ts d+  minusDelta ts (DeltaTextStyle d) = minusDelta ts d++data DeltaMaybeText = DeltaMaybeText (Maybe Text, Maybe Text)  deriving (Eq, Generic, Show)+instance NFData DeltaMaybeText+instance Delta (Maybe Text) DeltaMaybeText where+  plusDelta mt (DeltaMaybeText d) = plusDelta mt d+  minusDelta mt (DeltaMaybeText d) = minusDelta mt d++data DeltaTextArea = DeltaTextArea (Map XY (Maybe PChar, Maybe PChar))   deriving (Eq, Generic, Show)+instance NFData DeltaTextArea+instance Delta TextAreaMapping DeltaTextArea where+  plusDelta tam (DeltaTextArea m) = justs `Map.union` tam `Map.difference` empties where+    m' = fmap snd m+    justs = Map.mapMaybe id m'+    empties = Map.mapMaybe (\x -> if isNothing x then Just () else Nothing) m'+  minusDelta tam (DeltaTextArea m) =  justs `Map.union` tam `Map.difference` empties where+    m' = fmap fst m+    justs = Map.mapMaybe id m'+    empties = Map.mapMaybe (\x -> if isNothing x then Just () else Nothing) m'++-- TODO+data DeltaTextAreaToggle = DeltaTextAreaToggle SElt  deriving (Eq, Generic, Show)+instance NFData DeltaTextAreaToggle+instance Delta SElt DeltaTextAreaToggle where+  plusDelta s (DeltaTextAreaToggle s') = assert (s == s') $ undefined -- TODO+  minusDelta _ (DeltaTextAreaToggle s') = s'++data CRename = CRename {+  _cRename_deltaLabel :: DeltaText+} deriving (Eq, Generic, Show)+instance NFData CRename+instance Delta SEltLabel CRename where+  plusDelta (SEltLabel name selt) CRename {..} = SEltLabel (plusDelta name _cRename_deltaLabel) selt+  minusDelta (SEltLabel name selt) CRename {..} = SEltLabel (minusDelta name _cRename_deltaLabel) selt++data CLine = CLine {+  _cLine_deltaStart :: Maybe DeltaXY+  , _cLine_deltaEnd :: Maybe DeltaXY+  , _cLine_deltaAttachStart :: Maybe (Maybe Attachment, Maybe Attachment)+  , _cLine_deltaAttachEnd :: Maybe (Maybe Attachment, Maybe Attachment)+} deriving (Eq, Generic, Show)+instance NFData CLine+instance Default CLine where+  def = CLine Nothing Nothing Nothing Nothing++instance Delta SAutoLine CLine where+  plusDelta sline@SAutoLine {..} CLine {..} = sline {+      _sAutoLine_start   = case _cLine_deltaStart of+        Nothing -> _sAutoLine_start+        Just d  -> plusDelta _sAutoLine_start d+      , _sAutoLine_end   =  case _cLine_deltaEnd of+        Nothing -> _sAutoLine_end+        Just d  -> plusDelta _sAutoLine_end d+      , _sAutoLine_attachStart = case _cLine_deltaAttachStart of+        Nothing -> _sAutoLine_attachStart+        Just d  -> plusDelta _sAutoLine_attachStart d+      , _sAutoLine_attachEnd = case _cLine_deltaAttachEnd of+        Nothing -> _sAutoLine_attachEnd+        Just d  -> plusDelta _sAutoLine_attachEnd d+    }+  minusDelta sline@SAutoLine {..} CLine {..} = sline {+      _sAutoLine_start   = case _cLine_deltaStart of+        Nothing -> _sAutoLine_start+        Just d  -> minusDelta _sAutoLine_start d+      , _sAutoLine_end   =  case _cLine_deltaEnd of+        Nothing -> _sAutoLine_end+        Just d  -> minusDelta _sAutoLine_end d+      , _sAutoLine_attachStart = case _cLine_deltaAttachStart of+        Nothing -> _sAutoLine_attachStart+        Just d  -> minusDelta _sAutoLine_attachStart d+      , _sAutoLine_attachEnd = case _cLine_deltaAttachEnd of+        Nothing -> _sAutoLine_attachEnd+        Just d  -> minusDelta _sAutoLine_attachEnd d+    }++data CBoxText = CBoxText {+  _cBoxText_deltaText      :: DeltaText+} deriving (Eq, Generic, Show)++instance NFData CBoxText++instance Delta SBox CBoxText where+  plusDelta sbox@SBox {..} ctext = sbox {+      _sBox_text   = plusDelta _sBox_text ctext+    }+  minusDelta sbox@SBox {..} ctext = sbox {+      _sBox_text   = minusDelta _sBox_text ctext+    }++instance Delta SBoxText CBoxText where+  plusDelta sboxtext@SBoxText {..} CBoxText {..} = sboxtext {+      _sBoxText_text   = plusDelta _sBoxText_text _cBoxText_deltaText+    }+  minusDelta sboxtext@SBoxText {..} CBoxText {..} = sboxtext {+      _sBoxText_text   = minusDelta _sBoxText_text _cBoxText_deltaText+    }++data CBoxType = CBoxType (SBoxType, SBoxType) deriving (Eq, Generic, Show)++instance NFData CBoxType++instance Delta SBox CBoxType where+  plusDelta sbox@SBox {..} (CBoxType deltatype) = sbox {+      _sBox_boxType   = plusDelta _sBox_boxType deltatype+    }+  minusDelta sbox@SBox {..} (CBoxType deltatype) = sbox {+      _sBox_boxType   = minusDelta _sBox_boxType deltatype+    }++data CBoundingBox = CBoundingBox {+  _cBoundingBox_deltaBox    :: DeltaLBox+} deriving (Eq, Generic, Show)+instance NFData CBoundingBox++data CSuperStyle = CSuperStyle DeltaSuperStyle deriving (Eq, Generic, Show)+instance NFData CSuperStyle++data CLineStyle = CLineStyle DeltaLineStyle deriving (Eq, Generic, Show)+instance NFData CLineStyle++data CTextStyle = CTextStyle DeltaTextStyle deriving (Eq, Generic, Show)+instance NFData CTextStyle++data CTextAlign = CTextAlign DeltaTextAlign deriving (Eq, Generic, Show)+instance NFData CTextAlign++data CMaybeText = CMaybeText DeltaMaybeText deriving (Eq, Generic, Show)+instance NFData CMaybeText++data CTextArea = CTextArea DeltaTextArea deriving (Eq, Generic, Show)+instance NFData CTextArea++data CTextAreaToggle = CTextAreaToggle DeltaTextAreaToggle deriving (Eq, Generic, Show)+instance NFData CTextAreaToggle++-- NOTE, in some previous (very flawed) design, these were fanned out in a Reflex event hence the `DSum CTag` thing+-- we don't do this anymore, but DSum is still a nice alternative to using an ADT so we keep it.+data CTag a where+  CTagRename :: CTag CRename++  CTagLine :: CTag CLine++  CTagBoxText :: CTag CBoxText+  CTagBoxType :: CTag CBoxType+  CTagBoxTextStyle :: CTag CTextStyle++  CTagBoxLabelAlignment :: CTag CTextAlign+  CTagBoxLabelText :: CTag CMaybeText++  CTagTextArea :: CTag CTextArea+  CTagTextAreaToggle :: CTag CTextAreaToggle++  CTagSuperStyle :: CTag CSuperStyle+  CTagLineStyle :: CTag CLineStyle+  CTagBoundingBox :: CTag CBoundingBox+++deriveGEq      ''CTag+deriveGCompare ''CTag+deriveGShow ''CTag+deriveArgDict ''CTag++-- | Controllers represent changes to SElts+type Controller = DS.DSum CTag Identity++instance NFData Controller where+  rnf (CTagRename DS.:=> Identity a)       = rnf a+  rnf (CTagLine DS.:=> Identity a)         = rnf a+  rnf (CTagBoxText DS.:=> Identity a)      = rnf a+  rnf (CTagBoxType DS.:=> Identity a)      = rnf a+  rnf (CTagBoundingBox DS.:=> Identity a)  = rnf a+  rnf (CTagSuperStyle DS.:=> Identity a)   = rnf a+  rnf (CTagLineStyle DS.:=> Identity a)   = rnf a+  rnf (CTagBoxTextStyle DS.:=> Identity a) = rnf a+  rnf (CTagBoxLabelAlignment DS.:=> Identity a) = rnf a+  rnf (CTagBoxLabelText DS.:=> Identity a) = rnf a+  rnf (CTagTextArea DS.:=> Identity a) = rnf a+  rnf (CTagTextAreaToggle DS.:=> Identity a) = rnf a++-- | indexed my REltId+type ControllersWithId = IntMap Controller++controller_isParams :: Controller -> Bool+controller_isParams (CTagBoxType DS.:=> Identity _)      = True+controller_isParams (CTagSuperStyle DS.:=> Identity _)   = True+controller_isParams (CTagLineStyle DS.:=> Identity _)   = True+controller_isParams (CTagBoxTextStyle DS.:=> Identity _) = True+controller_isParams (CTagBoxLabelAlignment DS.:=> Identity _) = True+controller_isParams _                                    = False++controllerWithId_isParams :: ControllersWithId -> Bool+controllerWithId_isParams = all controller_isParams
+ test/Potato/Data/Text/UnicodeSpec.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}++module Potato.Data.Text.UnicodeSpec (+  spec+) where++import           Prelude++import           Test.Hspec++import           Control.Monad++import           Potato.Data.Text.Unicode++++spec :: Spec+spec = describe "Unicode" $ do+  it "isSingleGraphemeCluster" $ do+    isSingleGraphemeCluster "👎🏼" `shouldBe` True+    isSingleGraphemeCluster "👎" `shouldBe` False+    isSingleGraphemeCluster "" `shouldBe` False+    isSingleGraphemeCluster "a" `shouldBe` False+    isSingleGraphemeCluster "👎🏻👎🏼👎🏽👎🏾👎🏿" `shouldBe` False+    isSingleGraphemeCluster "🧑\8205🍳" `shouldBe` True -- zwidges can't be used directly https://gitlab.haskell.org/ghc/ghc/-/issues/21228+  it "endsInGraphemeCluster" $ do+    endsInGraphemeCluster "👎🏼" `shouldBe` True+    endsInGraphemeCluster "👎🏿" `shouldBe` True+    endsInGraphemeCluster "" `shouldBe` False+    endsInGraphemeCluster "a" `shouldBe` False+    endsInGraphemeCluster "👎🏻👎🏼👎🏽👎🏾👎🏿" `shouldBe` True+    endsInGraphemeCluster "👎🏻👎🏼👎🏽👎🏾👎🏿😱" `shouldBe` False+    endsInGraphemeCluster "goop😱dedoop👎🏿" `shouldBe` True+  it "removeGraphemeCluster" $ do+    removeGraphemeCluster "👎🏻👎🏼👎🏽👎🏾👎🏿" `shouldBe` "👎👎👎👎👎"+  it "containsGraphemeCluster" $ do+    containsGraphemeCluster "👎👎👎👎👎" `shouldBe` False+    containsGraphemeCluster "👎👎👎🏿👎👎👎" `shouldBe` True+
+ test/Potato/Data/Text/Zipper2Spec.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}++module Potato.Data.Text.Zipper2Spec (+  spec+) where++import           Prelude++import           Test.Hspec++import qualified Data.Map         as Map+import qualified          Data.Text as T+import Control.Monad++import           Potato.Data.Text.Zipper2++tz = TextZipper (reverse ["this is an example content of", "a text zipper"])+                "the capital "+                ["TEXT IS THE SELECTED", "PORTION"]+                " of the"+                ["text zipper"]++spec :: Spec+spec =+  describe "Zipper2" $ do++  it "leftN 1" $ do+    let tz_1 = TextZipper (reverse ["this is an example content of", "a text zipper"])+                        "the capital"+                        []+                        " TEXT IS THE SELECTED"+                        ["PORTION of the","text zipper"]+    leftN 1 tz `shouldBe` tz_1++  it "leftN 5" $ do+    let tz_5 = TextZipper   (reverse ["this is an example content of", "a text zipper"])+                            "the cap"+                            []+                            "ital TEXT IS THE SELECTED"+                            ["PORTION of the","text zipper"]+    leftN 5 tz `shouldBe` tz_5++  it "leftN 20" $ do+    let tz_20 = TextZipper  ["this is an example content of"]+                            "a text"+                            []+                            " zipper"+                            ["the capital TEXT IS THE SELECTED","PORTION of the","text zipper"]+    leftN 20 tz `shouldBe` tz_20++  it "home/end example_1" $ do+    let tz_0 = TextZipper  ["this is an example"]+                            "this line is selected "+                            []+                            "lines after"+                            ["blah blah blah"]+        tz_1h = TextZipper  ["this is an example"]+                            ""+                            []+                            "this line is selected lines after"+                            ["blah blah blah"]+        tz_1e = TextZipper  ["this is an example"]+                            "this line is selected lines after"+                            []+                            ""+                            ["blah blah blah"]+    home tz_0 `shouldBe` tz_1h+    end tz_0 `shouldBe` tz_1e++  it "home/end example_2" $ do+    let tz_0 = TextZipper  ["this is an example"]+                    "this line is selected "+                    ["pooh bear"]+                    " lines after"+                    ["blah blah blah"]+        tz_1h = TextZipper  ["this is an example"]+                    ""+                    []+                    "this line is selected pooh bear lines after"+                    ["blah blah blah"]+        tz_1e = TextZipper  ["this is an example"]+                            "this line is selected pooh bear lines after"+                            []+                            ""+                            ["blah blah blah"]+    home tz_0 `shouldBe` tz_1h+    end tz_0 `shouldBe` tz_1e+    +  it "home/end example_3" $ do+    let tz_0 = TextZipper  ["this is an example"]+                    "this line is selected "+                    ["pooh bear", "canned chicken cat"]+                    " lines after"+                    ["blah blah blah"]+        tz_1h = TextZipper  ["this is an example"]+                    ""+                    []+                    "this line is selected pooh bear"+                    ["canned chicken cat lines after", "blah blah blah"]+        tz_1e = TextZipper  ["this is an example", "this line is selected pooh bear"]+                    "canned chicken cat lines after"+                    []+                    ""+                    ["blah blah blah"]+    home tz_0 `shouldBe` tz_1h+    end tz_0 `shouldBe` tz_1e++  it "top examples" $ do+    top (TextZipper [] "" [] "dd d" ["a","b"]) `shouldBe` +         TextZipper [] "" [] "dd d" ["a","b"]+    top (TextZipper ["hello"] "" [] "dd d" ["a","b"]) `shouldBe` +         TextZipper [] "" [] "hello" ["dd d", "a","b"]+    top (TextZipper (reverse ["hello", "ok", "very good"]) "" [] "dd d" ["a","b"]) `shouldBe` +         TextZipper [] "" [] "hello" ["ok", "very good","dd d", "a","b"]+    top (TextZipper (reverse ["hello", "ok", "very good"]) "" [] "dd d" ["a","b"]) `shouldBe` +         TextZipper [] "" [] "hello" ["ok", "very good","dd d", "a","b"]+    top (TextZipper (reverse ["hello", "ok", "very good"]) "" ["a b c"] "dd d" ["a","b"]) `shouldBe` +         TextZipper [] "" [] "hello" ["ok", "very good","a b cdd d", "a","b"]+    top (TextZipper (reverse ["hello", "ok", "very good"]) "" ["a b c", "d e "] "dd d" ["a","b"]) `shouldBe` +         TextZipper [] "" [] "hello" ["ok", "very good", "a b c", "d e dd d", "a","b"]++  it "up examples" $ do+    up (TextZipper [] "ab " [] "dd d" ["a","b"]) `shouldBe` +        (TextZipper [] "" [] "ab dd d" ["a","b"])+    up (TextZipper ["cat dog"] "ab " [] "dd d" ["a","b"]) `shouldBe` +        (TextZipper [] "cat" [] " dog" ["ab dd d", "a","b"])+    up (TextZipper ["cat dog"] "abfeeeere " [] "dd d" ["a","b"]) `shouldBe` +        (TextZipper [] "cat dog" [] "" ["abfeeeere dd d", "a","b"])+    up (TextZipper (reverse ["cat dog", "bird_sky"]) "ab " [] "dd d" ["a","b"]) `shouldBe` +        (TextZipper ["cat dog"] "bir" [] "d_sky" ["ab dd d", "a","b"])+    up (TextZipper [] "ab " ["story"] "dd d" ["a","b"]) `shouldBe` +        (TextZipper [] "" [] "ab storydd d" ["a","b"])+    up (TextZipper [] "ab " ["STORY", "COOL"] "dd d" ["a","b"]) `shouldBe` +        (TextZipper [] "ab S" [] "TORY" ["COOLdd d", "a","b"])+    up (TextZipper ["a", "b"] "ab " ["STORY", "COOL"] "dd d" ["a","b"]) `shouldBe` +        (TextZipper ["a", "b"] "ab S" [] "TORY" ["COOLdd d", "a","b"])+        -- (TextZipper ["a", "b"] "" [] "ab story" ["cooldd d", "a","b"])+    up (TextZipper (reverse ["a", "b"]) "ab " ["story"] "dd d" ["a","b"]) `shouldBe` +        (TextZipper ["a"] "b" [] "" ["ab storydd d", "a","b"])++  it "down example_1" $ do+    down (TextZipper ["a","b"] "ab " [] "dd d" []) `shouldBe` +        (TextZipper ["a", "b"] "ab dd d" [] "" [])+    down (TextZipper (reverse ["a","b"]) "ab " [] "dd d" ["hello"]) `shouldBe` +        (TextZipper (reverse ["a", "b", "ab dd d"]) "hel" [] "lo" [])+    down (TextZipper (reverse ["a","b"]) "ab " [] "dd d" ["hello", "thanks"]) `shouldBe` +        (TextZipper (reverse ["a", "b", "ab dd d"]) "hel" [] "lo" ["thanks"])+    down (TextZipper (reverse ["a", "b"]) "ab " ["CENTER"] "dd d" []) `shouldBe` +         (TextZipper (reverse ["a", "b"]) "ab CENTERdd d" [] "" [])+    down (TextZipper (reverse ["a","b"]) "ab " ["center"] "dd d" ["hello", "thanks"]) `shouldBe` +        (TextZipper (reverse ["a", "b", "ab centerdd d"]) "hello" [] "" ["thanks"])+    down (TextZipper (reverse ["a", "b"]) "ab " ["CENTER", "MIDDLE"] " dd d" ["hello", "thanks"]) `shouldBe`+         (TextZipper (reverse ["a", "b", "ab CENTER", "MIDDLE dd d"]) "hello" [] "" ["thanks"] )
+ test/Potato/Data/Text/ZipperSpec.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++module Potato.Data.Text.ZipperSpec (+  spec+) where++import           Prelude++import           Test.Hspec++import qualified Data.Map         as Map+import qualified          Data.Text as T+import Control.Monad++import           Potato.Data.Text.Zipper+++someSentence :: T.Text+someSentence = "12345 1234 12"++splitSentenceAtDisplayWidth :: Int -> T.Text -> [(T.Text, Bool)]+splitSentenceAtDisplayWidth w t = splitWordsAtDisplayWidth w (wordsWithWhitespace t)++spec :: Spec+spec =+  describe "Zipper" $ do+  it "wordsWithWhitespace" $ do+    wordsWithWhitespace "" `shouldBe` []+    wordsWithWhitespace "😱😱😱" `shouldBe` ["😱😱😱"]+    wordsWithWhitespace "abcd efgf f" `shouldBe` ["abcd ","efgf ", "f"]+    wordsWithWhitespace "aoeu    " `shouldBe` ["aoeu    "]+  it "splitWordsAtDisplayWidth" $ do+    fmap fst (splitSentenceAtDisplayWidth 5 "123456") `shouldBe` ["12345","6"]+    fmap fst (splitSentenceAtDisplayWidth 5 "12345 6") `shouldBe` ["12345","6"]+    fmap fst (splitSentenceAtDisplayWidth 5 "1234 56") `shouldBe` ["1234","56"]+    fmap fst (splitSentenceAtDisplayWidth 5 "12345678912345") `shouldBe` ["12345","67891","2345"]+    fmap fst (splitSentenceAtDisplayWidth 5 "1234   56") `shouldBe` ["1234 "," 56"]+    fmap fst (splitSentenceAtDisplayWidth 8 "1 2 3 4 5 6 7 8 9 1") `shouldBe` ["1 2 3 4","5 6 7 8", "9 1"]+  it "wrapWithOffsetAndAlignment" $ do+    wrapWithOffsetAndAlignment TextAlignment_Left 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 0)]+    wrapWithOffsetAndAlignment TextAlignment_Right 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 1), (WrappedLine "12" False 3)]+    wrapWithOffsetAndAlignment TextAlignment_Center 5 0 someSentence `shouldBe` [(WrappedLine "12345" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 1)]+    wrapWithOffsetAndAlignment TextAlignment_Left 5 1 someSentence `shouldBe` [(WrappedLine "1234" False 0), (WrappedLine "5" True 0), (WrappedLine "1234" True 0), (WrappedLine "12" False 0)]+  it "eolSpacesToLogicalLines" $ do+    eolSpacesToLogicalLines+      [+        [ (WrappedLine "😱" True 1), (WrappedLine "😱" False 2), (WrappedLine "😱" False 3) ]+        , [ (WrappedLine "aa" True 1), (WrappedLine "aa" True 2), (WrappedLine "aa" False 3) ]+      ]+      `shouldBe`+      [+        [ ("😱",1) ]+        , [ ("😱",2), ("😱",3) ]+        , [ ("aa",1) ]+        , [ ("aa",2) ]+        , [ ("aa",3) ]+      ]+  it "offsetMapWithAlignmentInternal" $ do+    offsetMapWithAlignmentInternal+      [+        [ (WrappedLine "😱" True 1), (WrappedLine "😱" False 2), (WrappedLine "😱" False 3) ]+        , [ (WrappedLine "aa" True 1), (WrappedLine "aa" True 2), (WrappedLine "aa" False 3) ]+      ]+      `shouldBe`+      Map.fromList+      [ (0, (1,0))+      , (1, (2,2)) -- jump by 1 for char and 1 for space+      , (2, (3,3)) -- jump by 1 for char+      , (3, (1,5)) -- jump by 1 for char and 1 for newline+      , (4, (2,8)) -- jump by 2 for char and 1 for space+      , (5, (3,11)) -- jump by 2 for char and 1 for space+      ]+  it "displayLines - cursorPos" $ do+    let+      dl0 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "")+      dl1 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu")+      dl2 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "aoeu\n")+      dl3 = displayLinesWithAlignment TextAlignment_Right 10 () () (fromText "0123456789")+      dl4 = displayLinesWithAlignment TextAlignment_Right 10 () () (insertChar 'a' $ fromText "aoeu")+      dl5 = displayLinesWithAlignment TextAlignment_Right 10 () () (left $ insertChar 'a' $ fromText "aoeu")+      dl6 = displayLinesWithAlignment TextAlignment_Right 10 () () (deleteLeft $ insertChar 'a' $ fromText "aoeu")+    _displayLines_cursorPos dl0 `shouldBe` (0,0)+    _displayLines_cursorPos dl1 `shouldBe` (4,0)+    _displayLines_cursorPos dl2 `shouldBe` (0,1)+    _displayLines_cursorPos dl3 `shouldBe` (0,1)+    _displayLines_cursorPos dl4 `shouldBe` (5,0)+    _displayLines_cursorPos dl5 `shouldBe` (4,0)+    _displayLines_cursorPos dl6 `shouldBe` (4,0)+  it "displayLinesWithAlignment - spans" $ do+    let+      someText = top $ fromText "0123456789abcdefgh"+    -- outer span length should be invariant when changing TextAlignment and CursorPosition+    --print $ displayLinesWithAlignment TextAlignment_Left 5 () () someText+    forM_ [0..4] $ \x -> do+      forM_ [TextAlignment_Left, TextAlignment_Center, TextAlignment_Right] $ \ta -> do+        let t = rightN x $ someText+        length (_displayLines_spans $ (displayLinesWithAlignment ta 5 () () t)) `shouldBe` 4+        length (_displayLines_spans $ (displayLinesWithAlignment ta 10 () () t)) `shouldBe` 2
+ test/Potato/Flow/AttachmentsSpec.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.AttachmentsSpec (+  spec+) where++import           Relude           hiding (empty, fromList)++import           Test.Hspec++import           Potato.Flow.Attachments+import Potato.Flow.Methods.LineDrawer+import Potato.Flow.Methods.LineTypes+import           Potato.Flow.Math+import Potato.Flow.SElts++spec :: Spec+spec = do+  describe "Attachments" $ do+    it "attachLocationFromLBox" $ do+      let+        somelbox1 = LBox (V2 0 0) (V2 1 1)+        somelbox2 = LBox (V2 0 0) (V2 9 10)+      attachLocationFromLBox False (somelbox1, AL_Top, attachment_offset_rel_default) `shouldBe` V2 0 0+      attachLocationFromLBox False (somelbox1, AL_Left, attachment_offset_rel_default) `shouldBe` V2 0 0+      attachLocationFromLBox True (somelbox2, AL_Bot, attachment_offset_rel_default) `shouldBe` V2 4 10+      attachLocationFromLBox True (somelbox2, AL_Right, attachment_offset_rel_default) `shouldBe` V2 9 5
+ test/Potato/Flow/BroadPhaseSpec.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.BroadPhaseSpec(+  spec+) where++import           Relude       hiding (empty, fromList)++import           Test.Hspec++import           Data.Default (def)+import qualified Data.IntMap  as IM+import qualified Data.List    as L++import           Potato.Flow++spec :: Spec+spec = do+  describe "BroadPhase" $ do+    let+      makeChange rid lb = IM.singleton rid $ Just (SuperOwl {+          _superOwl_id = rid+          , _superOwl_meta = OwlItemMeta noOwl 0 0+          , _superOwl_elt = OwlItem (OwlInfo (show rid)) (OwlSubItemBox $ SBox lb def def def SBoxType_Box)+        })+    it "passes basic test" $ do+      let+        lb1_2 = LBox (V2 0 0) (V2 5 5)+        lb1_1 = LBox (V2 0 0) (V2 10 10)+        lb2 = LBox (V2 5 5) (V2 5 5)+        lb3 = LBox (V2 0 5) (V2 5 5)+        lb4 = LBox (V2 5 0) (V2 5 5)+        bpt0 = BPTree $ IM.empty+        changes1 = makeChange 1 lb1_1+        (aabbs1, BroadPhaseState bpt1) = update_bPTree emptyOwlTree changes1 bpt0+        culled1 = broadPhase_cull (L.head aabbs1) bpt1+      length aabbs1 `shouldBe` 1+      culled1 `shouldBe` [1]+      let+        changes2 = mconcat $ [makeChange 2 lb2, makeChange 3 lb3, makeChange 4 lb4]+        (aabbs2, BroadPhaseState bpt2) = update_bPTree emptyOwlTree changes2 bpt1+        culled2 = broadPhase_cull lb1_1 bpt2+      length aabbs2 `shouldBe` 3+      length culled2 `shouldBe` 4+      let+        changes3 = makeChange 1 lb1_2+        (aabbs3, BroadPhaseState bpt3) = update_bPTree emptyOwlTree changes3 bpt2+        culled3_1 = broadPhase_cull lb1_2 bpt3+        culled3_2 = broadPhase_cull (LBox (V2 3 3) (V2 5 5)) bpt3+      length aabbs3 `shouldBe` 2+      length culled3_1 `shouldBe` 1+      length culled3_2 `shouldBe` 4+    it "click on corner works as expected" $ do+      let+        box = LBox (V2 5 5) (V2 10 10)+        ul = LBox (V2 5 5) (V2 1 1)+        br = LBox (V2 14 14) (V2 1 1)+        notbr = LBox (V2 15 15) (V2 1 1)+        bpt0 = BPTree $ IM.empty+        changes = makeChange 1 box+        (_, BroadPhaseState bpt1) = update_bPTree emptyOwlTree changes bpt0+        culled_ul = broadPhase_cull ul bpt1+        culled_br = broadPhase_cull br bpt1+        culled_notbr = broadPhase_cull notbr bpt1+      length culled_ul `shouldBe` 1+      length culled_br `shouldBe` 1+      length culled_notbr `shouldBe` 0
+ test/Potato/Flow/Common.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Common where++import           Relude                            hiding (empty, fromList, first)++import           Test.HUnit++import           Reflex+import           Reflex.Test.Host++import           Potato.Flow+import           Potato.Flow.DebugHelpers++import qualified Data.IntMap                       as IM+import qualified Data.Sequence                     as Seq+import qualified Data.Text                         as T+import           Data.These+++-- generic testing+data GoatWidgetCmd =+  EWCMouse LMouseData+  | EWCKeyboard KeyboardData+  | EWCTool Tool+  | EWCSetParams ControllersWithId+  | EWCLoad (SPotatoFlow, ControllerMeta)+  | EWCNothing+  | EWCLabel Text+  | EWCCanvasResize XY+  | EWCNewFolder+  | EWCMarkSaved+  | EWCScreenRegion XY++everything_network_app+  :: forall t m. (t ~ SpiderTimeline Global, m ~ SpiderHost Global)+  => OwlPFState+  -> ControllerMeta+  -> AppIn t () GoatWidgetCmd -> TestGuestT t m (AppOut t GoatState GoatState)+everything_network_app pfs cm (AppIn _ ev) = do+  let ewc = GoatWidgetConfig  {+      -- TODO pass in actual ControllerMeta+      _goatWidgetConfig_initialState = (pfs, cm)+      , _goatWidgetConfig_load = fforMaybe ev $ \case+        EWCLoad x -> Just x+        _ -> Nothing+      , _goatWidgetConfig_setDebugLabel = fforMaybe ev $ \case+        EWCLabel x -> Just x+        _ -> Nothing+      , _goatWidgetConfig_mouse = fforMaybe ev $ \case+        EWCMouse x -> Just x+        _ -> Nothing+      , _goatWidgetConfig_keyboard = fforMaybe ev $ \case+        EWCKeyboard x -> Just x+        _ -> Nothing+      , _goatWidgetConfig_selectTool = fforMaybe ev $ \case+        EWCTool x -> Just x+        _ -> Nothing+      , _goatWidgetConfig_paramsEvent = fforMaybe ev $ \case+        EWCSetParams x -> Just (makePFCLlama $ OwlPFCManipulate x)+        _ -> Nothing+      , _goatWidgetConfig_canvasSize = fforMaybe ev $ \case+        EWCCanvasResize x -> Just x+        _ -> Nothing+      , _goatWidgetConfig_newFolder = fforMaybe ev $ \case+        EWCNewFolder -> Just ()+        _ -> Nothing+      , _goatWidgetConfig_setPotatoDefaultParameters = never+      , _goatWidgetConfig_markSaved = fforMaybe ev $ \case+        EWCMarkSaved -> Just ()+        _ -> Nothing+      , _goatWidgetConfig_bypassEvent = never+      , _goatWidgetConfig_canvasRegionDim = fforMaybe ev $ \case+        EWCScreenRegion x -> Just x+        _ -> Nothing+      , _goatWidgetConfig_unicodeWidthFn = Nothing+      , _goatWidgetConfig_setFocusedArea = never++    }+  everythingWidget <- holdGoatWidget ewc+  let rDyn = _goatWidget_DEBUG_goatState everythingWidget+  return $ AppOut (current rDyn) (updated rDyn)+++data EverythingPredicate where+  EqPredicate :: (Show a, Eq a) => (GoatState -> a) -> a -> EverythingPredicate+  FunctionPredicate :: (GoatState -> (Text, Bool)) -> EverythingPredicate+  PFStateFunctionPredicate :: (OwlPFState -> (Text, Bool)) -> EverythingPredicate+  AlwaysPass :: EverythingPredicate+  LabelCheck :: Text -> EverythingPredicate+  Combine :: [EverythingPredicate] -> EverythingPredicate++testEverythingPredicate :: EverythingPredicate -> GoatState -> Bool+testEverythingPredicate (EqPredicate f a) e     = f e == a+testEverythingPredicate (FunctionPredicate f) e = snd $ f e+testEverythingPredicate (PFStateFunctionPredicate f) e = snd . f $ goatState_pFState e+testEverythingPredicate AlwaysPass _            = True+-- TODO actually set a label and pipe it through EverythingCombined_DEBUG?+testEverythingPredicate (LabelCheck l) e = l == _goatState_debugLabel e+testEverythingPredicate (Combine xs) e          = all id . map (\p -> testEverythingPredicate p e) $ xs++showEverythingPredicate :: EverythingPredicate -> GoatState -> Text+showEverythingPredicate (EqPredicate f a) e = "expected: " <> show a <> " got: " <> show (f e)+showEverythingPredicate (FunctionPredicate f) e = fst $ f e+showEverythingPredicate (PFStateFunctionPredicate f) e = fst . f $ goatState_pFState e+showEverythingPredicate AlwaysPass _ = "always pass"+-- TODO actually set a label and pipe it through EverythingCombined_DEBUG?+showEverythingPredicate (LabelCheck l) e = "expected label: " <> show l <> " got: " <> show (_goatState_debugLabel e)+-- TODO this should not print passing tests as well :(+showEverythingPredicate (Combine xs) e = "[" <> foldr (\p acc -> showEverythingPredicate p e <> ", " <> acc) "" xs <> "]"++checkNumElts :: Int -> OwlPFState -> (Text, Bool)+checkNumElts n OwlPFState {..} = (t,r) where+  ds = IM.size (_owlTree_mapping _owlPFState_owlTree)+  r = ds == n+  t = "expected: " <> show n <> " owlTree: " <> show ds++numEltsInLBoxUsingBroadphasePredicate :: Int -> LBox -> EverythingPredicate+numEltsInLBoxUsingBroadphasePredicate n lbox = FunctionPredicate $+  (\(BroadPhaseState bps) ->+    let gotn = length $ broadPhase_cull lbox bps+    in ("BroadPhase passed: " <> show gotn <> " expected: " <> show n <> " broadphase: " <> show bps, gotn == n))+  . _goatState_broadPhaseState++numSelectedEltsEqualPredicate :: Int -> EverythingPredicate+numSelectedEltsEqualPredicate n = FunctionPredicate $+  (\s ->+    let nSelected = Seq.length s+    in ("Selected: " <> show nSelected <> " expected: " <> show n, nSelected == n))+  . unSuperOwlParliament . _goatState_selection++-- you can prob delete this, better to always check for state using version below+checkHandlerName :: Text -> EverythingPredicate+checkHandlerName name = FunctionPredicate $+  (\(SomePotatoHandler h) ->+    let hName = pHandlerName h+    in ("Handler: " <> hName <> " expected: " <> name, hName == name))+  . _goatState_handler++checkHandlerNameAndState :: Text -> Bool -> EverythingPredicate+checkHandlerNameAndState name st = FunctionPredicate $+  (\(SomePotatoHandler h) ->+    let+      hName = pHandlerName h+      hst = pIsHandlerActive h+    in ("Handler: " <> hName <> "(" <> show hst <> ") expected: " <> name <> " (" <> show st <> ")", hName == name && hst == st))+  . _goatState_handler++firstSelectedSuperOwlWithOwlTreePredicate :: Maybe Text -> (OwlTree -> SuperOwl -> Bool) -> EverythingPredicate+firstSelectedSuperOwlWithOwlTreePredicate mlabel f = FunctionPredicate fn where+  fn GoatState {..} = r where+    s = unSuperOwlParliament _goatState_selection+    owltree = _owlPFState_owlTree $ _owlPFWorkspace_owlPFState _goatState_workspace+    mfirst = case mlabel of+      Nothing    -> Seq.lookup 0 s+      Just label -> find (\sowl -> hasOwlItem_name sowl == label) s+    r = case mfirst of+      Nothing    -> ("No elt with label " <> show mlabel <> show (fmap hasOwlItem_name s), False)+      Just first -> ("First selected: " <> show first, f owltree first)++firstSelectedSuperOwlPredicate :: Maybe Text -> (SuperOwl -> Bool) -> EverythingPredicate+firstSelectedSuperOwlPredicate mlabel f = firstSelectedSuperOwlWithOwlTreePredicate mlabel (\_ sowl -> f sowl)++firstSuperOwlPredicate :: Maybe Text -> (SuperOwl -> Bool) -> EverythingPredicate+firstSuperOwlPredicate mlabel f = FunctionPredicate $+  (\ot ->+    let+      sowls = toList $ owliterateall ot+      mfirst = case mlabel of+        Nothing -> case sowls of+          []  -> Nothing+          x:_ -> Just x+        Just label -> case find (\sowl -> hasOwlItem_name sowl == label) sowls of+          Nothing     -> Nothing+          Just sowl -> Just sowl+    in case mfirst of+      Nothing    -> ("No elt with label " <> show mlabel, False)+      Just first -> ("First elt with label " <> show mlabel <> ": " <> show first, f first))+  . _owlPFState_owlTree . goatState_pFState+++constructTestWithControllerMeta :: String -> OwlPFState -> ControllerMeta -> [GoatWidgetCmd] -> [EverythingPredicate] -> Test+constructTestWithControllerMeta label pfs cm bs expected = TestLabel label $ TestCase $ do+  let+    run = runApp (everything_network_app pfs cm) () (fmap (Just . That) bs)+  values :: [[(GoatState, Maybe GoatState)]]+    <- liftIO run++  -- expect only 1 tick per event+  forM values $ \x -> assertEqual "expect only 1 tick per event" (length x) 1++  -- expect correct number of outputs+  assertEqual "expect correct number of outputs" (length values) (length expected)++  -- TODO do index counting from labels+  -- expect each output matches predicate+  -- if no output event, uses output behavior to test predicate+  forM_ (zip3 (join values) expected [(0::Int)..]) $ \((b, me), p, i) -> let+      testfn ewcd =+        (assertBool . T.unpack) ((showEverythingPredicate p ewcd)+          <> " \n[label = " <> _goatState_debugLabel ewcd+          <> ", index = " <> show i <> "]"+          <> "\ntree = " <> case me of+            Just e -> (potatoShow . _owlPFState_owlTree . goatState_pFState $ e)+            Nothing -> (potatoShow . _owlPFState_owlTree . goatState_pFState $ b))+          {-<> "\nstate = " <> case me of+            Just e  -> show (goatState_pFState e)+            Nothing -> show (goatState_pFState b))-}+        (testEverythingPredicate p ewcd)++    in case me of+      Just e  -> testfn e+      Nothing -> testfn b++constructTest :: String -> OwlPFState -> [GoatWidgetCmd] -> [EverythingPredicate] -> Test+constructTest label pfs bs expected = constructTestWithControllerMeta label pfs emptyControllerMeta bs expected+++++-- partial function to get SAutoLine+hasOwlItem_test_toSAutoLine :: (HasOwlItem a) => a -> SAutoLine+hasOwlItem_test_toSAutoLine o = case hasOwlItem_toSElt_hack o of+  SEltLine ssline  -> ssline+  selt -> error $ "expected SAutoLine, got " <> show selt
+ test/Potato/Flow/Controller/Manipulator/BoxSpec.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Controller.Manipulator.BoxSpec (+  spec+) where++import           Relude                                         hiding (empty,+                                                                 fromList)++import           Test.Hspec++import           Potato.Flow.GoatTester++import           Potato.Flow+import           Potato.Flow.Common+import           Potato.Flow.Controller.Manipulator.TestHelpers++initSimpleBox :: GoatTester ()+initSimpleBox = drawCanvasBox (0, 0, 100, 100)++basic_test :: Spec+basic_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  initSimpleBox++  -- TODO+++basic_cancel_test :: Spec+basic_cancel_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  setMarker "mouse down and cancel and ensure no box is created"+  setTool Tool_Box+  canvasMouseDown (0, 0)+  pressEscape+  canvasMouseDown (100, 100)+  canvasMouseUp (100, 100)+  verifyOwlCount 0++  setMarker "draw a line and cancel after moving it"+  setTool Tool_Box+  canvasMouseDown (0, 0)+  canvasMouseDown (100, 100)+  verifyOwlCount 1+  pressEscape+  verifyOwlCount 0+  canvasMouseDown (110, 90)+  canvasMouseUp (110, 90)+  verifyOwlCount 0++  initSimpleBox+++spec :: Spec+spec = do+  describe "Box" $ do+    describe "basic" $ basic_test+    describe "basic_cancel" $ basic_cancel_test
+ test/Potato/Flow/Controller/Manipulator/LayersSpec.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Controller.Manipulator.LayersSpec (+  spec+) where++import           Relude                                         hiding (empty,+                                                                 fromList)++import           Test.Hspec++import           Potato.Flow.GoatTester++import           Potato.Flow+import           Potato.Flow.Controller.Manipulator.TestHelpers++import qualified Data.List                                      as L+++someFolderName :: Text+someFolderName = "testfolder"++verifyFolderSelected :: Text -> GoatTester ()+verifyFolderSelected name = verifySelectionIsAndOnlyIs ("selected " <> name) $+  \sowl -> if hasOwlItem_name sowl == name && hasOwlItem_isFolder sowl+    then Nothing+    else Just $ "expected folder named \"" <> name <> "\", got: " <> show sowl++basic_test :: Spec+basic_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  setMarker "create a folder"+  verifyOwlCount 0+  addFolder someFolderName+  verifyOwlCount 1+  verifyFolderSelected someFolderName++  setMarker "press escape to unselect the folder"+  pressEscape+  verifySelectionCount 0++  setMarker "select the folder"+  layerMouseDown (5,0)+  layerMouseUp (5,0)+  verifyFolderSelected someFolderName++++rename_focus_test :: Spec+rename_focus_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  setMarker "draw a box"+  setTool Tool_Box+  canvasMouseDown (0, 0)+  canvasMouseDown (100, 100)+  canvasMouseUp (100, 100)+  verifyOwlCount 1++  setMarker "select the box via layers"+  -- TODO++  setMarker "begin renaming the box"+  -- TODO++  setMarker "change focus and ensure rename took effect"+  setFocusArea GoatFocusedArea_Other+  -- TODO verify++create_in_folder_test :: Spec+create_in_folder_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  setMarker "create a folder"+  addFolder someFolderName+  verifyFolderSelected someFolderName++  folder <- mustGetMostRecentlyCreatedOwl++  setMarker "create a new element"+  drawCanvasBox (0, 0, 100, 100)++  setMarker "ensure it has the correct parent"+  verifyMostRecentlyCreatedOwl $ \sowl -> if _owlItemMeta_parent (_superOwl_meta sowl) == _superOwl_id folder then Nothing else Just $ "expected parent " <> show (_superOwl_id folder) <> " got " <> show sowl++++spec :: Spec+spec = do+  describe "Layers" $ do+    describe "basic" $ basic_test+    describe "rename_focus_test" $ rename_focus_test+    describe "create_in_folder_test" $ create_in_folder_test
+ test/Potato/Flow/Controller/Manipulator/LineSpec.hs view
@@ -0,0 +1,505 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Controller.Manipulator.LineSpec (+  spec+) where++import           Relude                                         hiding (empty,+                                                                 fromList)++import           Test.Hspec++import           Potato.Flow.GoatTester++import           Potato.Flow+import           Potato.Flow.Controller.Manipulator.TestHelpers+import           Potato.Flow.Methods.LineDrawer+import           Potato.Flow.RenderCache++import qualified Data.List                                      as L+import qualified Data.Text                                      as T+import qualified Data.IntMap as IM+++verifyMostRecentlyCreatedLinesLatestLineLabelHasText :: Text -> GoatTester ()+verifyMostRecentlyCreatedLinesLatestLineLabelHasText text = verifyMostRecentlyCreatedLine  checkfn where+  checkfn sline = case _sAutoLine_labels sline of+    [] -> Just "most recently created line has no line labels"+    (x:_) -> if _sAutoLineLabel_text x == text+      then Nothing+      else Just $ "found line label with text: " <> _sAutoLineLabel_text x <> " expected: " <> text++verifyMostRecentlyCreatedLinesLatestLineLabelHasPosition :: (Int, Int) -> GoatTester ()+verifyMostRecentlyCreatedLinesLatestLineLabelHasPosition (px, py) = verifyState "verifyMostRecentlyCreatedLinesLatestLineLabelHasPosition" checkfn where+  checkfn gs = r where+    pfs = goatState_pFState gs+    r' = do+      sowl <- case maybeGetMostRecentlyCreatedOwl' (goatState_pFState gs) of+        Nothing -> Left "failed, no 🦉s"+        Just x  -> Right x+      sline <- case _owlItem_subItem (_superOwl_elt sowl) of+        OwlSubItemLine x -> Right x+        x                  -> Left $ "expected SAutoLine got: " <> show x+      llabel <- case _sAutoLine_labels sline of+        []    -> Left "most recently created line has no line labels"+        (x:_) -> Right x+      return $ getSAutoLineLabelPosition pfs sline llabel+    r = case r' of+      Left e -> Just e+      Right (V2 x y) -> if px == x && py == y+        then Nothing+        else Just $ "expected line label position: " <> show (px, py) <> " got " <> show (x, y)++blankOwlPFState :: OwlPFState+blankOwlPFState = OwlPFState emptyOwlTree (SCanvas (LBox 0 200))++expectMidpointCount :: Int -> GoatTester ()+expectMidpointCount n = verifyMostRecentlyCreatedLine $ \sline -> toMaybe (L.length (_sAutoLine_midpoints sline) /= n) ("expected " <> show n <> " midpoint, got: " <> show (_sAutoLine_midpoints sline))++expectLabelCount :: Int -> GoatTester ()+expectLabelCount n = verifyMostRecentlyCreatedLine $ \sline -> toMaybe (L.length (_sAutoLine_labels sline) /= n) ("expected 1 label, got: " <> show (_sAutoLine_labels sline))+++initSimpleLine :: GoatTester ()+initSimpleLine = drawCanvasLine (0, 0) (100, 0)++basic_test :: Spec+basic_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine++  setMarker "add a text label"+  canvasMouseDown (40, 0)+  canvasMouseUp (40, 0)+  expectLabelCount 0 -- no label is created yet beacues we haven't entered any text+  pressKeys "meow meow meow meow"+  expectLabelCount 1+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "meow meow meow meow"+++  setMarker "add a midpoint"+  canvasMouseDown (50, 0)+  canvasMouseDown (50, 50)+  canvasMouseUp (50, 50)+  expectMidpointCount 1++basic_cancel_test :: Spec+basic_cancel_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  setMarker "mouse down and cancel and ensure no line is created"+  setTool Tool_Line+  canvasMouseDown (0, 0)+  pressEscape+  canvasMouseDown (100, 0)+  canvasMouseUp (110, 0)+  verifyOwlCount 0++  setMarker "draw a line and cancel after moving it"+  setTool Tool_Line+  canvasMouseDown (0, 0)+  canvasMouseDown (100, 0)+  verifyOwlCount 1+  pressEscape+  verifyOwlCount 0+  canvasMouseDown (110, 0)+  canvasMouseUp (110, 0)+  verifyOwlCount 0++  initSimpleLine++  setMarker "create a midpoint and cancel"+  canvasMouseDown (50, 0)+  canvasMouseDown (50, 1)+  expectMidpointCount 1+  pressEscape+  expectMidpointCount 0+  canvasMouseDown (50, 2)+  canvasMouseUp (50, 2)+  expectMidpointCount 0++  setMarker "add a midpoint"+  canvasMouseDown (50, 0)+  canvasMouseDown (50, 50)+  canvasMouseUp (50, 50)+  expectMidpointCount 1++++midpoint_modify_basic_test :: Spec+midpoint_modify_basic_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine++  setMarker "add a midpoint"+  canvasMouseDown (50, 0)+  canvasMouseDown (50, 1)+  canvasMouseUp (50, 1)+  expectMidpointCount 1++  setMarker "move it"+  canvasMouseDown (50, 1)+  canvasMouseDown (50, 10)+  canvasMouseUp (50, 10)+  -- TODO verify position++  setMarker "destroy it by dragging it over the start anchor"+  canvasMouseDown (50, 10)+  canvasMouseDown (0, 0)+  canvasMouseUp (0, 0)+  expectMidpointCount 0++  setMarker "undo its destruction"+  pressUndo+  expectMidpointCount 1++  setMarker "destroy it by dragging it over the end anchor"+  canvasMouseDown (50, 10)+  canvasMouseDown (100, 0)+  canvasMouseUp (100, 0)+  expectMidpointCount 0+++++midpoint_double_adjacent_delete_test :: Spec+midpoint_double_adjacent_delete_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine++  setMarker "add a midpoint"+  canvasMouseDown (50, 0)+  canvasMouseDown (50, 1)+  canvasMouseUp (50, 1)+  expectMidpointCount 1++  setMarker "add another midpoint right next to the first"+  canvasMouseDown (20, 0)+  canvasMouseDown (50, 2)+  canvasMouseUp (50, 2)+  expectMidpointCount 2++  setMarker "add a third midpoint"+  canvasMouseDown (90, 0)+  canvasMouseDown (50, 0)+  expectMidpointCount 3++  setMarker "delete the third midpoint by dragging it over the first"+  canvasMouseDown (50, 1)+  expectMidpointCount 2++  setMarker "you should be allowed to drag it over the second midpoint since it's not adjacent (this is the main edge case we are trying to test)"+  canvasMouseDown (50, 2)+  expectMidpointCount 3+++initUnitBox :: (Int, Int) -> GoatTester ()+initUnitBox (x, y) = do+  setMarker "draw a 1x1 box"+  setTool Tool_Box+  canvasMouseDown (x, y)+  canvasMouseDown (x+1, y+1)+  canvasMouseUp (x+1, y+1)+  -- TODO verify box is selected++attaching_delete_test :: Spec+attaching_delete_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do+  initUnitBox (0,0)+  verifyOwlCount 1++  setMarker "draw line attached to box"+  setTool Tool_Line+  canvasMouseDown (-1, 0)+  canvasMouseDown (-10, 1)+  canvasMouseUp (-10, 1)+  verifyOwlCount 2++  -- TODO verify line is attached to box++  setMarker "delete the box"+  canvasMouseDown (0, 0)+  canvasMouseUp (0, 0)+  pressDelete+  verifyOwlCount 1++  -- TODO verify the line that's left is in a sensible place++  pressUndo+  verifyOwlCount 2+  -- TODO verify again that the line is in the expected place++attaching_fully_attached_wont_move_test :: Spec+attaching_fully_attached_wont_move_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do+  initUnitBox (0,0)+  initUnitBox (10,0)+  verifyOwlCount 2++  setMarker "draw line attached to box"+  setTool Tool_Line+  canvasMouseDown (1, 0)+  canvasMouseDown (9, 0)+  canvasMouseUp (9, 0)+  verifyOwlCount 3++  -- TODO verify line is attached to box+  -- TODO verify line is selected++  --+  setMarker "draw another line so that we can select both lines and move them together (otherwise you create a midpoint)"+  setTool Tool_Line+  canvasMouseDown (0, -1)+  canvasMouseDown (10, -1)+  canvasMouseUp (10, -1)+  verifyOwlCount 4++  s1 <- getOwlPFState++  setMarker "select both lines"+  canvasMouseDown (5, -5)+  canvasMouseDown (5, 5)+  canvasMouseUp (5, 5)+  verifySelectionCount 2++  setMarker "try and move the lines"+  canvasMouseDown (5, 0)+  canvasMouseDown (5, 10)+  canvasMouseUp (5, 10)++  s2 <- getOwlPFState+  verify "state did not change after attempting to move line" $ if s1 == s2 then Nothing else Just "it changed!!"++  setMarker "select everything"+  canvasMouseDown (-10, -10)+  canvasMouseDown (20, 20)+  canvasMouseUp (20, 20)+  verifySelectionCount 4++  setMarker "move everything"+  canvasMouseDown (5, 0)+  canvasMouseDown (5, 10)+  canvasMouseUp (5, 10)++  s3 <- getOwlPFState+  verify "state did not change after attempting to move line" $ if s2 == s3 then Just "it didn't change!" else Nothing++label_undo_test :: Spec+label_undo_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine+  verifySelectionCount 1++  setMarker "add a label"+  canvasMouseDown (50, 0)+  canvasMouseUp (50, 0)+  pressKey '1'+  pressKey '2'+  pressKey '3'+  pressKey '4'+  pressKey '5'+  pressReturn+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "12345"+  pressUndo+  -- since this is a newly created label, undo deletes the label+  expectLabelCount 0+  pressRedo+  expectLabelCount 1++label_move_test :: Spec+label_move_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  let screams = "😱😱😱"++  initSimpleLine++  setMarker "add a label"+  canvasMouseDown (50, 0)+  canvasMouseUp (50, 0)+  pressKeys screams+  pressEscape+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText (T.pack screams)+  verifyMostRecentlyCreatedLinesLatestLineLabelHasPosition (50,0)++  setMarker "move the label "+  canvasMouseDown (50, 0)+  canvasMouseDown (40, 0)+  canvasMouseUp (40, 0)+  verifyMostRecentlyCreatedLinesLatestLineLabelHasPosition (40,0)++  setMarker "add a midpoint"+  canvasMouseDown (75, 0)+  canvasMouseDown (76, 0)+  canvasMouseUp (76, 0)+  expectMidpointCount 1++  setMarker "move the label past the midpoint"+  -- TODO this is broken becaues label position got changed after a new midpoint was added+  canvasMouseDown (40, 0)+  canvasMouseDown (90, 0)+  canvasMouseUp (90, 0)+  verifyMostRecentlyCreatedLinesLatestLineLabelHasPosition (90,0)+++label_cursor_test :: Spec+label_cursor_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine+  verifySelectionCount 1++  setMarker "add a label"+  canvasMouseDown (50, 0)+  canvasMouseUp (50, 0)+  pressKey '1'+  pressKey '2'+  pressKey '3'+  pressKey '4'+  pressKey '5'+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "12345"++  setMarker "move the cursor to 3"+  canvasMouseDown (50, 0)+  canvasMouseUp (50, 0)+  pressKey 'A'+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "12A345"++  setMarker "attempt to move the cursor to beyond the line"+  canvasMouseDown (150, 0)+  canvasMouseUp (150, 0)+  verifySelectionCount 0++  setMarker "select the line and type at eol"+  canvasMouseDown (1, 0)+  canvasMouseUp (1, 0)+  verifySelectionCount 1+  canvasMouseDown (47, 0)+  canvasMouseUp (47, 0)+  pressKey 'B'+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "12A345B"++  setMarker "then select directly move the cursor to 1 on the label"+  canvasMouseDown (47, 0)+  canvasMouseUp (47, 0)+  pressKey 'C'+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "C12A345B"++++label_delete_test :: Spec+label_delete_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine+  verifySelectionCount 1++  setMarker "add a label"+  canvasMouseDown (50, 0)+  canvasMouseUp (50, 0)+  pressKey '1'+  pressKey '2'+  pressKey '3'+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "123"+  pressBackspace+  pressBackspace+  pressBackspace+  expectLabelCount 0+  pressBackspace+  expectLabelCount 0++label_delete_midpoint_test :: Spec+label_delete_midpoint_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine+  verifySelectionCount 1++  setMarker "add a midpoint"+  canvasMouseDown (50, 0)+  canvasMouseDown (51, 0)+  canvasMouseUp (51, 0)+  expectMidpointCount 1++  -- BROKEN why??+  setMarker "add a label after last midpoint"+  canvasMouseDown (90, 0)+  canvasMouseUp (90, 0)+  pressKey 'D'+  pressReturn+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "D"++  setMarker "delete the midpoint"+  canvasMouseDown (51, 0)+  canvasMouseDown (100, 0)+  canvasMouseUp (100, 0)+  expectMidpointCount 0+  -- ensure the line label has not been affected+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "D"+++label_delete_after_back_and_forth_test :: Spec+label_delete_after_back_and_forth_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do+  initSimpleLine+  verifySelectionCount 1++  setMarker "add a label"+  canvasMouseDown (90, 0)+  canvasMouseUp (90, 0)+  pressKeys "chicken"+  pressReturn+  expectLabelCount 1+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "chicken"++  setMarker "add another label"+  canvasMouseDown (10, 0)+  canvasMouseUp (10, 0)+  pressKeys "cat"+  pressReturn+  expectLabelCount 2+  verifyMostRecentlyCreatedLinesLatestLineLabelHasText "cat"+++  setMarker "go back to the other label and delete it"+  canvasMouseDown (90, 0)+  canvasMouseUp (90, 0)+  pressBackspace+  pressBackspace+  pressBackspace+  pressBackspace+  pressBackspace+  pressBackspace+  pressBackspace+  pressReturn+  expectLabelCount 1++++cache_basic_test :: Spec+cache_basic_test = hSpecGoatTesterWithOwlPFState blankOwlPFState $ do++  initSimpleLine++  sowl <- mustGetMostRecentlyCreatedOwl+  let+    f gs = case IM.lookup (_superOwl_id sowl) (unRenderCache (_goatState_renderCache gs)) of+      Just (OwlItemCache_Line _ _) -> Nothing+      _ -> Just "expected to find cache"+  verifyState "verify cache got created for the line we just created" f++++spec :: Spec+spec = do+  describe "Line" $ do+    describe "basic" $ basic_test+    describe "basic_cancel" $ basic_cancel_test+    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+    describe "label_undo_test" $ label_undo_test+    describe "label_move_test" $ label_move_test+    describe "label_cursor_test" $ label_cursor_test+    describe "label_delete_midpoint_test" $ label_delete_midpoint_test+    describe "label_delete_after_back_and_forth_test" $ label_delete_after_back_and_forth_test+    describe "label_delete_test" $ label_delete_test++++    -- TODO enable once you fix the "-- TODO DELETE THIS YOU SHOULDN'T HAVE TO DO THIS, this is breaking caching" comment in Goat.hs+    --describe "cache_basic_test" $ cache_basic_test
+ test/Potato/Flow/Controller/Manipulator/PanSpec.hs view
@@ -0,0 +1,90 @@+module Potato.Flow.Controller.Manipulator.PanSpec (+  spec+) where++import           Relude                                         hiding (empty,+                                                                 fromList)++import           Test.Hspec++import           Potato.Flow.GoatTester++import           Potato.Flow+import           Potato.Flow.Controller.Manipulator.TestHelpers++++-- | verifies that the number of owls (elts) in the state is what is expected, includes folders in the count+verifyPan :: (Int, Int) -> GoatTester ()+verifyPan expected = verifyState "verifyPan" f where+  f gs = if pan == expected+    then Nothing+    else Just $ "got " <> show pan <> " expected " <> show expected+    where+      V2 x y = _goatState_pan gs+      pan = (x,y)++++-- TODO broken...+basic_test :: Spec+basic_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  setMarker "draw a box"+  drawCanvasBox (0, 0, 10, 10)+  -- TODO verify box position++  let pan = (5, -7)+  setMarker "pan"+  verifyPan (0,0)+  setTool Tool_Pan+  canvasMouseDown (0, 0)+  canvasMouseDown (1, 1)+  verifyPan (1, 1)+  canvasMouseDown pan+  verifyPan pan+  canvasMouseUp pan+  verifyPan pan++  setMarker "draw a box"+  drawCanvasBox (0, 0, 10, 10)+  -- TODO verify box position is offset by pan+++cancel_test :: Spec+cancel_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do+  let pan = (5, -7)+  setMarker "pan and cancel"+  verifyPan (0,0)+  setTool Tool_Pan+  canvasMouseDown (0, 0)+  canvasMouseDown pan+  verifyPan pan+  pressEscape+  canvasMouseDown pan+  verifyPan (0, 0)+++middle_button_pan_test :: Spec+middle_button_pan_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do++  setMarker "set tool to box, then pan using middle mouse button"+  setTool Tool_Box+  mouse True False [] MouseButton_Middle (V2 0 0)+  mouse True False [] MouseButton_Middle (V2 10 10)+  mouse True True [] MouseButton_Middle (V2 10 10)++  setMarker "check we went back to box handler"+  verifyOwlCount 0+  canvasMouseDown (0, 0)+  canvasMouseDown (1, 1)+  canvasMouseUp (1, 1)+  verifyOwlCount 1+++spec :: Spec+spec = do+  describe "Pan" $ do+    --describe "basic_test" $ basic_test+    describe "cancel_test" $ cancel_test+    describe "middle_button_pan_test" $ middle_button_pan_test
+ test/Potato/Flow/Controller/Manipulator/TestHelpers.hs view
@@ -0,0 +1,35 @@+module Potato.Flow.Controller.Manipulator.TestHelpers where++import           Relude++import           Potato.Flow.GoatTester+import           Potato.Flow            hiding (ex, ey)++drawCanvasBox :: (Int, Int, Int, Int) -> GoatTester ()+drawCanvasBox (x, y, sx, sy) = do+  count <- getOwlCount+  setTool Tool_Box+  canvasMouseDown (x, y)+  canvasMouseDown (x+sx, y+sy)+  verifyOwlCount (count+1)+  canvasMouseUp (x+sx, y+sy)+  let+    f sowl = case _superOwl_elt sowl of+      OwlItem _ (OwlSubItemBox _) -> Nothing+      x                           -> Just ("expected box, got " <> show x)+  verifySelectionIsAndOnlyIs "box is selected" f+++drawCanvasLine :: (Int, Int) -> (Int, Int) -> GoatTester ()+drawCanvasLine (sx, sy) (ex, ey) = do+  count <- getOwlCount+  setTool Tool_Line+  canvasMouseDown (sx, sy)+  canvasMouseDown (ex, ey)+  verifyOwlCount (count+1)+  canvasMouseUp (ex, ey)+  let+    f sowl = case _superOwl_elt sowl of+      OwlItem _ (OwlSubItemLine _) -> Nothing+      x -> Just ("expected line, got " <> show x)+  verifySelectionIsAndOnlyIs "line is selected" f
+ test/Potato/Flow/Deprecated/Controller/EverythingWidgetSpec.hs view
@@ -0,0 +1,764 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.EverythingWidgetSpec+  ( spec+  )+where++import           Relude                            hiding (empty, fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit          (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow+import Potato.Flow.RenderCache (toIndexSafe)++-- test imports+import           Potato.Flow.Common+import           Potato.Flow.TestStates++import qualified Data.List.Ordered                 as L+import qualified Data.Sequence                     as Seq+import qualified Data.Vector.Unboxed     as V+++hasUnsavedChanges  :: Bool -> EverythingPredicate+hasUnsavedChanges unsavedchanges = FunctionPredicate $+  (\gs -> ("expected " <> show unsavedchanges,+    goatState_hasUnsavedChanges gs == unsavedchanges))++expectState :: OwlPFState -> EverythingPredicate+expectState pfs = FunctionPredicate $+  (\pfs' -> ("expected owlpfstate_basic1",+    owlTree_equivalent (_owlPFState_owlTree pfs) (_owlPFState_owlTree pfs')+    && _owlPFState_canvas pfs == _owlPFState_canvas pfs'))+  . goatState_pFState++everything_load_test :: Test+everything_load_test = constructTest "load" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "Load"+      , EWCLoad (owlPFState_to_sPotatoFlow owlpfstate_basic1, emptyControllerMeta)+      , EWCLoad (owlPFState_to_sPotatoFlow owlpfstate_basic1, emptyControllerMeta)+      , EWCLoad (owlPFState_to_sPotatoFlow owlpfstate_someValidState1, emptyControllerMeta)+      , EWCLoad (owlPFState_to_sPotatoFlow owlpfstate_basic1, emptyControllerMeta)+      , EWCLoad (owlPFState_to_sPotatoFlow owlpfstate_someValidState1, emptyControllerMeta)+      , EWCLoad (owlPFState_to_sPotatoFlow emptyOwlPFState, emptyControllerMeta)+    ]+  expected = [+      LabelCheck "Load"+      , expectState owlpfstate_basic1+      , expectState owlpfstate_basic1+      , expectState owlpfstate_someValidState1+      , Combine [+          expectState owlpfstate_basic1+          -- intersects "b1" "b2" "b3" "b4" in owlpfstate_basic1+          , numEltsInLBoxUsingBroadphasePredicate 4 (LBox 0 (V2 15 15))+        ]+      , expectState owlpfstate_someValidState1+      , Combine [+          expectState emptyOwlPFState+          , numEltsInLBoxUsingBroadphasePredicate 0 (LBox 0 (V2 1000 1000))+        ]+++    ]++validateLayersOrderPredicate :: EverythingPredicate+validateLayersOrderPredicate = FunctionPredicate fn where+  fn GoatState {..} = r where+    lentries = _layersState_entries _goatState_layersState+    -- TODO report position of superowls in tree+    msg = "expected LayerEntries in order " <> show (fmap _layerEntry_superOwl lentries)+    owltree = _owlPFState_owlTree $ _owlPFWorkspace_owlPFState _goatState_workspace+    sortingfn le1 le2 = owlTree_superOwl_comparePosition owltree (_layerEntry_superOwl le1) (_layerEntry_superOwl le2) == LT+    r = (msg, L.isSortedBy sortingfn (toList lentries))++checkLayerEntriesNum :: Int -> EverythingPredicate+checkLayerEntriesNum n = r where+  r = FunctionPredicate $+    (\lentries -> ("expected " <> show n <> " got " <> show (Seq.length lentries), Seq.length lentries == n))+    . _layersState_entries . _goatState_layersState++-- TODO what does this even test???+everything_layers_test :: Test+everything_layers_test = constructTest "layers" owlpfstate_basic1 bs expected where+  bs = [+      EWCLabel "Initial"+      , EWCNothing -- dummy to check state++      , EWCLabel "Create A"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+      , EWCNothing -- dummy to check state+    ]+  expected = [+      LabelCheck "Initial"+      -- this isn't an especially useful/exciting test... but it's better than nothing+      , Combine [+        validateLayersOrderPredicate+        , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)  )+      ]++      , LabelCheck "Create A"+      , (EqPredicate goatState_selectedTool Tool_Box)+      , AlwaysPass+      , AlwaysPass+      , AlwaysPass+      , Combine [+        validateLayersOrderPredicate+        , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      ]+    ]++-- test specific behaviour on input focus between layers and canvas+everything_inputfocusing_test :: Test+everything_inputfocusing_test = constructTest "inputfocusing" owlpfstate_basic1 bs expected where+  bs = [+      EWCLabel "Create A"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+      , EWCNothing++      , EWCLabel "undo redo"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Esc) []) -- deselect so we don't go into renaming mode later++      -- TODO actually do something in layers+      , EWCLabel "click on layers"+      , EWCMouse (LMouseData (V2 10 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 10 0) True MouseButton_Left [] True)++      -- expect undo redo to work even though our focus is in layers now+      , EWCLabel "undo redo"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl])++      -- TODO (when it's implemented) add test for renaming in layers and then changing focus back to canvas should cancel rename action+    ]+  expected = [+      LabelCheck "Create A"+      , (EqPredicate goatState_selectedTool Tool_Box)+      , AlwaysPass+      , AlwaysPass+      , AlwaysPass+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)++      , LabelCheck "undo redo"+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 0)+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      , AlwaysPass++      -- TODO test that something in layers got seleceted+      -- TODO test that last mouse input is in layers+      , LabelCheck "click on layers"+      , AlwaysPass+      , AlwaysPass++      , LabelCheck "undo redo"+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 0)+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)++    ]++everything_canvasSize_test :: Test+everything_canvasSize_test = constructTest "canvas resize" owlpfstate_basic1 bs expected where+  bs = [+      EWCLabel "Initial"+      , EWCNothing -- dummy to check state++      , EWCLabel "Resize Canvas By"+      , EWCCanvasResize (V2 100 100)+    ]+  expected = [+      LabelCheck "Initial"+      -- TODO test canvas size (expect 50 25)+      , AlwaysPass++      , LabelCheck "Resize Canvas By"+      -- TODO test canvas size (expect 150 125)+      , AlwaysPass+    ]++everything_keyboard_test :: Test+everything_keyboard_test = constructTest "keyboard" owlpfstate_basic1 bs expected where+  bs = [+      EWCLabel "Copy pasta nothing"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'c') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl])++      , EWCLabel "Create A with random keyboard inputs in between"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'v') [])+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'c') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char '\\') [])+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+      , EWCNothing -- dummy to check state++      , EWCLabel "Copy pasta A"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'c') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl])++      , EWCLabel "Delete A using Delete key"+      , EWCKeyboard (KeyboardData (KeyboardKey_Delete) [])++      , EWCLabel "Select everything"+      , EWCTool Tool_Select+      , EWCMouse (LMouseData (V2 (-100) (-100)) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 200 200) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 200 200) True MouseButton_Left [] False)++      , EWCLabel "Cut pasta everything"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'x') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl])++      , EWCLabel "Esc deselect everything"+      , EWCKeyboard (KeyboardData (KeyboardKey_Esc) [])+    ]++  -- I can't remember why we're using checkLayerEntriesNum instead of counting number of entries in PFState but it doesn't matter, should be the same+  expected = [+      LabelCheck "Copy pasta nothing"+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)  )+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)  )++      , LabelCheck "Create A with random keyboard inputs in between"+      , (EqPredicate goatState_selectedTool Tool_Box)+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)  )+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)  )+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      , Combine [+        validateLayersOrderPredicate+        , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+        , numSelectedEltsEqualPredicate 1+      ]++      , LabelCheck "Copy pasta A"+      , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 1)+      , Combine [+          -- TODO copy not implemented yet so this doesn't work+          checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 2)+          , numSelectedEltsEqualPredicate 1+        ]+      , Combine [+          checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 3)+          , numSelectedEltsEqualPredicate 1+        ]++      , LabelCheck "Delete A using Delete key"+      , Combine [+          checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 2)+          , numSelectedEltsEqualPredicate 0+        ]++      , LabelCheck "Select everything"+      , (EqPredicate goatState_selectedTool Tool_Select)+      , checkHandlerNameAndState handlerName_select True+      , checkHandlerNameAndState handlerName_select True+      , numSelectedEltsEqualPredicate ((owlPFState_numElts owlpfstate_basic1)   + 2)++      , LabelCheck "Cut pasta everything"+      , checkLayerEntriesNum 0+      , Combine [+          numSelectedEltsEqualPredicate ((owlPFState_numElts owlpfstate_basic1)   + 2)+          , checkLayerEntriesNum ((owlPFState_numElts owlpfstate_basic1)   + 2)+        ]++      , LabelCheck "Esc deselect everything"+      , numSelectedEltsEqualPredicate 0++    ]++-- 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++everything_lockhiddenselectionvialayers_test :: Test+everything_lockhiddenselectionvialayers_test = constructTestWithControllerMeta "lock hidden selection via folders" owlpfstate_basic1 controllermeta_basic1_lockandhidestuff1 bs expected where+  bs = [+      EWCLabel "Select b1" -- locked+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [] True)++      , EWCLabel "Select b2"+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) True MouseButton_Left [] True)++      , EWCLabel "Select b3" -- hidden+      , EWCMouse (LMouseData (V2 moveOffset 2) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 2) True MouseButton_Left [] True)+    ]+  expected = [+      -- okay, turns out you can totally select locked/hidden stuff via folders lol+      -- TODO you might want to consider disallowing selection of locked stuff (directly NOT ok, via parents OK)+      LabelCheck "Select b1"+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "Select b2"+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "Select b3"+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 1++    ]++everything_lockhiddenselectionviacanvas_test :: Test+everything_lockhiddenselectionviacanvas_test = constructTestWithControllerMeta "lock hidden selection via canvas" owlpfstate_basic1 controllermeta_basic1_lockandhidestuff1 bs expected where+  bs = [+      EWCLabel "Select b1" -- locked+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 0) True MouseButton_Left [] False)++      , EWCLabel "Select b2"+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)++      , EWCLabel "Select b3" -- hidden+      , EWCMouse (LMouseData (V2 0 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 10) True MouseButton_Left [] False)+    ]+  expected = [+      -- can't select b1 because locked+      LabelCheck "Select b1"+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 0++      -- select b2 OK+      , LabelCheck "Select b2"+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 1++      -- can't select b3 because hidden+      , LabelCheck "Select b3"+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 0++    ]++++everything_basic_test :: Test+everything_basic_test = constructTest "basic" emptyOwlPFState bs expected where+  bs = [+      -- test basic panning+      EWCLabel "Pan"+      , EWCTool Tool_Pan+      -- drag to (1, 1) and release+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 1 1) True MouseButton_Left [] False)+      -- drag to (10, 15) and cancel without releasing+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 (-1) (-1)) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 9 14) False MouseButton_Left [] False)+      -- cancel and keep tracking and make sure nothing changes+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCMouse (LMouseData (V2 9 100) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 (-20) 31) True MouseButton_Left [] False)++      -- create elt A+      , EWCLabel "Create A"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+      , EWCNothing -- dummy to check state++      , EWCLabel "create another elt, but cancel it"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 (-1) (-1)) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)++      , EWCLabel "press escape a bunch of times and make sure nothing breaks"+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])++      , EWCLabel "select elt A"+      , EWCTool Tool_Select+      , EWCMouse (LMouseData (V2 9 9) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 9 9) True MouseButton_Left [] False)++      , EWCLabel "create elt B"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 0 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 30) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+      , EWCNothing -- dummy to check state++      -- unselect+      , EWCTool Tool_Select+      , EWCMouse (LMouseData (V2 100 100) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 100 100) True MouseButton_Left [] False)++      , EWCLabel "single click select elt B"+      , EWCMouse (LMouseData (V2 1 21) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 1 21) True MouseButton_Left [] False)++      -- now select elts A + B+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 100 100) True MouseButton_Left [] False)++      , EWCLabel "begin selecting nothing and cancel"+      , EWCMouse (LMouseData (V2 100 100) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 200 200) False MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCMouse (LMouseData (V2 200 200) True MouseButton_Left [] False)++      , EWCLabel "single click shift unselect elt B"+      , EWCMouse (LMouseData (V2 1 21) False MouseButton_Left [KeyModifier_Shift] False)+      , EWCMouse (LMouseData (V2 1 21) True MouseButton_Left [KeyModifier_Shift] False)++      , EWCLabel "unselect"+      , EWCMouse (LMouseData (V2 100 100) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 100 100) True MouseButton_Left [] False)++      , EWCLabel "single click select elt A"+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 1 1) True MouseButton_Left [] False)++      , EWCLabel "manipulate A"+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 (-2) (-2)) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 (-2) (-2)) True MouseButton_Left [] False)++      , EWCLabel "single click shift select elt B"+      , EWCMouse (LMouseData (V2 1 21) False MouseButton_Left [KeyModifier_Shift] False)+      , EWCMouse (LMouseData (V2 1 21) True MouseButton_Left [KeyModifier_Shift] False)++      , EWCLabel "manipulate A+B"+      , EWCMouse (LMouseData (V2 5 5) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 7 5) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 7 5) True MouseButton_Left [] False)++      , EWCLabel "Mainpulate A+B then cancel"+      , EWCMouse (LMouseData (V2 7 5) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCMouse (LMouseData (V2 7 5) True MouseButton_Left [] False)+++      -- TODO delete the elt+      -- check in layers and check render+    ]++  expected = [+      LabelCheck "Pan"+      , (EqPredicate goatState_selectedTool Tool_Pan)+      , (EqPredicate _goatState_pan (V2 0 0))+      , (EqPredicate _goatState_pan (V2 1 1))+      , (EqPredicate _goatState_pan (V2 1 1))+      , (EqPredicate _goatState_pan (V2 0 0))+      , (EqPredicate _goatState_pan (V2 10 15))+      , (EqPredicate _goatState_pan (V2 1 1))+      , AlwaysPass+      , (EqPredicate _goatState_pan (V2 1 1))++      , LabelCheck "Create A"+      , (EqPredicate goatState_selectedTool Tool_Box)+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box False+      , Combine [+          PFStateFunctionPredicate (checkNumElts 1)+          , numSelectedEltsEqualPredicate 1+        ]++      , LabelCheck "create another elt, but cancel it"+      , (EqPredicate goatState_selectedTool Tool_Box)+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          PFStateFunctionPredicate (checkNumElts 1) -- make sure no elt was created+          , numSelectedEltsEqualPredicate 0 -- the newly created elt gets selected and after cancelling, the previous selection is lost, womp womp+          , checkHandlerNameAndState handlerName_empty False -- handler defaults to empty selection after cancelling :(+        ]+      -- same as above+      , Combine [+          PFStateFunctionPredicate (checkNumElts 1)+          , numSelectedEltsEqualPredicate 0+          , checkHandlerNameAndState handlerName_empty False+        ]++      , LabelCheck "press escape a bunch of times and make sure nothing breaks"+      , Combine [+          numSelectedEltsEqualPredicate 0+          , checkHandlerNameAndState handlerName_empty False+        ]+      , AlwaysPass+      , AlwaysPass+      , AlwaysPass++      , LabelCheck "select elt A"+      , EqPredicate goatState_selectedTool Tool_Select+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "create elt B"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_boxText False+      , Combine [+          PFStateFunctionPredicate (checkNumElts 2) -- make sure second box was created+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_boxText False+        ]++      -- unselect+      , (EqPredicate goatState_selectedTool Tool_Select)+      , checkHandlerNameAndState handlerName_select True+      , Combine [+          numSelectedEltsEqualPredicate 0+          , checkHandlerNameAndState handlerName_empty False+        ]++      , LabelCheck "single click select elt B"+      , checkHandlerNameAndState handlerName_box True -- select+drag case, expect box handler+      , Combine [+          numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_box False+        ]++      -- now select elts A + B+      , checkHandlerNameAndState handlerName_select True+      , numSelectedEltsEqualPredicate 2++      , LabelCheck "begin selecting nothing and cancel"+      , checkHandlerNameAndState handlerName_select True+      , checkHandlerNameAndState handlerName_select True+      , numSelectedEltsEqualPredicate 2+      , numSelectedEltsEqualPredicate 2++      , LabelCheck "single click shift unselect elt B"+      , checkHandlerNameAndState handlerName_select True -- single click shift unselect case uses select handler+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "unselect"+      , checkHandlerNameAndState handlerName_select True+      , numSelectedEltsEqualPredicate 0++      , LabelCheck "single click select elt A"+      , checkHandlerNameAndState handlerName_box True+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "manipulate A"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      -- check that it got moved to 0 0+      , firstSelectedSuperOwlPredicate Nothing (\sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox (LBox (V2 x y) _) _ _ _ _) -> x == (-2) && y == (-2)+        _                                        -> False)++      , LabelCheck "single click shift select elt B"+      , checkHandlerNameAndState handlerName_select True -- single click shift unselect case uses select handler+      , numSelectedEltsEqualPredicate 2++      , LabelCheck "manipulate A+B"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      -- check that first elt A got moved over by 2+      -- TODO also check elt B+      , firstSelectedSuperOwlPredicate (Just "<box>") (\sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox (LBox (V2 x y) _) _ _ _ _) -> x == 0 && y == (-2)+        _                                        -> False)++      , LabelCheck "Mainpulate A+B then cancel"+      , checkHandlerNameAndState handlerName_box True+      , firstSelectedSuperOwlPredicate (Just "<box>") (\sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox (LBox (V2 x y) _) _ _ _ _) -> x == 3 && y == 3+        _                                        -> False)+      , firstSelectedSuperOwlPredicate (Just "<box>") (\sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox (LBox (V2 x y) _) _ _ _ _) -> x == 0 && y == (-2)+        _                                        -> False)+      , firstSelectedSuperOwlPredicate (Just "<box>") (\sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox (LBox (V2 x y) _) _ _ _ _) -> x == 0 && y == (-2)+        _                                        -> False)+++    ]++-- test specific behaviour on input focus between layers and canvas+everything_hasSavedChanges_test :: Test+everything_hasSavedChanges_test = constructTest "has saved changes" owlpfstate_basic1 bs expected where+  bs = [+      EWCLabel "Start"+      , EWCNothing++      , EWCLabel "Create A"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)++      , EWCLabel "undo redo"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl])++      , EWCLabel "save undo redo undo do"+      , EWCMarkSaved+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl])+      -- TODO++      , EWCLabel "Create B"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+++    ]+  expected = [+      LabelCheck "Start"+      , hasUnsavedChanges False++      , LabelCheck "Create A"+      , (EqPredicate goatState_selectedTool Tool_Box)+      , AlwaysPass+      , AlwaysPass+      , hasUnsavedChanges True++      , LabelCheck "undo redo"+      , hasUnsavedChanges False+      , hasUnsavedChanges True++      , LabelCheck "save undo redo undo do"+      , hasUnsavedChanges False+      , hasUnsavedChanges True+      , hasUnsavedChanges False+      , hasUnsavedChanges True++      , LabelCheck "Create B"+      , (EqPredicate goatState_selectedTool Tool_Box)+      , AlwaysPass+      , AlwaysPass+      , hasUnsavedChanges True++    ]++testForChar_internal :: RenderedCanvasRegion -> XY -> Bool+testForChar_internal rc pos = case toIndexSafe (_renderedCanvasRegion_box rc) pos of+  Nothing -> False+  Just i -> _renderedCanvasRegion_contents rc V.! i /= (-1, ' ')+++-- bad because this function assumes:+-- - element render fills the entire box+-- - nothing else is overlapping it+-- - element is canonical and non zero+badTestVisibility  :: Text -> Bool -> EverythingPredicate+badTestVisibility name cansee = FunctionPredicate f where+  f gs = r where++    pfs = goatState_pFState gs++    rc = _goatState_renderedCanvas gs++    lmm = _layersState_meta $ _goatState_layersState gs++    msowl = hasOwlTree_test_findFirstSuperOwlByName pfs name+    wasrendered = case msowl of+      Nothing -> False+      Just sowl -> case getSEltBox_naive (hasOwlItem_toSElt_hack sowl) of+        Nothing -> False+        Just box -> wasrendered' where+          wasrendered' = testForChar_internal rc (_lBox_tl box)+    r = (show (_renderedCanvasRegion_box rc) <> show lmm <> " expected " <> show cansee <> " got " <> show wasrendered <> "\n\n" <> renderedCanvasToText rc <> "\n\n", cansee == wasrendered)++everything_hideStuff_test :: Test+everything_hideStuff_test = constructTestWithControllerMeta "render hide via folders test" owlpfstate_basic2 controllermeta_basic2_expandEverything bs expected where+  bs = [+      EWCLabel "Nothing"+      , EWCScreenRegion 25 -- must set the screen so we can see stuff++      , EWCLabel "hide b1"+      , EWCMouse (LMouseData (V2 3 2) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 3 2) True MouseButton_Left [] True)+      , EWCNothing+      , EWCNothing++      , EWCLabel "hide fstart1"+      , EWCMouse (LMouseData (V2 1 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 1 0) True MouseButton_Left [] True)++      , EWCLabel "show fstart1"+      , EWCMouse (LMouseData (V2 1 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 1 0) True MouseButton_Left [] True)++    ]+  expected = [+      LabelCheck "Nothing"+      , badTestVisibility "b1" True -- test b1 is not hidden++      , LabelCheck "hide b1"+      , AlwaysPass+      , AlwaysPass+      , badTestVisibility "b1" False -- test b1 is hidden+      , badTestVisibility "b2" True -- test b2 is not hidden++      , LabelCheck "hide fstart1"+      , badTestVisibility "b1" False -- test b1 is hidden+      , badTestVisibility "b2" False -- test b2 is hidden++      , LabelCheck "show fstart1"+      , badTestVisibility "b1" False -- test b1 is hidden+      , badTestVisibility "b2" True -- test b2 is not hidden++    ]+++spec :: Spec+spec = do+  describe "EverythingWidget" $ do+    fromHUnitTest $ everything_load_test+    fromHUnitTest $ everything_layers_test+    fromHUnitTest $ everything_canvasSize_test+    fromHUnitTest $ everything_keyboard_test+    fromHUnitTest $ everything_lockhiddenselectionvialayers_test+    fromHUnitTest $ everything_lockhiddenselectionviacanvas_test+    fromHUnitTest $ everything_basic_test+    fromHUnitTest $ everything_inputfocusing_test+    fromHUnitTest $ everything_hasSavedChanges_test+    fromHUnitTest $ everything_hideStuff_test+    --fromHUnitTest $ everything_newfolder_test
+ test/Potato/Flow/Deprecated/Controller/LayersSpec.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.LayersSpec+  ( spec+  )+where++import           Relude                        hiding (empty, fromList)++import           Test.Hspec++import           Potato.Flow++import           Potato.Flow.TestStates+import           Potato.Flow.Deprecated.State (PFState(..))++import           Data.Default+import qualified Data.IntMap                   as IM+import qualified Data.Sequence                 as Seq+++someState1 :: OwlPFState+someState1 = pFState_to_owlPFState $ PFState {+      _pFState_layers = Seq.fromList [0..5]+      , _pFState_directory = IM.fromList [+          (0, folderStart)+            , (1, someSEltLabel)+            , (2, someSEltLabel)+            , (3, someSEltLabel)+            , (4, someSEltLabel)+            , (5, folderEnd)+        ]+      , _pFState_canvas = someSCanvas+  }+someState2 :: OwlPFState+someState2 = pFState_to_owlPFState $ PFState {+      _pFState_layers = Seq.fromList [0..11]+      , _pFState_directory = IM.fromList [+          (0, folderStart)+            , (1, folderStart)+              , (2, someSEltLabel)+              , (3, folderStart)+                , (4, someSEltLabel)+                , (5, folderEnd)+              , (6, someSEltLabel)+              , (7, folderEnd)+            , (8, someSEltLabel)+            , (9, folderStart)+              , (10, folderEnd)+            , (11, folderEnd)+        ]+      , _pFState_canvas = someSCanvas+  }++-- multiple (4) folders at top level+someState3 :: OwlPFState+someState3 = pFState_to_owlPFState $ PFState {+      _pFState_layers = Seq.fromList [0..15]+      , _pFState_directory = IM.fromList [+          (0, folderStart)+            , (1, folderStart)+              , (2, someSEltLabel)+              , (3, folderEnd)+            , (4, someSEltLabel)+            , (5, folderStart)+              , (6, folderEnd)+            , (7, someSEltLabel)+            , (8, folderEnd)+          , (9, folderStart)+            , (10, folderEnd)+          , (11, folderStart)+            , (12, folderEnd)+          , (13, folderStart)+            , (14, someSEltLabel)+            , (15, folderEnd)+        ]+      , _pFState_canvas = someSCanvas+  }+++generateLayersNew' :: OwlPFState -> LayerMetaMap -> Seq LayerEntry+generateLayersNew' pfs lmm = generateLayersNew (_owlPFState_owlTree pfs) lmm++createLayerMetaMap :: Bool -> OwlPFState -> LayerMetaMap+createLayerMetaMap collapseAll OwlPFState {..} = fmap (\_ -> def { _layerMeta_isCollapsed = collapseAll }) (_owlTree_mapping _owlPFState_owlTree)+++spec :: Spec+spec = do+  describe "Layers" $ do+    describe "generateLayersNew'" $ do+      it "basic" $ if defaultFolderCollapseState+        then do+          -- empty LayerMetaMap means everything is collapsed by default+          Seq.length (generateLayersNew' someState1 IM.empty) `shouldBe` 1+          Seq.length (generateLayersNew' someState2 IM.empty) `shouldBe` 1+        else do+          -- empty LayerMetaMap means everything is collapsed by default+          Seq.length (generateLayersNew' someState1 IM.empty) `shouldBe` 5+          Seq.length (generateLayersNew' someState2 IM.empty) `shouldBe` 8+      it "handles empty state" $ do+        Seq.length (generateLayersNew' emptyOwlPFState IM.empty) `shouldBe` 0+    describe "toggleLayerEntry" $ do+      it "basic1" $ do+        -- open 0+        let+          -- start with everything collapsed+          lmm_0 = createLayerMetaMap True someState1+          lentries_0 = generateLayersNew' someState1 lmm_0+          (LayersState lmm_1 lentries_1 _) = toggleLayerEntry someState1 (LayersState lmm_0 lentries_0 0) 0 LHCO_ToggleCollapse+        Seq.length lentries_1 `shouldBe` 5++        -- hide 0+        let+          (LayersState lmm_2 lentries_2 _) = toggleLayerEntry someState1 (LayersState lmm_1 lentries_1 0) 0 LHCO_ToggleHide+        _layerEntry_hideState (Seq.index lentries_2 0) `shouldBe` LHS_True+        forM_ [1,2,3,4] $ \i -> do+          _layerEntry_hideState (Seq.index lentries_2 i) `shouldBe` LHS_False_InheritTrue++        -- hide 1, show 0+        let+          (LayersState lmm_3 lentries_3 _) = toggleLayerEntry someState1 (LayersState lmm_2 lentries_2 0) 1 LHCO_ToggleHide+          (LayersState lmm_4 lentries_4 _) = toggleLayerEntry someState1 (LayersState lmm_3 lentries_3 0) 0 LHCO_ToggleHide+        forM_ [0,2,3,4] $ \i -> do+          _layerEntry_hideState (Seq.index lentries_4 i) `shouldBe` LHS_False+        _layerEntry_hideState (Seq.index lentries_4 1) `shouldBe` LHS_True++        -- lock 4+        let+          (LayersState lmm_5 lentries_5 _) = toggleLayerEntry someState1 (LayersState lmm_4 lentries_4 0) 4 LHCO_ToggleLock+        _layerEntry_lockState (Seq.index lentries_5 4) `shouldBe` LHS_True++        -- close first folder+        let+          (LayersState _ lentries_final _) = toggleLayerEntry someState1 (LayersState lmm_5 lentries_5 0) 0 LHCO_ToggleCollapse+        Seq.length lentries_final `shouldBe` 1+        lentries_final `shouldBe` lentries_0+      it "basic2" $ do+        let+          lmm_0 = createLayerMetaMap False someState2 -- everything expanded+          lentries_0 = generateLayersNew' someState2 lmm_0+        Seq.length lentries_0 `shouldBe` 8++        -- ensure layer entry 7 is rid 9+        (_superOwl_id . _layerEntry_superOwl) (Seq.index lentries_0 7) `shouldBe` 9++        -- collapse layer entry 7, which should do nothing because it's an empty folder+        let+          (LayersState _ lentries_1 _) = toggleLayerEntry someState1 (LayersState lmm_0 lentries_0 0) 7 LHCO_ToggleCollapse+        Seq.length lentries_1 `shouldBe` 8++      it "basic3" $ do+        let+          lmm_0 = createLayerMetaMap True someState3 -- everything collapsed+          lentries_0 = generateLayersNew' someState3 lmm_0+        Seq.length lentries_0 `shouldBe` 4++        -- ensure layer entry 3 is rid 13+        (_superOwl_id . _layerEntry_superOwl) (Seq.index lentries_0 3) `shouldBe` 13++        -- expand last folder, there should be one more element+        let+          (LayersState _ lentries_1 _) = toggleLayerEntry someState3 (LayersState lmm_0 lentries_0 0) 3 LHCO_ToggleCollapse+        Seq.length lentries_1 `shouldBe` 5+    describe "updateLayers" $ do+      it "basic" $ do+        let+          state_0 = someState1+          lmm_0 = createLayerMetaMap False state_0 -- everything expanded+          lentries_0 = generateLayersNew' state_0 lmm_0++          deleteme = owlTree_mustFindSuperOwl (_owlPFState_owlTree state_0) 4+          rid = _superOwl_id deleteme+          spot = owlTree_owlItemMeta_toOwlSpot (_owlPFState_owlTree state_0) (_superOwl_meta deleteme)+          oelt = _superOwl_elt deleteme++          (state_1, changes) = do_deleteElts [(rid,spot,oelt)] state_0+          (LayersState _ lentries_1 _) = updateLayers state_1 changes (LayersState lmm_0 lentries_0 0)+        Seq.length lentries_1 `shouldBe` 4
+ test/Potato/Flow/Deprecated/Controller/Manipulator/BoxSpec.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.Manipulator.BoxSpec (+  spec+) where++import           Relude                                     hiding (empty,+                                                             fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit                   (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow++import           Potato.Flow.Common++++test_basic :: Test+test_basic = constructTest "keyboard movement" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "Create A"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)++      , EWCLabel "KB move A"+      , EWCKeyboard (KeyboardData (KeyboardKey_Up) [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Down) [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Left) [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Right) [])++    ]+  testFirstBoxIs lbox = firstSuperOwlPredicate (Just "<box>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+    SEltBox (SBox lbox' _ _ _ _) -> lbox' == lbox+    _                           -> False+  expected = [+      LabelCheck "Create A"+      , EqPredicate goatState_selectedTool Tool_Box+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          testFirstBoxIs (LBox (V2 1 1) (V2 9 9))+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_box False+        ]++      , LabelCheck "KB move A"+      , testFirstBoxIs (LBox (V2 1 0) (V2 9 9))+      , testFirstBoxIs (LBox (V2 1 1) (V2 9 9))+      , testFirstBoxIs (LBox (V2 0 1) (V2 9 9))+      , testFirstBoxIs (LBox (V2 1 1) (V2 9 9))++    ]++spec :: Spec+spec = do+  describe "Box" $ do+    fromHUnitTest $ test_basic
+ test/Potato/Flow/Deprecated/Controller/Manipulator/BoxTextSpec.hs view
@@ -0,0 +1,472 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.Manipulator.BoxTextSpec (+  spec+) where++import           Relude                                     hiding (empty,+                                                             fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit                   (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow++import           Potato.Flow.Common++import           Data.Default+import           Data.Dependent.Sum                         (DSum ((:=>)))+import qualified Data.IntMap                                as IM+import qualified Potato.Data.Text.Zipper                           as TZ++testText1 :: Text+testText1 = "aoeu\nhi\n12345wrapping"++testSBoxWithText1 :: SBox+testSBoxWithText1 = def {+    _sBox_box = LBox (V2 5 5) (V2 5 10)+    , _sBox_text = SBoxText testText1 def+    , _sBox_boxType = SBoxType_NoBoxText+  }++testClick :: Int -> Int -> RelMouseDrag+testClick x y = RelMouseDrag $ def {+    _mouseDrag_to = V2 x y+  }++boxTextInputState_basic_test :: Spec+boxTextInputState_basic_test = let+    tais1 = makeTextInputState 0 testSBoxWithText1 (testClick 5 5)+    tais2 = mouseText tais1 (testClick 6 5)+  in+    it "makeTextInputState_basic" $ do+      _textInputState_original tais1 `shouldBe` Just testText1+      _textInputState_original tais2 `shouldBe` Just testText1+      -- TZ has no Eq instance but show works fine, whatever+      show @[Char] (TZ.right (_textInputState_zipper tais1)) `shouldBe` show (_textInputState_zipper tais2)+++checkSBoxText :: Text -> Text -> EverythingPredicate+checkSBoxText label text = firstSuperOwlPredicate (Just label) $ \sowl -> case hasOwlItem_toSElt_hack sowl of+  SEltBox (SBox _ _ _ (SBoxText {..}) _) -> _sBoxText_text == text+  _                                         -> False++checkSBoxLabel :: Text -> Text -> EverythingPredicate+checkSBoxLabel label text = firstSuperOwlPredicate (Just label) $ \sowl -> case hasOwlItem_toSElt_hack sowl of+  SEltBox sbox -> _sBoxTitle_title (_sBox_title sbox) == Just text+  _                                         -> False++test_basic :: Test+test_basic = constructTest "basic" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "create <text>"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "modify <text>"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])++      , EWCLabel "move cursor <text>"+      , EWCMouse (LMouseData (V2 12 11) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 12 11) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'a') [])++      , EWCLabel "exit BoxText"+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])++      , EWCLabel "select <text> at end of line"+      , EWCMouse (LMouseData (V2 11 18) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 18) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'b') [])++      , EWCLabel "set noborder"+      , EWCSetParams $ IM.singleton 1 (CTagBoxType :=> Identity (CBoxType (SBoxType_BoxText, SBoxType_NoBoxText)))+      -- there is no border so click location is offset by (-1,-1) from before+      , EWCMouse (LMouseData (V2 11 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 10) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char '🥔') [])++    ]+  expected = [+      LabelCheck "create <text>"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 10 10)+            _                           -> False+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_boxText False+        ]++      , LabelCheck "modify <text>"+      , checkHandlerNameAndState handlerName_boxText False+      , checkHandlerNameAndState handlerName_boxText False+      , checkHandlerNameAndState handlerName_boxText False+      , checkSBoxText "<text>" "poop"++      , LabelCheck "move cursor <text>"+      , checkHandlerNameAndState handlerName_boxText True+      , checkHandlerNameAndState handlerName_boxText False+      , checkSBoxText "<text>" "paoop"++      , LabelCheck "exit BoxText"+      , checkHandlerNameAndState handlerName_box False++      , LabelCheck "select <text> at end of line"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_boxText False+      , checkSBoxText "<text>" "paoopb"++      , Combine [+          LabelCheck "set noborder"+          -- make sure REltId is 0 because next step we will modify using it+          , firstSuperOwlPredicate (Just "<text>") $ \sowl -> _superOwl_id sowl == 1+        ]+      , firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox _ _ _ _ boxtype) -> boxtype == SBoxType_NoBoxText+        _                                 -> False+      , checkHandlerNameAndState handlerName_boxText True+      , checkHandlerNameAndState handlerName_boxText False+      , checkSBoxText "<text>" "p🥔aoopb"+    ]++test_handler_state :: Test+test_handler_state = constructTest "handler state" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "create <text>"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "exit BoxText"+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])++      , EWCLabel "deselect <text>"+      , EWCTool Tool_Select+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 0) True MouseButton_Left [] False)++      , EWCLabel "select + drag <text>"+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 11) True MouseButton_Left [] False)++      , EWCLabel "enter edit mode"+      , EWCMouse (LMouseData (V2 11 15) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 15) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char '😱') [])++    ]+  expected = [+      LabelCheck "create <text>"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 10 10)+            _                           -> False+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_boxText False+        ]++      , LabelCheck "exit BoxText"+      , checkHandlerNameAndState handlerName_box False++      , LabelCheck "deselect <text>"+      , EqPredicate goatState_selectedTool Tool_Select+      , checkHandlerNameAndState handlerName_select True+      , Combine [+          checkHandlerNameAndState handlerName_empty False+          , numSelectedEltsEqualPredicate 0+        ]++      , LabelCheck "select + drag <text>"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box False++      , LabelCheck "enter edit mode"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_boxText False+      , checkSBoxText "<text>" "😱"++    ]++-- same test as basic except box is inverted+test_negative :: Test+test_negative = constructTest "negative" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "create <text>"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 0) True MouseButton_Left [] False)++      , EWCLabel "modify <text>"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'g') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])++      , EWCLabel "move cursor <text>"+      , EWCMouse (LMouseData (V2 2 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 2 1) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'a') [])+++    ]+  expected = [+      LabelCheck "create <text>"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            -- old non-canonical version, keeping here in case we ever decide to go back to non-canonical version+            --SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 (-10) (-10))+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 0 0) (V2 (10) (10))+            _                           -> False+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_boxText False+        ]++      , LabelCheck "modify <text>"+      , checkHandlerNameAndState handlerName_boxText False+      , checkHandlerNameAndState handlerName_boxText False+      , checkHandlerNameAndState handlerName_boxText False+      , checkSBoxText "<text>" "goop"++      , LabelCheck "move cursor <text>"+      , checkHandlerNameAndState handlerName_boxText True+      , checkHandlerNameAndState handlerName_boxText False+      , checkSBoxText "<text>" "gaoop"++    ]++test_zero :: Test+test_zero = constructTest "zero" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "create <text>"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 12 12) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 12 12) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char '🥔') [])++      , EWCLabel "exit BoxText"+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])++      , EWCLabel "resize box to 0"+      , EWCMouse (LMouseData (V2 12 12) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+    ]+  expected = [+      LabelCheck "create <text>"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 2 2)+            _                           -> False+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_boxText False+        ]+      , checkSBoxText "<text>" "🥔"++      , LabelCheck "exit BoxText"+      , checkHandlerNameAndState handlerName_box False++      , LabelCheck "resize box to 0"+      , AlwaysPass+      , AlwaysPass+      , firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 0 0)+        _                           -> False++    ]+++lookup :: Int -> [a] -> Maybe a+lookup _ []       = Nothing+lookup 0 (x : _)  = Just x+lookup i (_ : xs) = lookup (i - 1) xs++-- | check the position of the cursor+checkRenderHandlerPos :: XY -> EverythingPredicate+checkRenderHandlerPos pos = FunctionPredicate $ \gs ->+  let+    h = _goatState_handler gs+    phi = potatoHandlerInputFromGoatState gs+    HandlerRenderOutput hs = pRenderHandler h phi+  -- cursor is always 4th position in HandlerRenderOutput+  in case lookup 4 hs of+    Nothing -> ("could not find render handler for " <> pHandlerName h <> " got: " <> show hs, False)+    Just (RenderHandle (LBox p _) _ _) -> if p == pos+      then ("", True)+      else ("handler output mismatch expected: " <> show pos <> " got: " <> show p, False)++test_output :: Test+test_output = constructTest "output" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "create <text>"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "modify <text>"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])++      , EWCLabel "move cursor <text>"+      , EWCMouse (LMouseData (V2 12 11) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 12 11) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'a') [])++      , EWCLabel "exit BoxText"+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])++      , EWCLabel "select <text> at end of line"+      , EWCMouse (LMouseData (V2 11 18) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 18) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'b') [])++      , EWCLabel "navigate"+      , EWCKeyboard (KeyboardData KeyboardKey_Left [])+      , EWCKeyboard (KeyboardData KeyboardKey_Left [])+      , EWCKeyboard (KeyboardData KeyboardKey_Home [])+      , EWCKeyboard (KeyboardData KeyboardKey_Right [])+      , EWCKeyboard (KeyboardData KeyboardKey_Right [])+      , EWCKeyboard (KeyboardData KeyboardKey_End [])++      , EWCLabel "set noborder"+      , EWCSetParams $ IM.singleton 1 (CTagBoxType :=> Identity (CBoxType (SBoxType_BoxText, SBoxType_NoBoxText)))+      , EWCKeyboard (KeyboardData KeyboardKey_Backspace [])++      , EWCLabel "align right"+      , EWCSetParams $ IM.singleton 1 (CTagBoxTextStyle :=> Identity (CTextStyle $ DeltaTextStyle (TextStyle TextAlign_Left, TextStyle TextAlign_Right)))++    ]+  expected = [+      LabelCheck "create <text>"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          numSelectedEltsEqualPredicate 1+          , checkRenderHandlerPos (V2 11 11)+        ]++      , LabelCheck "modify <text>"+      , checkRenderHandlerPos (V2 12 11)+      , checkRenderHandlerPos (V2 13 11)+      , checkRenderHandlerPos (V2 14 11)+      , checkRenderHandlerPos (V2 15 11)++      , LabelCheck "move cursor <text>"+      , checkHandlerNameAndState handlerName_boxText True+      , checkRenderHandlerPos (V2 12 11)+      , checkRenderHandlerPos (V2 13 11)++      , LabelCheck "exit BoxText"+      , checkHandlerNameAndState handlerName_box False++      , LabelCheck "select <text> at end of line"+      , checkHandlerNameAndState handlerName_box True+      , checkRenderHandlerPos (V2 16 11)+      , checkRenderHandlerPos (V2 17 11)++      , LabelCheck "navigate"+      , checkRenderHandlerPos (V2 16 11)+      , checkRenderHandlerPos (V2 15 11)+      , checkRenderHandlerPos (V2 11 11)+      , checkRenderHandlerPos (V2 12 11)+      , checkRenderHandlerPos (V2 13 11)+      , checkRenderHandlerPos (V2 17 11)+++      , Combine [+          LabelCheck "set noborder"+          -- make sure REltId is 0 because next step we will modify using it+          , firstSuperOwlPredicate (Just "<text>") $ \sowl -> _superOwl_id sowl == 1+        ]+      , checkRenderHandlerPos (V2 16 10)+      , checkRenderHandlerPos (V2 15 10)++      , Combine [+          LabelCheck "align right"+          -- make sure REltId is 0 because next step we will modify using it+          , firstSuperOwlPredicate (Just "<text>") $ \sowl -> _superOwl_id sowl == 1+        ]+      , checkRenderHandlerPos (V2 19 10)+    ]++++test_boxlabel_basic :: Test+test_boxlabel_basic = constructTest "basic" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "create <box>"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "select <box> label"+      , EWCMouse (LMouseData (V2 12 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 12 10) True MouseButton_Left [] False)++      , EWCLabel "modify <box> label"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])+    ]+  expected = [+      LabelCheck "create <box>"+      , EqPredicate goatState_selectedTool Tool_Box+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<box>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 10 10)+            _                           -> False+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_box False+        ]++      , LabelCheck "select <box> label"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_boxLabel False++      , LabelCheck "modify <box> label"+      , checkHandlerNameAndState handlerName_boxLabel False+      , checkHandlerNameAndState handlerName_boxLabel False+      , checkHandlerNameAndState handlerName_boxLabel False+      , checkSBoxLabel "<box>" "poop"+    ]++spec :: Spec+spec = do+  describe "BoxTextHandler" $ do+    boxTextInputState_basic_test+    fromHUnitTest $ test_basic+    fromHUnitTest $ test_handler_state+    fromHUnitTest $ test_negative+    fromHUnitTest $ test_zero+    fromHUnitTest $ test_output+  describe "BoxLabelHandler" $ do+    fromHUnitTest $ test_boxlabel_basic
+ test/Potato/Flow/Deprecated/Controller/Manipulator/CartLineSpec.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.Manipulator.CartLineSpec (+  spec+) where++import           Relude                                     hiding (empty,+                                                             fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit                   (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow+import           Potato.Flow.Common+++test_basic :: Test+test_basic = constructTest "basic" emptyOwlPFState bs expected where+  bs = [+      EWCLabel "create <cartline>"+      , EWCTool Tool_CartLine+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 10) True MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)+      -- click on same point to finish it+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++    ]+  expected = [+      LabelCheck "create <cartline>"+      , EqPredicate goatState_selectedTool Tool_CartLine+      , checkHandlerNameAndState handlerName_cartesianLine True+      , checkHandlerNameAndState handlerName_cartesianLine True+      , checkHandlerNameAndState handlerName_cartesianLine True+      , checkHandlerNameAndState handlerName_cartesianLine True+      , checkHandlerNameAndState handlerName_cartesianLine True+      , checkHandlerNameAndState handlerName_cartesianLine True+      , checkHandlerNameAndState handlerName_cartesianLine False+      , checkHandlerNameAndState handlerName_cartesianLine False++    ]+++spec :: Spec+spec = do+  describe "CartLine" $ do+    fromHUnitTest $ test_basic
+ test/Potato/Flow/Deprecated/Controller/Manipulator/LayersSpec.hs view
@@ -0,0 +1,449 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.Manipulator.LayersSpec+  ( spec+  )+where++import           Relude                            hiding (empty, fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit          (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow++import           Potato.Flow.Common+import           Potato.Flow.TestStates++import qualified Data.Sequence                     as Seq+import Data.Default++moveOffset :: Int+moveOffset = 100++collapseOffset :: Int+collapseOffset = 0++hideOffset :: Int+hideOffset = 1++lockOffset :: Int+lockOffset = 2+++numLayerEntriesEqualPredicate :: Int -> EverythingPredicate+numLayerEntriesEqualPredicate n = FunctionPredicate $+  (\lentries ->+    let nlentries = Seq.length lentries+    in ("LayerEntries count: " <> show nlentries <> " expected: " <> show n <> " lentries:\n" <> layerEntriesToPrettyText lentries, nlentries == n))+  . _layersState_entries . _goatState_layersState+++numVisibleHiddenLayerEntriesEqualPredicate :: Int -> EverythingPredicate+numVisibleHiddenLayerEntriesEqualPredicate n = FunctionPredicate $+  (\lentries ->+    let nhidden = Seq.length $ Seq.filter (lockHiddenStateToBool . _layerEntry_hideState) lentries+    in ("Hidden: " <> show nhidden <> " expected: " <> show n <> " lentries: " <> layerEntriesToPrettyText lentries, nhidden == n))+  . _layersState_entries . _goatState_layersState++numVisibleLockedEltsLayerEntriesPredicate :: Int -> EverythingPredicate+numVisibleLockedEltsLayerEntriesPredicate n = FunctionPredicate $+  (\lentries ->+    let nlocked = Seq.length $ Seq.filter (lockHiddenStateToBool . _layerEntry_lockState) lentries+    in ("Locked: " <> show nlocked <> " expected: " <> show n <> " lentries:\n" <> layerEntriesToPrettyText lentries, nlocked == n))+  . _layersState_entries . _goatState_layersState++-- this should work with any initial state so long as default names aren't used+test_LayersHandler_basic :: Test+test_LayersHandler_basic = constructTest "basic" owlpfstate_basic1 bs expected where+  bs = [++      EWCLabel "select"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [] True)++      , EWCLabel "deselect"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [KeyModifier_Shift] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [KeyModifier_Shift] True)++      , EWCLabel "select and cancel"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [] True)++      , EWCLabel "shift select 2 elts"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [KeyModifier_Shift] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [KeyModifier_Shift] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [KeyModifier_Shift] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) True MouseButton_Left [KeyModifier_Shift] True)++      , EWCLabel "out of bounds"+      , EWCMouse (LMouseData (V2 124 10232) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 124 10234) True MouseButton_Left [] True)++    ]+  expected = [+      LabelCheck "select"+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "deselect"+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 0++      , LabelCheck "select and cancel"+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 0++      , LabelCheck "shift select 2 elts"+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 2++      , LabelCheck "out of bounds"+      , numSelectedEltsEqualPredicate 2+      , numSelectedEltsEqualPredicate 0+    ]++test_LayersHandler_toggle :: Test+test_LayersHandler_toggle = constructTest "toggle" owlpfstate_basic1 bs expected where+  bs = [+      EWCLabel "lock"+      , EWCNothing+      , EWCMouse (LMouseData (V2 lockOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 lockOffset 0) True MouseButton_Left [] True)++      , EWCLabel "hide"+      , EWCNothing+      , EWCMouse (LMouseData (V2 hideOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 hideOffset 0) True MouseButton_Left [] True)++      -- TODO inherit/folder test stuff+    ]+  expected = [+      LabelCheck "lock"+      , numVisibleLockedEltsLayerEntriesPredicate 0+      , numVisibleLockedEltsLayerEntriesPredicate 1+      , numVisibleLockedEltsLayerEntriesPredicate 1++      , LabelCheck "hide"+      , numVisibleHiddenLayerEntriesEqualPredicate 0+      , numVisibleHiddenLayerEntriesEqualPredicate 1+      , numVisibleHiddenLayerEntriesEqualPredicate 1+    ]++createLayerMetaMap :: Bool -> OwlPFState -> LayerMetaMap+createLayerMetaMap collapseAll OwlPFState {..} = fmap (\_ -> def { _layerMeta_isCollapsed = collapseAll }) (_owlTree_mapping _owlPFState_owlTree)++controllermeta_basic2_collapseall :: ControllerMeta+controllermeta_basic2_collapseall = emptyControllerMeta { _controllerMeta_layers = createLayerMetaMap True owlpfstate_basic2 }++test_LayersHandler_collapse :: Test+test_LayersHandler_collapse = constructTestWithControllerMeta "collapse" owlpfstate_basic2 controllermeta_basic2_collapseall bs expected where+  bs = [++      EWCLabel "expand fstart1"+      , EWCNothing+      , EWCMouse (LMouseData (V2 collapseOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 collapseOffset 0) True MouseButton_Left [] True)+      , EWCLabel "expand fstart2"+      , EWCMouse (LMouseData (V2 (1+collapseOffset) 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 (1+collapseOffset) 1) True MouseButton_Left [] True)+      , EWCLabel "collapse fstart2"+      , EWCMouse (LMouseData (V2 (1+collapseOffset) 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 (1+collapseOffset) 1) True MouseButton_Left [] True)+      , EWCLabel "expand fstart3"+      , EWCMouse (LMouseData (V2 (1+collapseOffset) 2) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 (1+collapseOffset) 2) True MouseButton_Left [] True)+      , EWCLabel "collapse fstart1"+      , EWCMouse (LMouseData (V2 collapseOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 collapseOffset 0) True MouseButton_Left [] True)++      -- TODO select folder test (not support yet)++    ]+  expected = [+      LabelCheck "expand fstart1"+      , numLayerEntriesEqualPredicate 1+      , numLayerEntriesEqualPredicate 3+      , numLayerEntriesEqualPredicate 3+      , LabelCheck "expand fstart2"+      , numLayerEntriesEqualPredicate 7+      , numLayerEntriesEqualPredicate 7+      , LabelCheck "collapse fstart2"+      , numLayerEntriesEqualPredicate 3+      , numLayerEntriesEqualPredicate 3+      , LabelCheck "expand fstart3"+      , numLayerEntriesEqualPredicate 5+      , numLayerEntriesEqualPredicate 5+      , LabelCheck "collapse fstart1"+      , numLayerEntriesEqualPredicate 1+      , numLayerEntriesEqualPredicate 1+    ]++test_LayersHandler_move :: Test+test_LayersHandler_move = constructTest "move" owlpfstate_basic1 bs expected where+  bs = [++      EWCLabel "select b1"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [] True)++      , EWCLabel "drag b1"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      -- must enter "Dragging" state for handler to work correctly+      , EWCMouse (LMouseData (V2 moveOffset 4) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 4) True MouseButton_Left [] True)++    ]+  expected = [+      LabelCheck "select b1"+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 1+      , LabelCheck "drag b1"+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \od sowl -> owlTree_rEltId_toFlattenedIndex_debug od (_superOwl_id sowl) == 0+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \od sowl -> owlTree_rEltId_toFlattenedIndex_debug od (_superOwl_id sowl) == 3+    ]++test_LayersHandler_moveToSelf :: Test+test_LayersHandler_moveToSelf = constructTest "move elt into its own position (edge case)" owlpfstate_basic1 bs expected where+  bs = [++      EWCLabel "select b1"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [] True)++      , EWCLabel "drag b1"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      -- must enter "Dragging" state for handler to work correctly+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) True MouseButton_Left [] True)++      , EWCLabel "shift select b3"+      , EWCMouse (LMouseData (V2 moveOffset 2) False MouseButton_Left [KeyModifier_Shift] True)+      , EWCMouse (LMouseData (V2 moveOffset 2) True MouseButton_Left [KeyModifier_Shift] True)++      , EWCLabel "drag b1 and b3"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      -- must enter "Dragging" state for handler to work correctly+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) True MouseButton_Left [] True)+++    ]+  expected = [+      LabelCheck "select b1"+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "drag b1"+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \od sowl -> owlTree_rEltId_toFlattenedIndex_debug od (_superOwl_id sowl) == 0+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \od sowl -> owlTree_rEltId_toFlattenedIndex_debug od (_superOwl_id sowl) == 0++      , LabelCheck "shift select b3"+      , numSelectedEltsEqualPredicate 1+      , numSelectedEltsEqualPredicate 2++      , LabelCheck "drag b1 and b3"+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b3") $ \od sowl -> (owlTree_rEltId_toFlattenedIndex_debug od (_superOwl_id sowl)) == 2+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b3") $ \od sowl -> (owlTree_rEltId_toFlattenedIndex_debug od (_superOwl_id sowl)) == 1+    ]++expandfoldersforbasic2 :: [GoatWidgetCmd]+expandfoldersforbasic2 = [+    EWCLabel "expand fstart1"+    , EWCNothing+    , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] True) -- expands folder on the downclick+    , EWCMouse (LMouseData (V2 0 0) True MouseButton_Left [] True) -- but we still need to release the mouse to continue++    , EWCLabel "expand fstart2"+    , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] True)+    , EWCMouse (LMouseData (V2 1 1) True MouseButton_Left [] True)]++expandfoldersforbasic2_expected :: [EverythingPredicate]+expandfoldersforbasic2_expected = [+    LabelCheck "expand fstart1"+    , numLayerEntriesEqualPredicate 1+    , numLayerEntriesEqualPredicate 3+    , numLayerEntriesEqualPredicate 3++    , LabelCheck "expand fstart2"+    , numLayerEntriesEqualPredicate 7+    , numLayerEntriesEqualPredicate 7+  ]+++test_LayersHandler_folders :: Test+test_LayersHandler_folders = constructTestWithControllerMeta "folders" owlpfstate_basic2 controllermeta_basic2_collapseall bs expected where+  bs = expandfoldersforbasic2 <> [+      EWCLabel "select b1"+      , EWCMouse (LMouseData (V2 moveOffset 2) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 2) True MouseButton_Left [] True)++      -- drag b1 to first elt in fstart1+      , EWCLabel "drag b1"+      , EWCMouse (LMouseData (V2 moveOffset 2) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [] True) -- must enter "Dragging" state for handler to work correctly+      , EWCMouse (LMouseData (V2 moveOffset 1) True MouseButton_Left [] True)++      -- drag b1 into fstart3 (collapsed) (this will auto expand fastart3)+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 7) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 7) True MouseButton_Left [] True) -- go far to the right so it goes inside the folder++      , EWCLabel "deselect everything"+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])++      , EWCLabel "collapse fstart3"+      , EWCMouse (LMouseData (V2 1 5) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 1 5) True MouseButton_Left [] True)++      , EWCLabel "collapse fstart2"+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 1 1) True MouseButton_Left [] True)++      , EWCLabel "collapse fstart1"+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 0 0) True MouseButton_Left [] True)++    ]+  expected = expandfoldersforbasic2_expected <> [+      LabelCheck "select b1"+      , numSelectedEltsEqualPredicate 0+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \_ _ -> True++      , LabelCheck "drag b1"+      , AlwaysPass+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \_ sowl -> _owlItemMeta_parent (_superOwl_meta sowl) == 0++      , AlwaysPass+      , AlwaysPass+      , numLayerEntriesEqualPredicate 9 -- fstart3 auto expands++      , LabelCheck "deselect everything"+      , numSelectedEltsEqualPredicate 0++      , LabelCheck "collapse fstart3"+      , numLayerEntriesEqualPredicate 6+      , AlwaysPass++      , LabelCheck "collapse fstart2"+      , numLayerEntriesEqualPredicate 3+      , numLayerEntriesEqualPredicate 3++      , LabelCheck "collapse fstart1"+      , numLayerEntriesEqualPredicate 1+      , numLayerEntriesEqualPredicate 1+    ]++test_LayersHandler_folders2 :: Test+test_LayersHandler_folders2 = constructTestWithControllerMeta "folders2" owlpfstate_basic2 controllermeta_basic2_collapseall bs expected where+  bs = expandfoldersforbasic2 <> [+      EWCLabel "expand fstart3"+      , EWCMouse (LMouseData (V2 1 6) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 1 6) True MouseButton_Left [] True)++      , EWCLabel "select b1"+      , EWCMouse (LMouseData (V2 moveOffset 2) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 2) True MouseButton_Left [] True)++      -- drag b1 to the end+      , EWCLabel "drag b1"+      , EWCMouse (LMouseData (V2 moveOffset 2) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 9) False MouseButton_Left [] True) -- must enter "Dragging" state for handler to work correctly+      , EWCMouse (LMouseData (V2 moveOffset 9) True MouseButton_Left [] True)++      -- drag b1 to parent level+      , EWCLabel "drag b1 2"+      , EWCMouse (LMouseData (V2 moveOffset 8) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 0 10) False MouseButton_Left [] True) -- must enter "Dragging" state for handler to work correctly+      , EWCMouse (LMouseData (V2 0 10) True MouseButton_Left [] True)++      -- drag fstart2 to parent level+      , EWCLabel "drag fstart2"+      --first select it+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) True MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 1) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 0 10) False MouseButton_Left [] True) -- must enter "Dragging" state for handler to work correctly+      , EWCMouse (LMouseData (V2 0 10) True MouseButton_Left [] True)+    ]+  expected = expandfoldersforbasic2_expected <> [+      LabelCheck "expand fstart3"+      , numLayerEntriesEqualPredicate 9+      , numSelectedEltsEqualPredicate 0++      , LabelCheck "select b1"+      , numSelectedEltsEqualPredicate 0+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \_ _ -> True++      , LabelCheck "drag b1"+      , AlwaysPass+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \_ sowl -> _owlItemMeta_parent (_superOwl_meta sowl) == 7++      , LabelCheck "drag b1 2"+      , AlwaysPass+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \_ sowl -> _owlItemMeta_parent (_superOwl_meta sowl) == noOwl++      , LabelCheck "drag fstart2"+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "fstart2") $ \_ _ -> True+      , AlwaysPass+      , AlwaysPass+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "fstart2") $ \_ sowl -> _owlItemMeta_parent (_superOwl_meta sowl) == noOwl+    ]++-- TODO DELETE this test becaues you're deleting built in scroll prob...+test_LayersHandler_scroll :: Test+test_LayersHandler_scroll = constructTest "scroll" owlpfstate_basic1 bs expected where+  bs = [+      -- click first to focus on layers (so it can register keyboard input)+      EWCLabel "select b1"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [] True)++      , EWCLabel "scroll"+      , EWCKeyboard (KeyboardData (KeyboardKey_Scroll 1) [])++      , EWCLabel "select b2"+      , EWCMouse (LMouseData (V2 moveOffset 0) False MouseButton_Left [] True)+      , EWCMouse (LMouseData (V2 moveOffset 0) True MouseButton_Left [] True)++      -- TODO folder drag/move++    ]+  expected = [+      LabelCheck "select b1"+      , numSelectedEltsEqualPredicate 0+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b1") $ \_ _ -> True++      , LabelCheck "scroll"+      , AlwaysPass++      , LabelCheck "select b2"+      , numSelectedEltsEqualPredicate 1 -- b1 still selected+      , firstSelectedSuperOwlWithOwlTreePredicate (Just "b2") $ \_ _ -> True+    ]+++spec :: Spec+spec = do+  describe "LayersHandler" $ do+    fromHUnitTest $ test_LayersHandler_basic+    fromHUnitTest $ test_LayersHandler_toggle+    fromHUnitTest $ test_LayersHandler_collapse+    fromHUnitTest $ test_LayersHandler_move+    fromHUnitTest $ test_LayersHandler_moveToSelf+    fromHUnitTest $ test_LayersHandler_folders+    fromHUnitTest $ test_LayersHandler_folders2+    fromHUnitTest $ test_LayersHandler_scroll
+ test/Potato/Flow/Deprecated/Controller/Manipulator/SelectSpec.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.Manipulator.SelectSpec+  ( spec+  )+where++import           Relude                            hiding (empty, fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit          (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow+import           Potato.Flow.Common+import           Potato.Flow.TestStates+++-- attempt to select 0 area objects and ensure behavior is correct+test_Select_zero :: Test+test_Select_zero = constructTest "zero" owlpfstate_zero bs expected where+  bs = [++      EWCLabel "select b1"+      , EWCTool Tool_Select+      , EWCMouse (LMouseData (V2 (-1) (-1)) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 1 1) True MouseButton_Left [] False)++      , EWCLabel "deselect"+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])++      , EWCLabel "select sl1"+      , EWCMouse (LMouseData (V2 9 9) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 11) True MouseButton_Left [] False)+    ]+  expected = [+      LabelCheck "select b1"+      , EqPredicate goatState_selectedTool Tool_Select+      , numSelectedEltsEqualPredicate 0+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "deselect"+      , numSelectedEltsEqualPredicate 0++      , LabelCheck "select sl1"+      , numSelectedEltsEqualPredicate 0+      -- not possible to select zero area lines ATM (TODO fix)+      , numSelectedEltsEqualPredicate 0+    ]+++spec :: Spec+spec = do+  describe "SelectHandler" $ do+    fromHUnitTest $ test_Select_zero
+ test/Potato/Flow/Deprecated/Controller/Manipulator/TextAreaSpec.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+++module Potato.Flow.Deprecated.Controller.Manipulator.TextAreaSpec (+  spec+) where++import           Relude                                     hiding (empty,+                                                             fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit                   (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow++import           Potato.Flow.Common++import qualified Data.Map                                as Map++checkSTextAreaTextAt :: Text -> XY -> PChar -> EverythingPredicate+checkSTextAreaTextAt label k c = firstSuperOwlPredicate (Just label) $ \sowl -> case hasOwlItem_toSElt_hack sowl of+  SEltTextArea (STextArea _ tm _) -> Map.lookup k tm == Just c+  _                                         -> False++test_basic :: Test+test_basic = constructTest "basic" emptyOwlPFState bs expected where+  bs = [+      -- TODO  text area tool???+      EWCLabel "create <text>"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "modify <text>"+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      , EWCKeyboard (KeyboardData (KeyboardKey_Char 'o') [])+      --, EWCKeyboard (KeyboardData (KeyboardKey_Char 'p') [])++    ]+  expected = [+      LabelCheck "create <text>"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 10 10)+            _                           -> False+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_boxText False+        ]++      , LabelCheck "modify <text>"+      , checkHandlerNameAndState handlerName_boxText False+      , checkHandlerNameAndState handlerName_boxText False+      , checkHandlerNameAndState handlerName_boxText False+      --, checkSBoxText "<text>" "poop"++    ]++++spec :: Spec+spec = do+  describe "TextAreaHandler" $ do+    fromHUnitTest $ test_basic
+ test/Potato/Flow/Deprecated/Controller/ManipulatorSpec.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.Deprecated.Controller.ManipulatorSpec+  ( spec+  )+where++import           Relude                            hiding (empty, fromList)++import           Test.Hspec+import           Test.Hspec.Contrib.HUnit          (fromHUnitTest)+import           Test.HUnit++import           Potato.Flow++import           Potato.Flow.Common+import           Potato.Flow.TestStates+++test_BoxHandler_drag :: Test+test_BoxHandler_drag = constructTest "drag" owlpfstate_basic1 bs expected where+  bs = [+      EWCTool Tool_Select++      , EWCLabel "select b2"+      -- Note, this is a little weird, even though we are just selecting (no dragging) it will still go to BoxHandler first to do the selection...+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)++      , EWCLabel "resize tl corner b2"+      , EWCMouse (LMouseData (V2 9 9) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)++      , EWCLabel "resize tr corner b2"+      , EWCMouse (LMouseData (V2 15 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 15 8) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 15 8) True MouseButton_Left [] False)++      , EWCLabel "resize bl corner b2"+      , EWCMouse (LMouseData (V2 10 15) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 7 15) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 7 15) True MouseButton_Left [] False)++      , EWCLabel "resize br corner b2"+      , EWCMouse (LMouseData (V2 15 15) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "area move b2"+      , EWCMouse (LMouseData (V2 15 15) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)+    ]+  expected = [+      EqPredicate goatState_selectedTool Tool_Select++      , LabelCheck "select b2"+      , checkHandlerNameAndState handlerName_box True+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "resize tl corner b2"+      , AlwaysPass+      , AlwaysPass+      , firstSuperOwlPredicate (Just "b2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 11 11) (V2 4 4)+        _                           -> False++      , LabelCheck "resize tr corner b2"+      , AlwaysPass+      , AlwaysPass+      , firstSuperOwlPredicate (Just "b2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 11 9) (V2 4 6)+        _                           -> False++      , LabelCheck "resize bl corner b2"+      , AlwaysPass+      , AlwaysPass+      , firstSuperOwlPredicate (Just "b2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 8 9) (V2 7 6)+        _                           -> False++      , LabelCheck "resize br corner b2"+      , AlwaysPass+      , AlwaysPass+      , firstSuperOwlPredicate (Just "b2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 8 9) (V2 12 11)+        _                           -> False++      , LabelCheck "area move b2"+      , AlwaysPass+      , AlwaysPass+      , firstSuperOwlPredicate (Just "b2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 13 14) (V2 12 11)+        _                           -> False+    ]++-- TODO test this on non-SBox stuff too+test_BoxHandler_select_and_drag :: Test+test_BoxHandler_select_and_drag = constructTest "select and drag" owlpfstate_basic1 bs expected where+  bs = [+      EWCTool Tool_Select++      , EWCLabel "select + drag b2"+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 11) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 11 11) True MouseButton_Left [] False)++    ]+  expected = [+      EqPredicate goatState_selectedTool Tool_Select++      , LabelCheck "select + drag b2"+      , checkHandlerNameAndState handlerName_box True+      , numSelectedEltsEqualPredicate 1+      , firstSuperOwlPredicate (Just "b2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 11 11) (V2 5 5)+        _                           -> False++    ]+++-- TODO+--test_BoxHandler_boundingbox++test_BoxHandler_restrict8 :: Test+test_BoxHandler_restrict8 = constructTest "restrict8" owlpfstate_basic1 bs expected where+  bs = [+      EWCTool Tool_Select++      , EWCLabel "select b2"+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)++      , EWCLabel "resize tl corner b2 while holding shift"+      , EWCMouse (LMouseData (V2 9 9) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 0) False MouseButton_Left [KeyModifier_Shift] False)+      , EWCMouse (LMouseData (V2 10 0) True MouseButton_Left [KeyModifier_Shift] False)+    ]+  expected = [+      EqPredicate goatState_selectedTool Tool_Select++      , LabelCheck "select b2"+      , checkHandlerNameAndState handlerName_box True+      , numSelectedEltsEqualPredicate 1++      , LabelCheck "resize tl corner b2 while holding shift"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , firstSuperOwlPredicate (Just "b2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox (LBox (V2 x y) _) _ _ _ _) -> x == 10 && y == 1+        _                                        -> False+    ]++test_BoxHandler_clickOnSelectionDragging :: Test+test_BoxHandler_clickOnSelectionDragging = constructTest "drags only when click on selection" owlpfstate_basic1 bs expected where+  bs = [+      EWCTool Tool_Select++      , EWCLabel "select all boxes"+      , EWCMouse (LMouseData (V2 (-1) (-1)) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "click on something and drag"+      , EWCMouse (LMouseData (V2 0 0) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 1 1) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 1 1) True MouseButton_Left [] False)++      , EWCLabel "click on nothing and drag"+      , EWCMouse (LMouseData (V2 8 8) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 10 10) True MouseButton_Left [] False)+    ]+  expected = [+      EqPredicate goatState_selectedTool Tool_Select++      , LabelCheck "select all boxes"+      , checkHandlerNameAndState handlerName_select True+      , checkHandlerNameAndState handlerName_select True+      , numSelectedEltsEqualPredicate 4++      , LabelCheck "click on something and drag"+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , firstSuperOwlPredicate (Just "b1") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltBox (SBox (LBox (V2 x y) _) _ _ _ _) -> x == 1 && y == 1+        _                                        -> False++      , LabelCheck "click on nothing and drag"+      , checkHandlerNameAndState handlerName_select True+      , checkHandlerNameAndState handlerName_select True+      , numSelectedEltsEqualPredicate 0+    ]++test_LineHandler_drag :: Test+test_LineHandler_drag = constructTest "drag" owlpfstate_basic1 bs expected where+  bs = [+      EWCTool Tool_Select++      , EWCLabel "select sl1"+      -- TODO switch to V2 0 100 once AL_Any cases render in the location they start from (as oppose to 1 box away due to offsetting)+      , EWCMouse (LMouseData (V2 0 101) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 101) True MouseButton_Left [] False)++      , EWCLabel "move end of line"+      , EWCMouse (LMouseData (V2 0 110) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 120) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 120) True MouseButton_Left [] False)++      , EWCLabel "select sl2"+      , EWCMouse (LMouseData (V2 4 100) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 4 100) True MouseButton_Left [] False)++      , EWCLabel "move start of line"+      , EWCMouse (LMouseData (V2 0 100) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 90) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 0 90) True MouseButton_Left [] False)+    ]+  expected = [+      EqPredicate goatState_selectedTool Tool_Select++      , LabelCheck "select sl1"+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_simpleLine False+        ]++      , LabelCheck "move end of line"+      , checkHandlerNameAndState handlerName_simpleLine_endPoint True+      , checkHandlerNameAndState handlerName_simpleLine_endPoint True+      , firstSuperOwlPredicate (Just "sl1") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltLine sline -> (_sAutoLine_start sline) == (V2 0 100) && (_sAutoLine_end sline) == (V2 0 120)+        _                                  -> False++      , LabelCheck "select sl2"+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_simpleLine False+        ]++      , LabelCheck "move start of line"+      , checkHandlerNameAndState handlerName_simpleLine_endPoint True+      , checkHandlerNameAndState handlerName_simpleLine_endPoint True+      , firstSuperOwlPredicate (Just "sl2") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+        SEltLine sline -> (_sAutoLine_start sline) == (V2 0 90) && (_sAutoLine_end sline) == (V2 10 100)+        _                                  -> False+    ]+++-- this should work with any initial state so long as default names aren't used+test_Common_create :: Test+test_Common_create = constructTest "create" owlpfstate_basic1 bs expected where+  bs = [++      EWCLabel "create <box>"+      , EWCTool Tool_Box+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "create <line>"+      , EWCTool Tool_Line+      , EWCMouse (LMouseData (V2 10 10) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 20 20) True MouseButton_Left [] False)++      , EWCLabel "create <text>"+      , EWCTool Tool_Text+      , EWCMouse (LMouseData (V2 100 100) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 120 120) False MouseButton_Left [] False)+      , EWCMouse (LMouseData (V2 120 120) True MouseButton_Left [] False)+      , EWCKeyboard (KeyboardData KeyboardKey_Esc [])+    ]+  expected = [+      LabelCheck "create <box>"+      , EqPredicate goatState_selectedTool Tool_Box+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<box>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 10 10) (V2 10 10)+            _                           -> False+          , numSelectedEltsEqualPredicate 1+        ]++      , LabelCheck "create <line>"+      , EqPredicate goatState_selectedTool Tool_Line+      , checkHandlerNameAndState handlerName_simpleLine_endPoint True+      , checkHandlerNameAndState handlerName_simpleLine_endPoint True+      , Combine [+          firstSuperOwlPredicate (Just "<line>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltLine sline -> (_sAutoLine_start sline) == (V2 10 10) && (_sAutoLine_end sline) == (V2 20 20)+            _                    -> False+          , numSelectedEltsEqualPredicate 1+        ]++      , LabelCheck "create <text>"+      , EqPredicate goatState_selectedTool Tool_Text+      , checkHandlerNameAndState handlerName_box True+      , checkHandlerNameAndState handlerName_box True+      , Combine [+          firstSuperOwlPredicate (Just "<text>") $ \sowl -> case hasOwlItem_toSElt_hack sowl of+            SEltBox (SBox lbox _ _ _ _) -> lbox == LBox (V2 100 100) (V2 20 20)+            _                         -> False+          , numSelectedEltsEqualPredicate 1+          , checkHandlerNameAndState handlerName_boxText False+        ]+      , checkHandlerNameAndState handlerName_box False++++    ]++spec :: Spec+spec = do+  describe "Manipulator" $ do+    describe "BoxHandler" $ do+      fromHUnitTest $ test_BoxHandler_drag+      fromHUnitTest $ test_BoxHandler_select_and_drag+      fromHUnitTest $ test_BoxHandler_restrict8+      fromHUnitTest $ test_BoxHandler_clickOnSelectionDragging+    describe "LineHandler" $ do+      fromHUnitTest $ test_LineHandler_drag+    describe "Common" $ do+      fromHUnitTest $ test_Common_create
+ test/Potato/Flow/Deprecated/LayersSpec.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module Potato.Flow.Deprecated.LayersSpec(+  spec+) where++import           Relude++import           Test.Hspec++import qualified Data.Sequence            as Seq++import           Potato.Flow.Deprecated.Layers++someSeq1 :: Seq.Seq Int+someSeq1 = Seq.fromList [0,0,0,0,0]++someSeq2 :: Seq.Seq Int+someSeq2 = Seq.fromList [1,2,3]++someSeq3 :: Seq.Seq Int+someSeq3 = Seq.fromList [0..9]++scopeFn :: Int -> Maybe Bool+scopeFn 0 = Nothing+scopeFn 1 = Just True+scopeFn 2 = Just False++scopingSeq1 :: Seq.Seq Int+scopingSeq1 = Seq.fromList [0,0,0,0,1,1,1,2,2,1,2,1,2,1,2,1,1,1,2,2,2,2]+scopingSeq2 :: Seq.Seq Int+scopingSeq2 = Seq.fromList [0,0,0,0,1,1,1,2,0,1,2,1,2,1,2,1,1,1,2,2,2,2]++spec :: Spec+spec = do+  describe "Layers" $ do+    it "reindexing" $ do+      reindexSEltLayerPosForRemoval [0..9] `shouldBe` [0 | _ <- [0..9]]+      reindexSEltLayerPosForInsertion [0..9] `shouldBe` [0..9]+    it "hasScopingProperty" $ do+      hasScopingProperty scopeFn scopingSeq1 `shouldBe` True+      hasScopingProperty scopeFn scopingSeq2 `shouldBe` False+    it "selectionHasScopingProperty" $ do+      selectionHasScopingProperty scopeFn scopingSeq1 [4,5,20,21] `shouldBe` True+      selectionHasScopingProperty scopeFn scopingSeq1 [0..21] `shouldBe` True+      selectionHasScopingProperty scopeFn scopingSeq1 [0..20] `shouldBe` False+      selectionHasScopingProperty scopeFn scopingSeq2 ([0..4]<>[6..21]) `shouldBe` True+    it "findMatchingScope" $ do+      findMatchingScope scopeFn scopingSeq1 4 `shouldBe` 21+    it "scopeSelection" $ do+      scopeSelection scopeFn scopingSeq1 [0,4,5,17] `shouldBe` [0,4,5,8,17,18,21]+      scopeSelection scopeFn scopingSeq1 [0..3] `shouldBe` [0..3]+      scopeSelection scopeFn scopingSeq1 [18..21] `shouldBe` [4]<>[15..21]+    it "insertElts" $ do+      insertElts 2 someSeq2 someSeq1 `shouldBe` Seq.fromList [0,0,1,2,3,0,0,0]+    it "insertElt" $ do+      insertElt 5 1 someSeq1 `shouldBe` Seq.fromList [0,0,0,0,0,1]+    it "removeElts" $ do+      removeElts 2 0 someSeq2 `shouldBe` Seq.fromList [3]+    it "insertEltList_indexBeforeInsertion" $ do+      insertEltList_indexBeforeInsertion [(0,1),(2,1),(4,1)] someSeq1 `shouldBe` Seq.fromList [1,0,0,1,0,0,1,0]+    it "insertEltList_indexAfterInsertion" $ do+      insertEltList_indexAfterInsertion [(0,1),(2,1),(4,1)] someSeq1 `shouldBe` Seq.fromList [1,0,1,0,1,0,0,0]+    it "removeEltList" $ do+      removeEltList [0..5] someSeq3 `shouldBe` Seq.fromList [6..9]+      removeEltList [0,1,5,9] someSeq3 `shouldBe` Seq.fromList [2,3,4,6,7,8]+    it "moveEltList" $ do+      moveEltList [0,1,5,9] 8 someSeq3 `shouldBe` Seq.fromList [2,3,4,6,7,0,1,5,9,8]+    it "undoMoveEltList" $ do+      undoMoveEltList [0,1,5,9] 8 (Seq.fromList [2,3,4,6,7,0,1,5,9,8]) `shouldBe` someSeq3
+ test/Potato/Flow/Deprecated/StateSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module Potato.Flow.Deprecated.StateSpec(+  spec+) where++import           Relude++import           Test.Hspec++import qualified Data.IntMap            as IM+import qualified Data.Sequence          as Seq++import           Potato.Flow+import           Potato.Flow.Deprecated.State+import           Potato.Flow.Deprecated.TestStates++someValidState1 :: PFState+someValidState1 = PFState {+      _pFState_layers = Seq.fromList [0..5]+      , _pFState_directory = IM.fromList [(0, folderStart), (1, folderEnd), (2, someSEltLabel), (3, someSEltLabel), (4, someSEltLabel), (5, someSEltLabel)]+      , _pFState_canvas = someSCanvas+  }++someInvalidState1 :: PFState+someInvalidState1 = PFState {+      _pFState_layers = Seq.fromList [0..5]+      -- missing REltId 5+      , _pFState_directory = IM.fromList [(0, folderStart), (1, folderEnd), (2, someSEltLabel), (3, someSEltLabel), (4, someSEltLabel)]+      , _pFState_canvas = someSCanvas+  }++someInvalidState2 :: PFState+someInvalidState2 = PFState {+      -- folder mismatch+      _pFState_layers = Seq.fromList [0..5]+      , _pFState_directory = IM.fromList [(0, folderStart), (1, folderStart), (2, someSEltLabel), (3, someSEltLabel), (4, someSEltLabel)]+      , _pFState_canvas = someSCanvas+  }++spec :: Spec+spec = do+  describe "Layers" $ do+    it "SPotatoFlow <-> PFState conversion passes basic tests" $ do+      let+        orig = SPotatoFlow (SCanvas (LBox 10 123)) [(0,SEltLabel "some selt" SEltNone)]+      pFState_to_sPotatoFlow (sPotatoFlow_to_pFState orig) `shouldBe` orig+    it "pFState_isValid" $ do+      pFState_isValid someValidState1 `shouldBe` True+      pFState_isValid someInvalidState1 `shouldBe` False+      pFState_isValid someInvalidState2 `shouldBe` False
+ test/Potato/Flow/GoatCmdSpec.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecursiveDo     #-}++module Potato.Flow.GoatCmdSpec (+  spec+) where++import           Relude              ++import           Test.Hspec++import           Potato.Flow.GoatTester++import           Potato.Flow++verifyCanvasSize :: (Int, Int) -> GoatTester ()+verifyCanvasSize (w,h) = verifyState "verifyCanvasSize" f where+  f gs = r where+    SCanvas (LBox _ (V2 w' h')) = _owlPFState_canvas $ goatState_pFState gs+    r = if w == w' && h == h'+      then Nothing+      else Just $ "expected: " <> show (w, h) <> " got " <> show (w', h')++deltaResizeCanvasCmd :: (Int, Int) -> GoatCmd+deltaResizeCanvasCmd (w, h) = GoatCmdWSEvent $ WSEResizeCanvas (DeltaLBox 0 (V2 w h))++goatCmdWSEvent_basic_test ::  Spec+goatCmdWSEvent_basic_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do+  verifyCanvasSize (1,1)++  setMarker "resize canvas"+  runCommand $ deltaResizeCanvasCmd (10, 0)+  verifyCanvasSize (11,1)+  runCommand $ deltaResizeCanvasCmd (-5, 5)+  verifyCanvasSize (6,6)++++goatCmdWSEvent_invalid_test ::  Spec+goatCmdWSEvent_invalid_test = hSpecGoatTesterWithOwlPFState emptyOwlPFState $ do+  verifyCanvasSize (1,1)++  setMarker "resize canvas"+  runCommand $ deltaResizeCanvasCmd (-1, 0)+  verifyCanvasSize (1,1)+  ++spec :: Spec+spec = do+  describe "GoatCmd" $ do+    describe "goatCmdWSEvent_basic_test" $ goatCmdWSEvent_basic_test+    describe "goatCmdWSEvent_invalid_test" $ goatCmdWSEvent_invalid_test
+ test/Potato/Flow/GoatTester.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RecordWildCards            #-}+++module Potato.Flow.GoatTester where++import           Relude                   hiding (empty, first, fromList)++import           Test.Hspec++import           Potato.Flow+import           Potato.Flow.DebugHelpers++import           Data.Default+import qualified Data.IntMap              as IM+import qualified Data.List                as L+import           Data.Maybe               (fromJust)+import qualified Data.Sequence            as Seq+import qualified Data.Text                as T+import           Data.Tuple.Extra+++type GoatTesterTrackingState = (Text, Int, Int) -- (marker, operations since start of test, operations since last marker)++-- TODO include ref to rendered canvas and then you can render it on failure cases!!+data GoatTesterRecord = GoatTesterRecord {+  _goatTesterRecord_trackingState    :: GoatTesterTrackingState+  , _goatTesterRecord_failureMessage :: Maybe Text+  , _goatTesterRecord_description    :: Text+} deriving (Show)++data GoatTesterState = GoatTesterState {+    _goatTesterState_goatState                          :: GoatState+    , _goatTesterState_rawOperationCount                :: Int++    -- TODO consider making marker more complex+    , _goatTesterState_marker                           :: Text++    , _goatTesterState_rawOperationCountSinceLastMarker :: Int+    , _goatTesterState_records                          :: [GoatTesterRecord]+  } deriving (Show)++instance Default GoatTesterState where+  def = GoatTesterState {+      _goatTesterState_goatState = makeGoatState (V2 100 100) (emptyOwlPFState, emptyControllerMeta)+      , _goatTesterState_rawOperationCount = 0+      , _goatTesterState_marker = "__START__"+      , _goatTesterState_rawOperationCountSinceLastMarker = 0+      , _goatTesterState_records = []+    }++newtype GoatTesterT m a = GoatTesterT { unGoatTesterT :: StateT GoatTesterState m a } deriving (Functor, Applicative, Monad, MonadState GoatTesterState)+type GoatTester a = GoatTesterT Identity a+++runCommand :: (Monad m) => GoatCmd -> GoatTesterT m ()+runCommand cmd = GoatTesterT $ modify $+  \gts@GoatTesterState {..} -> gts {+      _goatTesterState_goatState = foldGoatFn cmd _goatTesterState_goatState+      , _goatTesterState_rawOperationCount = _goatTesterState_rawOperationCount + 1+      , _goatTesterState_rawOperationCountSinceLastMarker = _goatTesterState_rawOperationCountSinceLastMarker + 1+    }++getOwlPFState :: (Monad m) => GoatTesterT m OwlPFState+getOwlPFState = GoatTesterT $ do+  GoatTesterState {..} <- get+  return $ goatState_pFState _goatTesterState_goatState++getTrackingState :: (Monad m) => GoatTesterT m GoatTesterTrackingState+getTrackingState = GoatTesterT $ do+  GoatTesterState {..} <- get+  return $ (_goatTesterState_marker, _goatTesterState_rawOperationCountSinceLastMarker, _goatTesterState_rawOperationCount)++putRecord :: (Monad m) => Text -> Maybe Text -> GoatTesterT m ()+putRecord desc mf = GoatTesterT $ do+  gts <- get+  ts <- unGoatTesterT getTrackingState+  let record = GoatTesterRecord {+      _goatTesterRecord_trackingState = ts+      , _goatTesterRecord_failureMessage = mf+      , _goatTesterRecord_description = desc+    }+  put $ gts { _goatTesterState_records = record : _goatTesterState_records gts }++setMarker :: (Monad m) => Text -> GoatTesterT m ()+setMarker marker = GoatTesterT $ do+  modify $ \gts -> gts {+      _goatTesterState_marker = marker+      , _goatTesterState_rawOperationCountSinceLastMarker = 0+    }++verify :: (Monad m) => Text -> Maybe Text -> GoatTesterT m ()+verify desc mf = GoatTesterT $ do+  unGoatTesterT $ putRecord desc mf++verifyState' :: (Monad m) => Text -> (GoatState -> Maybe Text) -> GoatTesterT m Bool+verifyState' desc fn = GoatTesterT $ do+  gts <- get+  let mf = fn (_goatTesterState_goatState gts)+  unGoatTesterT $ putRecord desc mf+  return $ isJust mf++verifyState :: (Monad m) => Text -> (GoatState -> Maybe Text) -> GoatTesterT m ()+verifyState desc f = verifyState' desc f >> return ()++--verifyStateFatal :: (GoatState -> Maybe Text) -> GoatTesterT m ()+--verifyStateFatal = undefined++runGoatTesterT :: (Monad m) => GoatState -> GoatTesterT m a -> m [GoatTesterRecord]+runGoatTesterT gs m = do+  gts <- execStateT (unGoatTesterT m) $ def { _goatTesterState_goatState = gs }+  return $ reverse $ _goatTesterState_records gts++runGoatTester :: GoatState -> GoatTester a -> [GoatTesterRecord]+runGoatTester gs m = runIdentity $ runGoatTesterT gs m++hSpecGoatTesterWithOwlPFState_verbose :: OwlPFState -> GoatTester a -> SpecWith ()+hSpecGoatTesterWithOwlPFState_verbose pfs m = do+  let+    rslt' = runGoatTester (makeGoatState (V2 100 100) (pfs, emptyControllerMeta)) m+    rslt = L.groupBy (\a b -> fst3 (_goatTesterRecord_trackingState a) == fst3 (_goatTesterRecord_trackingState b)) rslt'+  forM_ rslt $ \gtss -> case gtss of+    [] -> return ()+    (x:xs) -> do+      describe (T.unpack (fst3 (_goatTesterRecord_trackingState x))) $ forM_ (x:xs) $ \GoatTesterRecord {..} -> do+        it (T.unpack _goatTesterRecord_description) $ case _goatTesterRecord_failureMessage of+          Nothing -> return ()+          Just x' -> expectationFailure (T.unpack x')+++hSpecGoatTesterWithOwlPFState_quiet :: OwlPFState -> GoatTester a -> SpecWith ()+hSpecGoatTesterWithOwlPFState_quiet pfs m = do+  let+    rslt' = runGoatTester (makeGoatState (V2 100 100) (pfs, emptyControllerMeta)) m+    rslt = L.groupBy (\a b -> fst3 (_goatTesterRecord_trackingState a) == fst3 (_goatTesterRecord_trackingState b)) rslt'+  -- TODO better test case name  (pass it in)+  -- TODO accumulate and output more information on failure as single failure+  it "passes" $ forM_ rslt $ \gtss -> case gtss of+    [] -> return ()+    (x:xs) -> do+      forM_ (x:xs) $ \GoatTesterRecord {..} -> do+        case _goatTesterRecord_failureMessage of+          Nothing -> return ()+          Just x' -> expectationFailure (T.unpack x')++hSpecGoatTesterWithOwlPFState :: OwlPFState -> GoatTester a -> SpecWith ()+hSpecGoatTesterWithOwlPFState = hSpecGoatTesterWithOwlPFState_verbose++-- state getter helpers+getOwlCount :: (Monad m) => GoatTesterT m Int+getOwlCount = do+  pfs <- getOwlPFState+  return . IM.size . _owlTree_mapping . hasOwlTree_owlTree $ pfs++maybeGetMostRecentlyCreatedOwl' :: OwlPFState -> Maybe SuperOwl+maybeGetMostRecentlyCreatedOwl' pfs = maximumBy' (\s1 s2 -> compare (_superOwl_id s1) (_superOwl_id s2)) $ owliterateall (hasOwlTree_owlTree pfs)++mustGetMostRecentlyCreatedOwl :: (Monad m) => GoatTesterT m SuperOwl+mustGetMostRecentlyCreatedOwl = do+  pfs <- getOwlPFState+  return $ fromJust $ maybeGetMostRecentlyCreatedOwl' pfs+++-- operation helpers++setTool :: (Monad m) => Tool -> GoatTesterT m ()+setTool tool = runCommand $ GoatCmdTool tool++setFocusArea :: (Monad m) => GoatFocusedArea -> GoatTesterT m ()+setFocusArea fa = runCommand $ GoatCmdSetFocusedArea fa++addFolder :: (Monad m) => Text -> GoatTesterT m ()+addFolder name = runCommand $ GoatCmdNewFolder name++canvasMouseToScreenMouse :: GoatState -> XY -> XY+canvasMouseToScreenMouse gs pos = owlPFState_fromCanvasCoordinates (goatState_pFState gs) pos + _goatState_pan gs++mouse :: (Monad m) => Bool -> Bool -> [KeyModifier] -> MouseButton -> XY -> GoatTesterT m ()+mouse isCanvas isRelease modifiers button pos = do+  gts <- get+  runCommand $ GoatCmdMouse $ LMouseData {+    _lMouseData_position       = if isCanvas then canvasMouseToScreenMouse (_goatTesterState_goatState gts ) pos else pos+    , _lMouseData_isRelease    = isRelease+    , _lMouseData_button       = button+    , _lMouseData_modifiers    = modifiers+    , _lMouseData_isLayerMouse = not isCanvas+  }++canvasMouseDown :: (Monad m) =>  (Int, Int) -> GoatTesterT m ()+canvasMouseDown (x,y) = mouse True False [] MouseButton_Left (V2 x y)++canvasMouseUp :: (Monad m) =>  (Int, Int) -> GoatTesterT m ()+canvasMouseUp (x,y) = mouse True True [] MouseButton_Left (V2 x y)++layerMouseDown :: (Monad m) =>  (Int, Int) -> GoatTesterT m ()+layerMouseDown (x,y) = mouse False False [] MouseButton_Left (V2 x y)++layerMouseUp :: (Monad m) =>  (Int, Int) -> GoatTesterT m ()+layerMouseUp (x,y) = mouse False True [] MouseButton_Left (V2 x y)++pressKeyboardKey :: (Monad m) => KeyboardKey -> GoatTesterT m ()+pressKeyboardKey k = runCommand (GoatCmdKeyboard (KeyboardData k []))++pressKey :: (Monad m) => Char -> GoatTesterT m ()+pressKey c = pressKeyboardKey (KeyboardKey_Char c)++pressKeys :: (Monad m) => String -> GoatTesterT m ()+pressKeys text = forM_ text $ \c -> pressKeyboardKey (KeyboardKey_Char c)++pressEscape :: (Monad m) => GoatTesterT m ()+pressEscape = pressKeyboardKey KeyboardKey_Esc++pressReturn :: (Monad m) => GoatTesterT m ()+pressReturn = pressKeyboardKey KeyboardKey_Return++pressBackspace :: (Monad m) => GoatTesterT m ()+pressBackspace = pressKeyboardKey KeyboardKey_Backspace++pressDelete :: (Monad m) => GoatTesterT m ()+pressDelete = pressKeyboardKey KeyboardKey_Delete++pressUndo :: (Monad m) => GoatTesterT m ()+pressUndo = runCommand (GoatCmdKeyboard (KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl]))++pressRedo :: (Monad m) => GoatTesterT m ()+pressRedo = runCommand (GoatCmdKeyboard (KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl]))++-- verification helpers++-- | verifies that the number of owls (elts) in the state is what is expected, includes folders in the count+verifyOwlCount :: (Monad m) => Int -> GoatTesterT m ()+verifyOwlCount expected = verifyState "verifyOwlCount" f where+  f gs = if n == expected+    then Nothing+    else Just $ "got " <> show n <> " owls, expected " <> show expected+    where n = IM.size . _owlTree_mapping . hasOwlTree_owlTree . goatState_pFState $ gs++-- | verifies that the number of selected owls (elts) is what's expected (uses regular selection, NOT canvas selection)+verifySelectionCount :: (Monad m) => Int -> GoatTesterT m ()+verifySelectionCount expected = verifyState "verifySelectionCount" f where+  f gs = if n == expected+    then Nothing+    else Just $ "got " <> show n <> " selected owls, expected " <> show expected+    where n = isParliament_length . _goatState_selection $ gs++maximumBy' :: Foldable t => (a -> a -> Ordering) -> t a -> Maybe a+maximumBy' f l = if length l == 0+  then Nothing+  else Just $ L.maximumBy f l++verifyMostRecentlyCreatedOwl' :: (Monad m) => Text -> (SuperOwl -> Maybe Text) -> GoatTesterT m ()+verifyMostRecentlyCreatedOwl' desc f = verifyState desc f' where+  f' gs = r where+    msowl = maybeGetMostRecentlyCreatedOwl' (goatState_pFState gs)+    r = case msowl of+      Nothing -> Just "failed, no 🦉s"+      Just sowl -> (\m -> "failed with message: " <> m <> "\ngot:\n" <> potatoShow (_superOwl_elt sowl)) <$> f sowl++verifyMostRecentlyCreatedOwl :: (Monad m) => (SuperOwl -> Maybe Text) -> GoatTesterT m ()+verifyMostRecentlyCreatedOwl = verifyMostRecentlyCreatedOwl' "verifyMostRecentlyCreatedOwl"++verifyMostRecentlyCreatedLine :: (Monad m) => (SAutoLine -> Maybe Text) -> GoatTesterT m ()+verifyMostRecentlyCreatedLine f = verifyMostRecentlyCreatedOwl' "verifyMostRecentlyCreatedLine" f' where+  f' sowl = case _owlItem_subItem (_superOwl_elt sowl) of+    OwlSubItemLine sline -> f sline+    x                      -> Just $ "expected SAutoLine got: " <> show x++verifySelectionIsAndOnlyIs :: (Monad m) => Text -> (SuperOwl -> Maybe Text) -> GoatTesterT m ()+verifySelectionIsAndOnlyIs desc f = verifyState desc f' where+  f' gs = r where+    SuperOwlParliament selection = _goatState_selection gs+    sowl = Seq.index selection 0+    nselection = Seq.length selection+    r = if nselection /= 1+      then Just $ "failed, expected 1 selected 🦉, got " <> show nselection+      else (\m -> "failed with message: " <> m <> "\ngot:\n" <> potatoShow (_superOwl_elt sowl)) <$> f sowl++-- otheruseful stuff++-- export as part of this module becaues it's super useful+-- from https://hackage.haskell.org/package/utility-ht-0.0.16/docs/src/Data.Maybe.HT.html#toMaybe+{-# INLINE toMaybe #-}+toMaybe :: Bool -> a -> Maybe a+toMaybe False _ = Nothing+toMaybe True  x = Just x++alwaysFail :: (Monad m) => Text -> GoatTesterT m ()+alwaysFail msg = GoatTesterT $ do+  unGoatTesterT $ putRecord "this test always fails" (Just msg)
+ test/Potato/Flow/LlamaSpec.hs view
@@ -0,0 +1,16 @@+module Potato.Flow.LlamaSpec (+  spec+) where+++import           Relude++import           Test.Hspec++import Potato.Flow.Llama++spec :: Spec+spec = do+  describe "Llama" $ do+    it "TODO" $ do+      True `shouldBe` True
+ test/Potato/Flow/MathSpec.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.MathSpec(+  spec+) where++import           Relude           hiding (empty, fromList)++import           Test.Hspec++import           Data.Default     (def)++import           Potato.Flow.Math+++spec :: Spec+spec = do+  describe "Math" $ do+    it "add_XY_to_lBox" $ do+      add_XY_to_lBox 0 (LBox 1 1) `shouldBe` LBox 0 2+      add_XY_to_lBox 3 (LBox 1 1) `shouldBe` LBox 1 2+    it "lBox_expand" $ do+      lBox_expand (LBox (V2 0 0) (V2 10 10)) (1,1,1,1) `shouldBe` (LBox (V2 (-1) (-1)) (V2 12 12))+    it "make_lBox_from_XYlist" $ do+      make_lBox_from_XYlist [V2 0 0, V2 2 2, V2 1 1] `shouldBe` (LBox 0 2)+      make_lBox_from_XYlist [V2 0 0] `shouldBe` (LBox 0 0)+    it "substract_lBox" $ do+      let+        lb1 = LBox (V2 0 0) (V2 10 10)+        lb2 = LBox (V2 5 5) (V2 10 10)+        lb3 = LBox (V2 2 2) (V2 6 6)+      length (substract_lBox lb1 lb2) `shouldBe` 2+      length (substract_lBox lb2 lb1) `shouldBe` 2+      length (substract_lBox lb1 lb3) `shouldBe` 4+      length (substract_lBox lb3 lb1) `shouldBe` 0
+ test/Potato/Flow/Methods/LineDrawerSpec.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.Methods.LineDrawerSpec(+  spec+) where++import           Relude           hiding (empty, fromList)++import           Test.Hspec+++import Potato.Flow+import           Potato.Flow.Methods.LineDrawer+import           Potato.Flow.TestStates++++import Data.Default+import Data.Tuple.Extra++generateTestCases :: [OwlPFState]+generateTestCases = r where++  -- MODIFY THESE TO TEST WHAT YOU NEED TO TEST :O+  --al1s = [AL_Left, AL_Right, AL_Top, AL_Bot, AL_Any]+  --al2s = [AL_Left, AL_Right, AL_Top, AL_Bot, AL_Any]+  al1s = [AL_Bot]+  al2s = [AL_Top]+  box1s = [LBox (V2 0 0) 10]+  box2s = [LBox (V2 0 12) 10]+  canvasbox = LBox (-5) (V2 25 25)+++  boxpairs = [(b1,b2) | b1 <- box1s, b2 <- box2s]+  attachmentpairs = [(al1,al2) | al1 <- al1s, al2 <- al2s]++++  makestree (b1,b2) (al1, al2) =+    [ (0, SEltLabel "b1" (SEltBox (def {_sBox_box = b1})))+    , (1, SEltLabel "b2" (SEltBox (def {_sBox_box = b2})))+    , (2, SEltLabel "l" (SEltLine (def {+          _sAutoLine_attachStart = Just (attachment_create_default 0 al1), _sAutoLine_attachEnd = Just (attachment_create_default 1 al2)+          , _sAutoLine_lineStyle = LineStyle "" "" "" ""+        })))+    --, (3, SEltLabel "lreverse" (SEltLine (def {_sAutoLine_attachStart = Just (Attachment 1 al2), _sAutoLine_attachEnd = Just (Attachment 0 al1)})))+    ]++  topfs ot = OwlPFState {+      _owlPFState_owlTree = ot+      , _owlPFState_canvas = SCanvas $ canvasbox+    }++  r = [topfs $ owlTree_fromSEltTree (makestree bp ap) | bp <- boxpairs, ap <- attachmentpairs]+++validateTransformMe :: (Eq a, TransformMe a) => a -> Bool+validateTransformMe a =+  (transformMe_rotateLeft . transformMe_rotateRight $ a) == a+  && (transformMe_rotateRight . transformMe_rotateLeft $ a) == a+  && (transformMe_reflectHorizontally . transformMe_reflectHorizontally $ a) == a+++emptyLineAnchorsForRender :: LineAnchorsForRender+emptyLineAnchorsForRender = LineAnchorsForRender {+    _lineAnchorsForRender_start = V2 (-123) 45+    , _lineAnchorsForRender_rest = []+  }++unsimplifiedLineAnchorsForRender :: LineAnchorsForRender+unsimplifiedLineAnchorsForRender = LineAnchorsForRender {+    _lineAnchorsForRender_start = 0+    , _lineAnchorsForRender_rest = [(CD_Up, 10, True),(CD_Up, 15, False),(CD_Up, 1, False),(CD_Right, 10, False)]+  }++someLineAnchorsForRender :: LineAnchorsForRender+someLineAnchorsForRender = LineAnchorsForRender {+    _lineAnchorsForRender_start = 0+    , _lineAnchorsForRender_rest = [(CD_Up, 10, True),(CD_Right, 15, False),(CD_Down, 1, False),(CD_Left, 10, False)]+  }+++someSAutoLine_withLabels_label3 :: SAutoLineLabel+someSAutoLine_withLabels_label3 = SAutoLineLabel 0 (SAutoLineLabelPositionRelative 0) ""++someSAutoLine_withLabels :: SAutoLine+someSAutoLine_withLabels = def {+      _sAutoLine_start = 0+      , _sAutoLine_end = V2 100 0+      , _sAutoLine_midpoints = [SAutoLineConstraintFixed (V2 50 0)]+      , _sAutoLine_labels = [+          SAutoLineLabel 1 (SAutoLineLabelPositionRelative 0) ""+          , SAutoLineLabel 0 (SAutoLineLabelPositionRelative 0.5) ""+          , someSAutoLine_withLabels_label3+        ]+  }+++spec :: Spec+spec = do+  describe "Lines - internal" $ do+    it "rotateMe" $ do+      let+        somelbx1 = LBox (V2 12 (-2)) (V2 12323 (143))+        somexy1 :: XY = V2 345 21+      validateTransformMe somelbx1 `shouldBe` True+      validateTransformMe somexy1 `shouldBe` True+    it "determineSeparation" $ do+      let+        lb1 = LBox (V2 0 0) (V2 10 10)+        lb2 = LBox (V2 11 11) (V2 10 10)+      determineSeparation (lb1, (0,0,0,0)) (lb2, (0,0,0,0)) `shouldBe` (True, True)+      determineSeparation (lb1, (2,2,0,0)) (lb2, (0,0,0,0)) `shouldBe` (False, True)+      determineSeparation (lb1, (1,1,1,1)) (lb2, (1,1,1,1)) `shouldBe` (False, False)+    it "lineAnchorsForRender_simplify" $ do+      _lineAnchorsForRender_rest (lineAnchorsForRender_simplify unsimplifiedLineAnchorsForRender) `shouldBe` [(CD_Up, 26, True),(CD_Right, 10, False)]+      lineAnchorsForRender_simplify someLineAnchorsForRender `shouldBe` someLineAnchorsForRender+    it "lineAnchorsForRender_length" $ do+      lineAnchorsForRender_length unsimplifiedLineAnchorsForRender `shouldBe` 36 + 1+      lineAnchorsForRender_length someLineAnchorsForRender `shouldBe` 36 + 1+      lineAnchorsForRender_length emptyLineAnchorsForRender `shouldBe` 1+    it "internal_getSAutoLineLabelPosition_walk" $ do+      let totall = lineAnchorsForRender_length someLineAnchorsForRender+      internal_getSAutoLineLabelPosition_walk someLineAnchorsForRender 0 `shouldBe` 0+      internal_getSAutoLineLabelPosition_walk someLineAnchorsForRender totall `shouldBe` V2 5 (-9)+    it "getSAutoLineLabelPosition" $ do+      -- use owlpfstate_zero OK because there are no attachments so state is never read+      getSAutoLineLabelPosition owlpfstate_zero someSAutoLine_withLabels someSAutoLine_withLabels_label3 `shouldBe` V2 0 0+    it "getSortedSAutoLineLabelPositions" $ do+      -- use owlpfstate_zero OK because there are no attachments so state is never read+      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+    --putTextLn (renderedCanvasToText (potatoRenderPFState pfs))+    True `shouldBe` True++    -- TODO write a test such that reversing start/end parts of lines always renders the same thing+    -- (actually, this won't work because rotation messed with whether we go up/down for midpoint stuff)+    -- (you could fix this by keeping a rotation counter flag of course)
+ test/Potato/Flow/OwlSpec.hs view
@@ -0,0 +1,156 @@+module Potato.Flow.OwlSpec (+  spec+) where+++import           Relude++import           Test.Hspec++import qualified Data.Sequence            as Seq+import qualified Data.IntSet as IS+import qualified Data.IntMap as IM+import           Potato.Flow.OwlItem+import Potato.Flow.Owl+import           Potato.Flow.Deprecated.TestStates+import           Potato.Flow.Deprecated.State+import Potato.Flow.Types+import Potato.Flow.SElts+++-- | 'owlTree_toSEltTree' may change SEltFolderEnd name and REltId during reconstruction+-- so we simply filter it out so we can compare the parts that should not have changed+filterFolderEndFn :: (REltId, SEltLabel) -> Bool+filterFolderEndFn (_, SEltLabel _ SEltFolderEnd) = False+filterFolderEndFn _ = True++spec :: Spec+spec = do+  describe "Owl" $ do+    let+      owlTree0 = owlTree_fromOldState (_pFState_directory pfstate_basic2) (_pFState_layers pfstate_basic2)+      owlMapping0 = _owlTree_mapping owlTree0+    describe "OwlMapping" $ do+      it "isDescendentOf" $ do+        isDescendentOf owlMapping0 1 2 `shouldBe` True+        isDescendentOf owlMapping0 0 2 `shouldBe` True+        isDescendentOf owlMapping0 2 1 `shouldBe` False -- 2 is child of 1+        isDescendentOf owlMapping0 1 7 `shouldBe` False -- siblings++    describe "OwlTree" $ do+      let+        sEltTree2 = _sPotatoFlow_sEltTree (pFState_to_sPotatoFlow pfstate_basic2)+      it "owlTree_validate" $ do+        --putTextLn $ show $ owlTree_validate owlTree0+        fst (owlTree_validate owlTree0) `shouldBe` True+      it "owlTree_fromOldState" $ do+        --forM (potatoShow owlTree0) print+        (Seq.length (owlTree_topSuperOwls owlTree0) `shouldBe` 1)+        owlTree_owlCount owlTree0 `shouldBe` 9+      it "owliterateall" $ do+        toList (fmap _superOwl_id (owliterateall owlTree0)) `shouldBe` [0,1,2,3,4,5,7,8,9]+      it "owlTree_toSEltTree" $ do+        filter filterFolderEndFn (owlTree_toSEltTree owlTree0) `shouldBe` filter filterFolderEndFn sEltTree2+      it "owlTree_removeSuperOwl" $ do+        let+          sowl1 = owlTree_mustFindSuperOwl owlTree0 2 -- b1+          sowl2 = owlTree_mustFindSuperOwl owlTree0 1 -- fstart2+          ot1 = owlTree_removeSuperOwl sowl1 owlTree0+          ot2 = owlTree_removeSuperOwl sowl2 owlTree0+        owlTree_owlCount ot1 `shouldBe` 8+        owlTree_owlCount ot2 `shouldBe` 4+        fst (owlTree_validate ot1) `shouldBe` True+        fst (owlTree_validate ot2) `shouldBe` True+      it "owlTree_addOwlItem" $ do+        let+          owlSpot1 = OwlSpot (-1) Nothing+          owlItem1 = OwlItem (OwlInfo "💩") OwlSubItemNone+          rid = owlTree_maxId owlTree0 + 1+          owlSpot2 = OwlSpot 7 (Just 9)+          (ot1, _) = owlTree_addOwlItem owlSpot1 rid owlItem1 owlTree0+          (ot2, _) = owlTree_addOwlItem owlSpot2 rid owlItem1 owlTree0+        owlTree_owlCount ot1 `shouldBe` 10+        owlTree_owlCount ot2 `shouldBe` 10+        fst (owlTree_validate ot1) `shouldBe` True+        fst (owlTree_validate ot2) `shouldBe` True+        -- too lazy to write proper test, just print and verify manually+        --putTextLn (potatoShow $ owlTree_addOwlItem owlSpot2 rid owlItem1 owlTree0)+      it "owlTree_moveOwlParliament" $ do+        let+          owlSpot1 = OwlSpot (-1) Nothing+          parliament = OwlParliament $ Seq.fromList [2,3,7]+          (ot1, c1) = owlTree_moveOwlParliament parliament owlSpot1 owlTree0+        owlTree_owlCount ot1 `shouldBe` 9+        -- 5 becaues this includes the 2 children of 7+        length c1 `shouldBe` 5+        fst (owlTree_validate ot1) `shouldBe` True+        -- too lazy to write proper test, just print and verify manually+        --putTextLn (potatoShow . fst $ owlTree_moveOwlParliament parliament owlSpot1 owlTree0)+      it "owlTree_addSEltTree" $ do+        let+          owlSpot1 = OwlSpot (-1) Nothing+          -- current version of owlTree_addSEltTree requires non-colliding REltIds so we reindex here+          seltree1 = fmap (\(rid,seltl) -> (rid+100, seltl)) $ owlTree_toSEltTree owlTree0+          (ot1, c1) = owlTree_addSEltTree owlSpot1 seltree1 owlTree0+        owlTree_owlCount ot1 `shouldBe` 18+        length c1 `shouldBe` 9+        fst (owlTree_validate ot1) `shouldBe` True+      it "owlTree_equivalent" $ do+        owlTree_equivalent owlTree0 owlTree0 `shouldBe` True+      it "owlTree_findSuperOwlAtOwlSpot" $ do+        let+          b2sowl = owlTree_mustFindSuperOwl owlTree0 2+        owlTree_findSuperOwlAtOwlSpot owlTree0 (owlTree_owlItemMeta_toOwlSpot owlTree0 (_superOwl_meta $ b2sowl)) `shouldBe` Just b2sowl++      let+        owlTreeWithAttachments0 = owlTree_fromOldState (_pFState_directory pfstate_attachments1) (_pFState_layers pfstate_attachments1)+        am0 = owlTree_makeAttachmentMap owlTreeWithAttachments0+      it "owlTree_makeAttachmentMap" $ do+        liftIO $ print am0+        IM.lookup 0 am0 `shouldBe` (Just $ IS.fromList [4])+        IM.lookup 2 am0 `shouldBe` (Just $ IS.fromList [4,5])+        IM.lookup 3 am0 `shouldBe` (Just $ IS.fromList [5])+      it "owlTree_hasDanglingAttachments" $ do+        owlTree_hasDanglingAttachments owlTreeWithAttachments0 `shouldBe` False+        owlTree_hasDanglingAttachments (owlTree_reindex 100 owlTreeWithAttachments0) `shouldBe` False+    describe "OwlParliament" $ do+      it "superOwlParliament_isValid" $ do+        --putTextLn (potatoShow owlTree0)+        let+          validParliament = owlParliament_toSuperOwlParliament owlTree0 (OwlParliament $ Seq.fromList [2,3,7])+          invalidParliament = owlParliament_toSuperOwlParliament owlTree0 (OwlParliament $ Seq.fromList [2,3,7,9])+        superOwlParliament_isValid owlTree0 validParliament `shouldBe` True+        superOwlParliament_isValid owlTree0 invalidParliament `shouldBe` False+      it "superOwlParliament_disjointUnionAndCorrect" $ do+        let+          tosop = SuperOwlParliament . Seq.fromList . fmap (owlTree_mustFindSuperOwl owlTree0)+          torids (SuperOwlParliament sop) = toList $ fmap _superOwl_id sop+          sopnil = tosop []+          sop0 = tosop [0]+          sop1 = tosop [1]+          sop2 = tosop [2]+          sop3 = tosop [3]+          sop7 = tosop [7]+          sop8 = tosop [8]+          sop9 = tosop [9]+          sop89 = tosop [8,9]+          sop28 = tosop [2,8]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sopnil sopnil) `shouldBe` []+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sopnil sop1) `shouldBe` [1]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop1 sop1) `shouldBe` []+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop2 sop3) `shouldBe` [2,3]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop1 sop2) `shouldBe` [3,4,5]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop1 sop2) `shouldBe` [3,4,5]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop1 sop28) `shouldBe` [3,4,5,8]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop0 sop28) `shouldBe` [3,4,5,9]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop7 sop8) `shouldBe` [9]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop7 sop9) `shouldBe` [8]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop89 sop7) `shouldBe` [7]+        torids (superOwlParliament_disjointUnionAndCorrect owlTree0 sop28 sop0) `shouldBe` [0]+      it "owlParliament_convertToMiniOwltree" $ do+        let+          mot = owlParliament_convertToMiniOwltree owlTree0 (OwlParliament (_owlTree_topOwls owlTree0))+        --putTextLn (potatoShow mot)+        -- also tests owlTree_equivalent :D+        owlTree_equivalent mot owlTree0 `shouldBe` True+        owlTree_equivalent owlTree0 mot `shouldBe` True
+ test/Potato/Flow/OwlWorkspaceSpec.hs view
@@ -0,0 +1,107 @@+module Potato.Flow.OwlWorkspaceSpec (+  spec+) where+++import           Relude++import           Test.Hspec++import           Data.Maybe                        (fromJust)+import qualified Data.Sequence                     as Seq+import           Potato.Flow.Deprecated.State+import           Potato.Flow.Deprecated.TestStates+import           Potato.Flow.Owl+import           Potato.Flow.OwlItem+import           Potato.Flow.OwlState+import           Potato.Flow.OwlWorkspace++verifyOwlAt :: OwlPFWorkspace -> OwlSpot -> (SuperOwl -> Bool) -> Bool+verifyOwlAt ws ospot f = fromMaybe False $ do+  let+    ot = _owlPFState_owlTree . _owlPFWorkspace_owlPFState $ ws+  sowl <- owlTree_findSuperOwlAtOwlSpot ot ospot+  Just $ f sowl++pred_nameIs :: Text -> SuperOwl -> Bool+pred_nameIs n sowl = hasOwlItem_name sowl == n++undoAndVerify :: OwlPFWorkspace -> OwlPFState -> Bool+undoAndVerify ws prev = r where+  undows = updateOwlPFWorkspace WSEUndo ws+  newstate = _owlPFWorkspace_owlPFState undows+  r =+    owlTree_equivalent (_owlPFState_owlTree prev) (_owlPFState_owlTree newstate)+    && (_owlPFState_canvas prev) == (_owlPFState_canvas newstate)+++spec :: Spec+spec = do+  describe "OwlWorkspace" $ do+    let+      owlTree0 = owlTree_fromOldState (_pFState_directory pfstate_basic2) (_pFState_layers pfstate_basic2)+      someState0 = OwlPFState owlTree0 someSCanvas+      someWorkspace0 = loadOwlPFStateIntoWorkspace someState0 emptyWorkspace++      spot1 = OwlSpot (-1) Nothing+      spot2 = OwlSpot 7 (Just 9)++      owlItem1 = OwlItem (OwlInfo "💩") OwlSubItemNone++    describe "updateOwlPFWorkspace" $ do+      it "WSEAddElt" $ do+        let+          wse1 = WSEAddElt (False, spot1, owlItem1)+          newws1 = updateOwlPFWorkspace wse1 someWorkspace0+        verifyOwlAt newws1 spot1 (pred_nameIs (hasOwlItem_name owlItem1)) `shouldBe` True+        undoAndVerify newws1 (_owlPFWorkspace_owlPFState someWorkspace0) `shouldBe` True+        let+          wse2 = WSEAddElt (False, spot2, owlItem1)+          newws2 = updateOwlPFWorkspace wse2 someWorkspace0+        --putTextLn $ debugPrintOwlPFState (_owlPFWorkspace_owlPFState newws2)+        verifyOwlAt newws2 spot2 (pred_nameIs (hasOwlItem_name owlItem1)) `shouldBe` True+        undoAndVerify newws2 (_owlPFWorkspace_owlPFState someWorkspace0) `shouldBe` True+      it "WSEAddFolder" $ do+        let+          folderName = "🥕🥕🥕"+          wse1 = WSEAddFolder (spot2, folderName)+          newws1 = updateOwlPFWorkspace wse1 someWorkspace0+          ot1 = _owlPFState_owlTree $ _owlPFWorkspace_owlPFState newws1+        --putTextLn $ debugPrintOwlPFState (_owlPFWorkspace_owlPFState newws1)+        verifyOwlAt newws1 spot2 (pred_nameIs folderName) `shouldBe` True+        undoAndVerify newws1 (_owlPFWorkspace_owlPFState someWorkspace0) `shouldBe` True+        -- create a child in the folder we just created and verify it got added correctly+        let+          sowl = fromJust $ owlTree_findSuperOwlAtOwlSpot ot1 spot2+          childSpot = OwlSpot (_superOwl_id sowl) Nothing+          wse2 = WSEAddElt (False, childSpot, owlItem1)+          newws2 = updateOwlPFWorkspace wse2 newws1+        verifyOwlAt newws2 childSpot (pred_nameIs (hasOwlItem_name owlItem1)) `shouldBe` True+        undoAndVerify newws2 (_owlPFWorkspace_owlPFState newws1) `shouldBe` True+      it "WSERemoveElt" $ do+        let+          --remove b1+          wse1 = WSERemoveElt (OwlParliament $ Seq.fromList [2])+          newws1 = updateOwlPFWorkspace wse1 someWorkspace0+        --putTextLn $ debugPrintOwlPFState (_owlPFWorkspace_owlPFState newws1)+        -- b2 should now be where b1 was+        verifyOwlAt newws1 (OwlSpot 1 Nothing) (pred_nameIs ("b2")) `shouldBe` True+        undoAndVerify newws1 (_owlPFWorkspace_owlPFState someWorkspace0) `shouldBe` True+      it "WSEMoveElt" $ do+        let+          -- move b2 to b1+          b1spot = owlTree_rEltId_toOwlSpot owlTree0 2+          wse1 = WSEMoveElt (b1spot, (OwlParliament $ Seq.fromList [3]))+          newws1 = updateOwlPFWorkspace wse1 someWorkspace0+        verifyOwlAt newws1 b1spot (pred_nameIs "b2") `shouldBe` True+        undoAndVerify newws1 (_owlPFWorkspace_owlPFState someWorkspace0) `shouldBe` True+        {-+      it "WSEResizeCanvas" $ do+        1 `shouldBe` 1+      it "WSEUndo" $ do+        1 `shouldBe` 1+      it "WSERedo" $ do+        1 `shouldBe` 1+      it "WSELoad" $ do+        1 `shouldBe` 1+        -}
+ test/Potato/Flow/RenderSpec.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE RecordWildCards #-}++module Potato.Flow.RenderSpec(+  spec+) where++import           Relude                 hiding (empty, fromList)++import           Test.Hspec++import           Data.Default           (def)+import qualified Data.IntMap            as IM+import qualified Data.Text              as T++import           Potato.Flow+import           Potato.Flow.TestStates++testCanvas :: Int -> Int -> Int -> Int -> RenderedCanvasRegion+testCanvas x y w h = emptyRenderedCanvasRegion (LBox (V2 x y) (V2 w h))++makeRenderContextForTest :: (HasOwlTree a) => a -> BroadPhaseState -> RenderedCanvasRegion -> RenderContext+makeRenderContextForTest a bps rc = RenderContext {+    _renderContext_owlTree = hasOwlTree_owlTree a+    , _renderContext_layerMetaMap = IM.empty+    , _renderContext_broadPhase = bps+    , _renderContext_renderedCanvasRegion = rc+    , _renderContext_cache = emptyRenderCache+  }++potatoRenderWithSEltAndEmptyOwlTreeForTest :: [SElt] -> RenderedCanvasRegion -> RenderedCanvasRegion+potatoRenderWithSEltAndEmptyOwlTreeForTest selts rcr = potatoRenderWithOwlTree emptyOwlTree (fmap sElt_to_owlSubItem selts) rcr++testsstyle :: SuperStyle+testsstyle = def { _superStyle_fill = FillStyle_Simple '@' }++spec :: Spec+spec = do+  describe "Canvas" $ do+    it "potato renders blank text" $ do+      let+        (w,h) = (1003, 422)+        canvasText = renderedCanvasToText (testCanvas (-540) 33 w h)+      T.length canvasText `shouldBe` w * h + h - 1+    it "potato renders stuff" $ do+      let+        canvas1 = testCanvas (-12) (-44) 100 100+        n = 10+        selts = flip map [1..n] $ \i ->+          SEltBox $ def {+              _sBox_box    = LBox (V2 (i*2) 0) (V2 2 2)+              , _sBox_superStyle = testsstyle+            }+        canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest selts canvas1+        canvas2Text = renderedCanvasToText canvas2+      --putTextLn $ canvas2Text+      T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2Text) `shouldBe` n*4+    it "renders negative LBox" $ do+      let+        canvas1 = testCanvas 0 0 20 20+        selt = SEltBox $ def {+            _sBox_box    = LBox (V2 10 10) (V2 (-10) (-10))+            , _sBox_superStyle = testsstyle+          }+        canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest [selt] canvas1+        canvas2Text = renderedCanvasToText canvas2+      T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2Text) `shouldBe` 100+    it "renders to a region" $ do+      let+        fillBox = LBox (V2 (-12) (-44)) (V2 100 100)+        renderBox = LBox (V2 (-1) 10) (V2 10 10)+        canvas1 = emptyRenderedCanvasRegion fillBox+        rendercontext1 = (emptyRenderContext fillBox) {+            _renderContext_renderedCanvasRegion = canvas1+          }+        selt = SEltBox $ def {+            _sBox_box    = fillBox+            , _sBox_superStyle = testsstyle+          }+        canvas2 = _renderContext_renderedCanvasRegion $ render renderBox [sElt_to_owlSubItem selt] rendercontext1+        canvas2Text = renderedCanvasToText canvas2+        canvas2TextRegion = renderedCanvasRegionToText renderBox canvas2+      --putTextLn $ canvas2Text+      T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2Text) `shouldBe` lBox_area renderBox+      T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas2TextRegion) `shouldBe` lBox_area renderBox+    it "moveRenderedCanvasRegionNoReRender - translate" $ do+      let+        -- fill the whole canvas+        canvas1 = testCanvas 0 0 100 100+        selt = SEltBox $ def {+            _sBox_box    = LBox (V2 0 0) (V2 100 100)+            , _sBox_superStyle = testsstyle+          }+        canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest [selt] canvas1+        target = LBox (V2 (-50) (-50)) (V2 100 100)+        canvas3 = moveRenderedCanvasRegionNoReRender target canvas2+        canvas3Text = renderedCanvasToText canvas3+      T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas3Text) `shouldBe` 50*50+    it "moveRenderedCanvasRegionNoReRender - resize" $ do+      let+        canvas1 = testCanvas 0 0 50 100+        -- fill the whole canvas and then some+        selt = SEltBox $ def {+            _sBox_box    = LBox (V2 0 0) (V2 100 100)+            , _sBox_superStyle = testsstyle+          }+        canvas2 = potatoRenderWithSEltAndEmptyOwlTreeForTest [selt] canvas1+        target = LBox (V2 0 0) (V2 100 50)+        canvas3 = moveRenderedCanvasRegionNoReRender target canvas2+        canvas3Text = renderedCanvasToText canvas3+      T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas3Text) `shouldBe` 50*50+    it "moveRenderedCanvasRegion" $ do+      let+        initial = LBox (V2 0 0) (V2 50 100)+        target = LBox (V2 0 0) (V2 100 50)+        selt = SEltBox $ def {+            _sBox_box    = LBox (V2 0 0) (V2 100 100)+            , _sBox_superStyle = testsstyle+          }+        state0 = owlPFState_fromSElts [selt] initial+        bps0 = BroadPhaseState $ bPTreeFromOwlPFState state0+        canvas0 = potatoRenderPFState state0+        rendercontext0 = makeRenderContextForTest state0 bps0 canvas0+        rendercontext1 = moveRenderedCanvasRegion target rendercontext0+        --canvas1 = _renderContext_renderedCanvasRegion rendercontext1+        -- only thing changed is the canvas size, so we can keep using rendercontext+        rendercontext2 = moveRenderedCanvasRegion initial rendercontext1+        canvas2 = _renderContext_renderedCanvasRegion rendercontext2+      --liftIO $ printRenderedCanvasRegion canvas0+      --liftIO $ printRenderedCanvasRegion canvas1+      -- TODO test something+      canvas0 `shouldBe` canvas2+    it "moveRenderedCanvasRegion - from zero" $ do+      let+        initial = LBox (V2 0 0) (V2 0 0)+        target = LBox (V2 0 0) (V2 50 50)+        selt = SEltBox $ def {+            _sBox_box    = LBox (V2 0 0) (V2 100 100)+            , _sBox_superStyle = testsstyle+          }+        state0 = owlPFState_fromSElts [selt] initial+        bps0 = BroadPhaseState $ bPTreeFromOwlPFState state0+        canvas0 = potatoRenderPFState state0+        rendercontext0 = makeRenderContextForTest state0 bps0 canvas0+        -- only thing changed is the canvas size+        rendercontext1 = moveRenderedCanvasRegion target rendercontext0+        canvas1 = _renderContext_renderedCanvasRegion rendercontext1+        canvas1Text = renderedCanvasToText canvas1+      --liftIO $ printRenderedCanvasRegion canvas0+      --liftIO $ printRenderedCanvasRegion canvas1+      T.length (T.filter (\x -> x /= ' ' && x /= '\n') canvas1Text) `shouldBe` 50*50+    it "updateCanvas - basic" $ do+      let+        --makeChange rid lb = IM.singleton rid $ Just (SEltLabel (show rid) (SEltBox $ SBox lb def def def SBoxType_Box))+        canvas0 = testCanvas 0 0 100 100+        state0 = owlpfstate_basic1+        bpt0 = bPTreeFromOwlPFState state0+        -- TODO actual changes+        changes1 = IM.empty+        (aabbs1, bps1) = update_bPTree emptyOwlTree IM.empty bpt0+        state1 = state0++        rendercontext0 = makeRenderContextForTest state1 bps1 canvas0+        rendercontext1 = updateCanvas changes1 aabbs1 rendercontext0+        canvas1 = _renderContext_renderedCanvasRegion rendercontext1+      -- TODO test something+      canvas1 `shouldBe` canvas1
+ test/Potato/Flow/SEltMethodsSpec.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-unused-local-binds #-}++module Potato.Flow.SEltMethodsSpec(+  spec+) where++import           Relude       hiding (empty, fromList)++import           Test.Hspec++import qualified Data.Map as Map+import           Data.Default (def)++import           Potato.Flow+++spec :: Spec+spec = do+  let+    testsstyle = def { _superStyle_fill = FillStyle_Simple '@' }+    renderfn sd = _sEltDrawer_renderFn sd emptyOwlTree+  describe "SEltMethod" $ do+    describe "getDrawerFromSEltForTest" $ do+      describe "SBox" $ do+        let+          somesbox1 style = def {+              _sBox_box       = LBox 0 (V2 5 5)+              , _sBox_text    = def {+                  _sBoxText_text = "m ow meow meow"+                }+              , _sBox_boxType = style+              , _sBox_superStyle = testsstyle+            }+          somesbox2 style = def {+              _sBox_box       = LBox 0 (V2 1 1)+              , _sBox_boxType = style+              , _sBox_superStyle = testsstyle+            }+          somesbox3 style = def {+              _sBox_box       = LBox 0 (V2 10 10)+              , _sBox_text    = def {+                  _sBoxText_text = "m ow meeuew ee  meow hello boop no12 meow whatever"+                  , _sBoxText_style = TextStyle TextAlign_Right+                }+              , _sBox_boxType = style+              , _sBox_superStyle = testsstyle+            }+          somesbox4 style = def {+              _sBox_box       = LBox 0 (V2 10 10)+              , _sBox_text    = def {+                  _sBoxText_text = "ｔｈｅｒｅ　ａｒｅ　ｎｏ　ｓｐａｃｅ　ｂｅｔｗｅｅｎ　ａｄｊａｃｅｎｔ　ｃｈａｒａｃｔｅｒｓ"+                  , _sBoxText_style = TextStyle TextAlign_Left+                }+              , _sBox_boxType = style+              , _sBox_superStyle = testsstyle+            }+          somesbox5 style = def {+            _sBox_box       = LBox 0 (V2 10 5)+            , _sBox_text    = def {+                _sBoxText_text = "aoeuaoeu"+              }+            , _sBox_title = SBoxTitle {+                _sBoxTitle_title = Just "boop"+                , _sBoxTitle_align = TextAlign_Right+              }+            , _sBox_boxType = style+            , _sBox_superStyle = testsstyle+          }+        it "SBoxType_NoBoxText" $ do+          let+            sd = getDrawerFromSEltForTest (SEltBox (somesbox1 SBoxType_NoBoxText))+          renderfn sd (V2 100 0) `shouldBe` Nothing+          renderfn sd (V2 (-1) 0) `shouldBe` Nothing+          renderfn sd (V2 0 0) `shouldBe` Just 'm'+          renderfn sd (V2 1 0) `shouldBe` Just ' '+          renderfn sd (V2 2 0) `shouldBe` Just 'o'+          -- TODO it seems EOL space characters are not rendered and this gives the fill char. Maybe this is desired behavior thought?+          --renderfn sd (V2 3 0) `shouldBe` Just ' '+          renderfn sd (V2 1 1) `shouldBe` Just 'e'+          renderfn sd (V2 4 4) `shouldBe` Just '@'+        it "SBoxType_Box" $ do+          let+            sd = getDrawerFromSEltForTest (SEltBox (somesbox2 SBoxType_Box))+          --forM_ (sEltDrawer_renderToLines sd emptyOwlTree) putTextLn+          renderfn sd (V2 0 0) `shouldBe` _superStyle_point def+        it "SBoxType_NoBoxText_alignRight" $ do+          let+            sd = getDrawerFromSEltForTest (SEltBox (somesbox3 SBoxType_NoBoxText))+          --forM_ (sEltDrawer_renderToLines sd emptyOwlTree) putTextLn+          renderfn sd (V2 0 0) `shouldBe` Just '@'+        it "SBoxType_NoBoxText_widechar" $ do+          let+            sd = getDrawerFromSEltForTest (SEltBox (somesbox4 SBoxType_NoBoxText))+          --forM_ (sEltDrawer_renderToLines sd emptyOwlTree) putTextLn+          renderfn sd (V2 0 0) `shouldBe` Just 'ｔ'+          renderfn sd (V2 1 0) `shouldBe` Nothing+          renderfn sd (V2 2 0) `shouldBe` Just 'ｈ'+          renderfn sd (V2 3 0) `shouldBe` Nothing+        it "box label" $ do+          let+            sd = getDrawerFromSEltForTest (SEltBox (somesbox5 SBoxType_BoxText))+          --forM_ (sEltDrawer_renderToLines sd emptyOwlTree) putTextLn+          renderfn sd (V2 0 0) `shouldBe` Just '╔'+          renderfn sd (V2 8 0) `shouldBe` Just 'p'+      describe "STextArea" $ do+        let+          sometextarea = STextArea {+              _sTextArea_box         = LBox (V2 1 1) (V2 10 10)+              , _sTextArea_text      = Map.fromList [((V2 0 0),'a'),((V2 1 1),'b'),((V2 9 9),'c')]+              , _sTextArea_transparent = False+            }+        it "basic" $ do+          let+            sd = getDrawerFromSEltForTest (SEltTextArea $ sometextarea)+          --forM_ ((sEltDrawer_renderToLines sd) emptyOwlTree sd) putTextLn+          renderfn sd (V2 1 1) `shouldBe` Just 'a'+          renderfn sd (V2 10 10) `shouldBe` Just 'c'+          renderfn sd (V2 100 0) `shouldBe` Nothing
+ test/Spec.hs view
@@ -0,0 +1,2 @@+-- hspec auto-discovery stuff+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tinytools.cabal view
@@ -0,0 +1,272 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           tinytools+version:        0.1.0.0+description:    Please see the README on GitHub at <https://github.com/pdlla/tinytools#readme>+homepage:       https://github.com/pdlla/tinytools#readme+bug-reports:    https://github.com/pdlla/tinytools/issues+author:         minimaple+maintainer:     chippermonky@gmail.com+copyright:      2022 Peter Lu+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md+++source-repository head+  type: git+  location: https://github.com/pdlla/tinytools++library+  exposed-modules:+      Potato.Data.Text.Unicode+      Potato.Data.Text.Zipper+      Potato.Data.Text.Zipper2+      Potato.Flow+      Potato.Flow.Attachments+      Potato.Flow.BroadPhase+      Potato.Flow.Cmd+      Potato.Flow.Configuration+      Potato.Flow.Controller+      Potato.Flow.Controller.Goat+      Potato.Flow.Controller.Handler+      Potato.Flow.Controller.Input+      Potato.Flow.Controller.Manipulator.Box+      Potato.Flow.Controller.Manipulator.BoxText+      Potato.Flow.Controller.Manipulator.CartLine+      Potato.Flow.Controller.Manipulator.Common+      Potato.Flow.Controller.Manipulator.Layers+      Potato.Flow.Controller.Manipulator.Line+      Potato.Flow.Controller.Manipulator.Pan+      Potato.Flow.Controller.Manipulator.Select+      Potato.Flow.Controller.Manipulator.TextArea+      Potato.Flow.Controller.Manipulator.TextInputState+      Potato.Flow.Controller.OwlLayers+      Potato.Flow.Controller.Types+      Potato.Flow.DebugHelpers+      Potato.Flow.Deprecated.Layers+      Potato.Flow.Deprecated.State+      Potato.Flow.Deprecated.TestStates+      Potato.Flow.Deprecated.Workspace+      Potato.Flow.Llama+      Potato.Flow.Math+      Potato.Flow.Methods.LineDrawer+      Potato.Flow.Methods.LineTypes+      Potato.Flow.Methods.TextCommon+      Potato.Flow.Methods.Types+      Potato.Flow.Owl+      Potato.Flow.OwlHelpers+      Potato.Flow.OwlItem+      Potato.Flow.OwlState+      Potato.Flow.OwlWorkspace+      Potato.Flow.Reflex+      Potato.Flow.Reflex.GoatSwitcher+      Potato.Flow.Reflex.GoatWidget+      Potato.Flow.Render+      Potato.Flow.RenderCache+      Potato.Flow.SEltMethods+      Potato.Flow.SElts+      Potato.Flow.TestStates+      Potato.Flow.Types+  hs-source-dirs:+      src+  default-extensions:+      ApplicativeDo+      BangPatterns+      DataKinds+      ConstraintKinds+      DeriveFoldable+      DeriveFunctor+      DeriveTraversable+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      EmptyCase+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      PatternSynonyms+      RankNTypes+      ScopedTypeVariables+      StandaloneDeriving+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      NoImplicitPrelude+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-ignore-asserts+  build-depends:+      MonadRandom+    , aeson+    , base >=4.7 && <5+    , bimap+    , binary+    , bytestring+    , constraints-extras+    , containers+    , data-default+    , data-ordlist+    , deepseq+    , dependent-map+    , dependent-sum+    , dependent-sum-template+    , extra+    , hashable+    , ilist+    , lens+    , linear+    , listsafe+    , mtl+    , patch+    , pretty-simple+    , random-shuffle+    , ref-tf+    , reflex >= 0.8 && <1+    , reflex-potatoes >=0.1+    , reflex-test-host >=0.1.2+    , relude+    , semialign+    , template-haskell+    , text+    , text-icu+    , these+    , vector+    , vty+  default-language: Haskell2010++test-suite potato-flow-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Potato.Data.Text.UnicodeSpec+      Potato.Data.Text.Zipper2Spec+      Potato.Data.Text.ZipperSpec+      Potato.Flow.AttachmentsSpec+      Potato.Flow.BroadPhaseSpec+      Potato.Flow.Common+      Potato.Flow.Controller.Manipulator.BoxSpec+      Potato.Flow.Controller.Manipulator.LayersSpec+      Potato.Flow.Controller.Manipulator.LineSpec+      Potato.Flow.Controller.Manipulator.PanSpec+      Potato.Flow.Controller.Manipulator.TestHelpers+      Potato.Flow.Deprecated.Controller.EverythingWidgetSpec+      Potato.Flow.Deprecated.Controller.LayersSpec+      Potato.Flow.Deprecated.Controller.Manipulator.BoxSpec+      Potato.Flow.Deprecated.Controller.Manipulator.BoxTextSpec+      Potato.Flow.Deprecated.Controller.Manipulator.CartLineSpec+      Potato.Flow.Deprecated.Controller.Manipulator.LayersSpec+      Potato.Flow.Deprecated.Controller.Manipulator.SelectSpec+      Potato.Flow.Deprecated.Controller.Manipulator.TextAreaSpec+      Potato.Flow.Deprecated.Controller.ManipulatorSpec+      Potato.Flow.Deprecated.LayersSpec+      Potato.Flow.Deprecated.StateSpec+      Potato.Flow.GoatCmdSpec+      Potato.Flow.GoatTester+      Potato.Flow.LlamaSpec+      Potato.Flow.MathSpec+      Potato.Flow.Methods.LineDrawerSpec+      Potato.Flow.OwlSpec+      Potato.Flow.OwlWorkspaceSpec+      Potato.Flow.RenderSpec+      Potato.Flow.SEltMethodsSpec+      Paths_tinytools+  hs-source-dirs:+      test+  default-extensions:+      ApplicativeDo+      BangPatterns+      DataKinds+      ConstraintKinds+      DeriveFoldable+      DeriveFunctor+      DeriveTraversable+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      EmptyCase+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedStrings+      PatternSynonyms+      RankNTypes+      ScopedTypeVariables+      StandaloneDeriving+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      NoImplicitPrelude+  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+    , binary+    , bytestring+    , constraints-extras+    , containers+    , data-default+    , data-ordlist+    , deepseq+    , dependent-map+    , dependent-sum+    , dependent-sum-template+    , extra+    , hashable+    , hspec+    , hspec-contrib+    , ilist+    , lens+    , linear+    , listsafe+    , mtl+    , patch+    , pretty-simple+    , random-shuffle+    , ref-tf+    , reflex >= 0.8 && <1+    , reflex-potatoes >=0.1+    , reflex-test-host >=0.1.2+    , relude+    , semialign+    , template-haskell+    , text+    , text-icu+    , these+    , tinytools+    , vector+    , vty+  default-language: Haskell2010