    {-# LANGUAGE CPP                        #-}
    {-# LANGUAGE ConstraintKinds            #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE RankNTypes                 #-}
    {-# LANGUAGE StandaloneDeriving         #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE TypeOperators              #-}
    {-# LANGUAGE UndecidableInstances       #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Core.Envelope
    -- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- diagrams-core defines the core library of primitives forming the
    -- basis of an embedded domain-specific language for describing and
    -- rendering diagrams.
    --
    -- The @Diagrams.Core.Envelope@ module defines a data type and type class for
    -- \"envelopes\", aka functional bounding regions.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Core.Envelope
           ( -- * Envelopes
             Envelope(..)

           , appEnvelope
           , onEnvelope
           , mkEnvelope
           , pointEnvelope

           , Enveloped(..)

             -- * Utility functions
           , diameter
           , radius
           , extent
           , size
           , envelopeVMay
           , envelopeV
           , envelopePMay
           , envelopeP
           , envelopeSMay
           , envelopeS

             -- * Miscellaneous
           , OrderedField
           ) where

    #if __GLASGOW_HASKELL__ < 710
    import           Control.Applicative     ((<$>))
    #endif
    import           Control.Lens            (Rewrapped, Wrapped (..), iso, mapped,
                                              op, over, (&), (.~), _Wrapping')
    import           Data.Functor.Rep
    import qualified Data.Map                as M
    import           Data.Maybe              (fromMaybe)
    import           Data.Semigroup
    import qualified Data.Set                as S

    import           Diagrams.Core.HasOrigin
    import           Diagrams.Core.Points
    import           Diagrams.Core.Transform
    import           Diagrams.Core.V

    import           Linear.Metric
    import           Linear.Vector

    ------------------------------------------------------------
    --  Envelopes  ---------------------------------------------
    ------------------------------------------------------------

    -- | Every diagram comes equipped with an /envelope/.  What is an envelope?
    --
    --   Consider first the idea of a /bounding box/. A bounding box
    --   expresses the distance to a bounding plane in every direction
    --   parallel to an axis.  That is, a bounding box can be thought of
    --   as the intersection of a collection of half-planes, two
    --   perpendicular to each axis.
    --
    --   More generally, the intersection of half-planes in /every/
    --   direction would give a tight \"bounding region\", or convex hull.
    --   However, representing such a thing intensionally would be
    --   impossible; hence bounding boxes are often used as an
    --   approximation.
    --
    --   An envelope is an /extensional/ representation of such a
    --   \"bounding region\".  Instead of storing some sort of direct
    --   representation, we store a /function/ which takes a direction as
    --   input and gives a distance to a bounding half-plane as output.
    --   The important point is that envelopes can be composed, and
    --   transformed by any affine transformation.
    --
    --   Formally, given a vector @v@, the envelope computes a scalar @s@ such
    --   that
    --
    --     * for every point @u@ inside the diagram,
    --       if the projection of @(u - origin)@ onto @v@ is @s' *^ v@, then @s' <= s@.
    --
    --     * @s@ is the smallest such scalar.
    --
    --   There is also a special \"empty envelope\".
    --
    --   The idea for envelopes came from
    --   Sebastian Setzer; see
    --   <http://byorgey.wordpress.com/2009/10/28/collecting-attributes/#comment-2030>.  See also Brent Yorgey, /Monoids: Theme and Variations/, published in the 2012 Haskell Symposium: <http://ozark.hendrix.edu/~yorgey/pub/monoid-pearl.pdf>; video: <http://www.youtube.com/watch?v=X-8NCkD2vOw>.
    newtype Envelope v n = Envelope (Maybe (v n -> Max n))

    instance Wrapped (Envelope v n) where
      type Unwrapped (Envelope v n) = Maybe (v n -> Max n)
      _Wrapped' :: Iso' (Envelope v n) (Unwrapped (Envelope v n))
    _Wrapped' = (Envelope v n -> Maybe (v n -> Max n))
    -> (Maybe (v n -> Max n) -> Envelope v n)
    -> Iso
         (Envelope v n)
         (Envelope v n)
         (Maybe (v n -> Max n))
         (Maybe (v n -> Max n))
    forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
    iso (\(Envelope Maybe (v n -> Max n)
    e) -> Maybe (v n -> Max n)
    e) Maybe (v n -> Max n) -> Envelope v n
    forall (v :: * -> *) n. Maybe (v n -> Max n) -> Envelope v n
    Envelope

    instance Rewrapped (Envelope v n) (Envelope v' n')

    -- | \"Apply\" an envelope by turning it into a function.  @Nothing@
    --   is returned iff the envelope is empty.
    appEnvelope :: Envelope v n -> Maybe (v n -> n)
    appEnvelope :: forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
    appEnvelope (Envelope Maybe (v n -> Max n)
    e) = (Max n -> n
    forall a. Max a -> a
    getMax (Max n -> n) -> (v n -> Max n) -> v n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((v n -> Max n) -> v n -> n)
    -> Maybe (v n -> Max n) -> Maybe (v n -> n)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (v n -> Max n)
    e

    -- | A convenient way to transform an envelope, by specifying a
    --   transformation on the underlying @v n -> n@ function.  The empty
    --   envelope is unaffected.
    onEnvelope :: ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
    onEnvelope :: forall (v :: * -> *) n.
    ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
    onEnvelope (v n -> n) -> v n -> n
    t = ASetter (Envelope v n) (Envelope v n) (v n -> Max n) (v n -> Max n)
    -> ((v n -> Max n) -> v n -> Max n) -> Envelope v n -> Envelope v n
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ((Unwrapped (Envelope v n) -> Envelope v n)
    -> Iso' (Envelope v n) (Unwrapped (Envelope v n))
    forall s. Wrapped s => (Unwrapped s -> s) -> Iso' s (Unwrapped s)
    _Wrapping' Maybe (v n -> Max n) -> Envelope v n
    Unwrapped (Envelope v n) -> Envelope v n
    forall (v :: * -> *) n. Maybe (v n -> Max n) -> Envelope v n
    Envelope ((Maybe (v n -> Max n) -> Identity (Maybe (v n -> Max n)))
     -> Envelope v n -> Identity (Envelope v n))
    -> (((v n -> Max n) -> Identity (v n -> Max n))
        -> Maybe (v n -> Max n) -> Identity (Maybe (v n -> Max n)))
    -> ASetter
         (Envelope v n) (Envelope v n) (v n -> Max n) (v n -> Max n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((v n -> Max n) -> Identity (v n -> Max n))
    -> Maybe (v n -> Max n) -> Identity (Maybe (v n -> Max n))
    Setter
      (Maybe (v n -> Max n))
      (Maybe (v n -> Max n))
      (v n -> Max n)
      (v n -> Max n)
    forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
    mapped) ((n -> Max n
    forall a. a -> Max a
    Max (n -> Max n) -> (v n -> n) -> v n -> Max n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((v n -> n) -> v n -> Max n)
    -> ((v n -> Max n) -> v n -> n) -> (v n -> Max n) -> v n -> Max n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (v n -> n) -> v n -> n
    t ((v n -> n) -> v n -> n)
    -> ((v n -> Max n) -> v n -> n) -> (v n -> Max n) -> v n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Max n -> n
    forall a. Max a -> a
    getMax (Max n -> n) -> (v n -> Max n) -> v n -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .))

    -- | Create an envelope from a @v n -> n@ function.
    mkEnvelope :: (v n -> n) -> Envelope v n
    mkEnvelope :: forall (v :: * -> *) n. (v n -> n) -> Envelope v n
    mkEnvelope = Maybe (v n -> Max n) -> Envelope v n
    forall (v :: * -> *) n. Maybe (v n -> Max n) -> Envelope v n
    Envelope (Maybe (v n -> Max n) -> Envelope v n)
    -> ((v n -> n) -> Maybe (v n -> Max n))
    -> (v n -> n)
    -> Envelope v n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (v n -> Max n) -> Maybe (v n -> Max n)
    forall a. a -> Maybe a
    Just ((v n -> Max n) -> Maybe (v n -> Max n))
    -> ((v n -> n) -> v n -> Max n)
    -> (v n -> n)
    -> Maybe (v n -> Max n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (n -> Max n
    forall a. a -> Max a
    Max (n -> Max n) -> (v n -> n) -> v n -> Max n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .)

    -- | Create a point envelope for the given point.  A point envelope
    --   has distance zero to a bounding hyperplane in every direction.
    --   Note this is /not/ the same as the empty envelope.
    pointEnvelope :: (Fractional n, Metric v) => Point v n -> Envelope v n
    pointEnvelope :: forall n (v :: * -> *).
    (Fractional n, Metric v) =>
    Point v n -> Envelope v n
    pointEnvelope Point v n
    p = Point v n -> Envelope v n -> Envelope v n
    forall (v :: * -> *) n t.
    (InSpace v n t, HasOrigin t) =>
    Point v n -> t -> t
    moveTo Point v n
    p ((v n -> n) -> Envelope v n
    forall (v :: * -> *) n. (v n -> n) -> Envelope v n
    mkEnvelope ((v n -> n) -> Envelope v n) -> (v n -> n) -> Envelope v n
    forall a b. (a -> b) -> a -> b
    $ n -> v n -> n
    forall a b. a -> b -> a
    const n
    0)

    -- | Envelopes form a semigroup with pointwise maximum as composition.
    --   Hence, if @e1@ is the envelope for diagram @d1@, and
    --   @e2@ is the envelope for @d2@, then @e1 \`mappend\` e2@
    --   is the envelope for @d1 \`atop\` d2@.
    deriving instance Ord n => Semigroup (Envelope v n)

    -- | The special empty envelope is the identity for the
    --   'Monoid' instance.
    deriving instance Ord n => Monoid (Envelope v n)

    type instance V (Envelope v n) = v
    type instance N (Envelope v n) = n

    instance Show (Envelope v n) where
      show :: Envelope v n -> String
    show Envelope v n
    _ = String
    "<envelope>"

    ------------------------------------------------------------
    --  Transforming envelopes  --------------------------------
    ------------------------------------------------------------

    -- | The local origin of an envelope is the point with respect to
    --   which bounding queries are made, /i.e./ the point from which the
    --   input vectors are taken to originate.
    instance (Metric v, Fractional n) => HasOrigin (Envelope v n) where
      moveOriginTo :: Point (V (Envelope v n)) (N (Envelope v n))
    -> Envelope v n -> Envelope v n
    moveOriginTo (P V (Envelope v n) (N (Envelope v n))
    u) = ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
    forall (v :: * -> *) n.
    ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
    onEnvelope (((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n)
    -> ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
    forall a b. (a -> b) -> a -> b
    $ \v n -> n
    oldEnv v n
    v -> v n -> n
    oldEnv v n
    v n -> n -> n
    forall a. Num a => a -> a -> a
    - ((v n
    V (Envelope v n) (N (Envelope v n))
    u v n -> n -> v n
    forall (f :: * -> *) a.
    (Functor f, Fractional a) =>
    f a -> a -> f a
    ^/ (v n
    v v n -> v n -> n
    forall a. Num a => v a -> v a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot` v n
    v)) v n -> v n -> n
    forall a. Num a => v a -> v a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot` v n
    v)
      -- For a detailed explanation of this code, see note
      -- [Transforming Envelopes] below.

    instance (Metric v, Floating n) => Transformable (Envelope v n) where
      transform :: Transformation (V (Envelope v n)) (N (Envelope v n))
    -> Envelope v n -> Envelope v n
    transform Transformation (V (Envelope v n)) (N (Envelope v n))
    t = Point (V (Envelope v n)) (N (Envelope v n))
    -> Envelope v n -> Envelope v n
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo (v n -> Point v n
    v n -> Point (V (Envelope v n)) (N (Envelope v n))
    forall (f :: * -> *) a. f a -> Point f a
    P (v n -> Point (V (Envelope v n)) (N (Envelope v n)))
    -> (Transformation (V (Envelope v n)) (N (Envelope v n)) -> v n)
    -> Transformation (V (Envelope v n)) (N (Envelope v n))
    -> Point (V (Envelope v n)) (N (Envelope v n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v n -> v n
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
    negated (v n -> v n)
    -> (Transformation v n -> v n) -> Transformation v n -> v n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Transformation v n -> v n
    forall (v :: * -> *) n. Transformation v n -> v n
    transl (Transformation (V (Envelope v n)) (N (Envelope v n))
     -> Point (V (Envelope v n)) (N (Envelope v n)))
    -> Transformation (V (Envelope v n)) (N (Envelope v n))
    -> Point (V (Envelope v n)) (N (Envelope v n))
    forall a b. (a -> b) -> a -> b
    $ Transformation (V (Envelope v n)) (N (Envelope v n))
    t) (Envelope v n -> Envelope v n)
    -> (Envelope v n -> Envelope v n) -> Envelope v n -> Envelope v n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
    forall (v :: * -> *) n.
    ((v n -> n) -> v n -> n) -> Envelope v n -> Envelope v n
    onEnvelope (v n -> n) -> v n -> n
    g
        where

          -- For a detailed explanation of this code, see note
          -- [Transforming Envelopes] below.
          g :: (v n -> n) -> v n -> n
    g v n -> n
    f v n
    v = v n -> n
    f v n
    v' n -> n -> n
    forall a. Fractional a => a -> a -> a
    / (v n
    v' v n -> v n -> n
    forall a. Num a => v a -> v a -> a
    forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
    `dot` v n
    vi)
            where
              v' :: v n
    v' = v n -> v n
    forall a. Floating a => v a -> v a
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
    signorm (v n -> v n) -> v n -> v n
    forall a b. (a -> b) -> a -> b
    $ (v n :-: v n) -> v n -> v n
    forall u v. (u :-: v) -> u -> v
    lapp (Transformation v n -> v n :-: v n
    forall (v :: * -> *) n. Transformation v n -> v n :-: v n
    transp Transformation v n
    Transformation (V (Envelope v n)) (N (Envelope v n))
    t) v n
    v
              vi :: v n
    vi = Transformation v n -> v n -> v n
    forall (v :: * -> *) n. Transformation v n -> v n -> v n
    apply (Transformation v n -> Transformation v n
    forall (v :: * -> *) n.
    (Functor v, Num n) =>
    Transformation v n -> Transformation v n
    inv Transformation v n
    Transformation (V (Envelope v n)) (N (Envelope v n))
    t) v n
    v

    {-

    Note [Transforming Envelopes]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    We are given an envelope for some object, and want to apply an affine
    transformation, such that the new envelope will be the envelope for
    the transformed object.  The HasOrigin instance handles the
    translational component; the rest of the code in the Transformable
    instance handles the linear component.

    See <<diagrams/EnvHasOrigin.png>>.

    To implement moveOriginTo, we need to move the "base point" from which
    envelope queries are made.  We are given the old envelope @oldEnv@ (a
    function from vectors to scalars), a vector @u@ from the old origin to
    the new origin, and a query vector @v@ which we imagine to emanate
    from the new origin.  If we query the old envelope with v, it will
    find the correct perpendicular hyperplane, but the reported distance
    may be wrong (it will only be correct if the origin was moved in a
    direction perpendicular to v).  The part that needs to be subtracted
    is just the projection of u onto v, which is given by (u.v)/(v.v) *^
    v.  In fact envelopes return not a distance or vector, but a scalar
    which is taken to be a multiple of the query vector, so the scalar we
    need to subtract is just (u.v)/(v.v).

    We now consider how to apply a linear transformation to an envelope.
    Recall that an envelope is a function that takes a vector and returns
    a scaling factor s such that scaling the vector by s will produce a
    vector to the minimum separating hyperplane.  (So if given a unit
    vector as input, the output will be simply the distance to the minimum
    separating hyperplane.)

    We are given a linear transformation t and must produce a new envelope
    function.  Given an input vector v, the "obvious" thing to do is to
    transform v back into the original coordinate system using the inverse
    of t, apply the original envelope, and then adjust the resulting
    scalar according to how much the transformation scales v.

    However, this does not work, since linear transformations do not
    preserve angles.  Thus, in particular, given the query vector v and
    the perpendicular separating hyperplane H which we wish to find, t^-1
    v and t^-1 H are not necessarily perpendicular anymore.  So if we
    query the envelope with t^-1 v we will get information about the
    distance to some separating hyperplane, which when mapped forward
    through t will no longer be perpendicular to v.

    However, it turns out that if v and w are perpendicular, then t^-1 v
    will be perpendicular to t^T w, that is, the *transpose* of t (when
    considered as a matrix) applied to w.  The proof is simple. Recall
    that v and w are perpendicular if and only if v . w = v^T w = 0.  Thus,

      (t^-1 v) . (t^T w) = (t^-1 v)^T (t^T w) = v^T t^-T t^T w = v^T w = 0.

    Now to explain this code:

          g f v = f v' / (v' `dot` vi)
            where
              v' = signorm $ lapp (transp t) v
              vi = apply (inv t) v

    In our case, our new envelope function (transformed by t) will be
    given a query vector v, and we suppose v is perpendicular to the
    separating hyperplane H.  Instead of querying the old envelope
    function f with t^-1 v, we query it with t^T v (after normalizing),
    since that vector will be perpendicular to t^-1 H.

    Finally, to scale the resulting value correctly, we divide by (t^T v
    . t^-1 v); I forget why.  Perhaps I will come back later and complete
    this explanation.

    -}

    ------------------------------------------------------------
    --  Enveloped class
    ------------------------------------------------------------

    -- | When dealing with envelopes we often want scalars to be an
    --   ordered field (i.e. support all four arithmetic operations and be
    --   totally ordered) so we introduce this constraint as a convenient
    --   shorthand.
    type OrderedField s = (Floating s, Ord s)

    -- | @Enveloped@ abstracts over things which have an envelope.
    class (Metric (V a), OrderedField (N a)) => Enveloped a where

      -- | Compute the envelope of an object.  For types with an intrinsic
      --   notion of \"local origin\", the envelope will be based there.
      --   Other types (e.g. 'Trail') may have some other default
      --   reference point at which the envelope will be based; their
      --   instances should document what it is.
      getEnvelope :: a -> Envelope (V a) (N a)

    instance (Metric v, OrderedField n) => Enveloped (Envelope v n) where
      getEnvelope :: Envelope v n -> Envelope (V (Envelope v n)) (N (Envelope v n))
    getEnvelope = Envelope v n -> Envelope v n
    Envelope v n -> Envelope (V (Envelope v n)) (N (Envelope v n))
    forall a. a -> a
    id

    instance (OrderedField n, Metric v) => Enveloped (Point v n) where
      getEnvelope :: Point v n -> Envelope (V (Point v n)) (N (Point v n))
    getEnvelope Point v n
    p = Point v n -> Envelope v n -> Envelope v n
    forall (v :: * -> *) n t.
    (InSpace v n t, HasOrigin t) =>
    Point v n -> t -> t
    moveTo Point v n
    p (Envelope v n -> Envelope (V (Point v n)) (N (Point v n)))
    -> ((v n -> n) -> Envelope v n)
    -> (v n -> n)
    -> Envelope (V (Point v n)) (N (Point v n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (v n -> n) -> Envelope v n
    forall (v :: * -> *) n. (v n -> n) -> Envelope v n
    mkEnvelope ((v n -> n) -> Envelope (V (Point v n)) (N (Point v n)))
    -> (v n -> n) -> Envelope (V (Point v n)) (N (Point v n))
    forall a b. (a -> b) -> a -> b
    $ n -> v n -> n
    forall a b. a -> b -> a
    const n
    0

    instance Enveloped t => Enveloped (TransInv t) where
      getEnvelope :: TransInv t -> Envelope (V (TransInv t)) (N (TransInv t))
    getEnvelope = t -> Envelope (V t) (N t)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope (t -> Envelope (V t) (N t))
    -> (TransInv t -> t) -> TransInv t -> Envelope (V t) (N t)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unwrapped (TransInv t) -> TransInv t)
    -> TransInv t -> Unwrapped (TransInv t)
    forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
    op t -> TransInv t
    Unwrapped (TransInv t) -> TransInv t
    forall t. t -> TransInv t
    TransInv

    instance (Enveloped a, Enveloped b, V a ~ V b, N a ~ N b) => Enveloped (a,b) where
      getEnvelope :: (a, b) -> Envelope (V (a, b)) (N (a, b))
    getEnvelope (a
    x,b
    y) = a -> Envelope (V a) (N a)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope a
    x Envelope (V b) (N b)
    -> Envelope (V b) (N b) -> Envelope (V b) (N b)
    forall a. Semigroup a => a -> a -> a
    <> b -> Envelope (V b) (N b)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope b
    y

    instance Enveloped b => Enveloped [b] where
      getEnvelope :: [b] -> Envelope (V [b]) (N [b])
    getEnvelope = [Envelope (V b) (N b)] -> Envelope (V b) (N b)
    forall a. Monoid a => [a] -> a
    mconcat ([Envelope (V b) (N b)] -> Envelope (V b) (N b))
    -> ([b] -> [Envelope (V b) (N b)]) -> [b] -> Envelope (V b) (N b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Envelope (V b) (N b)) -> [b] -> [Envelope (V b) (N b)]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Envelope (V b) (N b)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope

    instance Enveloped b => Enveloped (M.Map k b) where
      getEnvelope :: Map k b -> Envelope (V (Map k b)) (N (Map k b))
    getEnvelope = [Envelope (V b) (N b)] -> Envelope (V b) (N b)
    forall a. Monoid a => [a] -> a
    mconcat ([Envelope (V b) (N b)] -> Envelope (V b) (N b))
    -> (Map k b -> [Envelope (V b) (N b)])
    -> Map k b
    -> Envelope (V b) (N b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Envelope (V b) (N b)) -> [b] -> [Envelope (V b) (N b)]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Envelope (V b) (N b)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope ([b] -> [Envelope (V b) (N b)])
    -> (Map k b -> [b]) -> Map k b -> [Envelope (V b) (N b)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map k b -> [b]
    forall k a. Map k a -> [a]
    M.elems

    instance Enveloped b => Enveloped (S.Set b) where
      getEnvelope :: Set b -> Envelope (V (Set b)) (N (Set b))
    getEnvelope = [Envelope (V b) (N b)] -> Envelope (V b) (N b)
    forall a. Monoid a => [a] -> a
    mconcat ([Envelope (V b) (N b)] -> Envelope (V b) (N b))
    -> (Set b -> [Envelope (V b) (N b)])
    -> Set b
    -> Envelope (V b) (N b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Envelope (V b) (N b)) -> [b] -> [Envelope (V b) (N b)]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Envelope (V b) (N b)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope ([b] -> [Envelope (V b) (N b)])
    -> (Set b -> [b]) -> Set b -> [Envelope (V b) (N b)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set b -> [b]
    forall a. Set a -> [a]
    S.elems

    ------------------------------------------------------------
    --  Computing with envelopes
    ------------------------------------------------------------

    -- | Compute the vector from the local origin to a separating
    --   hyperplane in the given direction, or @Nothing@ for the empty
    --   envelope.
    envelopeVMay :: Enveloped a => Vn a -> a -> Maybe (Vn a)
    envelopeVMay :: forall a. Enveloped a => Vn a -> a -> Maybe (Vn a)
    envelopeVMay Vn a
    v = ((Vn a -> N a) -> Vn a) -> Maybe (Vn a -> N a) -> Maybe (Vn a)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((N a -> Vn a -> Vn a
    forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
    *^ Vn a
    v) (N a -> Vn a) -> ((Vn a -> N a) -> N a) -> (Vn a -> N a) -> Vn a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Vn a -> N a) -> Vn a -> N a
    forall a b. (a -> b) -> a -> b
    $ Vn a
    v)) (Maybe (Vn a -> N a) -> Maybe (Vn a))
    -> (a -> Maybe (Vn a -> N a)) -> a -> Maybe (Vn a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Envelope (V a) (N a) -> Maybe (Vn a -> N a)
    forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
    appEnvelope (Envelope (V a) (N a) -> Maybe (Vn a -> N a))
    -> (a -> Envelope (V a) (N a)) -> a -> Maybe (Vn a -> N a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Envelope (V a) (N a)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope

    -- | Compute the vector from the local origin to a separating
    --   hyperplane in the given direction.  Returns the zero vector for
    --   the empty envelope.
    envelopeV :: Enveloped a => Vn a -> a -> Vn a
    envelopeV :: forall a. Enveloped a => Vn a -> a -> Vn a
    envelopeV Vn a
    v = Vn a -> Maybe (Vn a) -> Vn a
    forall a. a -> Maybe a -> a
    fromMaybe Vn a
    forall a. Num a => V a a
    forall (f :: * -> *) a. (Additive f, Num a) => f a
    zero (Maybe (Vn a) -> Vn a) -> (a -> Maybe (Vn a)) -> a -> Vn a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vn a -> a -> Maybe (Vn a)
    forall a. Enveloped a => Vn a -> a -> Maybe (Vn a)
    envelopeVMay Vn a
    v

    -- | Compute the point on a separating hyperplane in the given
    --   direction, or @Nothing@ for the empty envelope.
    envelopePMay :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe (Point v n)
    envelopePMay :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> Maybe (Point v n)
    envelopePMay v n
    v = (v n -> Point v n) -> Maybe (v n) -> Maybe (Point v n)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap v n -> Point v n
    forall (f :: * -> *) a. f a -> Point f a
    P (Maybe (v n) -> Maybe (Point v n))
    -> (a -> Maybe (v n)) -> a -> Maybe (Point v n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vn a -> a -> Maybe (Vn a)
    forall a. Enveloped a => Vn a -> a -> Maybe (Vn a)
    envelopeVMay v n
    Vn a
    v

    -- | Compute the point on a separating hyperplane in the given
    --   direction.  Returns the origin for the empty envelope.
    envelopeP :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Point v n
    envelopeP :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> Point v n
    envelopeP v n
    v = v n -> Point v n
    forall (f :: * -> *) a. f a -> Point f a
    P (v n -> Point v n) -> (a -> v n) -> a -> Point v n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vn a -> a -> Vn a
    forall a. Enveloped a => Vn a -> a -> Vn a
    envelopeV v n
    Vn a
    v

    -- | Equivalent to the norm of 'envelopeVMay':
    --
    --   @ envelopeSMay v x == fmap norm (envelopeVMay v x) @
    --
    --   (other than differences in rounding error)
    --
    --   Note that the 'envelopeVMay' / 'envelopePMay' functions above should be
    --   preferred, as this requires a call to norm.  However, it is more
    --   efficient than calling norm on the results of those functions.
    envelopeSMay :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe n
    envelopeSMay :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> Maybe n
    envelopeSMay v n
    v = ((v n -> n) -> n) -> Maybe (v n -> n) -> Maybe n
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((n -> n -> n
    forall a. Num a => a -> a -> a
    * v n -> n
    forall a. Floating a => v a -> a
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
    norm v n
    v) (n -> n) -> ((v n -> n) -> n) -> (v n -> n) -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((v n -> n) -> v n -> n
    forall a b. (a -> b) -> a -> b
    $ v n
    v)) (Maybe (v n -> n) -> Maybe n)
    -> (a -> Maybe (v n -> n)) -> a -> Maybe n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Envelope v n -> Maybe (v n -> n)
    forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
    appEnvelope (Envelope v n -> Maybe (v n -> n))
    -> (a -> Envelope v n) -> a -> Maybe (v n -> n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Envelope v n
    a -> Envelope (V a) (N a)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope

    -- | Equivalent to the norm of 'envelopeV':
    --
    --   @ envelopeS v x == norm (envelopeV v x) @
    --
    --   (other than differences in rounding error)
    --
    --   Note that the 'envelopeV' / 'envelopeP' functions above should be
    --   preferred, as this requires a call to norm. However, it is more
    --   efficient than calling norm on the results of those functions.
    envelopeS :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n
    envelopeS :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> n
    envelopeS v n
    v = n -> Maybe n -> n
    forall a. a -> Maybe a -> a
    fromMaybe n
    0 (Maybe n -> n) -> (a -> Maybe n) -> a -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v n -> a -> Maybe n
    forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> Maybe n
    envelopeSMay v n
    v

    -- | Compute the diameter of a enveloped object along a particular
    --   vector.  Returns zero for the empty envelope.
    diameter :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n
    diameter :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> n
    diameter v n
    v a
    a = n -> ((n, n) -> n) -> Maybe (n, n) -> n
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe n
    0 (\(n
    lo,n
    hi) -> (n
    hi n -> n -> n
    forall a. Num a => a -> a -> a
    - n
    lo) n -> n -> n
    forall a. Num a => a -> a -> a
    * v n -> n
    forall a. Floating a => v a -> a
    forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
    norm v n
    v) (v n -> a -> Maybe (n, n)
    forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> Maybe (n, n)
    extent v n
    v a
    a)

    -- | Compute the \"radius\" (1\/2 the diameter) of an enveloped object
    --   along a particular vector.
    radius :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> n
    radius :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> n
    radius v n
    v = (n
    0.5n -> n -> n
    forall a. Num a => a -> a -> a
    *) (n -> n) -> (a -> n) -> a -> n
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v n -> a -> n
    forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> n
    diameter v n
    v

    -- | Compute the range of an enveloped object along a certain
    --   direction.  Returns a pair of scalars @(lo,hi)@ such that the
    --   object extends from @(lo *^ v)@ to @(hi *^ v)@. Returns @Nothing@
    --   for objects with an empty envelope.
    extent :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Maybe (n, n)
    extent :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> Maybe (n, n)
    extent v n
    v a
    a = (\v n -> n
    f -> (-v n -> n
    f (v n -> v n
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
    negated v n
    v), v n -> n
    f v n
    v)) ((v n -> n) -> (n, n)) -> Maybe (v n -> n) -> Maybe (n, n)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Envelope v n -> Maybe (v n -> n)
    forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
    appEnvelope (Envelope v n -> Maybe (v n -> n))
    -> (a -> Envelope v n) -> a -> Maybe (v n -> n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Envelope v n
    a -> Envelope (V a) (N a)
    forall a. Enveloped a => a -> Envelope (V a) (N a)
    getEnvelope (a -> Maybe (v n -> n)) -> a -> Maybe (v n -> n)
    forall a b. (a -> b) -> a -> b
    $ a
    a)

    -- | The smallest positive /axis-parallel/ vector that bounds the
    --   envelope of an object.
    size :: (V a ~ v, N a ~ n, Enveloped a, HasBasis v) => a -> v n
    size :: forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a, HasBasis v) =>
    a -> v n
    size a
    d = (Rep v -> n) -> v n
    forall a. (Rep v -> a) -> v a
    forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
    tabulate ((Rep v -> n) -> v n) -> (Rep v -> n) -> v n
    forall a b. (a -> b) -> a -> b
    $ \(E forall x. Lens' (v x) x
    l) -> v n -> a -> n
    forall a (v :: * -> *) n.
    (V a ~ v, N a ~ n, Enveloped a) =>
    v n -> a -> n
    diameter (v n
    forall a. Num a => v a
    forall (f :: * -> *) a. (Additive f, Num a) => f a
    zero v n -> (v n -> v n) -> v n
    forall a b. a -> (a -> b) -> b
    & (n -> Identity n) -> v n -> Identity (v n)
    forall x. Lens' (v x) x
    l ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ n
    1) a
    d