    {-# LANGUAGE ConstraintKinds       #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE UndecidableInstances  #-}

    -- The UndecidableInstances flag is needed under 6.12.3 for the
    -- HasOrigin (a,b) instance.

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Core.HasOrigin
    -- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Types which have an intrinsic notion of a \"local origin\",
    -- /i.e./ things which are /not/ invariant under translation.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Core.HasOrigin
           ( HasOrigin(..), moveOriginBy, moveTo, place
           ) where

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

    import           Diagrams.Core.Measure
    import           Diagrams.Core.Points  ()
    import           Diagrams.Core.V

    import           Linear.Affine
    import           Linear.Vector

    -- | Class of types which have an intrinsic notion of a \"local
    --   origin\", i.e. things which are not invariant under translation,
    --   and which allow the origin to be moved.
    --
    --   One might wonder why not just use 'Transformable' instead of
    --   having a separate class for 'HasOrigin'; indeed, for types which
    --   are instances of both we should have the identity
    --
    --   @
    --   moveOriginTo (origin .^+ v) === translate (negated v)
    --   @
    --
    --   The reason is that some things (e.g. vectors, 'Trail's) are
    --   transformable but are translationally invariant, i.e. have no
    --   origin.
    class HasOrigin t where

      -- | Move the local origin to another point.
      --
      --   Note that this function is in some sense dual to 'translate'
      --   (for types which are also 'Transformable'); moving the origin
      --   itself while leaving the object \"fixed\" is dual to fixing the
      --   origin and translating the diagram.
      moveOriginTo :: Point (V t) (N t) -> t -> t

    -- | Move the local origin by a relative vector.
    moveOriginBy :: (V t ~ v, N t ~ n, HasOrigin t) => v n -> t -> t
    moveOriginBy :: forall t (v :: * -> *) n.
    (V t ~ v, N t ~ n, HasOrigin t) =>
    v n -> t -> t
    moveOriginBy = Point v n -> t -> t
    Point (V t) (N t) -> t -> t
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo (Point v n -> t -> t) -> (v n -> Point v n) -> v n -> t -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . v n -> Point v n
    forall (f :: * -> *) a. f a -> Point f a
    P

    -- | Translate the object by the translation that sends the origin to
    --   the given point. Note that this is dual to 'moveOriginTo', i.e. we
    --   should have
    --
    --   @
    --   moveTo (origin .^+ v) === moveOriginTo (origin .^- v)
    --   @
    --
    --   For types which are also 'Transformable', this is essentially the
    --   same as 'translate', i.e.
    --
    --   @
    --   moveTo (origin .^+ v) === translate v
    --   @
    moveTo :: (InSpace v n t, HasOrigin t) => Point v n -> t -> t
    moveTo :: forall (v :: * -> *) n t.
    (InSpace v n t, HasOrigin t) =>
    Point v n -> t -> t
    moveTo = v n -> t -> t
    forall t (v :: * -> *) n.
    (V t ~ v, N t ~ n, HasOrigin t) =>
    v n -> t -> t
    moveOriginBy (v n -> t -> t) -> (Point v n -> v n) -> Point v n -> t -> t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Point v n
    forall (f :: * -> *) a. (Additive f, Num a) => Point f a
    origin Point v n -> Point v n -> Diff (Point v) n
    forall a. Num a => Point v a -> Point v a -> Diff (Point v) a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
    .-.)

    -- | A flipped variant of 'moveTo', provided for convenience.  Useful
    --   when writing a function which takes a point as an argument, such
    --   as when using 'withName' and friends.
    place :: (InSpace v n t, HasOrigin t) => t -> Point v n -> t
    place :: forall (v :: * -> *) n t.
    (InSpace v n t, HasOrigin t) =>
    t -> Point v n -> t
    place = (Point v n -> t -> t) -> t -> Point v n -> t
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Point v n -> t -> t
    forall (v :: * -> *) n t.
    (InSpace v n t, HasOrigin t) =>
    Point v n -> t -> t
    moveTo

    instance HasOrigin t => HasOrigin (Measured n t) where
      moveOriginTo :: Point (V (Measured n t)) (N (Measured n t))
    -> Measured n t -> Measured n t
    moveOriginTo = (t -> t) -> Measured n t -> Measured n t
    forall a b. (a -> b) -> Measured n a -> Measured n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((t -> t) -> Measured n t -> Measured n t)
    -> (Point (V t) (N t) -> t -> t)
    -> Point (V t) (N t)
    -> Measured n t
    -> Measured n t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point (V t) (N t) -> t -> t
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo

    instance (Additive v, Num n) => HasOrigin (Point v n) where
      moveOriginTo :: Point (V (Point v n)) (N (Point v n)) -> Point v n -> Point v n
    moveOriginTo (P V (Point v n) (N (Point v n))
    u) Point v n
    p = Point v n
    p Point v n -> Diff (Point v) n -> Point v n
    forall a. Num a => Point v a -> Diff (Point v) a -> Point v a
    forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
    .-^ Diff (Point v) n
    V (Point v n) (N (Point v n))
    u

    instance (HasOrigin t, HasOrigin s, SameSpace s t) => HasOrigin (s, t) where
      moveOriginTo :: Point (V (s, t)) (N (s, t)) -> (s, t) -> (s, t)
    moveOriginTo Point (V (s, t)) (N (s, t))
    p (s
    x,t
    y) = (Point (V s) (N s) -> s -> s
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo Point (V s) (N s)
    Point (V (s, t)) (N (s, t))
    p s
    x, Point (V t) (N t) -> t -> t
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo Point (V t) (N t)
    Point (V (s, t)) (N (s, t))
    p t
    y)

    instance HasOrigin t => HasOrigin [t] where
      moveOriginTo :: Point (V [t]) (N [t]) -> [t] -> [t]
    moveOriginTo = (t -> t) -> [t] -> [t]
    forall a b. (a -> b) -> [a] -> [b]
    map ((t -> t) -> [t] -> [t])
    -> (Point (V t) (N t) -> t -> t) -> Point (V t) (N t) -> [t] -> [t]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point (V t) (N t) -> t -> t
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo

    instance (HasOrigin t, Ord t) => HasOrigin (S.Set t) where
      moveOriginTo :: Point (V (Set t)) (N (Set t)) -> Set t -> Set t
    moveOriginTo = (t -> t) -> Set t -> Set t
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map ((t -> t) -> Set t -> Set t)
    -> (Point (V t) (N t) -> t -> t)
    -> Point (V t) (N t)
    -> Set t
    -> Set t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point (V t) (N t) -> t -> t
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo

    instance HasOrigin t => HasOrigin (M.Map k t) where
      moveOriginTo :: Point (V (Map k t)) (N (Map k t)) -> Map k t -> Map k t
    moveOriginTo = (t -> t) -> Map k t -> Map k t
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map ((t -> t) -> Map k t -> Map k t)
    -> (Point (V t) (N t) -> t -> t)
    -> Point (V t) (N t)
    -> Map k t
    -> Map k t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Point (V t) (N t) -> t -> t
    forall t. HasOrigin t => Point (V t) (N t) -> t -> t
    moveOriginTo