    {-# LANGUAGE ConstrainedClassMethods     #-}
    {-# LANGUAGE FlexibleContexts     #-}
    {-# LANGUAGE TypeFamilies         #-}
    {-# LANGUAGE UndecidableInstances #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Align
    -- Copyright   :  (c) 2011-2013 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- The /alignment/ of an object refers to the position of its local
    -- origin with respect to its envelope.  This module defines the
    -- 'Alignable' class for things which can be aligned, as well as a
    -- default implementation in terms of 'HasOrigin' and 'Enveloped',
    -- along with several utility methods for alignment.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Align
           ( -- * Alignable class

             Alignable(..)
           , alignBy'Default
           , envelopeBoundary
           , traceBoundary

             -- * General alignment functions

           , align
           , snug
           , centerV, center
           , snugBy
           , snugCenterV, snugCenter

           ) where

    import           Diagrams.Core
    import           Diagrams.Util    (applyAll)

    import           Data.Maybe       (fromMaybe)
    import           Data.Ord         (comparing)
    import           Data.Traversable
    import           Prelude

    import qualified Data.Foldable    as F
    import qualified Data.Map         as M
    import qualified Data.Set         as S

    import           Linear.Affine
    import           Linear.Metric
    import           Linear.Vector

    -- | Class of things which can be aligned.
    class Alignable a where

      -- | @alignBy v d a@ moves the origin of @a@ along the vector
      --   @v@. If @d = 1@, the origin is moved to the edge of the
      --   boundary in the direction of @v@; if @d = -1@, it moves to the
      --   edge of the boundary in the direction of the negation of @v@.
      --   Other values of @d@ interpolate linearly (so for example, @d =
      --   0@ centers the origin along the direction of @v@).
      alignBy' :: (InSpace v n a, Fractional n, HasOrigin a)
               => (v n -> a -> Point v n) -> v n -> n -> a -> a
      alignBy' = alignBy'Default

      defaultBoundary :: (V a ~ v, N a ~ n) => v n -> a -> Point v n

      alignBy :: (InSpace v n a, Fractional n, HasOrigin a)
              => v n -> n -> a -> a
      alignBy = alignBy' defaultBoundary

    -- | Default implementation of 'alignBy' for types with 'HasOrigin'
    --   and 'AdditiveGroup' instances.
    alignBy'Default :: (InSpace v n a, Fractional n, HasOrigin a)
                    => (v n -> a -> Point v n) -> v n -> n -> a -> a
    alignBy'Default boundary v d a = moveOriginTo (lerp ((d + 1) / 2)
                                                        (boundary v a)
                                                        (boundary (negated v) a)
                                                  ) a
    {-# ANN alignBy'Default ("HLint: ignore Use camelCase" :: String) #-}

    -- | Some standard functions which can be used as the `boundary` argument to
    --  `alignBy'`.
    envelopeBoundary :: (V a ~ v, N a ~ n, Enveloped a) => v n -> a -> Point v n
    envelopeBoundary = envelopeP

    traceBoundary :: (V a ~ v, N a ~ n, Num n, Traced a) => v n -> a -> Point v n
    traceBoundary v a = fromMaybe origin (maxTraceP origin v a)

    combineBoundaries
      :: (InSpace v n a, Metric v, Ord n, F.Foldable f)
      => (v n -> a -> Point v n) -> v n -> f a -> Point v n
    combineBoundaries b v fa
        = b v $ F.maximumBy (comparing (quadrance . (.-. origin) . b v)) fa

    instance (Metric v, OrderedField n) => Alignable (Envelope v n) where
      defaultBoundary = envelopeBoundary

    instance (Metric v, OrderedField n) => Alignable (Trace v n) where
      defaultBoundary = traceBoundary

    instance (V b ~ v, N b ~ n, Metric v, OrderedField n, Alignable b) => Alignable [b] where
      defaultBoundary = combineBoundaries defaultBoundary

    instance (V b ~ v, N b ~ n, Metric v, OrderedField n, Alignable b)
        => Alignable (S.Set b) where
      defaultBoundary = combineBoundaries defaultBoundary

    instance (V b ~ v, N b ~ n, Metric v, OrderedField n, Alignable b)
        => Alignable (M.Map k b) where
      defaultBoundary = combineBoundaries defaultBoundary

    instance (Metric v, OrderedField n, Monoid' m)
        => Alignable (QDiagram b v n m) where
      defaultBoundary = envelopeBoundary

    -- | Although the 'alignBy' method for the @(b -> a)@ instance is
    --   sensible, there is no good implementation for
    --   'defaultBoundary'. Instead, we provide a total method, but one that
    --   is not sensible. This should not present a serious problem as long
    --   as your use of 'Alignable' happens through 'alignBy'.
    instance (InSpace v n a, HasOrigin a, Alignable a) => Alignable (b -> a) where
      alignBy v d f b     = alignBy v d (f b)
      defaultBoundary _ _ = origin

    -- | @align v@ aligns an enveloped object along the edge in the
    --   direction of @v@.  That is, it moves the local origin in the
    --   direction of @v@ until it is on the edge of the envelope.  (Note
    --   that if the local origin is outside the envelope to begin with,
    --   it may have to move \"backwards\".)
    align :: (InSpace v n a, Fractional n, Alignable a, HasOrigin a) => v n -> a -> a
    align v = alignBy v 1

    -- | Version of @alignBy@ specialized to use @traceBoundary@
    snugBy :: (InSpace v n a, Fractional n, Alignable a, Traced a, HasOrigin a)
           => v n -> n -> a -> a
    snugBy = alignBy' traceBoundary

    -- | Like align but uses trace.
    snug :: (InSpace v n a, Fractional n, Alignable a, Traced a, HasOrigin a)
          => v n -> a -> a
    snug v = snugBy v 1

    -- | @centerV v@ centers an enveloped object along the direction of
    --   @v@.
    centerV :: (InSpace v n a, Fractional n, Alignable a, HasOrigin a) => v n -> a -> a
    centerV v = alignBy v 0

    -- | @center@ centers an enveloped object along all of its basis vectors.
    center :: (InSpace v n a, Fractional n, Traversable v, Alignable a, HasOrigin a) => a -> a
    center = applyAll fs
      where
        fs = map centerV basis

    -- | Like @centerV@ using trace.
    snugCenterV
      :: (InSpace v n a, Fractional n, Alignable a, Traced a, HasOrigin a)
       => v n -> a -> a
    snugCenterV v = alignBy' traceBoundary v 0

    -- | Like @center@ using trace.
    snugCenter :: (InSpace v n a, Traversable v, Fractional n, Alignable a, HasOrigin a, Traced a)
               => a -> a
    snugCenter = applyAll fs
      where
        fs = map snugCenterV basis

    {-# ANN module ("HLint: ignore Use camelCase" :: String) #-}