{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Point.PointF
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Implements a point by wrapping some Vector type
--
--------------------------------------------------------------------------------
module HGeometry.Point.PointF
  ( PointF(..)
  ) where


import           Control.DeepSeq
import           Control.Lens
import           Control.Monad (replicateM)
import           Data.Aeson
import           Data.Functor.Classes
import           Data.List (intersperse)
import           Data.Proxy
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
-- import           Data.YAML
import           GHC.Generics (Generic)
import           GHC.TypeLits
import           HGeometry.Point.Class
import           HGeometry.Properties
import           HGeometry.Vector
import           System.Random (Random (..))
import           System.Random.Stateful (UniformRange(..), Uniform(..))
import           Text.Read (Read (..), readListPrecDefault)
--------------------------------------------------------------------------------

-- | A Point wraps a vector
newtype PointF v = Point { forall v. PointF v -> v
toVec :: v }
                 deriving stock   ((forall x. PointF v -> Rep (PointF v) x)
-> (forall x. Rep (PointF v) x -> PointF v) -> Generic (PointF v)
forall x. Rep (PointF v) x -> PointF v
forall x. PointF v -> Rep (PointF v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (PointF v) x -> PointF v
forall v x. PointF v -> Rep (PointF v) x
$cfrom :: forall v x. PointF v -> Rep (PointF v) x
from :: forall x. PointF v -> Rep (PointF v) x
$cto :: forall v x. Rep (PointF v) x -> PointF v
to :: forall x. Rep (PointF v) x -> PointF v
Generic)
                 deriving newtype ( PointF v -> PointF v -> Bool
(PointF v -> PointF v -> Bool)
-> (PointF v -> PointF v -> Bool) -> Eq (PointF v)
forall v. Eq v => PointF v -> PointF v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => PointF v -> PointF v -> Bool
== :: PointF v -> PointF v -> Bool
$c/= :: forall v. Eq v => PointF v -> PointF v -> Bool
/= :: PointF v -> PointF v -> Bool
Eq, Eq (PointF v)
Eq (PointF v) =>
(PointF v -> PointF v -> Ordering)
-> (PointF v -> PointF v -> Bool)
-> (PointF v -> PointF v -> Bool)
-> (PointF v -> PointF v -> Bool)
-> (PointF v -> PointF v -> Bool)
-> (PointF v -> PointF v -> PointF v)
-> (PointF v -> PointF v -> PointF v)
-> Ord (PointF v)
PointF v -> PointF v -> Bool
PointF v -> PointF v -> Ordering
PointF v -> PointF v -> PointF v
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 v. Ord v => Eq (PointF v)
forall v. Ord v => PointF v -> PointF v -> Bool
forall v. Ord v => PointF v -> PointF v -> Ordering
forall v. Ord v => PointF v -> PointF v -> PointF v
$ccompare :: forall v. Ord v => PointF v -> PointF v -> Ordering
compare :: PointF v -> PointF v -> Ordering
$c< :: forall v. Ord v => PointF v -> PointF v -> Bool
< :: PointF v -> PointF v -> Bool
$c<= :: forall v. Ord v => PointF v -> PointF v -> Bool
<= :: PointF v -> PointF v -> Bool
$c> :: forall v. Ord v => PointF v -> PointF v -> Bool
> :: PointF v -> PointF v -> Bool
$c>= :: forall v. Ord v => PointF v -> PointF v -> Bool
>= :: PointF v -> PointF v -> Bool
$cmax :: forall v. Ord v => PointF v -> PointF v -> PointF v
max :: PointF v -> PointF v -> PointF v
$cmin :: forall v. Ord v => PointF v -> PointF v -> PointF v
min :: PointF v -> PointF v -> PointF v
Ord, (forall g.
 RandomGen g =>
 (PointF v, PointF v) -> g -> (PointF v, g))
-> (forall g. RandomGen g => g -> (PointF v, g))
-> (forall g.
    RandomGen g =>
    (PointF v, PointF v) -> g -> [PointF v])
-> (forall g. RandomGen g => g -> [PointF v])
-> Random (PointF v)
forall g. RandomGen g => g -> [PointF v]
forall g. RandomGen g => g -> (PointF v, g)
forall g. RandomGen g => (PointF v, PointF v) -> g -> [PointF v]
forall g. RandomGen g => (PointF v, PointF v) -> g -> (PointF v, g)
forall v g. (Random v, RandomGen g) => g -> [PointF v]
forall v g. (Random v, RandomGen g) => g -> (PointF v, g)
forall v g.
(Random v, RandomGen g) =>
(PointF v, PointF v) -> g -> [PointF v]
forall v g.
(Random v, RandomGen g) =>
(PointF v, PointF v) -> g -> (PointF v, g)
forall a.
(forall g. RandomGen g => (a, a) -> g -> (a, g))
-> (forall g. RandomGen g => g -> (a, g))
-> (forall g. RandomGen g => (a, a) -> g -> [a])
-> (forall g. RandomGen g => g -> [a])
-> Random a
$crandomR :: forall v g.
(Random v, RandomGen g) =>
(PointF v, PointF v) -> g -> (PointF v, g)
randomR :: forall g. RandomGen g => (PointF v, PointF v) -> g -> (PointF v, g)
$crandom :: forall v g. (Random v, RandomGen g) => g -> (PointF v, g)
random :: forall g. RandomGen g => g -> (PointF v, g)
$crandomRs :: forall v g.
(Random v, RandomGen g) =>
(PointF v, PointF v) -> g -> [PointF v]
randomRs :: forall g. RandomGen g => (PointF v, PointF v) -> g -> [PointF v]
$crandoms :: forall v g. (Random v, RandomGen g) => g -> [PointF v]
randoms :: forall g. RandomGen g => g -> [PointF v]
Random, PointF v -> ()
(PointF v -> ()) -> NFData (PointF v)
forall v. NFData v => PointF v -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall v. NFData v => PointF v -> ()
rnf :: PointF v -> ()
NFData, PointF v
PointF v -> PointF v -> Bounded (PointF v)
forall a. a -> a -> Bounded a
forall v. Bounded v => PointF v
$cminBound :: forall v. Bounded v => PointF v
minBound :: PointF v
$cmaxBound :: forall v. Bounded v => PointF v
maxBound :: PointF v
Bounded, Int -> PointF v
PointF v -> Int
PointF v -> [PointF v]
PointF v -> PointF v
PointF v -> PointF v -> [PointF v]
PointF v -> PointF v -> PointF v -> [PointF v]
(PointF v -> PointF v)
-> (PointF v -> PointF v)
-> (Int -> PointF v)
-> (PointF v -> Int)
-> (PointF v -> [PointF v])
-> (PointF v -> PointF v -> [PointF v])
-> (PointF v -> PointF v -> [PointF v])
-> (PointF v -> PointF v -> PointF v -> [PointF v])
-> Enum (PointF v)
forall v. Enum v => Int -> PointF v
forall v. Enum v => PointF v -> Int
forall v. Enum v => PointF v -> [PointF v]
forall v. Enum v => PointF v -> PointF v
forall v. Enum v => PointF v -> PointF v -> [PointF v]
forall v. Enum v => PointF v -> PointF v -> PointF v -> [PointF v]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: forall v. Enum v => PointF v -> PointF v
succ :: PointF v -> PointF v
$cpred :: forall v. Enum v => PointF v -> PointF v
pred :: PointF v -> PointF v
$ctoEnum :: forall v. Enum v => Int -> PointF v
toEnum :: Int -> PointF v
$cfromEnum :: forall v. Enum v => PointF v -> Int
fromEnum :: PointF v -> Int
$cenumFrom :: forall v. Enum v => PointF v -> [PointF v]
enumFrom :: PointF v -> [PointF v]
$cenumFromThen :: forall v. Enum v => PointF v -> PointF v -> [PointF v]
enumFromThen :: PointF v -> PointF v -> [PointF v]
$cenumFromTo :: forall v. Enum v => PointF v -> PointF v -> [PointF v]
enumFromTo :: PointF v -> PointF v -> [PointF v]
$cenumFromThenTo :: forall v. Enum v => PointF v -> PointF v -> PointF v -> [PointF v]
enumFromThenTo :: PointF v -> PointF v -> PointF v -> [PointF v]
Enum
                                  -- , FromYAML, ToYAML
                                  , [PointF v] -> Value
[PointF v] -> Encoding
PointF v -> Bool
PointF v -> Value
PointF v -> Encoding
(PointF v -> Value)
-> (PointF v -> Encoding)
-> ([PointF v] -> Value)
-> ([PointF v] -> Encoding)
-> (PointF v -> Bool)
-> ToJSON (PointF v)
forall v. ToJSON v => [PointF v] -> Value
forall v. ToJSON v => [PointF v] -> Encoding
forall v. ToJSON v => PointF v -> Bool
forall v. ToJSON v => PointF v -> Value
forall v. ToJSON v => PointF v -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall v. ToJSON v => PointF v -> Value
toJSON :: PointF v -> Value
$ctoEncoding :: forall v. ToJSON v => PointF v -> Encoding
toEncoding :: PointF v -> Encoding
$ctoJSONList :: forall v. ToJSON v => [PointF v] -> Value
toJSONList :: [PointF v] -> Value
$ctoEncodingList :: forall v. ToJSON v => [PointF v] -> Encoding
toEncodingList :: [PointF v] -> Encoding
$comitField :: forall v. ToJSON v => PointF v -> Bool
omitField :: PointF v -> Bool
ToJSON, Maybe (PointF v)
Value -> Parser [PointF v]
Value -> Parser (PointF v)
(Value -> Parser (PointF v))
-> (Value -> Parser [PointF v])
-> Maybe (PointF v)
-> FromJSON (PointF v)
forall v. FromJSON v => Maybe (PointF v)
forall v. FromJSON v => Value -> Parser [PointF v]
forall v. FromJSON v => Value -> Parser (PointF v)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall v. FromJSON v => Value -> Parser (PointF v)
parseJSON :: Value -> Parser (PointF v)
$cparseJSONList :: forall v. FromJSON v => Value -> Parser [PointF v]
parseJSONList :: Value -> Parser [PointF v]
$comittedField :: forall v. FromJSON v => Maybe (PointF v)
omittedField :: Maybe (PointF v)
FromJSON
                                  )
-- don't derive functor, or so here. since that will be confusing.

type instance Dimension (PointF v) = Dimension v
type instance NumType   (PointF v) = IxValue v
type instance IxValue   (PointF v) = IxValue v

-- deriving newtype instance Functor v => Functor (PointF v)
-- deriving newtype instance Foldable v => Foldable (PointF v)
-- deriving newtype instance Traversable v => Traversable (PointF v)

-- Functor, Foldable, Traversable

_PointF :: Iso (PointF v) (PointF v') v v'
_PointF :: forall v v' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p v (f v') -> p (PointF v) (f (PointF v'))
_PointF = (PointF v -> v)
-> (v' -> PointF v') -> Iso (PointF v) (PointF v') v v'
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso PointF v -> v
forall v. PointF v -> v
toVec v' -> PointF v'
forall v. v -> PointF v
Point
{-# INLINE _PointF #-}

instance ( Additive_ vector       d r
         , Additive_ (Vector d r) d r
         , Show r
         ) => Show (PointF vector) where
  showsPrec :: Int -> PointF vector -> ShowS
showsPrec Int
k PointF vector
p = Bool -> ShowS -> ShowS
showParen (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                    String -> ShowS
showString String
constr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    [ShowS] -> ShowS
unwordsS ((r -> ShowS) -> [r] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11) (PointF vector
pPointF vector -> Getting (Endo [r]) (PointF vector) r -> [r]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [r]) (PointF vector) r
(NumType (PointF vector)
 -> Const (Endo [r]) (NumType (PointF vector)))
-> PointF vector -> Const (Endo [r]) (PointF vector)
forall point point'.
HasCoordinates point point' =>
IndexedTraversal1 Int point point' (NumType point) (NumType point')
IndexedTraversal1
  Int
  (PointF vector)
  (PointF vector)
  (NumType (PointF vector))
  (NumType (PointF vector))
coordinates))
    where
      app_prec :: Int
app_prec = Int
10
      constr :: String
constr   = String
"Point" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal @d Proxy d
forall {k} (t :: k). Proxy t
Proxy))
      unwordsS :: [ShowS] -> ShowS
unwordsS = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS) -> ([ShowS] -> [ShowS]) -> [ShowS] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char -> ShowS
showChar Char
' ')

instance ( Additive_ vector       d r
         , Additive_ (Vector d r) d r
         , Read r
         ) => Read (PointF vector) where
  readPrec :: ReadPrec (PointF vector)
readPrec = ReadPrec (PointF vector) -> ReadPrec (PointF vector)
forall a. ReadPrec a -> ReadPrec a
readData (ReadPrec (PointF vector) -> ReadPrec (PointF vector))
-> ReadPrec (PointF vector) -> ReadPrec (PointF vector)
forall a b. (a -> b) -> a -> b
$
      ReadPrec [r]
-> String -> ([r] -> PointF vector) -> ReadPrec (PointF vector)
forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (Int -> ReadPrec r -> ReadPrec [r]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
d ReadPrec r
forall a. Read a => ReadPrec a
readPrec) String
constr (([r] -> PointF vector) -> ReadPrec (PointF vector))
-> ([r] -> PointF vector) -> ReadPrec (PointF vector)
forall a b. (a -> b) -> a -> b
$ \[r]
rs ->
        case [r] -> Maybe (PointF vector)
forall point (d :: Nat) r.
(ConstructablePoint_ point d r, Vector_ (Vector d r) d r) =>
[r] -> Maybe point
pointFromList [r]
rs of
          Just PointF vector
p -> PointF vector
p
          Maybe (PointF vector)
_      -> String -> PointF vector
forall a. HasCallStack => String -> a
error String
"internal error in HGeometry.Point read instance."
    where
      d :: Int
d        = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal @d Proxy d
forall {k} (t :: k). Proxy t
Proxy)
      constr :: String
constr   = String
"Point" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
d
  readListPrec :: ReadPrec [PointF vector]
readListPrec = ReadPrec [PointF vector]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance ( Vector_ vector d r
         , Vector_ vector' d s
         , Has_ Vector_ d r
         , Has_ Vector_ d s
         , AsVector_ vector vector' d r s
         , HasComponents vector vector'
         ) => HasVector (PointF vector) (PointF vector') where

  vector :: forall (d :: Nat) r s.
(Dimension (PointF vector) ~ d, NumType (PointF vector) ~ r,
 Dimension (PointF vector') ~ d, NumType (PointF vector') ~ s) =>
Lens (PointF vector) (PointF vector') (Vector d r) (Vector d s)
vector = (vector -> f vector') -> PointF vector -> f (PointF vector')
forall v v' (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p v (f v') -> p (PointF v) (f (PointF v'))
_PointF((vector -> f vector') -> PointF vector -> f (PointF vector'))
-> ((Vector d r -> f (Vector d s)) -> vector -> f vector')
-> (Vector d r -> f (Vector d s))
-> PointF vector
-> f (PointF vector')
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector d r -> f (Vector d s)) -> vector -> f vector'
(Vector d r -> f (Vector d s)) -> vector -> f vector'
forall vector vector' (d :: Nat) r s.
AsVector_ vector vector' d r s =>
Iso vector vector' (Vector d r) (Vector d s)
Iso vector vector' (Vector d r) (Vector d s)
_Vector
  {-# INLINE vector #-}

instance ( Has_ Vector_ d r
         , Has_ Vector_ d s
         , Vector_ vector d r
         , Vector_ vector' d s
         , AsVector_ vector vector' d r s
         , HasComponents (Vector d r) (Vector d s)
         , HasComponents vector vector'
         ) => HasCoordinates (PointF vector) (PointF vector')

instance ( Additive_ vector       d r
         , Additive_ (Vector d r) d r
         ) => Affine_ (PointF vector) d r where

instance ( Additive_ vector       d r
         , Additive_ (Vector d r) d r
         ) => Point_ (PointF vector) d r where

instance ( Additive_ vector       d r
         , Additive_ (Vector d r) d r
         ) => ConstructablePoint_ (PointF vector) d r where
  fromVector :: Vector d r -> PointF vector
fromVector = vector -> PointF vector
forall v. v -> PointF v
Point (vector -> PointF vector)
-> (Vector d r -> vector) -> Vector d r -> PointF vector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview vector (Vector d r) -> Vector d r -> vector
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview vector (Vector d r)
forall vector vector' (d :: Nat) r s.
AsVector_ vector vector' d r s =>
Iso vector vector' (Vector d r) (Vector d s)
Iso vector vector (Vector d r) (Vector d r)
_Vector
  {-# INLINE fromVector #-}

instance HasPoints (PointF v) (PointF v') (PointF v) (PointF v') where
  allPoints :: forall (d :: Nat) r r'.
(Point_ (PointF v) d r, Point_ (PointF v') d r',
 NumType (PointF v) ~ r, NumType (PointF v') ~ r',
 Dimension (PointF v) ~ d, Dimension (PointF v') ~ d) =>
Traversal1 (PointF v) (PointF v') (PointF v) (PointF v')
allPoints = (PointF v -> f (PointF v')) -> PointF v -> f (PointF v')
forall a. a -> a
id

instance Uniform v => Uniform (PointF v) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (PointF v)
uniformM g
gen = v -> PointF v
forall v. v -> PointF v
Point (v -> PointF v) -> m v -> m (PointF v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> m v
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
forall g (m :: * -> *). StatefulGen g m => g -> m v
uniformM g
gen

instance (UniformRange v) => UniformRange (PointF v) where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(PointF v, PointF v) -> g -> m (PointF v)
uniformRM (Point v
lows, Point v
highs) g
gen = v -> PointF v
forall v. v -> PointF v
Point (v -> PointF v) -> m v -> m (PointF v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v, v) -> g -> m v
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *). StatefulGen g m => (v, v) -> g -> m v
uniformRM (v
lows,v
highs) g
gen

newtype instance U.MVector s (PointF v) = MV_PointF (U.MVector s v)
newtype instance U.Vector    (PointF v) = V_PointF  (U.Vector    v)

instance U.IsoUnbox (PointF v) v where
  toURepr :: PointF v -> v
toURepr (Point v
v) = v
v
  fromURepr :: v -> PointF v
fromURepr = v -> PointF v
forall v. v -> PointF v
Point
  {-# INLINE toURepr #-}
  {-# INLINE fromURepr #-}

deriving via ((PointF v) `U.As` v) instance U.Unbox v => GM.MVector U.MVector (PointF v)
deriving via ((PointF v) `U.As` v) instance U.Unbox v => G.Vector   U.Vector  (PointF v)
instance U.Unbox v => U.Unbox (PointF v)