{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeOperators #-}
module Diagrams.Coordinates.Isomorphic
(
HasIndexedBasis, Euclidean
, VectorLike (..)
, V2Like, V3Like
, PointLike (..)
, P2Like, P3Like
)
where
import Control.Lens
import Data.Complex
import Data.Kind
import Data.Typeable
import Diagrams.Prelude
type HasIndexedBasis v = (HasBasis v, TraversableWithIndex (E v) v)
type Euclidean (v :: Type -> Type) = (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 = AnIso (v n) (v n) a a -> Iso' a (v n)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (v n) (v n) a a
forall (v :: * -> *) n a. VectorLike v n a => Iso' (v n) a
Iso' (v n) a
vectorLike
{-# INLINE unvectorLike #-}
instance VectorLike V2 n (V2 n) where
vectorLike :: Iso' (V2 n) (V2 n)
vectorLike = p (V2 n) (f (V2 n)) -> p (V2 n) (f (V2 n))
forall a. a -> a
id
{-# INLINE vectorLike #-}
type V2Like = VectorLike V2
instance n ~ m => VectorLike V2 n (n, m) where
vectorLike :: Iso' (V2 n) (n, m)
vectorLike = (V2 n -> (n, m)) -> ((n, m) -> V2 n) -> Iso' (V2 n) (n, m)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso V2 n -> (n, n)
V2 n -> (n, m)
forall n. V2 n -> (n, n)
unr2 (n, n) -> V2 n
(n, m) -> V2 n
forall n. (n, n) -> V2 n
r2
{-# INLINE vectorLike #-}
instance VectorLike V2 n (Complex n) where
vectorLike :: Iso' (V2 n) (Complex n)
vectorLike = (V2 n -> Complex n)
-> (Complex n -> V2 n) -> Iso' (V2 n) (Complex n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(V2 n
x n
y) -> n
x n -> n -> Complex n
forall a. a -> a -> Complex a
:+ n
y)
(\(n
i :+ n
j) -> n -> n -> V2 n
forall a. a -> a -> V2 a
V2 n
i n
j)
{-# INLINE vectorLike #-}
type V3Like = VectorLike V3
instance VectorLike V3 n (V3 n) where
vectorLike :: Iso' (V3 n) (V3 n)
vectorLike = p (V3 n) (f (V3 n)) -> p (V3 n) (f (V3 n))
forall a. a -> a
id
{-# INLINE vectorLike #-}
instance (n ~ m, m ~ o) => VectorLike V3 n (n, m, o) where
vectorLike :: Iso' (V3 n) (n, m, o)
vectorLike = (V3 n -> (n, m, o)) -> ((n, m, o) -> V3 n) -> Iso' (V3 n) (n, m, o)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso V3 n -> (n, n, n)
V3 n -> (n, m, o)
forall n. V3 n -> (n, n, n)
unr3 (n, n, n) -> V3 n
(n, m, o) -> V3 n
forall n. (n, n, n) -> V3 n
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 = AnIso (Point v n) (Point v n) a a -> Iso' a (Point v n)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso (Point v n) (Point v n) a a
forall (v :: * -> *) n a. PointLike v n a => Iso' (Point v n) a
Iso' (Point v n) a
pointLike
{-# INLINE unpointLike #-}
type P2Like = PointLike V2
instance (Euclidean v, Typeable v) => PointLike v n (Point v n) where
pointLike :: Iso' (Point v n) (Point v n)
pointLike = p (Point v n) (f (Point v n)) -> p (Point v n) (f (Point v n))
forall a. a -> a
id
instance PointLike V2 n (V2 n) where
pointLike :: Iso' (Point V2 n) (V2 n)
pointLike = p (V2 n) (f (V2 n)) -> p (Point V2 n) (f (Point V2 n))
forall (f1 :: * -> *) a (g :: * -> *) b (p :: * -> * -> *)
(f2 :: * -> *).
(Profunctor p, Functor f2) =>
p (f1 a) (f2 (g b)) -> p (Point f1 a) (f2 (Point g b))
_Point
{-# INLINE pointLike #-}
instance n ~ m => PointLike V2 n (n, m) where
pointLike :: Iso' (Point V2 n) (n, m)
pointLike = (Point V2 n -> (n, m))
-> ((n, m) -> Point V2 n) -> Iso' (Point V2 n) (n, m)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Point V2 n -> (n, n)
Point V2 n -> (n, m)
forall n. P2 n -> (n, n)
unp2 (n, n) -> Point V2 n
(n, m) -> Point V2 n
forall n. (n, n) -> P2 n
p2
{-# INLINE pointLike #-}
instance PointLike V2 n (Complex n) where
pointLike :: Iso' (Point V2 n) (Complex n)
pointLike = (Point V2 n -> Complex n)
-> (Complex n -> Point V2 n) -> Iso' (Point V2 n) (Complex n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Point V2 n -> (n, n)
forall n. P2 n -> (n, n)
unp2 -> (n
x,n
y)) -> n
x n -> n -> Complex n
forall a. a -> a -> Complex a
:+ n
y)
(\(n
i :+ n
j) -> (n, n) -> Point V2 n
forall n. (n, n) -> P2 n
p2 (n
i,n
j))
{-# INLINE pointLike #-}
type P3Like = PointLike V3
instance (n ~ m, m ~ o) => PointLike V3 n (n, m, o) where
pointLike :: Iso' (Point V3 n) (n, m, o)
pointLike = (Point V3 n -> (n, m, o))
-> ((n, m, o) -> Point V3 n) -> Iso' (Point V3 n) (n, m, o)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Point V3 n -> (n, n, n)
Point V3 n -> (n, m, o)
forall n. P3 n -> (n, n, n)
unp3 (n, n, n) -> Point V3 n
(n, m, o) -> Point V3 n
forall n. (n, n, n) -> P3 n
p3
{-# INLINE pointLike #-}