{-# LANGUAGE RankNTypes #-}
-- | This module provide lenses compatible with the `lens`

-- module but without the dependency to it.

module Graphics.Rasterific.Lenses
    ( -- * Line lenses

      lineX0
    , lineX1
    , linePoints

      -- * Quadratic bezier curve

    , bezX0
    , bezX1
    , bezX2
    , bezierPoints

      -- * Cubic bezier lenses

    , cbezX0
    , cbezX1
    , cbezX2
    , cbezX3
    , cubicBezierPoints

      -- * Primitive lenses

    , primitivePoints

      -- * Path oriented lenses

    , pathCommandPoints
    , pathPoints

      -- * Type definition to match Lens

    , Lens
    , Lens'
    , Traversal
    , Traversal'
    ) where

import Graphics.Rasterific.Types

-- | Does it look familiar? yes it's the official

-- Lens type.

type Lens s t a b =
    forall f. Functor f => (a -> f b) -> s -> f t

-- | Try to match the Lens' type alias.

type Lens' s a = Lens s s a a

-- | Traversal type, matched to the one of the lens

-- package.

type Traversal s t a b =
    forall f. Applicative f => (a -> f b) -> s -> f t

type Traversal' s a = Traversal s s a a

-- | Create a full lens out of setter and getter

lens :: (s -> a)
     -> (s -> b -> t)
     -> Lens s t a b
{-# INLINE lens #-}
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> a
accessor s -> b -> t
setter = \a -> f b
f s
src ->
  (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> b -> t
setter s
src) (f b -> f t) -> f b -> f t
forall a b. (a -> b) -> a -> b
$ a -> f b
f (s -> a
accessor s
src)

-- | Traverse all the points of a line.

linePoints :: Traversal' Line Point
linePoints :: (Point -> f Point) -> Line -> f Line
linePoints Point -> f Point
f (Line Point
p0 Point
p1) = Point -> Point -> Line
Line (Point -> Point -> Line) -> f Point -> f (Point -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> f Point
f Point
p0 f (Point -> Line) -> f Point -> f Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p1

-- | Line origin point.

lineX0 :: Lens' Line Point
lineX0 :: (Point -> f Point) -> Line -> f Line
lineX0 = (Line -> Point)
-> (Line -> Point -> Line) -> Lens Line Line Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Line -> Point
_lineX0 Line -> Point -> Line
setter where
  setter :: Line -> Point -> Line
setter Line
a Point
b = Line
a { _lineX0 :: Point
_lineX0 = Point
b }

-- | Line end point.

lineX1 :: Lens' Line Point
lineX1 :: (Point -> f Point) -> Line -> f Line
lineX1 = (Line -> Point)
-> (Line -> Point -> Line) -> Lens Line Line Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Line -> Point
_lineX1 Line -> Point -> Line
setter where
  setter :: Line -> Point -> Line
setter Line
a Point
b = Line
a { _lineX1 :: Point
_lineX1 = Point
b }

-- | Quadratic bezier starting point.

bezX0 :: Lens' Bezier Point
bezX0 :: (Point -> f Point) -> Bezier -> f Bezier
bezX0 = (Bezier -> Point)
-> (Bezier -> Point -> Bezier) -> Lens Bezier Bezier Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Bezier -> Point
_bezierX0 Bezier -> Point -> Bezier
setter where
  setter :: Bezier -> Point -> Bezier
setter Bezier
a Point
b = Bezier
a { _bezierX0 :: Point
_bezierX0 = Point
b }

-- | bezier control point.

bezX1 :: Lens' Bezier Point
bezX1 :: (Point -> f Point) -> Bezier -> f Bezier
bezX1 = (Bezier -> Point)
-> (Bezier -> Point -> Bezier) -> Lens Bezier Bezier Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Bezier -> Point
_bezierX1 Bezier -> Point -> Bezier
setter where
  setter :: Bezier -> Point -> Bezier
setter Bezier
a Point
b = Bezier
a { _bezierX1 :: Point
_bezierX1 = Point
b }

-- | bezier end point.

bezX2 :: Lens' Bezier Point
bezX2 :: (Point -> f Point) -> Bezier -> f Bezier
bezX2 = (Bezier -> Point)
-> (Bezier -> Point -> Bezier) -> Lens Bezier Bezier Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Bezier -> Point
_bezierX2 Bezier -> Point -> Bezier
setter where
  setter :: Bezier -> Point -> Bezier
setter Bezier
a Point
b = Bezier
a { _bezierX2 :: Point
_bezierX2 = Point
b }

-- | Traversal of all the bezier's points.

bezierPoints :: Traversal' Bezier Point
bezierPoints :: (Point -> f Point) -> Bezier -> f Bezier
bezierPoints Point -> f Point
f (Bezier Point
p0 Point
p1 Point
p2) =
  Point -> Point -> Point -> Bezier
Bezier (Point -> Point -> Point -> Bezier)
-> f Point -> f (Point -> Point -> Bezier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> f Point
f Point
p0 f (Point -> Point -> Bezier) -> f Point -> f (Point -> Bezier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p1 f (Point -> Bezier) -> f Point -> f Bezier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p2

-- | Cubic bezier first point

cbezX0 :: Lens' CubicBezier Point
cbezX0 :: (Point -> f Point) -> CubicBezier -> f CubicBezier
cbezX0 = (CubicBezier -> Point)
-> (CubicBezier -> Point -> CubicBezier)
-> Lens CubicBezier CubicBezier Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CubicBezier -> Point
_cBezierX0 CubicBezier -> Point -> CubicBezier
setter where
  setter :: CubicBezier -> Point -> CubicBezier
setter CubicBezier
a Point
b = CubicBezier
a { _cBezierX0 :: Point
_cBezierX0 = Point
b }

-- | Cubic bezier first control point.

cbezX1 :: Lens' CubicBezier Point
cbezX1 :: (Point -> f Point) -> CubicBezier -> f CubicBezier
cbezX1 = (CubicBezier -> Point)
-> (CubicBezier -> Point -> CubicBezier)
-> Lens CubicBezier CubicBezier Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CubicBezier -> Point
_cBezierX1 CubicBezier -> Point -> CubicBezier
setter where
  setter :: CubicBezier -> Point -> CubicBezier
setter CubicBezier
a Point
b = CubicBezier
a { _cBezierX1 :: Point
_cBezierX1 = Point
b }

-- | Cubic bezier second control point.

cbezX2 :: Lens' CubicBezier Point
cbezX2 :: (Point -> f Point) -> CubicBezier -> f CubicBezier
cbezX2 = (CubicBezier -> Point)
-> (CubicBezier -> Point -> CubicBezier)
-> Lens CubicBezier CubicBezier Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CubicBezier -> Point
_cBezierX2 CubicBezier -> Point -> CubicBezier
setter where
  setter :: CubicBezier -> Point -> CubicBezier
setter CubicBezier
a Point
b = CubicBezier
a { _cBezierX2 :: Point
_cBezierX2 = Point
b }

-- | Cubic bezier last point.

cbezX3 :: Lens' CubicBezier Point
cbezX3 :: (Point -> f Point) -> CubicBezier -> f CubicBezier
cbezX3 = (CubicBezier -> Point)
-> (CubicBezier -> Point -> CubicBezier)
-> Lens CubicBezier CubicBezier Point Point
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CubicBezier -> Point
_cBezierX2 CubicBezier -> Point -> CubicBezier
setter where
  setter :: CubicBezier -> Point -> CubicBezier
setter CubicBezier
a Point
b = CubicBezier
a { _cBezierX3 :: Point
_cBezierX3 = Point
b }

-- | Traversal of all the points of the cubic bezier.

cubicBezierPoints :: Traversal' CubicBezier Point
cubicBezierPoints :: (Point -> f Point) -> CubicBezier -> f CubicBezier
cubicBezierPoints Point -> f Point
f (CubicBezier Point
p0 Point
p1 Point
p2 Point
p3) =
  Point -> Point -> Point -> Point -> CubicBezier
CubicBezier (Point -> Point -> Point -> Point -> CubicBezier)
-> f Point -> f (Point -> Point -> Point -> CubicBezier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> f Point
f Point
p0 f (Point -> Point -> Point -> CubicBezier)
-> f Point -> f (Point -> Point -> CubicBezier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p1 f (Point -> Point -> CubicBezier)
-> f Point -> f (Point -> CubicBezier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p2 f (Point -> CubicBezier) -> f Point -> f CubicBezier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p3

-- | Traverse all the points defined in the primitive.

primitivePoints :: Traversal' Primitive Point
primitivePoints :: (Point -> f Point) -> Primitive -> f Primitive
primitivePoints Point -> f Point
f (LinePrim Line
l) = Line -> Primitive
LinePrim (Line -> Primitive) -> f Line -> f Primitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point -> f Point) -> Line -> f Line
Traversal' Line Point
linePoints Point -> f Point
f Line
l
primitivePoints Point -> f Point
f (BezierPrim Bezier
b) = Bezier -> Primitive
BezierPrim (Bezier -> Primitive) -> f Bezier -> f Primitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point -> f Point) -> Bezier -> f Bezier
Traversal' Bezier Point
bezierPoints Point -> f Point
f Bezier
b
primitivePoints Point -> f Point
f (CubicBezierPrim CubicBezier
c) =
    CubicBezier -> Primitive
CubicBezierPrim (CubicBezier -> Primitive) -> f CubicBezier -> f Primitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Point -> f Point) -> CubicBezier -> f CubicBezier
Traversal' CubicBezier Point
cubicBezierPoints Point -> f Point
f CubicBezier
c

-- | Traversal of all the points of a path

pathCommandPoints :: Traversal' PathCommand Point
pathCommandPoints :: (Point -> f Point) -> PathCommand -> f PathCommand
pathCommandPoints Point -> f Point
f (PathLineTo Point
p) = Point -> PathCommand
PathLineTo (Point -> PathCommand) -> f Point -> f PathCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> f Point
f Point
p
pathCommandPoints Point -> f Point
f (PathQuadraticBezierCurveTo Point
p1 Point
p2) =
    Point -> Point -> PathCommand
PathQuadraticBezierCurveTo (Point -> Point -> PathCommand)
-> f Point -> f (Point -> PathCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> f Point
f Point
p1 f (Point -> PathCommand) -> f Point -> f PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p2
pathCommandPoints Point -> f Point
f (PathCubicBezierCurveTo Point
p1 Point
p2 Point
p3) =
    Point -> Point -> Point -> PathCommand
PathCubicBezierCurveTo (Point -> Point -> Point -> PathCommand)
-> f Point -> f (Point -> Point -> PathCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> f Point
f Point
p1 f (Point -> Point -> PathCommand)
-> f Point -> f (Point -> PathCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p2 f (Point -> PathCommand) -> f Point -> f PathCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point -> f Point
f Point
p3

-- | Traversal of all the points in a path.

pathPoints :: Traversal' Path Point
pathPoints :: (Point -> f Point) -> Path -> f Path
pathPoints Point -> f Point
f (Path Point
p0 Bool
yn [PathCommand]
comms) =
  Point -> Bool -> [PathCommand] -> Path
Path (Point -> Bool -> [PathCommand] -> Path)
-> f Point -> f (Bool -> [PathCommand] -> Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> f Point
f Point
p0 f (Bool -> [PathCommand] -> Path)
-> f Bool -> f ([PathCommand] -> Path)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
yn f ([PathCommand] -> Path) -> f [PathCommand] -> f Path
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PathCommand -> f PathCommand) -> [PathCommand] -> f [PathCommand]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Point -> f Point) -> PathCommand -> f PathCommand
Traversal' PathCommand Point
pathCommandPoints Point -> f Point
f) [PathCommand]
comms