```{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses
, UndecidableInstances, TypeOperators, TypeSynonymInstances
, TypeFamilies
#-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}  -- Vector2
----------------------------------------------------------------------
-- |
-- Module      :  Vector2
-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
--
-- Maintainer  :  conal@conal.net, andygill@ku.edu
-- Stability   :  experimental
--
-- Vectors in 2D.  Uses the OpenGL 'Vector2' type, for convenience and
-- efficiency.
----------------------------------------------------------------------

module Graphics.FieldTrip.Vector2
(
Vector2(..), vector2x, vector2y
, xVector2, yVector2
, vector2Polar
, vector2PolarCoords
, vector2D, unvector2D
) where

import Control.Applicative

import Graphics.Rendering.OpenGL.GL.CoordTrans (Vector2(..))

import Data.VectorSpace
import Data.MemoTrie
import Data.Basis
import Data.Derivative
import Data.Cross

-- | The unit vector in the positive X direction.
xVector2 :: Num s => Vector2 s
xVector2 = Vector2 1 0

-- | The unit vector in the positive Y direction.
yVector2 :: Num s => Vector2 s
yVector2 = Vector2 0 1

vector2x, vector2y :: Vector2 s -> s
vector2x (Vector2 x _) = x
vector2y (Vector2 _ y) = y

vector2Polar :: Floating s => s -> s -> Vector2 s
vector2Polar rho theta = Vector2 (rho * cos theta) (rho * sin theta)

vector2PolarCoords :: (InnerSpace s s, Floating s) => Vector2 s -> (s,s)
vector2PolarCoords v@(Vector2 x y) = (rho, theta)
where
rho   = magnitude v
theta = atan (y/x)  -- in case (==) is not defined, as in (a:>b)
-- if x == 0 then 0 else atan (y/x)

instance Functor Vector2 where
fmap f (Vector2 x y)          = Vector2 (f x) (f y)

instance Applicative Vector2 where
pure x                        = Vector2 x x
Vector2 f g <*> Vector2 x y   = Vector2 (f x) (g y)

-- TODO: is UndecidableInstances still necessary?

zeroV                         = Vector2 zeroV zeroV
Vector2 u v ^+^ Vector2 u' v' = Vector2 (u^+^u') (v^+^v')
negateV (Vector2 u v)         = Vector2 (negateV u) (negateV v)

instance (VectorSpace u s) => VectorSpace (Vector2 u) s where
s *^ Vector2 u v            = Vector2 (s*^u) (s*^v)

instance (InnerSpace u s, AdditiveGroup s)
=> InnerSpace (Vector2 u) s where
Vector2 u v <.> Vector2 u' v' = u<.>u' ^+^ v<.>v'

instance HasBasis u s => HasBasis (Vector2 u) s where
type Basis (Vector2 u) = Basis (u,u)
basisValue             = toV2 . basisValue
decompose              = decompose  . fromV2
decompose'             = decompose' . fromV2

toV2 :: (u,u) -> Vector2 u
toV2 (u,v) = Vector2 u v

fromV2 :: Vector2 u -> (u,u)
fromV2 (Vector2 u v) = (u,v)

instance Num s => HasCross2 (Vector2 s) where
cross2 (Vector2 x y) = Vector2 (-y) x  -- or @Vector2 (-y) x@?

-- instance (Num s, LMapDom s s) => HasNormal (s :> Vector2 s) where
--   normalVec v = cross2 (derivativeAt v 1)

instance HasNormal (Float :> Vector2 Float) where
normalVec v = cross2 (derivative v `untrie` ())

-- instance HasNormal (One Double :> Two Double) where
--   normalVec v = cross2 (derivative v `untrie` ())

vector2D :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s) =>
Two (a :> s) -> a :> (Vector2 s)
vector2D (u,v) = liftD2 Vector2 u v

unvector2D :: (HasBasis a s, HasTrie (Basis a), VectorSpace s s) =>
a :> (Vector2 s) -> Two (a :> s)
unvector2D d = (vector2x <\$>> d, vector2y <\$>> d)
```