From 3c531e16564f1b03f57af3981d0f0cd14714a78e Mon Sep 17 00:00:00 2001 From: Frank Staals Date: Mon, 16 Sep 2024 22:04:42 +0200 Subject: [PATCH] getting rid of more template haskell --- hgeometry/ipe/src/Ipe/Content.hs | 39 +++++++++++--- hgeometry/ipe/src/Ipe/Path.hs | 8 +-- hgeometry/ipe/src/Ipe/Types.hs | 87 +++++++++++++++++++++++++------- 3 files changed, 106 insertions(+), 28 deletions(-) diff --git a/hgeometry/ipe/src/Ipe/Content.hs b/hgeometry/ipe/src/Ipe/Content.hs index 473b64a9c..9d165bb7b 100644 --- a/hgeometry/ipe/src/Ipe/Content.hs +++ b/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 diff --git a/hgeometry/ipe/src/Ipe/Path.hs b/hgeometry/ipe/src/Ipe/Path.hs index 625aaffdf..0b1d8a2ca 100644 --- a/hgeometry/ipe/src/Ipe/Path.hs +++ b/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,10 +101,12 @@ 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 @@ -111,7 +114,6 @@ 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. diff --git a/hgeometry/ipe/src/Ipe/Types.hs b/hgeometry/ipe/src/Ipe/Types.hs index ed443263f..ca7d2b5d7 100644 --- a/hgeometry/ipe/src/Ipe/Types.hs +++ b/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.