Move from store to flat

src/Geometry/ConvexPoly.hs

@@ -1,50 +1,57 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE BangPatterns #-}
-module Geometry.ConvexPoly
-    ( ConvexPoly (..)
-    , cpPoints
-    , cpCen
-    , cpRad
---    , centroid
-    , pointsToPoly
-    , convexPolysOverlap
-    , pointInPolyPoints
-    ) where
-import LinearHelp
-import GHC.Generics
-import Data.Aeson
-import Geometry.Data
-import Geometry.Vector
-import Geometry.LHS
-import Geometry.Intersect
-import Geometry.Polygon
+
+module Geometry.ConvexPoly (
+    ConvexPoly (..),
+    cpPoints,
+    cpCen,
+    cpRad,
+    --    , centroid
+    pointsToPoly,
+    convexPolysOverlap,
+    pointInPolyPoints,
+) where
 
 import Control.Lens
-import TH.Derive
-import Data.Store
+import Data.Aeson
+import Flat
+import Geometry.Data
+import Geometry.Intersect
+import Geometry.LHS
+import Geometry.Polygon
+import Geometry.Vector
+import LinearHelp ()
+
 --import qualified Control.Foldl as L
 data ConvexPoly = ConvexPoly
     { _cpPoints :: [Point2]
-    , _cpCen    :: Point2
-    , _cpRad    :: Float
+    , _cpCen :: Point2
+    , _cpRad :: Float
     }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ConvexPoly  where
+    deriving (Eq, Ord, Show, Read, Generic, Flat)
+
+instance ToJSON ConvexPoly where
     toEncoding = genericToEncoding defaultOptions
-instance FromJSON ConvexPoly 
+
+instance FromJSON ConvexPoly
+
 pointsToPoly :: [Point2] -> ConvexPoly
-pointsToPoly xs = ConvexPoly
-    { _cpPoints = xs
-    , _cpCen    = cen
-    , _cpRad    = maximum $ map (dist cen) xs
-    }
+pointsToPoly xs =
+    ConvexPoly
+        { _cpPoints = xs
+        , _cpCen = cen
+        , _cpRad = maximum $ map (dist cen) xs
+        }
   where
     cen = centroid xs
+
 -- | Test whether two polygons intersect or if one is contained in the other.
 convexPolysOverlap :: ConvexPoly -> ConvexPoly -> Bool
-convexPolysOverlap cp1 cp2 = dist (_cpCen cp1) (_cpCen cp2) < _cpRad cp1 + _cpRad cp2
-    && polyPointsOverlap (_cpPoints cp1) (_cpPoints cp2)
+convexPolysOverlap cp1 cp2 =
+    dist (_cpCen cp1) (_cpCen cp2) < _cpRad cp1 + _cpRad cp2
+        && polyPointsOverlap (_cpPoints cp1) (_cpPoints cp2)
 
 --pointInConvexPoly :: Point2 -> ConvexPoly -> Bool
 --pointInConvexPoly p cp = dist p (_cpCen cp) < _cpRad cp
@@ -52,33 +59,33 @@ convexPolysOverlap cp1 cp2 = dist (_cpCen cp1) (_cpCen cp2) < _cpRad cp1 + _cpRa
 
 -- | Test whether two polygons intersect or if one is contained in the other.
 polyPointsOverlap :: [Point2] -> [Point2] -> Bool
-polyPointsOverlap (p:ps) (q:qs) = pointInPolyPoints p (q:qs)
-    || pointInPolyPoints q (p:ps)
-    || polyPointsIntersect (p:ps) (q:qs) 
+polyPointsOverlap (p : ps) (q : qs) =
+    pointInPolyPoints p (q : qs)
+        || pointInPolyPoints q (p : ps)
+        || polyPointsIntersect (p : ps) (q : qs)
 polyPointsOverlap _ _ = False
 
--- | Test whether a point is strictly inside a polygon.
--- Supposes the points in the polygon are listed in anticlockwise order.
+{- | Test whether a point is strictly inside a polygon.
+ Supposes the points in the polygon are listed in anticlockwise order.
+-}
 pointInPolyPoints :: Point2 -> [Point2] -> Bool
-pointInPolyPoints !p (x:xs) = all (\l -> uncurry isLHS l p) $ zip (x:xs) (xs ++ [x])
+pointInPolyPoints !p (x : xs) = all (\l -> uncurry isLHS l p) $ zip (x : xs) (xs ++ [x])
 pointInPolyPoints _ [] = False
 
 polyPointsIntersect :: [Point2] -> [Point2] -> Bool
-polyPointsIntersect (a:b:xs) ps = go a (a:b:xs) ps
+polyPointsIntersect (a : b : xs) ps = go a (a : b : xs) ps
   where
-    go x' (a':b':xs') ps' = pairPolyPointsIntersect a' b' ps' || go x' (b':xs') ps'
+    go x' (a' : b' : xs') ps' = pairPolyPointsIntersect a' b' ps' || go x' (b' : xs') ps'
     go b' [a'] ps' = pairPolyPointsIntersect a' b' ps'
     go _ _ _ = False
 polyPointsIntersect _ _ = False
 
 pairPolyPointsIntersect :: Point2 -> Point2 -> [Point2] -> Bool
-pairPolyPointsIntersect a' b' (c':d':xs') = go c' a' b' (c':d':xs')
+pairPolyPointsIntersect a' b' (c' : d' : xs') = go c' a' b' (c' : d' : xs')
   where
-    go x a b (c:d:xs) = intersectSegSegTest a b c d || go x a b (d:xs)
+    go x a b (c : d : xs) = intersectSegSegTest a b c d || go x a b (d : xs)
     go d a b [c] = intersectSegSegTest a b c d
     go _ _ _ _ = False
 pairPolyPointsIntersect _ _ _ = False
 
-
 makeLenses ''ConvexPoly
-$($(derive [d| instance Deriving (Store ConvexPoly) |]))