{-# LANGUAGE TypeFamilies #-}

module Database.Postgis.Trivial.Traversable.PointND where

import GHC.Base
import GHC.Show ( Show )
import Control.Exception ( throw )

import Database.Postgis.Trivial.Types
import Database.Postgis.Trivial.Cast


-- | Default 2D point
data P2D = Point2D
        { P2D -> Double
xP2D :: {-# UNPACK #-} !Double
        , P2D -> Double
yP2D :: {-# UNPACK #-} !Double
        } deriving (Int -> P2D -> ShowS
[P2D] -> ShowS
P2D -> String
(Int -> P2D -> ShowS)
-> (P2D -> String) -> ([P2D] -> ShowS) -> Show P2D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> P2D -> ShowS
showsPrec :: Int -> P2D -> ShowS
$cshow :: P2D -> String
show :: P2D -> String
$cshowList :: [P2D] -> ShowS
showList :: [P2D] -> ShowS
Show, P2D -> P2D -> Bool
(P2D -> P2D -> Bool) -> (P2D -> P2D -> Bool) -> Eq P2D
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: P2D -> P2D -> Bool
== :: P2D -> P2D -> Bool
$c/= :: P2D -> P2D -> Bool
/= :: P2D -> P2D -> Bool
Eq)

instance PointND P2D where
    dimProps :: (Bool, Bool)
dimProps = (Bool
False, Bool
False)
    components :: P2D -> (Double, Double, Maybe Double, Maybe Double)
components (Point2D Double
x Double
y) = (Double
x, Double
y, Maybe Double
forall a. Maybe a
Nothing, Maybe Double
forall a. Maybe a
Nothing)
    fromComponents :: (Double, Double, Maybe Double, Maybe Double) -> P2D
fromComponents (Double
x, Double
y, Maybe Double
Nothing, Maybe Double
Nothing) = Double -> Double -> P2D
Point2D Double
x Double
y
    fromComponents (Double, Double, Maybe Double, Maybe Double)
_ = GeometryError -> P2D
forall a e. Exception e => e -> a
throw (GeometryError -> P2D) -> GeometryError -> P2D
forall a b. (a -> b) -> a -> b
$
        String -> GeometryError
GeometryError String
"invalid transition from user data type to Point2D"

-- | Default 3D point with Z component
data P3DZ = Point3DZ
        { P3DZ -> Double
xP3DZ :: {-# UNPACK #-} !Double
        , P3DZ -> Double
yP3DZ :: {-# UNPACK #-} !Double
        , P3DZ -> Double
zP3DZ :: {-# UNPACK #-} !Double
        } deriving (Int -> P3DZ -> ShowS
[P3DZ] -> ShowS
P3DZ -> String
(Int -> P3DZ -> ShowS)
-> (P3DZ -> String) -> ([P3DZ] -> ShowS) -> Show P3DZ
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> P3DZ -> ShowS
showsPrec :: Int -> P3DZ -> ShowS
$cshow :: P3DZ -> String
show :: P3DZ -> String
$cshowList :: [P3DZ] -> ShowS
showList :: [P3DZ] -> ShowS
Show, P3DZ -> P3DZ -> Bool
(P3DZ -> P3DZ -> Bool) -> (P3DZ -> P3DZ -> Bool) -> Eq P3DZ
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: P3DZ -> P3DZ -> Bool
== :: P3DZ -> P3DZ -> Bool
$c/= :: P3DZ -> P3DZ -> Bool
/= :: P3DZ -> P3DZ -> Bool
Eq)

instance PointND P3DZ where
    dimProps :: (Bool, Bool)
dimProps = (Bool
False, Bool
True)
    components :: P3DZ -> (Double, Double, Maybe Double, Maybe Double)
components (Point3DZ Double
x Double
y Double
z) = (Double
x, Double
y, Double -> Maybe Double
forall a. a -> Maybe a
Just Double
z, Maybe Double
forall a. Maybe a
Nothing)
    fromComponents :: (Double, Double, Maybe Double, Maybe Double) -> P3DZ
fromComponents (Double
x, Double
y, Just Double
z, Maybe Double
Nothing) = Double -> Double -> Double -> P3DZ
Point3DZ Double
x Double
y Double
z
    fromComponents (Double, Double, Maybe Double, Maybe Double)
_ = GeometryError -> P3DZ
forall a e. Exception e => e -> a
throw (GeometryError -> P3DZ) -> GeometryError -> P3DZ
forall a b. (a -> b) -> a -> b
$
        String -> GeometryError
GeometryError String
"invalid transition from user data type to Point3DZ"

-- | Default 3D point with M component
data P3DM = Point3DM
        { P3DM -> Double
xP3DM :: {-# UNPACK #-} !Double
        , P3DM -> Double
yP3DM :: {-# UNPACK #-} !Double
        , P3DM -> Double
mP3DM :: {-# UNPACK #-} !Double
        } deriving (Int -> P3DM -> ShowS
[P3DM] -> ShowS
P3DM -> String
(Int -> P3DM -> ShowS)
-> (P3DM -> String) -> ([P3DM] -> ShowS) -> Show P3DM
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> P3DM -> ShowS
showsPrec :: Int -> P3DM -> ShowS
$cshow :: P3DM -> String
show :: P3DM -> String
$cshowList :: [P3DM] -> ShowS
showList :: [P3DM] -> ShowS
Show, P3DM -> P3DM -> Bool
(P3DM -> P3DM -> Bool) -> (P3DM -> P3DM -> Bool) -> Eq P3DM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: P3DM -> P3DM -> Bool
== :: P3DM -> P3DM -> Bool
$c/= :: P3DM -> P3DM -> Bool
/= :: P3DM -> P3DM -> Bool
Eq)

instance PointND P3DM where
    dimProps :: (Bool, Bool)
dimProps = (Bool
True, Bool
False)
    components :: P3DM -> (Double, Double, Maybe Double, Maybe Double)
components (Point3DM Double
x Double
y Double
m) = (Double
x, Double
y, Double -> Maybe Double
forall a. a -> Maybe a
Just Double
m, Maybe Double
forall a. Maybe a
Nothing)
    fromComponents :: (Double, Double, Maybe Double, Maybe Double) -> P3DM
fromComponents (Double
x, Double
y, Just Double
m, Maybe Double
Nothing) = Double -> Double -> Double -> P3DM
Point3DM Double
x Double
y Double
m
    fromComponents (Double, Double, Maybe Double, Maybe Double)
_ = GeometryError -> P3DM
forall a e. Exception e => e -> a
throw (GeometryError -> P3DM) -> GeometryError -> P3DM
forall a b. (a -> b) -> a -> b
$
        String -> GeometryError
GeometryError String
"invalid transition from user data type to Point2DM"

-- | Default point with Z and M component
data P4D = Point4D
        { P4D -> Double
xP4D :: {-# UNPACK #-} !Double
        , P4D -> Double
yP4D :: {-# UNPACK #-} !Double
        , P4D -> Double
zP4D :: {-# UNPACK #-} !Double
        , P4D -> Double
mP4D :: {-# UNPACK #-} !Double
        } deriving (Int -> P4D -> ShowS
[P4D] -> ShowS
P4D -> String
(Int -> P4D -> ShowS)
-> (P4D -> String) -> ([P4D] -> ShowS) -> Show P4D
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> P4D -> ShowS
showsPrec :: Int -> P4D -> ShowS
$cshow :: P4D -> String
show :: P4D -> String
$cshowList :: [P4D] -> ShowS
showList :: [P4D] -> ShowS
Show, P4D -> P4D -> Bool
(P4D -> P4D -> Bool) -> (P4D -> P4D -> Bool) -> Eq P4D
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: P4D -> P4D -> Bool
== :: P4D -> P4D -> Bool
$c/= :: P4D -> P4D -> Bool
/= :: P4D -> P4D -> Bool
Eq)

instance PointND P4D where
    dimProps :: (Bool, Bool)
dimProps = (Bool
True, Bool
True)
    components :: P4D -> (Double, Double, Maybe Double, Maybe Double)
components (Point4D Double
x Double
y Double
z Double
m) = (Double
x, Double
y, Double -> Maybe Double
forall a. a -> Maybe a
Just Double
z, Double -> Maybe Double
forall a. a -> Maybe a
Just Double
m)
    fromComponents :: (Double, Double, Maybe Double, Maybe Double) -> P4D
fromComponents (Double
x, Double
y, Just Double
z, Just Double
m) = Double -> Double -> Double -> Double -> P4D
Point4D Double
x Double
y Double
z Double
m
    fromComponents (Double, Double, Maybe Double, Maybe Double)
_ = GeometryError -> P4D
forall a e. Exception e => e -> a
throw (GeometryError -> P4D) -> GeometryError -> P4D
forall a b. (a -> b) -> a -> b
$
        String -> GeometryError
GeometryError String
"invalid transition from user data type to Point4D"

-- Cast ========================================================================

type instance Cast P2D = P2D
type instance Cast P3DZ = P3DZ
type instance Cast P3DM = P3DM
type instance Cast P4D = P4D

instance Castable P2D where
    toPointND :: P2D -> Cast P2D
toPointND = P2D -> Cast P2D
P2D -> P2D
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P2D -> P2D
fromPointND = Cast P2D -> P2D
P2D -> P2D
forall a b. Coercible a b => a -> b
coerce
instance Castable P3DZ where
    toPointND :: P3DZ -> Cast P3DZ
toPointND = P3DZ -> Cast P3DZ
P3DZ -> P3DZ
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P3DZ -> P3DZ
fromPointND = Cast P3DZ -> P3DZ
P3DZ -> P3DZ
forall a b. Coercible a b => a -> b
coerce
instance Castable P3DM where
    toPointND :: P3DM -> Cast P3DM
toPointND = P3DM -> Cast P3DM
P3DM -> P3DM
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P3DM -> P3DM
fromPointND = Cast P3DM -> P3DM
P3DM -> P3DM
forall a b. Coercible a b => a -> b
coerce
instance Castable P4D where
    toPointND :: P4D -> Cast P4D
toPointND = P4D -> Cast P4D
P4D -> P4D
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P4D -> P4D
fromPointND = Cast P4D -> P4D
P4D -> P4D
forall a b. Coercible a b => a -> b
coerce