Refactor modules

src/Picture/Data.hs

@@ -1,9 +1,12 @@
 --{-# LANGUAGE TemplateHaskell #-}
 --{-# LANGUAGE Strict #-}
+{-# LANGUAGE DeriveGeneric #-}
 module Picture.Data
     where
 import Geometry.Data
 
+import GHC.Generics (Generic)
+import Control.DeepSeq
 import Data.Foldable
 --import qualified Data.List as L
 --import Data.Monoid
@@ -29,6 +32,8 @@ data RenderType
     | Render22x4 {_unRender22x4 :: ((Point2,Point2),Point4)}
     | Render3x2 {_unRender3x2 :: (Point3,Point2)}
     | Render3x3 {_unRender3x3 :: (Point3,Point3)}
+  deriving Generic
+instance NFData RenderType
 
 type RGBA = (Float,Float,Float,Float)
 type Color = (Float,Float,Float,Float)
@@ -47,11 +52,13 @@ instance Functor FTree where
     fmap f (FBranches ts) = FBranches $ fmap (fmap f) ts
     fmap f (FLeaf x) = FLeaf (f x)
     {-# INLINE fmap #-}
-    
+
 {- Tree with values at and only at the leaves. -}
 data LTree a
     = LBranches [LTree a]
     | LLeaf a
+  deriving (Generic)
+instance NFData a => NFData (LTree a)
 instance Foldable LTree where
     foldMap g (LBranches ts) = mconcat $ map (foldMap g) ts
     foldMap g (LLeaf a) = g a

src/Picture/Tree.hs

@@ -1,6 +1,7 @@
 {- Transform a picture into renderable objects. -}
 module Picture.Tree
     ( picToLTree
+    , picToLTree'
     , picToFTree
     , picToRenderList
     , picToAlt
@@ -10,6 +11,8 @@ module Picture.Tree
 import Picture.Data
 import Geometry
 import Geometry.Data
+--import StrictHelp
+import Control.DeepSeq
 
 import Data.Bifunctor
 import Data.List
@@ -17,6 +20,12 @@ import qualified Data.DList as DL
 import Control.Applicative
 --import Data.Maybe (isNothing)
 
+picToLTree'
+    :: Maybe Int -- ^ Layer filter. Draw 'Nothing' when value is the same as at the leaf.
+    -> Picture
+    -> LTree RenderType
+picToLTree' x p = rnf (picToLTree x p) `seq` picToLTree x p
+
 -- todo: refactor out the layer check somehow
 -- consider generalising to alternative rather than using LTree
 -- | Transform a picture into a tree of renderable objects
@@ -58,6 +67,7 @@ picToLTree _ (ThickArc startA endA rad wdth) = LLeaf $ RenderArc
 picToLTree _ (Text s) = LLeaf $ RenderText $ stringToList s
 picToLTree _ Blank = LBranches []
 picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
+--picToLTree j (Pictures pics) = LBranches . forceFoldable $ map (picToLTree j) pics
 picToLTree j (OverPic f f' (OverPic g g' pic)) = picToLTree j $ OverPic (f . g) (f' . g') pic
 picToLTree j (OverPic f f' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f') ps)
 picToLTree j (OverPic f f' pic) = overPos f . overCol f' <$> picToLTree j pic