{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Point.Either
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A type that is isomorphic to Either pointA pointB, and its isPoint instance
-- provided that pointA and pointB are actually points as well.
--
--------------------------------------------------------------------------------
module HGeometry.Point.Either
  ( OriginalOrExtra(..)
  , OriginalOrCanonical
  ) where

import Control.Lens
import Data.Bifoldable
import Data.Bitraversable
import HGeometry.Point
import HGeometry.Properties
import GHC.Generics (Generic)
import Control.DeepSeq

--------------------------------------------------------------------------------

-- | Helper type for distinguishing original vertices from extra ones.
data OriginalOrExtra orig extra = Original orig
                                | Extra    extra
                                deriving stock (Int -> OriginalOrExtra orig extra -> ShowS
[OriginalOrExtra orig extra] -> ShowS
OriginalOrExtra orig extra -> String
(Int -> OriginalOrExtra orig extra -> ShowS)
-> (OriginalOrExtra orig extra -> String)
-> ([OriginalOrExtra orig extra] -> ShowS)
-> Show (OriginalOrExtra orig extra)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall orig extra.
(Show orig, Show extra) =>
Int -> OriginalOrExtra orig extra -> ShowS
forall orig extra.
(Show orig, Show extra) =>
[OriginalOrExtra orig extra] -> ShowS
forall orig extra.
(Show orig, Show extra) =>
OriginalOrExtra orig extra -> String
$cshowsPrec :: forall orig extra.
(Show orig, Show extra) =>
Int -> OriginalOrExtra orig extra -> ShowS
showsPrec :: Int -> OriginalOrExtra orig extra -> ShowS
$cshow :: forall orig extra.
(Show orig, Show extra) =>
OriginalOrExtra orig extra -> String
show :: OriginalOrExtra orig extra -> String
$cshowList :: forall orig extra.
(Show orig, Show extra) =>
[OriginalOrExtra orig extra] -> ShowS
showList :: [OriginalOrExtra orig extra] -> ShowS
Show,OriginalOrExtra orig extra -> OriginalOrExtra orig extra -> Bool
(OriginalOrExtra orig extra -> OriginalOrExtra orig extra -> Bool)
-> (OriginalOrExtra orig extra
    -> OriginalOrExtra orig extra -> Bool)
-> Eq (OriginalOrExtra orig extra)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall orig extra.
(Eq orig, Eq extra) =>
OriginalOrExtra orig extra -> OriginalOrExtra orig extra -> Bool
$c== :: forall orig extra.
(Eq orig, Eq extra) =>
OriginalOrExtra orig extra -> OriginalOrExtra orig extra -> Bool
== :: OriginalOrExtra orig extra -> OriginalOrExtra orig extra -> Bool
$c/= :: forall orig extra.
(Eq orig, Eq extra) =>
OriginalOrExtra orig extra -> OriginalOrExtra orig extra -> Bool
/= :: OriginalOrExtra orig extra -> OriginalOrExtra orig extra -> Bool
Eq,(forall a b.
 (a -> b) -> OriginalOrExtra orig a -> OriginalOrExtra orig b)
-> (forall a b.
    a -> OriginalOrExtra orig b -> OriginalOrExtra orig a)
-> Functor (OriginalOrExtra orig)
forall a b. a -> OriginalOrExtra orig b -> OriginalOrExtra orig a
forall a b.
(a -> b) -> OriginalOrExtra orig a -> OriginalOrExtra orig b
forall orig a b.
a -> OriginalOrExtra orig b -> OriginalOrExtra orig a
forall orig a b.
(a -> b) -> OriginalOrExtra orig a -> OriginalOrExtra orig b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall orig a b.
(a -> b) -> OriginalOrExtra orig a -> OriginalOrExtra orig b
fmap :: forall a b.
(a -> b) -> OriginalOrExtra orig a -> OriginalOrExtra orig b
$c<$ :: forall orig a b.
a -> OriginalOrExtra orig b -> OriginalOrExtra orig a
<$ :: forall a b. a -> OriginalOrExtra orig b -> OriginalOrExtra orig a
Functor,(forall x.
 OriginalOrExtra orig extra -> Rep (OriginalOrExtra orig extra) x)
-> (forall x.
    Rep (OriginalOrExtra orig extra) x -> OriginalOrExtra orig extra)
-> Generic (OriginalOrExtra orig extra)
forall x.
Rep (OriginalOrExtra orig extra) x -> OriginalOrExtra orig extra
forall x.
OriginalOrExtra orig extra -> Rep (OriginalOrExtra orig extra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall orig extra x.
Rep (OriginalOrExtra orig extra) x -> OriginalOrExtra orig extra
forall orig extra x.
OriginalOrExtra orig extra -> Rep (OriginalOrExtra orig extra) x
$cfrom :: forall orig extra x.
OriginalOrExtra orig extra -> Rep (OriginalOrExtra orig extra) x
from :: forall x.
OriginalOrExtra orig extra -> Rep (OriginalOrExtra orig extra) x
$cto :: forall orig extra x.
Rep (OriginalOrExtra orig extra) x -> OriginalOrExtra orig extra
to :: forall x.
Rep (OriginalOrExtra orig extra) x -> OriginalOrExtra orig extra
Generic)

instance (NFData orig, NFData extra) => NFData (OriginalOrExtra orig extra)

-- | Shorthand for an Original or a Canonical Point
type OriginalOrCanonical orig = OriginalOrExtra orig (CanonicalPoint orig)

instance Bifunctor OriginalOrExtra where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> OriginalOrExtra a c -> OriginalOrExtra b d
bimap a -> b
f c -> d
g = \case
    Original a
p -> b -> OriginalOrExtra b d
forall orig extra. orig -> OriginalOrExtra orig extra
Original (a -> b
f a
p)
    Extra c
p    -> d -> OriginalOrExtra b d
forall orig extra. extra -> OriginalOrExtra orig extra
Extra (c -> d
g c
p)

instance Bifoldable OriginalOrExtra where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> OriginalOrExtra a b -> m
bifoldMap a -> m
f b -> m
g = \case
    Original a
p -> a -> m
f a
p
    Extra b
p    -> b -> m
g b
p

instance Bitraversable OriginalOrExtra where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> OriginalOrExtra a b -> f (OriginalOrExtra c d)
bitraverse a -> f c
f b -> f d
g = \case
    Original a
p -> c -> OriginalOrExtra c d
forall orig extra. orig -> OriginalOrExtra orig extra
Original (c -> OriginalOrExtra c d) -> f c -> f (OriginalOrExtra c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
p
    Extra b
p    -> d -> OriginalOrExtra c d
forall orig extra. extra -> OriginalOrExtra orig extra
Extra (d -> OriginalOrExtra c d) -> f d -> f (OriginalOrExtra c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
p


type instance NumType   (OriginalOrExtra orig extra) = NumType orig
type instance Dimension (OriginalOrExtra orig extra) = Dimension orig

instance ( HasVector orig orig, HasVector extra extra
         , HasVector orig orig', HasVector extra extra'
         , Dimension extra ~ Dimension orig, NumType extra ~ NumType orig
         , Dimension extra' ~ Dimension orig', NumType extra' ~ NumType orig'
         ) => HasVector (OriginalOrExtra orig extra) (OriginalOrExtra orig' extra') where
  vector :: forall (d :: Nat) r s.
(Dimension (OriginalOrExtra orig extra) ~ d,
 NumType (OriginalOrExtra orig extra) ~ r,
 Dimension (OriginalOrExtra orig' extra') ~ d,
 NumType (OriginalOrExtra orig' extra') ~ s) =>
Lens
  (OriginalOrExtra orig extra)
  (OriginalOrExtra orig' extra')
  (Vector d r)
  (Vector d s)
vector = (OriginalOrExtra orig extra -> Vector d r)
-> (OriginalOrExtra orig extra
    -> Vector d s -> OriginalOrExtra orig' extra')
-> Lens
     (OriginalOrExtra orig extra)
     (OriginalOrExtra orig' extra')
     (Vector d r)
     (Vector d s)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens OriginalOrExtra orig extra -> Vector d r
OriginalOrExtra orig extra
-> Vector (Dimension orig) (NumType orig)
g ((Vector d s
 -> OriginalOrExtra orig extra -> OriginalOrExtra orig' extra')
-> OriginalOrExtra orig extra
-> Vector d s
-> OriginalOrExtra orig' extra'
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector d s
-> OriginalOrExtra orig extra -> OriginalOrExtra orig' extra'
Vector (Dimension orig) (NumType orig')
-> OriginalOrExtra orig extra -> OriginalOrExtra orig' extra'
forall {orig} {a} {extra} {a}.
(Dimension orig ~ Dimension a, Dimension extra ~ Dimension a,
 Dimension a ~ Dimension a, NumType extra ~ NumType orig,
 HasVector a orig, HasVector a extra) =>
Vector (Dimension a) (NumType orig)
-> OriginalOrExtra a a -> OriginalOrExtra orig extra
s)
    where
      g :: OriginalOrExtra orig extra
-> Vector (Dimension orig) (NumType orig)
g = \case
        Original orig
o -> orig
oorig
-> Getting
     (Vector (Dimension orig) (NumType orig))
     orig
     (Vector (Dimension orig) (NumType orig))
-> Vector (Dimension orig) (NumType orig)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Dimension orig) (NumType orig))
  orig
  (Vector (Dimension orig) (NumType orig))
forall (d :: Nat) r s.
(Dimension orig ~ d, NumType orig ~ r, Dimension orig ~ d,
 NumType orig ~ s) =>
Lens orig orig (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  orig
  orig
  (Vector (Dimension orig) (NumType orig))
  (Vector (Dimension orig) (NumType orig))
vector
        Extra    extra
e -> extra
eextra
-> Getting
     (Vector (Dimension orig) (NumType orig))
     extra
     (Vector (Dimension orig) (NumType orig))
-> Vector (Dimension orig) (NumType orig)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Dimension orig) (NumType orig))
  extra
  (Vector (Dimension orig) (NumType orig))
forall (d :: Nat) r s.
(Dimension extra ~ d, NumType extra ~ r, Dimension extra ~ d,
 NumType extra ~ s) =>
Lens extra extra (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  extra
  extra
  (Vector (Dimension orig) (NumType orig))
  (Vector (Dimension orig) (NumType orig))
vector
      s :: Vector (Dimension a) (NumType orig)
-> OriginalOrExtra a a -> OriginalOrExtra orig extra
s Vector (Dimension a) (NumType orig)
v = \case
        Original a
o -> orig -> OriginalOrExtra orig extra
forall orig extra. orig -> OriginalOrExtra orig extra
Original (a
oa -> (a -> orig) -> orig
forall a b. a -> (a -> b) -> b
&(Vector (Dimension a) (NumType a)
 -> Identity (Vector (Dimension a) (NumType orig)))
-> a -> Identity orig
forall (d :: Nat) r s.
(Dimension a ~ d, NumType a ~ r, Dimension orig ~ d,
 NumType orig ~ s) =>
Lens a orig (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  a
  orig
  (Vector (Dimension a) (NumType a))
  (Vector (Dimension a) (NumType orig))
vector ((Vector (Dimension a) (NumType a)
  -> Identity (Vector (Dimension a) (NumType orig)))
 -> a -> Identity orig)
-> Vector (Dimension a) (NumType orig) -> a -> orig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Vector (Dimension a) (NumType orig)
v)
        Extra    a
e -> extra -> OriginalOrExtra orig extra
forall orig extra. extra -> OriginalOrExtra orig extra
Extra    (a
ea -> (a -> extra) -> extra
forall a b. a -> (a -> b) -> b
&(Vector (Dimension a) (NumType a)
 -> Identity (Vector (Dimension a) (NumType orig)))
-> a -> Identity extra
forall (d :: Nat) r s.
(Dimension a ~ d, NumType a ~ r, Dimension extra ~ d,
 NumType extra ~ s) =>
Lens a extra (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  a
  extra
  (Vector (Dimension a) (NumType a))
  (Vector (Dimension a) (NumType orig))
vector ((Vector (Dimension a) (NumType a)
  -> Identity (Vector (Dimension a) (NumType orig)))
 -> a -> Identity extra)
-> Vector (Dimension a) (NumType orig) -> a -> extra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Vector (Dimension a) (NumType orig)
v)


instance ( HasCoordinates orig orig', HasCoordinates extra extra'
         , HasVector orig orig, HasVector extra extra
         , Dimension extra ~ Dimension orig, NumType extra ~ NumType orig
         , Dimension extra' ~ Dimension orig', NumType extra' ~ NumType orig'
         ) => HasCoordinates (OriginalOrExtra orig extra) (OriginalOrExtra orig' extra')

instance (Affine_ orig d r, Affine_ extra d r) => Affine_ (OriginalOrExtra orig extra) d r

instance (Point_ orig d r, Point_ extra d r)   => Point_  (OriginalOrExtra orig extra) d r