+ origin = last current
+ foundPaths' = if origin == head current then foundPaths
+ else M.adjust (cp :) origin foundPaths
+ cp = CPath (head current) (length current - 1)
+
+-- collapsing the map
+
+interestingPoints :: Slides -> Grid -> Position -> Position -> CompressedMap
+interestingPoints slides forest start end = M.fromList [(p, []) | p <- pointsSE]
+ where Just minR = minimumOf (folded . _r) forest
+ Just maxR = maximumOf (folded . _r) forest
+ Just minC = minimumOf (folded . _c) forest
+ Just maxC = maximumOf (folded . _c) forest
+ points = [ V2 r c | r <- [(minR + 2)..(maxR - 2)]
+ , c <- [(minC + 1)..(maxC - 1)]
+ , (V2 r c) `S.notMember` forest
+ , (length $ adjacents (V2 r c) slides forest) > 2
+ ]
+ pointsSE = start : end : points
+
+compress :: Slides -> Grid -> Position -> Position -> CompressedMap
+compress slides forest start end = foldl' go compressed0 iPoints
+ where compressed0 = interestingPoints slides forest start end
+ iPoints = M.keys compressed0
+ go com here = search slides forest iPoints com $ fmap (: [here]) $ adjacents here slides forest
+
+
+searchCompressed :: CompressedMap -> Position -> [[Position]] -> [[Position]] -> [[Position]]
+-- searchCompressed _ _ _ (c:_) _ | DT.trace (show c) False = undefined
+searchCompressed _ _ found [] = found
+searchCompressed map goal found (current:agenda)
+ | head current == goal = searchCompressed map goal (current:found) agenda
+ | otherwise = searchCompressed map goal found (nextPositions ++ agenda)
+ where neighbours0 = map M.! (head current)
+ neighbours = neighbours0 ^.. folded . filtered ((`notElem` current) . _nextPos)
+ nextPositions = fmap ((: current) . _nextPos) neighbours