    {-# LANGUAGE DefaultSignatures    #-}
    {-# LANGUAGE FlexibleContexts     #-}
    {-# LANGUAGE TypeFamilies         #-}
    {-# LANGUAGE UndecidableInstances #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Parametric
    -- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Type classes for things which are parameterized in some way, /e.g./
    -- segments and trails.
    --
    -----------------------------------------------------------------------------
    module Diagrams.Parametric
      (
        stdTolerance
      , Codomain, Parametric(..)

      , DomainBounds(..), domainBounds, EndValues(..), Sectionable(..), HasArcLength(..)

      ) where

    import           Diagrams.Core.V
    import qualified Numeric.Interval.Kaucher as I

    -- | Codomain of parametric classes.  This is usually either @(V p)@, for relative
    --   vector results, or @(Point (V p))@, for functions with absolute coordinates.
    type family Codomain p :: * -> *

    -- | Type class for parametric functions.
    class Parametric p where

      -- | 'atParam' yields a parameterized view of an object as a
      --   continuous function. It is designed to be used infix, like @path
      --   ``atParam`` 0.5@.
      atParam :: p -> N p -> Codomain p (N p)

    -- | Type class for parametric functions with a bounded domain.  The
    --   default bounds are @[0,1]@.
    --
    --   Note that this domain indicates the main \"interesting\" portion of the
    --   function.  It must be defined within this range, but for some instances may
    --   still have sensible values outside.
    class DomainBounds p where
      -- | 'domainLower' defaults to being constantly 0 (for vector spaces with
      --   numeric scalars).
      domainLower :: p -> N p

      default domainLower :: Num (N p) => p -> N p
      domainLower = const 0

      -- | 'domainUpper' defaults to being constantly 1 (for vector spaces
      --   with numeric scalars).
      domainUpper :: p -> N p

      default domainUpper :: Num (N p) => p -> N p
      domainUpper = const 1

    -- | Type class for querying the values of a parametric object at the
    --   ends of its domain.
    class (Parametric p, DomainBounds p) => EndValues p where
      -- | 'atStart' is the value at the start of the domain.  That is,
      --
      --   > atStart x = x `atParam` domainLower x
      --
      --   This is the default implementation, but some representations will
      --   have a more efficient and/or precise implementation.
      atStart :: p -> Codomain p (N p)
      atStart x = x `atParam` domainLower x

      -- | 'atEnd' is the value at the end of the domain. That is,
      --
      --   > atEnd x = x `atParam` domainUpper x
      --
      --   This is the default implementation, but some representations will
      --   have a more efficient and/or precise implementation.
      atEnd :: p -> Codomain p (N p)
      atEnd x = x `atParam` domainUpper x

    -- | Return the lower and upper bounds of a parametric domain together
    --   as a pair.
    domainBounds :: DomainBounds p => p -> (N p, N p)
    domainBounds x = (domainLower x, domainUpper x)

    -- | Type class for parametric objects which can be split into
    --   subobjects.
    --
    --   Minimal definition: Either 'splitAtParam' or 'section',
    --   plus 'reverseDomain'.
    class DomainBounds p => Sectionable p where
      -- | 'splitAtParam' splits an object @p@ into two new objects
      --   @(l,r)@ at the parameter @t@, where @l@ corresponds to the
      --   portion of @p@ for parameter values from @0@ to @t@ and @r@ for
      --   to that from @t@ to @1@.  The following property should hold:
      --
      -- @
      --   prop_splitAtParam f t u =
      --     | u < t     = atParam f u == atParam l (u / t)
      --     | otherwise = atParam f u == atParam f t ??? atParam l ((u - t) / (domainUpper f - t))
      --     where (l,r) = splitAtParam f t
      -- @
      --
      --   where @(???) = (^+^)@ if the codomain is a vector type, or
      --   @const flip@ if the codomain is a point type.  Stated more
      --   intuitively, all this is to say that the parameterization
      --   scales linearly with splitting.
      --
      --   'splitAtParam' can also be used with parameters outside the
      --   range of the domain.  For example, using the parameter @2@ with
      --   a path (where the domain is the default @[0,1]@) gives two
      --   result paths where the first is the original path extended to
      --   the parameter 2, and the second result path travels /backwards/
      --   from the end of the first to the end of the original path.
      splitAtParam :: p -> N p -> (p, p)
      splitAtParam x t
        = ( section x (domainLower x) t
          , section x t (domainUpper x))

      -- | Extract a particular section of the domain, linearly
      --   reparameterized to the same domain as the original.  Should
      --   satisfy the property:
      --
      -- > prop_section x l u t =
      -- >   let s = section x l u
      -- >   in     domainBounds x == domainBounds x
      -- >       && (x `atParam` lerp l u t) == (s `atParam` t)
      --
      --   That is, the section should have the same domain as the
      --   original, and the reparameterization should be linear.
      section :: p -> N p -> N p -> p
      default section :: Fractional (N p) => p -> N p -> N p -> p
      section x t1 t2 = snd (splitAtParam (fst (splitAtParam x t2)) (t1/t2))

      -- | Flip the parameterization on the domain.
      reverseDomain :: p -> p

    -- | The standard tolerance used by @std...@ functions (like
    --   'stdArcLength' and 'stdArcLengthToParam', currently set at
    --   @1e-6@.
    stdTolerance :: Fractional a => a
    stdTolerance = 1e-6

    -- | Type class for parametric things with a notion of arc length.
    class Parametric p => HasArcLength p where

      -- | @arcLengthBounded eps x@ approximates the arc length of @x@.
      --   The true arc length is guaranteed to lie within the interval
      --   returned, which will have a size of at most @eps@.
      arcLengthBounded :: N p -> p -> I.Interval (N p)

      -- | @arcLength eps s@ approximates the arc length of @x@ up to the
      --   accuracy @eps@ (plus or minus).
      arcLength :: N p -> p -> N p
      default arcLength :: Fractional (N p) => N p -> p -> N p
      arcLength eps = I.midpoint . arcLengthBounded eps

      -- | Approximate the arc length up to a standard accuracy of
      --   'stdTolerance' (@1e-6@).
      stdArcLength :: p -> N p
      default stdArcLength :: Fractional (N p) => p -> N p
      stdArcLength = arcLength stdTolerance

      -- | @'arcLengthToParam' eps s l@ converts the absolute arc length
      --   @l@, measured from the start of the domain, to a parameter on
      --   the object @s@.  The true arc length at the parameter returned
      --   is guaranteed to be within @eps@ of the requested arc length.
      --
      --   This should work for /any/ arc length, and may return any
      --   parameter value (not just parameters in the domain).
      arcLengthToParam :: N p -> p -> N p -> N p

      -- | A simple interface to convert arc length to a parameter,
      --   guaranteed to be accurate within 'stdTolerance', or @1e-6@.
      stdArcLengthToParam :: p -> N p -> N p
      default stdArcLengthToParam :: Fractional (N p) => p -> N p -> N p
      stdArcLengthToParam = arcLengthToParam stdTolerance