{-# LANGUAGE CPP                   #-}
{-# 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

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative
import           Data.Foldable
#endif
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 f (getCorners -> Just (l, t)) = fromCorners <$> f l <*> f t
_corners _ _ = pure 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 = lens location (flip Diagrams.Prelude.moveTo)

-- * Diagrams.Located

_Loc :: Iso (Located a) (Located a') (Point (V a) (N a), a) (Point (V a') (N a'), a')
_Loc = iso viewLoc (uncurry $ flip 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 = iso mkFixedSeg fromFixedSeg

-- | Prism that constructs linear segments.  Can also destruct them, if the
--   segment is Linear.
_straight :: Prism' (Segment Closed v n) (v n)
_straight = prism' straight fromStraight
  where
    fromStraight :: Segment c v n -> Maybe (v n)
    fromStraight (Linear (OffsetClosed x)) = Just x
    fromStraight _ = 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 = prism' (\(c1, c2, c3) -> bezier3 c1 c2 c3) fromBezier3
  where
    fromBezier3 :: Segment c v n -> Maybe (v n, v n, v n)
    fromBezier3 (Cubic c1 c2 (OffsetClosed c3)) = Just (c1, c2, c3)
    fromBezier3 _ = 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 = iso lineSegments lineFromSegments