Comment out DeriveAnyClass extensions

src/Dodge/Path.hs

@@ -5,30 +5,33 @@ module Dodge.Path (
     makePathBetweenPs,
     --    , removePathsCrossing
     obstructPathsCrossing,
-    obstructPathsCrossing',
     pairsToGraph,
     getNodePos,
     walkableNodeNear,
     bfsNodePoints,
     snapToGrid,
+    pairsToIncGraph,
 ) where
 
-import Linear
-import Data.List (sortOn)
-import Data.Set (Set)
-import qualified Data.Set as Set
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as UV
 import Control.Lens
+import Data.Bifunctor
 import Data.Foldable
 import Data.Graph.Inductive hiding ((&))
+import Data.List (sortOn)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Dodge.Base.Collide
 import Dodge.Data.World
 import Dodge.Zoning.Base
 import Dodge.Zoning.Pathing
 import Geometry
-import Data.Bifunctor
+import Linear
+import qualified IntMapHelp as IM
 
 getNodePos :: Int -> World -> Maybe Point2
 getNodePos i w = (w ^. cWorld . pathGraph) `lab` i
@@ -37,31 +40,31 @@ makePathUsing :: (PathEdge -> Bool) -> Point2 -> Point2 -> World -> Maybe [Int]
 makePathUsing t s e w = do
     na <- walkableNodeNear w s
     nb <- walkableNodeNear w e
-    sp na nb . second _peDist 
-        . efilter (t . (^. _3)) $ w ^. cWorld . pathGraph
+    sp na nb . second _peDist . efilter (^. _3 . to t) $ w ^. cWorld . pathGraph
 
 makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
 makePathBetween = makePathUsing $ not . pathEdgeObstructed
 
 pathEdgeObstructed :: PathEdge -> Bool
-pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs
-    || ChasmObstacle `Set.member` obs
-  where
-    obs = _peObstacles pe
+pathEdgeObstructed pe =
+    any
+        (`Set.member` _peObstacles pe)
+        [DoorObstacle, BlockObstacle, ChasmObstacle]
 
 walkableNodeNear :: World -> Point2 -> Maybe Int
 {-# INLINE walkableNodeNear #-}
 walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
   where
-    --nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p
     nodesNear = zonesExtract (w ^. pnZoning) . snailAround $ zoneOfPoint pnZoneSize p
 
 snailAround :: Int2 -> [Int2]
-snailAround x = (x+) <$> smallSnailInt2
+snailAround x = (x +) <$> smallSnailInt2
 
 smallSnailInt2 :: [Int2]
-smallSnailInt2 = sortOn (distance (V2 0 (0::Float)) . fmap fromIntegral) 
-    [V2 x y | x <-[-2..2], y <-[-2..2]]
+smallSnailInt2 =
+    sortOn
+        (distance (V2 0 (0 :: Float)) . fmap fromIntegral)
+        [V2 x y | x <- [-2 .. 2], y <- [-2 .. 2]]
 
 makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
 makePathBetweenPs a b w = mapMaybe (lab $ w ^. cWorld . pathGraph) <$> makePathBetween a b w
@@ -72,8 +75,11 @@ bfsNodePoints n w = mapMaybe (lab g) $ bfs n g
     g = w ^. cWorld . pathGraph
 
 pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
-pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<< 
-    (makePathBetweenPs a b w <&> (<>[b]))
+pointTowardsImpulse a b w =
+--    (find (flip (isWalkable a) w) . reverse)
+--        =<< (makePathBetweenPs a b w <&> (<> [b]))
+    (find (flip (isWalkable a) w) . reverse)
+        =<< makePathBetweenPs a b w -- <&> (<> [b]))
 
 ------ continues a walk from a list of points, without repetitions
 ------ supposes that the list is non-empty
@@ -119,7 +125,21 @@ pointTowardsImpulse a b w = (find (flip (isWalkable a) w) . reverse) =<<
 --        _  -> return $ Just $ ns !! i
 --
 
-pairsToGraph :: Set.Set (Point2, Point2) -> (Map (V2 Point2) PathEdgeNodes, Gr Point2 PathEdge)
+pairsToIncGraph :: Set.Set (Point2,Point2) 
+    -> (UV.Vector Point2, V.Vector [(Int,SimpleEdge)])
+pairsToIncGraph pairs = (inodes,incgraph)
+  where
+    incgraph = V.generate (length im) (\i -> im ^?! ix i)
+    im = IM.fromListWith (<>) . fmap toedge $ Set.toList pairs
+    toedge (x,y) = (pstons ^?! ix x . _head
+        , [(pstons ^?! ix y . _head, SimpleEdge (distance x y) mempty)])
+    pstons = IM.invertIntMap . IM.fromList $ zip [0..] ps
+    inodes = UV.generate (length ps) (ps !!)
+    ps = Set.toList $ Set.map fst pairs <> Set.map snd pairs
+
+pairsToGraph ::
+    Set.Set (Point2, Point2) ->
+    (Map (V2 Point2) PathEdgeNodes, Gr Point2 PathEdge)
 pairsToGraph pairs = addEdges nodemap gr pairs
   where
     (nodemap, _, gr) = addNodes $ Set.toList $ Set.map fst pairs <> Set.map snd pairs
@@ -147,31 +167,25 @@ addEdges nodemap gr = foldl' f (mempty, gr)
         theedgedata = PathEdgeNodes (g a) (g b) (PathEdge a b (dist a b) mempty)
     g a = nodemap M.! a
 
-obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World 
-    -> (World, Set PathEdgeNodes)
+obstructPathsCrossing ::
+    EdgeObstacle ->
+    Point2 ->
+    Point2 ->
+    World ->
+    (World, Set PathEdgeNodes)
 obstructPathsCrossing obstacletype sp' ep w =
     ( w & cWorld . pathGraph %~ updateedges
     , es
     )
   where
     es = Set.filter edgecrosses $ pesNearSeg sp' ep w
-    edgecrosses (PathEdgeNodes _ _ pe) = isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
+    edgecrosses (PathEdgeNodes _ _ pe) =
+        isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
     updateedges gr = foldl' updateedge gr es
     updateedge gr (PathEdgeNodes x y pe) =
         insEdge (x, y, pe & peObstacles . at obstacletype ?~ ()) $ delEdge (x, y) gr
 
-obstructPathsCrossing' :: EdgeObstacle -> Point2 -> Point2 -> World 
-    -> World
-obstructPathsCrossing' obstacletype sp' ep w =
-     w & cWorld . pathGraph %~ updateedges
-  where
-    es = Set.filter edgecrosses $ pesNearSeg sp' ep w
-    edgecrosses (PathEdgeNodes _ _ pe) = isJust $ intersectSegSeg sp' ep (_peStart pe) (_peEnd pe)
-    updateedges gr = foldl' updateedge gr es
-    updateedge gr (PathEdgeNodes x y pe) =
-        insEdge (x, y, pe & peObstacles . at obstacletype ?~ ()) $ delEdge (x, y) gr
-
-snapToGrid :: Set (Point2,Point2) -> Set (Point2, Point2)
+snapToGrid :: Set (Point2, Point2) -> Set (Point2, Point2)
 snapToGrid = Set.map (over each (fmap (fromIntegral . f)))
   where
     f :: Float -> Int