    {-# LANGUAGE FlexibleContexts     #-}
    {-# LANGUAGE TemplateHaskell      #-}
    {-# LANGUAGE TypeFamilies         #-}
    {-# LANGUAGE TypeOperators        #-}
    {-# LANGUAGE UndecidableInstances #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Parametric.Adjust
    -- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Tools for adjusting the length of parametric objects such as
    -- segments and trails.
    --
    -----------------------------------------------------------------------------
    module Diagrams.Parametric.Adjust
        ( adjust
        , AdjustOpts(_adjMethod, _adjSide, _adjEps)
        , adjMethod, adjSide, adjEps
        , AdjustMethod(..), AdjustSide(..)

        ) where

    import           Control.Lens        (Lens', generateSignatures, lensRules, makeLensesWith, (&),
                                          (.~), (^.))
    import           Data.Proxy

    import           Data.Default.Class

    import           Diagrams.Core.V
    import           Diagrams.Parametric

    -- | What method should be used for adjusting a segment, trail, or
    --   path?
    data AdjustMethod n = ByParam n     -- ^ Extend by the given parameter value
                                        --   (use a negative parameter to shrink)
                        | ByAbsolute n  -- ^ Extend by the given arc length
                                        --   (use a negative length to shrink)
                        | ToAbsolute n  -- ^ Extend or shrink to the given
                                        --   arc length

    -- | Which side of a segment, trail, or path should be adjusted?
    data AdjustSide = Start  -- ^ Adjust only the beginning
                    | End    -- ^ Adjust only the end
                    | Both   -- ^ Adjust both sides equally
      deriving (Int -> AdjustSide -> ShowS
    [AdjustSide] -> ShowS
    AdjustSide -> String
    (Int -> AdjustSide -> ShowS)
    -> (AdjustSide -> String)
    -> ([AdjustSide] -> ShowS)
    -> Show AdjustSide
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AdjustSide -> ShowS
    showsPrec :: Int -> AdjustSide -> ShowS
    $cshow :: AdjustSide -> String
    show :: AdjustSide -> String
    $cshowList :: [AdjustSide] -> ShowS
    showList :: [AdjustSide] -> ShowS
    Show, ReadPrec [AdjustSide]
    ReadPrec AdjustSide
    Int -> ReadS AdjustSide
    ReadS [AdjustSide]
    (Int -> ReadS AdjustSide)
    -> ReadS [AdjustSide]
    -> ReadPrec AdjustSide
    -> ReadPrec [AdjustSide]
    -> Read AdjustSide
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS AdjustSide
    readsPrec :: Int -> ReadS AdjustSide
    $creadList :: ReadS [AdjustSide]
    readList :: ReadS [AdjustSide]
    $creadPrec :: ReadPrec AdjustSide
    readPrec :: ReadPrec AdjustSide
    $creadListPrec :: ReadPrec [AdjustSide]
    readListPrec :: ReadPrec [AdjustSide]
    Read, AdjustSide -> AdjustSide -> Bool
    (AdjustSide -> AdjustSide -> Bool)
    -> (AdjustSide -> AdjustSide -> Bool) -> Eq AdjustSide
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AdjustSide -> AdjustSide -> Bool
    == :: AdjustSide -> AdjustSide -> Bool
    $c/= :: AdjustSide -> AdjustSide -> Bool
    /= :: AdjustSide -> AdjustSide -> Bool
    Eq, Eq AdjustSide
    Eq AdjustSide =>
    (AdjustSide -> AdjustSide -> Ordering)
    -> (AdjustSide -> AdjustSide -> Bool)
    -> (AdjustSide -> AdjustSide -> Bool)
    -> (AdjustSide -> AdjustSide -> Bool)
    -> (AdjustSide -> AdjustSide -> Bool)
    -> (AdjustSide -> AdjustSide -> AdjustSide)
    -> (AdjustSide -> AdjustSide -> AdjustSide)
    -> Ord AdjustSide
    AdjustSide -> AdjustSide -> Bool
    AdjustSide -> AdjustSide -> Ordering
    AdjustSide -> AdjustSide -> AdjustSide
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: AdjustSide -> AdjustSide -> Ordering
    compare :: AdjustSide -> AdjustSide -> Ordering
    $c< :: AdjustSide -> AdjustSide -> Bool
    < :: AdjustSide -> AdjustSide -> Bool
    $c<= :: AdjustSide -> AdjustSide -> Bool
    <= :: AdjustSide -> AdjustSide -> Bool
    $c> :: AdjustSide -> AdjustSide -> Bool
    > :: AdjustSide -> AdjustSide -> Bool
    $c>= :: AdjustSide -> AdjustSide -> Bool
    >= :: AdjustSide -> AdjustSide -> Bool
    $cmax :: AdjustSide -> AdjustSide -> AdjustSide
    max :: AdjustSide -> AdjustSide -> AdjustSide
    $cmin :: AdjustSide -> AdjustSide -> AdjustSide
    min :: AdjustSide -> AdjustSide -> AdjustSide
    Ord, AdjustSide
    AdjustSide -> AdjustSide -> Bounded AdjustSide
    forall a. a -> a -> Bounded a
    $cminBound :: AdjustSide
    minBound :: AdjustSide
    $cmaxBound :: AdjustSide
    maxBound :: AdjustSide
    Bounded, Int -> AdjustSide
    AdjustSide -> Int
    AdjustSide -> [AdjustSide]
    AdjustSide -> AdjustSide
    AdjustSide -> AdjustSide -> [AdjustSide]
    AdjustSide -> AdjustSide -> AdjustSide -> [AdjustSide]
    (AdjustSide -> AdjustSide)
    -> (AdjustSide -> AdjustSide)
    -> (Int -> AdjustSide)
    -> (AdjustSide -> Int)
    -> (AdjustSide -> [AdjustSide])
    -> (AdjustSide -> AdjustSide -> [AdjustSide])
    -> (AdjustSide -> AdjustSide -> [AdjustSide])
    -> (AdjustSide -> AdjustSide -> AdjustSide -> [AdjustSide])
    -> Enum AdjustSide
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: AdjustSide -> AdjustSide
    succ :: AdjustSide -> AdjustSide
    $cpred :: AdjustSide -> AdjustSide
    pred :: AdjustSide -> AdjustSide
    $ctoEnum :: Int -> AdjustSide
    toEnum :: Int -> AdjustSide
    $cfromEnum :: AdjustSide -> Int
    fromEnum :: AdjustSide -> Int
    $cenumFrom :: AdjustSide -> [AdjustSide]
    enumFrom :: AdjustSide -> [AdjustSide]
    $cenumFromThen :: AdjustSide -> AdjustSide -> [AdjustSide]
    enumFromThen :: AdjustSide -> AdjustSide -> [AdjustSide]
    $cenumFromTo :: AdjustSide -> AdjustSide -> [AdjustSide]
    enumFromTo :: AdjustSide -> AdjustSide -> [AdjustSide]
    $cenumFromThenTo :: AdjustSide -> AdjustSide -> AdjustSide -> [AdjustSide]
    enumFromThenTo :: AdjustSide -> AdjustSide -> AdjustSide -> [AdjustSide]
    Enum)

    -- | How should a segment, trail, or path be adjusted?
    data AdjustOpts n = AO { forall n. AdjustOpts n -> AdjustMethod n
    _adjMethod    :: AdjustMethod n
                           , forall n. AdjustOpts n -> AdjustSide
    _adjSide      :: AdjustSide
                           , forall n. AdjustOpts n -> n
    _adjEps       :: n
                           , forall n. AdjustOpts n -> Proxy n
    adjOptsvProxy :: Proxy n
                           }

    -- See Diagrams.Combinators for reasoning behind 'Proxy'.

    makeLensesWith (lensRules & generateSignatures .~ False) ''AdjustOpts

    -- | Which method should be used for adjusting?
    adjMethod :: Lens' (AdjustOpts n) (AdjustMethod n)

    -- | Which end(s) of the object should be adjusted?
    adjSide :: Lens' (AdjustOpts n) AdjustSide

    -- | Tolerance to use when doing adjustment.
    adjEps :: Lens' (AdjustOpts n) n

    instance Fractional n => Default (AdjustMethod n) where
      def :: AdjustMethod n
    def = n -> AdjustMethod n
    forall n. n -> AdjustMethod n
    ByParam n
    0.2

    instance Default AdjustSide where
      def :: AdjustSide
    def = AdjustSide
    Both

    instance Fractional n => Default (AdjustOpts n) where
      def :: AdjustOpts n
    def = AO { _adjMethod :: AdjustMethod n
    _adjMethod    = AdjustMethod n
    forall a. Default a => a
    def
               , _adjSide :: AdjustSide
    _adjSide      = AdjustSide
    forall a. Default a => a
    def
               , _adjEps :: n
    _adjEps       = n
    forall a. Fractional a => a
    stdTolerance
               , adjOptsvProxy :: Proxy n
    adjOptsvProxy = Proxy n
    forall {k} (t :: k). Proxy t
    Proxy
               }

    -- | Adjust the length of a parametric object such as a segment or
    --   trail.  The second parameter is an option record which controls how
    --   the adjustment should be performed; see 'AdjustOpts'.
    adjust :: (N t ~ n, Sectionable t, HasArcLength t, Fractional n)
           => t -> AdjustOpts n -> t
    adjust :: forall t n.
    (N t ~ n, Sectionable t, HasArcLength t, Fractional n) =>
    t -> AdjustOpts n -> t
    adjust t
    s AdjustOpts n
    opts = t -> N t -> N t -> t
    forall p. Sectionable p => p -> N p -> N p -> p
    section t
    s
      (if AdjustOpts n
    optsAdjustOpts n
    -> Getting AdjustSide (AdjustOpts n) AdjustSide -> AdjustSide
    forall s a. s -> Getting a s a -> a
    ^.Getting AdjustSide (AdjustOpts n) AdjustSide
    forall n (f :: * -> *).
    Functor f =>
    (AdjustSide -> f AdjustSide) -> AdjustOpts n -> f (AdjustOpts n)
    adjSide AdjustSide -> AdjustSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == AdjustSide
    End   then t -> N t
    forall p. DomainBounds p => p -> N p
    domainLower t
    s else t -> n
    getParam t
    s)
      (if AdjustOpts n
    optsAdjustOpts n
    -> Getting AdjustSide (AdjustOpts n) AdjustSide -> AdjustSide
    forall s a. s -> Getting a s a -> a
    ^.Getting AdjustSide (AdjustOpts n) AdjustSide
    forall n (f :: * -> *).
    Functor f =>
    (AdjustSide -> f AdjustSide) -> AdjustOpts n -> f (AdjustOpts n)
    adjSide AdjustSide -> AdjustSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == AdjustSide
    Start then t -> N t
    forall p. DomainBounds p => p -> N p
    domainUpper t
    s else t -> N t
    forall p. DomainBounds p => p -> N p
    domainUpper t
    s n -> n -> n
    forall a. Num a => a -> a -> a
    - t -> n
    getParam (t -> t
    forall p. Sectionable p => p -> p
    reverseDomain t
    s))
     where
      getParam :: t -> n
    getParam t
    seg = case AdjustOpts n
    optsAdjustOpts n
    -> Getting (AdjustMethod n) (AdjustOpts n) (AdjustMethod n)
    -> AdjustMethod n
    forall s a. s -> Getting a s a -> a
    ^.Getting (AdjustMethod n) (AdjustOpts n) (AdjustMethod n)
    forall n (f :: * -> *).
    Functor f =>
    (AdjustMethod n -> f (AdjustMethod n))
    -> AdjustOpts n -> f (AdjustOpts n)
    adjMethod of
        ByParam n
    p -> -n
    p n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    bothCoef
        ByAbsolute n
    len -> N t -> N t
    param (-n
    len n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    bothCoef)
        ToAbsolute n
    len -> N t -> N t
    param (n -> n
    absDelta n
    len n -> n -> n
    forall a. Num a => a -> a -> a
    * n
    bothCoef)
       where
        param :: N t -> N t
    param        = N t -> t -> N t -> N t
    forall p. HasArcLength p => N p -> p -> N p -> N p
    arcLengthToParam n
    N t
    eps t
    seg
        absDelta :: n -> n
    absDelta n
    len = N t -> t -> N t
    forall p. HasArcLength p => N p -> p -> N p
    arcLength n
    N t
    eps t
    s n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    len
      bothCoef :: n
    bothCoef = if AdjustOpts n
    optsAdjustOpts n
    -> Getting AdjustSide (AdjustOpts n) AdjustSide -> AdjustSide
    forall s a. s -> Getting a s a -> a
    ^.Getting AdjustSide (AdjustOpts n) AdjustSide
    forall n (f :: * -> *).
    Functor f =>
    (AdjustSide -> f AdjustSide) -> AdjustOpts n -> f (AdjustOpts n)
    adjSide AdjustSide -> AdjustSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == AdjustSide
    Both then n
    0.5 else n
    1
      eps :: n
    eps = AdjustOpts n
    optsAdjustOpts n -> Getting n (AdjustOpts n) n -> n
    forall s a. s -> Getting a s a -> a
    ^.Getting n (AdjustOpts n) n
    forall n (f :: * -> *).
    Functor f =>
    (n -> f n) -> AdjustOpts n -> f (AdjustOpts n)
    adjEps