{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Diagrams.Coordinates.Isomorphic
(
HasIndexedBasis, Euclidean
, VectorLike (..)
, V2Like, V3Like
, PointLike (..)
, P2Like, P3Like
)
where
import Control.Lens
import Data.Complex
import Data.Typeable
import Diagrams.Prelude
type HasIndexedBasis v = (HasBasis v, TraversableWithIndex (E v) v)
type Euclidean (v :: * -> *) = (HasLinearMap v, HasIndexedBasis v, Metric v)
class (Euclidean v, Typeable v) => VectorLike v n a | a -> v n where
vectorLike :: Iso' (v n) a
unvectorLike :: Iso' a (v n)
unvectorLike = from vectorLike
{-# INLINE unvectorLike #-}
instance VectorLike V2 n (V2 n) where
vectorLike = id
{-# INLINE vectorLike #-}
type V2Like = VectorLike V2
instance n ~ m => VectorLike V2 n (n, m) where
vectorLike = iso unr2 r2
{-# INLINE vectorLike #-}
instance VectorLike V2 n (Complex n) where
vectorLike = iso (\(V2 x y) -> x :+ y)
(\(i :+ j) -> V2 i j)
{-# INLINE vectorLike #-}
type V3Like = VectorLike V3
instance VectorLike V3 n (V3 n) where
vectorLike = id
{-# INLINE vectorLike #-}
instance (n ~ m, m ~ o) => VectorLike V3 n (n, m, o) where
vectorLike = iso unr3 r3
{-# INLINE vectorLike #-}
class (Euclidean v, Typeable v) => PointLike v n a | a -> v n where
pointLike :: Iso' (Point v n) a
unpointLike :: Iso' a (Point v n)
unpointLike = from pointLike
{-# INLINE unpointLike #-}
type P2Like = PointLike V2
instance (Euclidean v, Typeable v) => PointLike v n (Point v n) where
pointLike = id
instance PointLike V2 n (V2 n) where
pointLike = _Point
{-# INLINE pointLike #-}
instance n ~ m => PointLike V2 n (n, m) where
pointLike = iso unp2 p2
{-# INLINE pointLike #-}
instance PointLike V2 n (Complex n) where
pointLike = iso (\(unp2 -> (x,y)) -> x :+ y)
(\(i :+ j) -> p2 (i,j))
{-# INLINE pointLike #-}
type P3Like = PointLike V3
instance (n ~ m, m ~ o) => PointLike V3 n (n, m, o) where
pointLike = iso unp3 p3
{-# INLINE pointLike #-}