DIAG: dump the Object data type, it's useless

Graphics/Diagram/AlgoDiags.hs

@@ -21,8 +21,8 @@ import Parser.PathParser
 polyLines :: Diag
 polyLines = Diag pp
   where
-    pp _ (Objects []) = mempty
+    pp _ [] = mempty
-    pp _ (Objects (x:y:_)) =
+    pp _ (x:y:_) =
       strokePoly x <> strokePoly y
       where
         strokePoly x' = (strokeTrail . fromVertices $ x' ++ [head x'])
@@ -34,7 +34,7 @@ polyLines = Diag pp
 polyIntersection :: Diag
 polyIntersection = Diag pi'
   where
-    pi' p (Objects (x:y:_)) = drawP vtpi (dotSize p) # fc red # lc red
+    pi' p (x:y:_) = drawP vtpi (dotSize p) # fc red # lc red
       where
         vtpi = intersectionPoints . sortLexPolys $ (sortLexPoly x, sortLexPoly y)
     pi' _ _ = mempty
@@ -44,7 +44,7 @@ polyIntersection = Diag pi'
 polyIntersectionText :: Diag
 polyIntersectionText = Diag pit'
   where
-    pit' p (Objects (x:y:_))
+    pit' p (x:y:_)
       | showCoordText p = position . zip vtpi $ (pointToTextCoord # fc red <$> vtpi)
           # translate (r2 (0, 10))
       | otherwise = mempty
@@ -60,7 +60,7 @@ polyIntersectionText = Diag pit'
 convexHP :: Diag
 convexHP = Diag chp
   where
-    chp p (Object vt) = drawP (grahamCH vt) (dotSize p) # fc red # lc red
+    chp p [vt] = drawP (grahamCH vt) (dotSize p) # fc red # lc red
     chp _ _ = mempty
 
 
@@ -68,7 +68,7 @@ convexHP = Diag chp
 convexHPText :: Diag
 convexHPText = Diag chpt
   where
-    chpt p (Object vt)
+    chpt p [vt]
       | showCoordText p =
           position $ zip vtchf (pointToTextCoord <$> vtchf) # translate (r2 (0, 10))
       | otherwise = mempty
@@ -82,8 +82,7 @@ convexHPText = Diag chpt
 convexHLs :: Diag
 convexHLs = Diag chl
   where
-    chl _ (Object []) = mempty
+    chl _ [vt] =
-    chl _ (Object vt) =
       (strokeTrail . fromVertices . flip (++) [head $ grahamCH vt] . grahamCH $ vt)
         # moveTo (head $ grahamCH vt) # lc red
     chl _ _ = mempty
@@ -105,8 +104,7 @@ convexHStepsLs = GifDiag chs
 squares :: Diag
 squares = Diag f
   where
-    f _ (Object []) = mempty
+    f p [vt] =
-    f p (Object vt) =
       mconcat
       $ (uncurry rectByDiagonal # lw ultraThin)
         <$>
@@ -120,8 +118,7 @@ squares = Diag f
 kdSquares :: Diag
 kdSquares = Diag f
   where
-    f _ (Object []) = mempty
+    f p [vt] =
-    f p (Object vt) =
       mconcat
       . fmap (uncurry (~~))
       $ kdLines (kdTree vt Horizontal) (xDimension p, yDimension p)
@@ -151,8 +148,7 @@ kdSquares = Diag f
 kdRange :: Diag
 kdRange = Diag f
   where
-    f _ (Object []) = mempty
+    f p [vt] =
-    f p (Object vt) =
       (uncurry rectByDiagonal # lc red) (rangeSquare p)
         <> drawP ptsInRange (dotSize p) # fc red # lc red
       where
@@ -164,8 +160,7 @@ kdRange = Diag f
 kdTreeDiag :: Diag
 kdTreeDiag = Diag f
   where
-    f _ (Object []) = mempty
+    f p [vt] =
-    f p (Object vt) =
       -- HACK: in order to give specific nodes a specific color
       renderTree (\n -> case n of
                    '*':'*':_ -> (text n # fontSizeL 5.0)
@@ -195,8 +190,7 @@ qt vt p = quadTree vt (xDimension p, yDimension p)
 quadPathSquare :: Diag
 quadPathSquare = Diag f
   where
-    f _ (Object []) = mempty
+    f p [vt] =
-    f p (Object vt) =
       (uncurry rectByDiagonal # lw thin # lc red)
       (getSquare (stringToQuads (quadPath p)) (qt vt p, []))
       where
@@ -230,8 +224,7 @@ gifQuadPath = GifDiag f
 treePretty :: Diag
 treePretty = Diag f
   where
-    f _ (Object []) = mempty
+    f p [vt] =
-    f p (Object vt) =
       prettyRoseTree (quadTreeToRoseTree
                       . flip getCurQT (qt vt p, [])
                       . stringToQuads

Graphics/Diagram/Core.hs

@@ -15,7 +15,7 @@ data Diag =
   Diag
   {
     mkDiag :: DiagProp
-           -> Object
+           -> [[PT]]
            -> Diagram Cairo R2
   }
   | GifDiag
@@ -29,10 +29,6 @@ data Diag =
   | EmptyDiag (Diagram Cairo R2)
 
 
-data Object = Object [PT]
-            | Objects [[PT]]
-
-
 -- |Holds the properties for a Diagram, like thickness of 2d points etc.
 -- This can also be seen as a context when merging multiple diagrams.
 data DiagProp = MkProp {
@@ -68,10 +64,10 @@ instance Monoid Diag where
       g p obj = mkDiag d1 p obj <> mkDiag d2 p obj
   mappend d1@(GifDiag {}) d2@(Diag {}) = GifDiag g
     where
-      g p col f vt = mkGifDiag d1 p col f vt ++ [mkDiag d2 p (Object vt)]
+      g p col f vt = mkGifDiag d1 p col f vt ++ [mkDiag d2 p [vt]]
   mappend d1@(Diag {}) d2@(GifDiag {}) = GifDiag g
     where
-      g p col f vt = mkDiag d2 p (Object vt) : mkGifDiag d1 p col f vt
+      g p col f vt = mkDiag d2 p [vt] : mkGifDiag d1 p col f vt
   mappend d1@(GifDiag {}) d2@(GifDiag {}) = GifDiag g
     where
       g p col f vt = mkGifDiag d1 p col f vt ++ mkGifDiag d2 p col f vt

Graphics/Diagram/Gif.hs

@@ -22,14 +22,14 @@ gifDiag p xs =
    (upperHullList
      <> fmap (<> last upperHullList) lowerHullList
      <> [mkDiag (mconcat [convexHPText, convexHP, convexHLs])
-         p{ showCoordText = True } (Object xs)])
+         p{ showCoordText = True } [xs]])
   where
     upperHullList = mkGifDiag convexHStepsLs p purple grahamUHSteps xs
     lowerHullList = mkGifDiag convexHStepsLs p orange grahamLHSteps xs
     -- add the x-axis and the other default stuff
     nonChDiag =
       mconcat                               .
-        fmap (\x -> mkDiag x p (Object xs)) $
+        fmap (\x -> mkDiag x p [xs]) $
         [coordPoints, plotterBG]
 
 

Graphics/Diagram/Gtk.hs

@@ -2,6 +2,7 @@
 
 module Graphics.Diagram.Gtk where
 
+import Algebra.Vector(PT)
 import qualified Data.ByteString.Char8 as B
 import Data.List(find)
 import Diagrams.Backend.Cairo
@@ -43,8 +44,8 @@ diagTreAlgos =
 
 
 -- |Create the Diagram from the points.
-diag :: DiagProp -> [DiagAlgo] -> Object -> Diagram Cairo R2
+diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo R2
-diag p das obj = maybe mempty (\x -> mkDiag x p obj)
+diag p das vts = maybe mempty (\x -> mkDiag x p vts)
                   $ mconcat
                       <$> getDiags
                       <$> find (\(DiagAlgo x _) -> x == algo p) das
@@ -55,11 +56,11 @@ diag p das obj = maybe mempty (\x -> mkDiag x p obj)
 diagS :: DiagProp -> B.ByteString -> Diagram Cairo R2
 diagS p mesh
   | algo p == 2 || algo p == 3 =
-      diag p diagAlgos . Objects . fmap (filterValidPT p) . facesToArr $ mesh
+      diag p diagAlgos . fmap (filterValidPT p) . facesToArr $ mesh
-  | otherwise = diag p diagAlgos . Object . filterValidPT p . meshToArr $ mesh
+  | otherwise = diag p diagAlgos . (: []) . filterValidPT p . meshToArr $ mesh
 
 
 -- |Create the tree diagram from a String which is supposed to be the contents
 -- of an obj file.
 diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo R2
-diagTreeS p = diag p diagTreAlgos . Object . filterValidPT p . meshToArr
+diagTreeS p = diag p diagTreAlgos . (: []) . filterValidPT p . meshToArr

Graphics/Diagram/Plotter.hs

@@ -13,16 +13,18 @@ import Graphics.Diagram.Core
 coordPoints :: Diag
 coordPoints = Diag cp
   where
-    cp p (Object vt) = drawP vt (dotSize p) # fc black # lc black
+    cp _ []   = mempty
-    cp p (Objects vts) = drawP (concat vts) (dotSize p) # fc black # lc black
+    cp p [vt] = drawP vt (dotSize p) # fc black # lc black
+    cp p vts  = drawP (concat vts) (dotSize p) # fc black # lc black
 
 
 -- |Show coordinates as text above all points.
 coordPointsText :: Diag
-coordPointsText = Diag cpt
+coordPointsText = Diag f
   where
-    cpt p (Object vt)   = drawT vt p
+    f _ []   = mempty
-    cpt p (Objects vts) = drawT (concat vts) p
+    f p [vt] = drawT vt p
+    f p vts  = drawT (concat vts) p
     drawT [] _ = mempty
     drawT vt p
       | showCoordText p = position $ zip vt (pointToTextCoord <$> vt)