Fix build and freeze

Graphics/Diagram/Core.hs

@@ -57,23 +57,24 @@ instance Def DiagProp where
   def = diagDefaultProp
 
 
-instance Monoid Diag where
-  mempty = EmptyDiag mempty
-  mappend d1@(Diag {}) d2@(Diag {}) = Diag g
+instance Semigroup Diag where
+  d1@(Diag {}) <> d2@(Diag {}) = Diag g
     where
       g p obj = mkDiag d1 p obj <> mkDiag d2 p obj
-  mappend d1@(GifDiag {}) d2@(Diag {}) = GifDiag g
+  d1@(GifDiag {}) <> d2@(Diag {}) = GifDiag g
     where
       g p col f vt = mkGifDiag d1 p col f vt ++ [mkDiag d2 p [vt]]
-  mappend d1@(Diag {}) d2@(GifDiag {}) = GifDiag g
+  d1@(Diag {}) <> d2@(GifDiag {}) = GifDiag g
     where
       g p col f vt = mkDiag d2 p [vt] : mkGifDiag d1 p col f vt
-  mappend d1@(GifDiag {}) d2@(GifDiag {}) = GifDiag g
+  d1@(GifDiag {}) <> d2@(GifDiag {}) = GifDiag g
     where
       g p col f vt = mkGifDiag d1 p col f vt ++ mkGifDiag d2 p col f vt
-  mappend (EmptyDiag _) g = g
-  mappend g (EmptyDiag _) = g
+  (EmptyDiag _) <> g = g
+  g <> (EmptyDiag _) = g
 
+instance Monoid Diag where
+  mempty = EmptyDiag mempty
   mconcat = foldr mappend mempty
 
 

Graphics/Diagram/Gtk.hs

@@ -63,7 +63,7 @@ diagS p mesh =
   diag p diagAlgos
     . fmap (filterValidPT p)
     . (\x -> if null x then [meshToArr mesh] else x)
-    . facesToArr
+    . parseObj
     $ mesh
 
 
@@ -74,6 +74,6 @@ diagTreeS p mesh =
   diag p diagTreAlgos
     . fmap (filterValidPT p)
     . (\x -> if null x then [meshToArr mesh] else x)
-    . facesToArr
+    . parseObj
     $ mesh
 

Graphics/HalfEdge.hs

@@ -29,6 +29,7 @@ import Control.Monad
 import qualified Data.ByteString.Char8 as B
 import qualified Data.IntMap.Lazy as Map
 import Data.Maybe
+import Diagrams.TwoD.Types
 import Parser.Meshparser
 import Safe
 
@@ -231,10 +232,10 @@ buildHeEdge pts fs
 
 -- |Build the HeEdge data structure from the .obj mesh file contents.
 buildHeEdgeFromStr :: B.ByteString -- ^ contents of an .obj mesh file
-                   -> HeEdge PT
+                   -> HeEdge (P2 Double)
 buildHeEdgeFromStr bmesh =
-  let pts    = meshVertices bmesh
-      faces' = indirectHeFaces . meshFaces $ bmesh
+  let pts    = meshToArr bmesh
+      faces' = indirectHeFaces . facesToArr $ bmesh
       edges  = indirectHeEdges faces'
       verts  = indirectHeVerts edges
   in  indirectToDirect pts edges faces' verts