{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

{-# OPTIONS_GHC -fno-warn-orphans  #-}

-- |
-- Module      :  Diagrams.Lens
-- Copyright   :  (c) 2013 Michael Sloan
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  Michael Sloan <mgsloan at gmail>
--
-- This module provides utilities for using "Control.Lens" with diagrams.
module Diagrams.Lens
  (
  -- * Diagrams.BoundingBox
    _corners
  -- * Diagrams.Core.Types
  , _location
  -- * Diagrams.Located
  , _Loc
  -- * Diagrams.Parametric
  -- , _arcLength
  -- * Diagrams.Segment
  , _mkFixedSeg
  , _straight
  , _bezier3
  -- * Diagrams.Trail
  , _lineSegments
  ) where

import           Diagrams.BoundingBox
import           Diagrams.Prelude


-- * Diagrams.BoundingBox

-- | A traversal that either has 0 (empty box) or 2 points.  These points are
--   the lower and upper corners, respectively.
_corners
    :: (Additive v', Foldable v', Ord n')
       => Traversal (BoundingBox v n) (BoundingBox v' n') (Point v n) (Point v' n')
_corners :: forall (v' :: * -> *) n' (v :: * -> *) n.
(Additive v', Foldable v', Ord n') =>
Traversal
  (BoundingBox v n) (BoundingBox v' n') (Point v n) (Point v' n')
_corners Point v n -> f (Point v' n')
f (BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners -> Just (Point v n
l, Point v n
t)) = Point v' n' -> Point v' n' -> BoundingBox v' n'
forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners (Point v' n' -> Point v' n' -> BoundingBox v' n')
-> f (Point v' n') -> f (Point v' n' -> BoundingBox v' n')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v n -> f (Point v' n')
f Point v n
l f (Point v' n' -> BoundingBox v' n')
-> f (Point v' n') -> f (BoundingBox v' n')
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point v n -> f (Point v' n')
f Point v n
t
_corners Point v n -> f (Point v' n')
_ BoundingBox v n
_ = BoundingBox v' n' -> f (BoundingBox v' n')
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoundingBox v' n'
forall (v :: * -> *) n. BoundingBox v n
emptyBox

-- * Diagrams.Core.Types

-- | Gets or set the 'location' of a 'Subdiagram'.
_location
  :: (HasLinearMap v, Metric v, OrderedField n)
  => Lens' (Subdiagram b v n m) (Point v n)
--TODO: Is this correct??
_location :: forall (v :: * -> *) n b m.
(HasLinearMap v, Metric v, OrderedField n) =>
Lens' (Subdiagram b v n m) (Point v n)
_location = (Subdiagram b v n m -> Point v n)
-> (Subdiagram b v n m -> Point v n -> Subdiagram b v n m)
-> Lens
     (Subdiagram b v n m) (Subdiagram b v n m) (Point v n) (Point v n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Subdiagram b v n m -> Point v n
forall (v :: * -> *) n b m.
(Additive v, Num n) =>
Subdiagram b v n m -> Point v n
location ((Point v n -> Subdiagram b v n m -> Subdiagram b v n m)
-> Subdiagram b v n m -> Point v n -> Subdiagram b v n m
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point v n -> Subdiagram b v n m -> Subdiagram b v n m
forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
Diagrams.Prelude.moveTo)

-- * Diagrams.Located

_Loc :: Iso (Located a) (Located a') (Point (V a) (N a), a) (Point (V a') (N a'), a')
_Loc :: forall a a' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (Point (V a) (N a), a) (f (Point (V a') (N a'), a'))
-> p (Located a) (f (Located a'))
_Loc = (Located a -> (Point (V a) (N a), a))
-> ((Point (V a') (N a'), a') -> Located a')
-> Iso
     (Located a)
     (Located a')
     (Point (V a) (N a), a)
     (Point (V a') (N a'), a')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Located a -> (Point (V a) (N a), a)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc ((Point (V a') (N a') -> a' -> Located a')
-> (Point (V a') (N a'), a') -> Located a'
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Point (V a') (N a') -> a' -> Located a')
 -> (Point (V a') (N a'), a') -> Located a')
-> (Point (V a') (N a') -> a' -> Located a')
-> (Point (V a') (N a'), a')
-> Located a'
forall a b. (a -> b) -> a -> b
$ (a' -> Point (V a') (N a') -> Located a')
-> Point (V a') (N a') -> a' -> Located a'
forall a b c. (a -> b -> c) -> b -> a -> c
flip a' -> Point (V a') (N a') -> Located a'
forall a. a -> Point (V a) (N a) -> Located a
Diagrams.Prelude.at)

-- * Diagrams.Parametric

{- TODO: requires 'arcLengthFromParam'

_arcLength
  :: HasArcLength p => N p -> p -> Iso' (N p)  (N p)
_arcLength eps curve
  = iso' (arcLengthFromParam eps curve) (arcLengthToParam eps curve)

-}

-- * Diagrams.Segment

_mkFixedSeg
  :: (Additive v, Additive v', Num n, Num n')
  => Iso
    (Located (Segment Closed v n))
    (Located (Segment Closed v' n'))
    (FixedSegment v n)
    (FixedSegment v' n')
_mkFixedSeg :: forall (v :: * -> *) (v' :: * -> *) n n'.
(Additive v, Additive v', Num n, Num n') =>
Iso
  (Located (Segment Closed v n))
  (Located (Segment Closed v' n'))
  (FixedSegment v n)
  (FixedSegment v' n')
_mkFixedSeg = (Located (Segment Closed v n) -> FixedSegment v n)
-> (FixedSegment v' n' -> Located (Segment Closed v' n'))
-> Iso
     (Located (Segment Closed v n))
     (Located (Segment Closed v' n'))
     (FixedSegment v n)
     (FixedSegment v' n')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Located (Segment Closed v n) -> FixedSegment v n
forall n (v :: * -> *).
(Num n, Additive v) =>
Located (Segment Closed v n) -> FixedSegment v n
mkFixedSeg FixedSegment v' n' -> Located (Segment Closed v' n')
forall n (v :: * -> *).
(Num n, Additive v) =>
FixedSegment v n -> Located (Segment Closed v n)
fromFixedSeg

-- | Prism that constructs linear segments.  Can also destruct them, if the
--   segment is Linear.
_straight :: Prism' (Segment Closed v n) (v n)
_straight :: forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (v n) (f (v n))
-> p (Segment Closed v n) (f (Segment Closed v n))
_straight = (v n -> Segment Closed v n)
-> (Segment Closed v n -> Maybe (v n))
-> Prism (Segment Closed v n) (Segment Closed v n) (v n) (v n)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight Segment Closed v n -> Maybe (v n)
forall c (v :: * -> *) n. Segment c v n -> Maybe (v n)
fromStraight
  where
    fromStraight :: Segment c v n -> Maybe (v n)
    fromStraight :: forall c (v :: * -> *) n. Segment c v n -> Maybe (v n)
fromStraight (Linear (OffsetClosed v n
x)) = v n -> Maybe (v n)
forall a. a -> Maybe a
Just v n
x
    fromStraight Segment c v n
_ = Maybe (v n)
forall a. Maybe a
Nothing

-- | Prism that constructs cubic bezier segments.  Can also destruct them, if
--   segment is a 'Cubic'.
_bezier3 :: Prism' (Segment Closed v n) (v n, v n, v n)
_bezier3 :: forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (v n, v n, v n) (f (v n, v n, v n))
-> p (Segment Closed v n) (f (Segment Closed v n))
_bezier3 = ((v n, v n, v n) -> Segment Closed v n)
-> (Segment Closed v n -> Maybe (v n, v n, v n))
-> Prism
     (Segment Closed v n)
     (Segment Closed v n)
     (v n, v n, v n)
     (v n, v n, v n)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\(v n
c1, v n
c2, v n
c3) -> v n -> v n -> v n -> Segment Closed v n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 v n
c1 v n
c2 v n
c3) Segment Closed v n -> Maybe (v n, v n, v n)
forall c (v :: * -> *) n. Segment c v n -> Maybe (v n, v n, v n)
fromBezier3
  where
    fromBezier3 :: Segment c v n -> Maybe (v n, v n, v n)
    fromBezier3 :: forall c (v :: * -> *) n. Segment c v n -> Maybe (v n, v n, v n)
fromBezier3 (Cubic v n
c1 v n
c2 (OffsetClosed v n
c3)) = (v n, v n, v n) -> Maybe (v n, v n, v n)
forall a. a -> Maybe a
Just (v n
c1, v n
c2, v n
c3)
    fromBezier3 Segment c v n
_ = Maybe (v n, v n, v n)
forall a. Maybe a
Nothing

-- * Diagrams.Trail

_lineSegments
  :: (Metric v', OrderedField n')
  => Iso
    (Trail' Line v n) (Trail' Line v' n')
    [Segment Closed v n] [Segment Closed v' n']
_lineSegments :: forall (v' :: * -> *) n' (v :: * -> *) n.
(Metric v', OrderedField n') =>
Iso
  (Trail' Line v n)
  (Trail' Line v' n')
  [Segment Closed v n]
  [Segment Closed v' n']
_lineSegments = (Trail' Line v n -> [Segment Closed v n])
-> ([Segment Closed v' n'] -> Trail' Line v' n')
-> Iso
     (Trail' Line v n)
     (Trail' Line v' n')
     [Segment Closed v n]
     [Segment Closed v' n']
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments [Segment Closed v' n'] -> Trail' Line v' n'
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail' Line v n
lineFromSegments