Getting rid of most of my TemplateHaskell usage (#249)

* removing TemplateHaskell from HGeometry itself

* getting rid of more template haskell

hgeometry/ipe/src/Ipe/Content.hs

@@ -33,6 +33,7 @@ import           Data.Text (Text)
 import           Data.Traversable
 import           Data.Vinyl hiding (Label)
 import           Data.Vinyl.TypeLevel (AllConstrained)
+import           GHC.Generics (Generic)
 import           HGeometry.Box (Rectangle)
 import           HGeometry.Ext
 import           HGeometry.Matrix
@@ -45,13 +46,24 @@ import           Ipe.Color
 import           Ipe.Layer
 import           Ipe.Path
 
+
 --------------------------------------------------------------------------------
 -- | Image Objects
 
+-- | bitmap image objects in Ipe
 data Image r = Image { _imageData :: ()
                      , _rect      :: Rectangle (Point 2 r)
-                     } deriving (Show,Eq,Ord)
-makeLenses ''Image
+                     } deriving (Show,Eq,Ord,Generic)
+
+-- | Lens to access the image data
+imageData :: Lens' (Image r) ()
+imageData f (Image i r) = fmap (\i' -> Image i' r) (f i)
+{-# INLINE imageData #-}
+
+-- | Lens to access the rectangle of the image
+rect :: Lens (Image r) (Image r') (Rectangle (Point 2 r)) (Rectangle (Point 2 r'))
+rect f (Image i r) = fmap (\r' -> Image i r') (f r)
+{-# INLINE rect #-}
 
 type instance NumType   (Image r) = r
 type instance Dimension (Image r) = 2
@@ -71,7 +83,7 @@ instance Traversable Image where
 
 -- | A text label
 data TextLabel r = Label Text (Point 2 r)
-                 deriving (Show,Eq,Ord)
+                 deriving (Show,Eq,Ord,Generic)
 
 type instance NumType   (TextLabel r) = r
 type instance Dimension (TextLabel r) = 2
@@ -88,7 +100,7 @@ instance Fractional r => IsTransformable (TextLabel r) where
 
 -- | A Minipage
 data MiniPage r = MiniPage Text (Point 2 r) r
-                 deriving (Show,Eq,Ord)
+                 deriving (Show,Eq,Ord,Generic)
 
 type instance NumType   (MiniPage r) = r
 type instance Dimension (MiniPage r) = 2
@@ -112,8 +124,18 @@ width (MiniPage _ _ w) = w
 data IpeSymbol r = Symbol { _symbolPoint :: Point 2 r
                           , _symbolName  :: Text
                           }
-                 deriving (Show,Eq,Ord)
-makeLenses ''IpeSymbol
+                 deriving (Show,Eq,Ord,Generic)
+
+-- | Lens to access the position of the symbol
+symbolPoint :: Lens (IpeSymbol r) (IpeSymbol r') (Point 2 r) (Point 2 r')
+symbolPoint f (Symbol p n) = fmap (\p' -> Symbol p' n) (f p)
+{-# INLINE symbolPoint #-}
+
+-- | Lens to access the name of the symbol
+symbolName :: Lens' (IpeSymbol r) Text
+symbolName f (Symbol p n) = fmap (\n' -> Symbol p n') (f n)
+{-# INLINE symbolName #-}
+
 
 type instance NumType   (IpeSymbol r) = r
 type instance Dimension (IpeSymbol r) = 2
@@ -241,7 +263,8 @@ instance TraverseIpeAttr Clip     where traverseIpeAttr f = traverseAttr (traver
 
 
 -- | A group is essentially a list of IpeObjects.
-newtype Group r = Group [IpeObject r] deriving (Show,Eq,Functor,Foldable,Traversable)
+newtype Group r = Group [IpeObject r]
+  deriving (Show,Eq,Functor,Foldable,Traversable,Generic)
 
 type instance NumType   (Group r) = r
 type instance Dimension (Group r) = 2
@@ -304,7 +327,7 @@ data IpeObject r =
   | IpeMiniPage  (IpeObject' MiniPage  r)
   | IpeUse       (IpeObject' IpeSymbol r)
   | IpePath      (IpeObject' Path      r)
-
+  deriving (Generic)
 
 traverseIpeObject'              :: forall g r f s. ( Applicative f
                                                    , Traversable g

hgeometry/ipe/src/Ipe/Path.hs

@@ -37,6 +37,7 @@ module Ipe.Path(
 import           Control.Lens hiding (rmap, elements)
 import qualified Data.Sequence as Seq
 import           Data.Traversable
+import           GHC.Generics (Generic)
 import           HGeometry.BezierSpline
 import           HGeometry.Ellipse (Ellipse)
 import           HGeometry.Matrix
@@ -100,18 +101,19 @@ instance Fractional r => IsTransformable (PathSegment r) where
 
 -- | A path is a non-empty sequence of PathSegments.
 newtype Path r = Path { _pathSegments :: Seq.Seq (PathSegment r) }
-                 deriving (Show,Eq,Functor,Foldable,Traversable)
+                 deriving (Show,Eq,Functor,Foldable,Traversable,Generic)
                  deriving newtype (Semigroup)
 
-makeLenses ''Path
+-- | Lens/Iso to access the sequcne of segments of the path
+pathSegments :: Iso (Path r) (Path r') (Seq.Seq (PathSegment r)) (Seq.Seq (PathSegment r'))
+pathSegments = coerced
 
 type instance NumType   (Path r) = r
 type instance Dimension (Path r) = 2
 
 instance Fractional r => IsTransformable (Path r) where
   transformBy t (Path s) = Path $ fmap (transformBy t) s
 
-
 --------------------------------------------------------------------------------
 
 -- | type that represents a path in ipe.

hgeometry/ipe/src/Ipe/Types.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
 --------------------------------------------------------------------------------
@@ -53,15 +52,16 @@ module Ipe.Types(
 
 
 import           Control.Lens hiding (views)
-import           Ipe.Attributes hiding (Matrix)
-import           Ipe.Content
-import           Ipe.Layer
-import           Ipe.Literal
 import qualified Data.List.NonEmpty as NE
 import           Data.Maybe (mapMaybe)
 import           Data.Semigroup (Endo)
 import qualified Data.Set as Set
 import           Data.Text (Text)
+import           GHC.Generics (Generic)
+import           Ipe.Attributes hiding (Matrix)
+import           Ipe.Content
+import           Ipe.Layer
+import           Ipe.Literal
 import           Text.XML.Expat.Tree (Node)
 
 
@@ -73,8 +73,17 @@ import           Text.XML.Expat.Tree (Node)
 data View = View { _layerNames      :: [LayerName]
                  , _activeLayer     :: LayerName
                  }
-          deriving (Eq, Ord, Show)
-makeLenses ''View
+          deriving (Eq, Ord, Show, Generic)
+
+-- | Lens to access the layers in this view
+layerNames :: Lens' View [LayerName]
+layerNames f (View ns a) = fmap (\ns' -> View ns' a) (f ns)
+{-# INLINE layerNames #-}
+
+-- | Lens to access the active layer
+activeLayer               :: Lens' View LayerName
+activeLayer f (View ns a) = fmap (\a' -> View ns a') (f a)
+{-# INLINE activeLayer #-}
 
 -- instance Default
 
@@ -83,8 +92,17 @@ makeLenses ''View
 data IpeStyle = IpeStyle { _styleName :: Maybe Text
                          , _styleData :: Node Text Text
                          }
-              deriving (Eq,Show)
-makeLenses ''IpeStyle
+              deriving (Eq,Show,Generic)
+
+-- | Lens to access the style name
+styleName :: Lens' IpeStyle (Maybe Text)
+styleName f (IpeStyle n sd) = fmap (\n' -> IpeStyle n' sd) (f n)
+{-# INLINE styleName #-}
+
+-- | Lens to access the style data
+styleData :: Lens' IpeStyle (Node Text Text)
+styleData f (IpeStyle n sd) = fmap (\sd' -> IpeStyle n sd') (f sd)
+{-# INLINE styleData #-}
 
 -- | The "basic" ipe stylesheet
 basicIpeStyle :: IpeStyle
@@ -99,12 +117,20 @@ opacitiesStyle = IpeStyle (Just "opacities") (xmlLiteral [litFile|data/ipe/opaci
 data IpePreamble  = IpePreamble { _encoding     :: Maybe Text
                                 , _preambleData :: Text
                                 }
-                  deriving (Eq,Read,Show,Ord)
-makeLenses ''IpePreamble
+                  deriving (Eq,Read,Show,Ord,Generic)
 
-type IpeBitmap = Text
+-- | Lens to access the encoding
+encoding :: Lens' IpePreamble (Maybe Text)
+encoding f (IpePreamble e pd) = fmap (\e' -> IpePreamble e' pd) (f e)
+{-# INLINE encoding #-}
 
+-- | Lens to access the preambleData
+preambleData :: Lens' IpePreamble Text
+preambleData f (IpePreamble e pd) = fmap (\pd' -> IpePreamble e pd') (f pd)
+{-# INLINE preambleData #-}
 
+-- | Ipe Bitmap data
+type IpeBitmap = Text
 
 --------------------------------------------------------------------------------
 -- Ipe Pages
@@ -115,8 +141,22 @@ data IpePage r = IpePage { _layers  :: [LayerName]
                          , _views   :: [View]
                          , _content :: [IpeObject r]
                          }
-              deriving (Eq,Show)
-makeLenses ''IpePage
+              deriving (Eq,Show,Generic)
+
+-- | Lens to access the layers of an ipe page
+layers :: Lens' (IpePage r) [LayerName]
+layers f (IpePage lrs vs cnts) = fmap (\lrs' -> IpePage lrs' vs cnts) (f lrs)
+{-# INLINE layers #-}
+
+-- | Lens to access the views of an ipe page
+views :: Lens' (IpePage r) [View]
+views f (IpePage lrs vs cnts) = fmap (\vs' -> IpePage lrs vs' cnts) (f vs)
+{-# INLINE views #-}
+
+-- | Lens to access the content of an ipe page
+content :: Lens (IpePage r) (IpePage r') [IpeObject r] [IpeObject r']
+content f (IpePage lrs vs cnts) = fmap (\cnts' -> IpePage lrs vs cnts') (f cnts)
+{-# INLINE content #-}
 
 -- | Creates an empty page with one layer and view.
 emptyPage :: IpePage r
@@ -177,9 +217,22 @@ data IpeFile r = IpeFile { _preamble :: Maybe IpePreamble
                          , _styles   :: [IpeStyle]
                          , _pages    :: NE.NonEmpty (IpePage r)
                          }
-               deriving (Eq,Show)
-makeLenses ''IpeFile
-
+               deriving (Eq,Show,Generic)
+
+-- | Lens to access the preamble of an ipe file
+preamble :: Lens' (IpeFile r) (Maybe IpePreamble)
+preamble f (IpeFile p ss pgs) = fmap (\p' -> IpeFile p' ss pgs) (f p)
+{-# INLINE preamble #-}
+
+-- | Lens to access the styles of an ipe file
+styles :: Lens' (IpeFile r) [IpeStyle]
+styles f (IpeFile p ss pgs) = fmap (\ss' -> IpeFile p ss' pgs) (f ss)
+{-# INLINE styles #-}
+
+-- | Lens to access the pages of an ipe file
+pages :: Lens (IpeFile r) (IpeFile r') (NE.NonEmpty (IpePage r)) (NE.NonEmpty (IpePage r'))
+pages f (IpeFile p ss pgs) = fmap (\pgs' -> IpeFile p ss pgs') (f pgs)
+{-# INLINE pages #-}
 
 -- | Convenience constructor for creating an ipe file without preamble
 -- and with the default stylesheet.

hgeometry/src/HGeometry/LineSegment/Intersection/Types.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE TemplateHaskell #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  HGeometry.LineSegment.Intersection.Types
@@ -58,9 +57,13 @@ import           HGeometry.Point
 
 
 -- | Assumes that two segments have the same start point
-newtype AroundStart a = AroundStart a deriving (Show,Read,NFData,Functor)
+newtype AroundStart a = AroundStart a
+  deriving (Show,Read,NFData,Functor,Generic)
 
-makeWrapped ''AroundStart
+instance Wrapped (AroundStart a) where
+  type Unwrapped (AroundStart a) = a
+
+instance (AroundStart a ~ t) => Rewrapped (AroundStart a) t
 
 instance ( Point_ point 2 r, Eq r
          , HasEnd lineSegment point) => Eq (AroundStart lineSegment) where
@@ -77,9 +80,12 @@ instance ( LineSegment_ lineSegment point
 ----------------------------------------
 
 -- | Assumes that two segments have the same end point
-newtype AroundEnd a = AroundEnd a deriving (Show,Read,NFData,Functor)
+newtype AroundEnd a = AroundEnd a deriving (Show,Read,NFData,Functor,Generic)
+
+instance Wrapped (AroundEnd a) where
+  type Unwrapped (AroundEnd a) = a
 
-makeWrapped ''AroundEnd
+instance (AroundEnd a ~ t) => Rewrapped (AroundEnd a) t
 
 instance (Point_ point 2 r, Eq r, HasStart lineSegment point) => Eq (AroundEnd lineSegment) where
   -- | equality on endpoint
@@ -96,9 +102,13 @@ instance ( LineSegment_ lineSegment point
 --------------------------------------------------------------------------------
 
 -- | Assumes that two segments intersect in a single point.
-newtype AroundIntersection a = AroundIntersection a deriving (Eq,Show,Read,NFData,Functor)
+newtype AroundIntersection a = AroundIntersection a
+  deriving (Eq,Show,Read,NFData,Functor,Generic)
 
-makeWrapped ''AroundIntersection
+instance Wrapped (AroundIntersection a) where
+    type Unwrapped (AroundIntersection a) = a
+
+instance (AroundIntersection a ~ t) => Rewrapped (AroundIntersection a) t
 
 instance ( LineSegment_ lineSegment point
          , Point_ point 2 r
@@ -168,7 +178,20 @@ type OrdArounds lineSegment = ( Ord (AroundStart lineSegment)
                               , Ord (AroundEnd lineSegment)
                               )
 
-makeLenses ''Associated
+-- | Lens to access the segments for which this is a startPoint
+startPointOf :: Lens' (Associated lineSegment) (Set.Set (AroundStart lineSegment))
+startPointOf f (Associated ss es is) = fmap (\ss' -> Associated ss' es is) (f ss)
+{-# INLINE startPointOf #-}
+
+-- | Lens to access the segments for which this is an endPoint
+endPointOf :: Lens' (Associated lineSegment) (Set.Set (AroundEnd lineSegment))
+endPointOf f (Associated ss es is) = fmap (\es' -> Associated ss es' is) (f es)
+{-# INLINE endPointOf #-}
+
+-- | Lens to access the segments for which this point lies in the interior of the segment
+interiorTo :: Lens' (Associated lineSegment) (Set.Set (AroundIntersection lineSegment))
+interiorTo f (Associated ss es is) = fmap (\is' -> Associated ss es is') (f is)
+{-# INLINE interiorTo #-}
 
 
 -- | Fold over the segments associated with the intersection.
@@ -247,7 +270,21 @@ data IntersectionPoint point lineSegment =
   IntersectionPoint { _intersectionPoint :: !point
                     , _associatedSegs    :: !(Associated lineSegment)
                     } deriving stock (Show,Generic)
-makeLenses ''IntersectionPoint
+
+-- | Lens to access the intersectionp oint
+intersectionPoint :: Lens (IntersectionPoint point lineSegment)
+                          (IntersectionPoint point' lineSegment)
+                          point point'
+intersectionPoint f (IntersectionPoint p ss) = fmap (\p' -> IntersectionPoint p' ss) (f p)
+{-# INLINE intersectionPoint #-}
+
+-- | Lens to access the associated segments
+associatedSegs :: Lens (IntersectionPoint point lineSegment)
+                       (IntersectionPoint point lineSegment')
+                       (Associated lineSegment) (Associated lineSegment')
+associatedSegs f (IntersectionPoint p ss) = fmap (\ss' -> IntersectionPoint p ss') (f ss)
+{-# INLINE associatedSegs #-}
+
 
 deriving stock instance ( Eq (AroundStart lineSegment)
                         , Eq (AroundIntersection lineSegment)