    {-# LANGUAGE ConstraintKinds       #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE UndecidableInstances  #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Core.Juxtapose
    -- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Things which can be placed \"next to\" other things, for some
    -- appropriate notion of \"next to\".
    --
    -----------------------------------------------------------------------------

    module Diagrams.Core.Juxtapose
           ( Juxtaposable(..), juxtaposeDefault
           ) where

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

    import           Diagrams.Core.Envelope
    import           Diagrams.Core.Measure
    import           Diagrams.Core.HasOrigin
    import           Diagrams.Core.V

    import           Linear.Metric
    import           Linear.Vector

    -- | Class of things which can be placed \"next to\" other things, for some
    --   appropriate notion of \"next to\".
    class Juxtaposable a where

      -- | @juxtapose v a1 a2@ positions @a2@ next to @a1@ in the
      --   direction of @v@.  In particular, place @a2@ so that @v@ points
      --   from the local origin of @a1@ towards the old local origin of
      --   @a2@; @a1@'s local origin becomes @a2@'s new local origin.  The
      --   result is just a translated version of @a2@.  (In particular,
      --   this operation does not /combine/ @a1@ and @a2@ in any way.)
      juxtapose :: Vn a -> a -> a -> a

    -- | Default implementation of 'juxtapose' for things which are
    --   instances of 'Enveloped' and 'HasOrigin'.  If either envelope is
    --   empty, the second object is returned unchanged.
    juxtaposeDefault :: (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
    juxtaposeDefault :: forall a. (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
    juxtaposeDefault Vn a
    v a
    a1 a
    a2 =
      case (Maybe (Vn a)
    mv1, Maybe (Vn a)
    mv2) of
        (Just Vn a
    v1, Just Vn a
    v2) -> Vn a -> a -> a
    forall t (v :: * -> *) n.
    (V t ~ v, N t ~ n, HasOrigin t) =>
    v n -> t -> t
    moveOriginBy (Vn a
    v1 Vn a -> Vn a -> Vn a
    forall a. Num a => V a a -> V a a -> V a a
    forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
    ^+^ Vn a
    v2) a
    a2
        (Maybe (Vn a), Maybe (Vn a))
    _                  -> a
    a2
      where mv1 :: Maybe (Vn a)
    mv1 = Vn a -> Vn a
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
    negated (Vn a -> Vn a) -> Maybe (Vn a) -> Maybe (Vn a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Vn a -> a -> Maybe (Vn a)
    forall a. Enveloped a => Vn a -> a -> Maybe (Vn a)
    envelopeVMay Vn a
    v a
    a1
            mv2 :: Maybe (Vn a)
    mv2 = Vn a -> a -> Maybe (Vn a)
    forall a. Enveloped a => Vn a -> a -> Maybe (Vn a)
    envelopeVMay (Vn a -> Vn a
    forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
    negated Vn a
    v) a
    a2

    instance (Metric v, OrderedField n) => Juxtaposable (Envelope v n) where
      juxtapose :: Vn (Envelope v n) -> Envelope v n -> Envelope v n -> Envelope v n
    juxtapose = Vn (Envelope v n) -> Envelope v n -> Envelope v n -> Envelope v n
    forall a. (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
    juxtaposeDefault

    instance (Enveloped a, HasOrigin a, Enveloped b, HasOrigin b, V a ~ V b, N a ~ N b)
             => Juxtaposable (a,b) where
      juxtapose :: Vn (a, b) -> (a, b) -> (a, b) -> (a, b)
    juxtapose = Vn (a, b) -> (a, b) -> (a, b) -> (a, b)
    forall a. (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
    juxtaposeDefault

    instance (Enveloped b, HasOrigin b) => Juxtaposable [b] where
      juxtapose :: Vn [b] -> [b] -> [b] -> [b]
    juxtapose = Vn [b] -> [b] -> [b] -> [b]
    forall a. (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
    juxtaposeDefault

    instance (Enveloped b, HasOrigin b) => Juxtaposable (M.Map k b) where
      juxtapose :: Vn (Map k b) -> Map k b -> Map k b -> Map k b
    juxtapose = Vn (Map k b) -> Map k b -> Map k b -> Map k b
    forall a. (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
    juxtaposeDefault

    instance (Enveloped b, HasOrigin b, Ord b) => Juxtaposable (S.Set b) where
      juxtapose :: Vn (Set b) -> Set b -> Set b -> Set b
    juxtapose = Vn (Set b) -> Set b -> Set b -> Set b
    forall a. (Enveloped a, HasOrigin a) => Vn a -> a -> a -> a
    juxtaposeDefault

    instance Juxtaposable a => Juxtaposable (b -> a) where
      juxtapose :: Vn (b -> a) -> (b -> a) -> (b -> a) -> b -> a
    juxtapose Vn (b -> a)
    v b -> a
    f1 b -> a
    f2 b
    b = Vn a -> a -> a -> a
    forall a. Juxtaposable a => Vn a -> a -> a -> a
    juxtapose Vn a
    Vn (b -> a)
    v (b -> a
    f1 b
    b) (b -> a
    f2 b
    b)

    instance Juxtaposable a => Juxtaposable (Measured n a) where
      juxtapose :: Vn (Measured n a) -> Measured n a -> Measured n a -> Measured n a
    juxtapose Vn (Measured n a)
    v = (a -> a -> a) -> Measured n a -> Measured n a -> Measured n a
    forall a b c.
    (a -> b -> c) -> Measured n a -> Measured n b -> Measured n c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (Vn a -> a -> a -> a
    forall a. Juxtaposable a => Vn a -> a -> a -> a
    juxtapose Vn a
    Vn (Measured n a)
    v)