{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# 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 :: 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 (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 (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)