{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Coordinates
-- Copyright   :  (c) 2012 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Nice syntax for constructing and pattern-matching on literal
-- points and vectors.
--
-----------------------------------------------------------------------------

module Diagrams.Coordinates
    ( (:&)(..), Coordinates(..)
    )
    where

import           Data.Kind       (Type)
import           Diagrams.Points
import           Linear          (V2 (..), V3 (..), V4 (..))

-- | Types which are instances of the @Coordinates@ class can be
--   constructed using '^&' (for example, a three-dimensional vector
--   could be constructed by @1 ^& 6 ^& 3@), and deconstructed using
--   'coords'.  A common pattern is to use 'coords' in conjunction
--   with the @ViewPatterns@ extension, like so:
--
-- @
-- foo :: Vector3 -> ...
-- foo (coords -> x :& y :& z) = ...
-- @
class Coordinates c where

  -- | The type of the final coordinate.
  type FinalCoord c    :: Type

  -- | The type of everything other than the final coordinate.
  type PrevDim c       :: Type

  -- | Decomposition of @c@ into applications of ':&'.
  type Decomposition c :: Type
    -- Decomposition c = Decomposition (PrevDim c) :& FinalCoord c  (essentially)

  -- | Construct a value of type @c@ by providing something of one
  --   less dimension (which is perhaps itself recursively constructed
  --   using @(^&)@) and a final coordinate.  For example,
  --
  -- @
  -- 2 ^& 3 :: P2
  -- 3 ^& 5 ^& 6 :: V3
  -- @
  --
  --   Note that @^&@ is left-associative.
  (^&)    :: PrevDim c -> FinalCoord c -> c

  -- | Prefix synonym for @^&@. pr stands for pair of @PrevDim@, @FinalCoord@
  pr      :: PrevDim c -> FinalCoord c -> c
  pr = forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
(^&)

  -- | Decompose a value of type @c@ into its constituent coordinates,
  --   stored in a nested @(:&)@ structure.
  coords :: c -> Decomposition c

infixl 7 ^&

-- | A pair of values, with a convenient infix (left-associative)
--   data constructor.
data a :& b = a :& b
  deriving ((a :& b) -> (a :& b) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
/= :: (a :& b) -> (a :& b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
== :: (a :& b) -> (a :& b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
Eq, (a :& b) -> (a :& b) -> Bool
(a :& b) -> (a :& b) -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (a :& b)
forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> Bool
forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> Ordering
forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> a :& b
min :: (a :& b) -> (a :& b) -> a :& b
$cmin :: forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> a :& b
max :: (a :& b) -> (a :& b) -> a :& b
$cmax :: forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> a :& b
>= :: (a :& b) -> (a :& b) -> Bool
$c>= :: forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> Bool
> :: (a :& b) -> (a :& b) -> Bool
$c> :: forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> Bool
<= :: (a :& b) -> (a :& b) -> Bool
$c<= :: forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> Bool
< :: (a :& b) -> (a :& b) -> Bool
$c< :: forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> Bool
compare :: (a :& b) -> (a :& b) -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => (a :& b) -> (a :& b) -> Ordering
Ord, Int -> (a :& b) -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a :& b) -> ShowS
forall a b. (Show a, Show b) => [a :& b] -> ShowS
forall a b. (Show a, Show b) => (a :& b) -> String
showList :: [a :& b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [a :& b] -> ShowS
show :: (a :& b) -> String
$cshow :: forall a b. (Show a, Show b) => (a :& b) -> String
showsPrec :: Int -> (a :& b) -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a :& b) -> ShowS
Show)

infixl 7 :&

-- Instance for :& (the buck stops here)
instance Coordinates (a :& b) where
  type FinalCoord (a :& b) = b
  type PrevDim (a :& b) = a
  type Decomposition (a :& b) = a :& b
  PrevDim (a :& b)
x ^& :: PrevDim (a :& b) -> FinalCoord (a :& b) -> a :& b
^& FinalCoord (a :& b)
y                    = PrevDim (a :& b)
x forall a b. a -> b -> a :& b
:& FinalCoord (a :& b)
y
  coords :: (a :& b) -> Decomposition (a :& b)
coords (a
x :& b
y)           = a
x forall a b. a -> b -> a :& b
:& b
y


-- Some standard instances for plain old tuples

instance Coordinates (a,b) where
  type FinalCoord (a,b)    = b
  type PrevDim (a,b)       = a
  type Decomposition (a,b) = a :& b

  PrevDim (a, b)
x ^& :: PrevDim (a, b) -> FinalCoord (a, b) -> (a, b)
^& FinalCoord (a, b)
y                   = (PrevDim (a, b)
x,FinalCoord (a, b)
y)
  coords :: (a, b) -> Decomposition (a, b)
coords (a
x,b
y)             = a
x forall a b. a -> b -> a :& b
:& b
y

instance Coordinates (a,b,c) where
  type FinalCoord (a,b,c)    = c
  type PrevDim (a,b,c)       = (a,b)
  type Decomposition (a,b,c) = Decomposition (a,b) :& c

  (a
x,b
y) ^& :: PrevDim (a, b, c) -> FinalCoord (a, b, c) -> (a, b, c)
^& FinalCoord (a, b, c)
z                  = (a
x,b
y,FinalCoord (a, b, c)
z)
  coords :: (a, b, c) -> Decomposition (a, b, c)
coords (a
x,b
y,c
z)             = forall c. Coordinates c => c -> Decomposition c
coords (a
x,b
y) forall a b. a -> b -> a :& b
:& c
z

instance Coordinates (a,b,c,d) where
  type FinalCoord (a,b,c,d)    = d
  type PrevDim (a,b,c,d)       = (a,b,c)
  type Decomposition (a,b,c,d) = Decomposition (a,b,c) :& d

  (a
w,b
x,c
y)  ^& :: PrevDim (a, b, c, d) -> FinalCoord (a, b, c, d) -> (a, b, c, d)
^& FinalCoord (a, b, c, d)
z                = (a
w,b
x,c
y,FinalCoord (a, b, c, d)
z)
  coords :: (a, b, c, d) -> Decomposition (a, b, c, d)
coords (a
w,b
x,c
y,d
z)             = forall c. Coordinates c => c -> Decomposition c
coords (a
w,b
x,c
y) forall a b. a -> b -> a :& b
:& d
z

instance Coordinates (v n) => Coordinates (Point v n) where
  type FinalCoord (Point v n)    = FinalCoord (v n)
  type PrevDim (Point v n)       = PrevDim (v n)
  type Decomposition (Point v n) = Decomposition (v n)

  PrevDim (Point v n)
x ^& :: PrevDim (Point v n) -> FinalCoord (Point v n) -> Point v n
^& FinalCoord (Point v n)
y       = forall (f :: * -> *) a. f a -> Point f a
P (PrevDim (Point v n)
x forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& FinalCoord (Point v n)
y)
  coords :: Point v n -> Decomposition (Point v n)
coords (P v n
v) = forall c. Coordinates c => c -> Decomposition c
coords v n
v

-- instances for linear

instance Coordinates (V2 n) where
  type FinalCoord (V2 n)    = n
  type PrevDim (V2 n)       = n
  type Decomposition (V2 n) = n :& n

  PrevDim (V2 n)
x ^& :: PrevDim (V2 n) -> FinalCoord (V2 n) -> V2 n
^& FinalCoord (V2 n)
y          = forall a. a -> a -> V2 a
V2 PrevDim (V2 n)
x FinalCoord (V2 n)
y
  coords :: V2 n -> Decomposition (V2 n)
coords (V2 n
x n
y) = n
x forall a b. a -> b -> a :& b
:& n
y

instance Coordinates (V3 n) where
  type FinalCoord (V3 n)    = n
  type PrevDim (V3 n)       = V2 n
  type Decomposition (V3 n) = n :& n :& n

  V2 n
x n
y ^& :: PrevDim (V3 n) -> FinalCoord (V3 n) -> V3 n
^& FinalCoord (V3 n)
z       = forall a. a -> a -> a -> V3 a
V3 n
x n
y FinalCoord (V3 n)
z
  coords :: V3 n -> Decomposition (V3 n)
coords (V3 n
x n
y n
z) = n
x forall a b. a -> b -> a :& b
:& n
y forall a b. a -> b -> a :& b
:& n
z

instance Coordinates (V4 n) where
  type FinalCoord (V4 n)    = n
  type PrevDim (V4 n)       = V3 n
  type Decomposition (V4 n) = n :& n :& n :& n

  V3 n
x n
y n
z ^& :: PrevDim (V4 n) -> FinalCoord (V4 n) -> V4 n
^& FinalCoord (V4 n)
w       = forall a. a -> a -> a -> a -> V4 a
V4 n
x n
y n
z FinalCoord (V4 n)
w
  coords :: V4 n -> Decomposition (V4 n)
coords (V4 n
x n
y n
z n
w) = n
x forall a b. a -> b -> a :& b
:& n
y forall a b. a -> b -> a :& b
:& n
z forall a b. a -> b -> a :& b
:& n
w