{-# LANGUAGE TypeFamilies #-}

module Database.Postgis.Trivial.Storable.PointND
( P2DS (..)
, P3DZS (..)
, P3DMS (..)
, P4DS (..)
) where

import GHC.Base
import GHC.Show ( Show )
import Foreign.Storable ( Storable (..) )
import Foreign.Storable.Record as Store
import Control.Exception ( throw )

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


-- | Four arguments LiftA
liftA4 :: Applicative f
        => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 :: forall (f :: * -> *) a b c d e.
Applicative f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 a -> b -> c -> d -> e
f f a
a f b
b f c
c f d
d = (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f (d -> e)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 a -> b -> c -> d -> e
f f a
a f b
b f c
c f (d -> e) -> f d -> f e
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f d
d

-- P2DS =========================================================================

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

storeP2DS :: Store.Dictionary P2DS
storeP2DS :: Dictionary P2DS
storeP2DS = Access P2DS P2DS -> Dictionary P2DS
forall r. Access r r -> Dictionary r
Store.run (Access P2DS P2DS -> Dictionary P2DS)
-> Access P2DS P2DS -> Dictionary P2DS
forall a b. (a -> b) -> a -> b
$
    (Double -> Double -> P2DS)
-> Access P2DS Double -> Access P2DS Double -> Access P2DS P2DS
forall a b c.
(a -> b -> c) -> Access P2DS a -> Access P2DS b -> Access P2DS c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Double -> Double -> P2DS
Point2DS
        ((P2DS -> Double) -> Access P2DS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P2DS -> Double
xP2DS)
        ((P2DS -> Double) -> Access P2DS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P2DS -> Double
yP2DS)

instance Storable P2DS where
   sizeOf :: P2DS -> Int
sizeOf = Dictionary P2DS -> P2DS -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary P2DS
storeP2DS
   alignment :: P2DS -> Int
alignment = Dictionary P2DS -> P2DS -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary P2DS
storeP2DS
   peek :: Ptr P2DS -> IO P2DS
peek = Dictionary P2DS -> Ptr P2DS -> IO P2DS
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary P2DS
storeP2DS
   poke :: Ptr P2DS -> P2DS -> IO ()
poke = Dictionary P2DS -> Ptr P2DS -> P2DS -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary P2DS
storeP2DS

instance PointND P2DS where
    dimProps :: (Bool, Bool)
dimProps = (Bool
False, Bool
False)
    components :: P2DS -> (Double, Double, Maybe Double, Maybe Double)
components (Point2DS 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) -> P2DS
fromComponents (Double
x, Double
y, Maybe Double
Nothing, Maybe Double
Nothing) = Double -> Double -> P2DS
Point2DS Double
x Double
y
    fromComponents (Double, Double, Maybe Double, Maybe Double)
_ = GeometryError -> P2DS
forall a e. Exception e => e -> a
throw (GeometryError -> P2DS) -> GeometryError -> P2DS
forall a b. (a -> b) -> a -> b
$
        String -> GeometryError
GeometryError String
"invalid transition from user data type to P2DS"

-- P3DZ ========================================================================

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

storeP3DZ :: Store.Dictionary P3DZS
storeP3DZ :: Dictionary P3DZS
storeP3DZ = Access P3DZS P3DZS -> Dictionary P3DZS
forall r. Access r r -> Dictionary r
Store.run (Access P3DZS P3DZS -> Dictionary P3DZS)
-> Access P3DZS P3DZS -> Dictionary P3DZS
forall a b. (a -> b) -> a -> b
$
    (Double -> Double -> Double -> P3DZS)
-> Access P3DZS Double
-> Access P3DZS Double
-> Access P3DZS Double
-> Access P3DZS P3DZS
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Double -> Double -> Double -> P3DZS
Point3DZS
        ((P3DZS -> Double) -> Access P3DZS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P3DZS -> Double
xP3DZ)
        ((P3DZS -> Double) -> Access P3DZS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P3DZS -> Double
yP3DZ)
        ((P3DZS -> Double) -> Access P3DZS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P3DZS -> Double
zP3DZ)

instance Storable P3DZS where
   sizeOf :: P3DZS -> Int
sizeOf = Dictionary P3DZS -> P3DZS -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary P3DZS
storeP3DZ
   alignment :: P3DZS -> Int
alignment = Dictionary P3DZS -> P3DZS -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary P3DZS
storeP3DZ
   peek :: Ptr P3DZS -> IO P3DZS
peek = Dictionary P3DZS -> Ptr P3DZS -> IO P3DZS
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary P3DZS
storeP3DZ
   poke :: Ptr P3DZS -> P3DZS -> IO ()
poke = Dictionary P3DZS -> Ptr P3DZS -> P3DZS -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary P3DZS
storeP3DZ

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

-- P3DM ========================================================================

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

storeP3DM :: Store.Dictionary P3DMS
storeP3DM :: Dictionary P3DMS
storeP3DM = Access P3DMS P3DMS -> Dictionary P3DMS
forall r. Access r r -> Dictionary r
Store.run (Access P3DMS P3DMS -> Dictionary P3DMS)
-> Access P3DMS P3DMS -> Dictionary P3DMS
forall a b. (a -> b) -> a -> b
$
    (Double -> Double -> Double -> P3DMS)
-> Access P3DMS Double
-> Access P3DMS Double
-> Access P3DMS Double
-> Access P3DMS P3DMS
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Double -> Double -> Double -> P3DMS
Point3DMS
        ((P3DMS -> Double) -> Access P3DMS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P3DMS -> Double
xP3DM)
        ((P3DMS -> Double) -> Access P3DMS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P3DMS -> Double
yP3DM)
        ((P3DMS -> Double) -> Access P3DMS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P3DMS -> Double
mP3DM)

instance Storable P3DMS where
   sizeOf :: P3DMS -> Int
sizeOf = Dictionary P3DMS -> P3DMS -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary P3DMS
storeP3DM
   alignment :: P3DMS -> Int
alignment = Dictionary P3DMS -> P3DMS -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary P3DMS
storeP3DM
   peek :: Ptr P3DMS -> IO P3DMS
peek = Dictionary P3DMS -> Ptr P3DMS -> IO P3DMS
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary P3DMS
storeP3DM
   poke :: Ptr P3DMS -> P3DMS -> IO ()
poke = Dictionary P3DMS -> Ptr P3DMS -> P3DMS -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary P3DMS
storeP3DM

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

-- P4D =========================================================================

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

storeP4D :: Store.Dictionary P4DS
storeP4D :: Dictionary P4DS
storeP4D = Access P4DS P4DS -> Dictionary P4DS
forall r. Access r r -> Dictionary r
Store.run (Access P4DS P4DS -> Dictionary P4DS)
-> Access P4DS P4DS -> Dictionary P4DS
forall a b. (a -> b) -> a -> b
$
    (Double -> Double -> Double -> Double -> P4DS)
-> Access P4DS Double
-> Access P4DS Double
-> Access P4DS Double
-> Access P4DS Double
-> Access P4DS P4DS
forall (f :: * -> *) a b c d e.
Applicative f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 Double -> Double -> Double -> Double -> P4DS
Point4DS
        ((P4DS -> Double) -> Access P4DS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P4DS -> Double
xP4D)
        ((P4DS -> Double) -> Access P4DS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P4DS -> Double
yP4D)
        ((P4DS -> Double) -> Access P4DS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P4DS -> Double
zP4D)
        ((P4DS -> Double) -> Access P4DS Double
forall a r. Storable a => (r -> a) -> Access r a
Store.element P4DS -> Double
mP4D)

instance Storable P4DS where
   sizeOf :: P4DS -> Int
sizeOf = Dictionary P4DS -> P4DS -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary P4DS
storeP4D
   alignment :: P4DS -> Int
alignment = Dictionary P4DS -> P4DS -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary P4DS
storeP4D
   peek :: Ptr P4DS -> IO P4DS
peek = Dictionary P4DS -> Ptr P4DS -> IO P4DS
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary P4DS
storeP4D
   poke :: Ptr P4DS -> P4DS -> IO ()
poke = Dictionary P4DS -> Ptr P4DS -> P4DS -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary P4DS
storeP4D

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

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

type instance Cast P2DS = P2DS
type instance Cast P3DZS = P3DZS
type instance Cast P3DMS = P3DMS
type instance Cast P4DS = P4DS

instance Castable P2DS where
    toPointND :: P2DS -> Cast P2DS
toPointND = P2DS -> Cast P2DS
P2DS -> P2DS
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P2DS -> P2DS
fromPointND = Cast P2DS -> P2DS
P2DS -> P2DS
forall a b. Coercible a b => a -> b
coerce
instance Castable P3DZS where
    toPointND :: P3DZS -> Cast P3DZS
toPointND = P3DZS -> Cast P3DZS
P3DZS -> P3DZS
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P3DZS -> P3DZS
fromPointND = Cast P3DZS -> P3DZS
P3DZS -> P3DZS
forall a b. Coercible a b => a -> b
coerce
instance Castable P3DMS where
    toPointND :: P3DMS -> Cast P3DMS
toPointND = P3DMS -> Cast P3DMS
P3DMS -> P3DMS
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P3DMS -> P3DMS
fromPointND = Cast P3DMS -> P3DMS
P3DMS -> P3DMS
forall a b. Coercible a b => a -> b
coerce
instance Castable P4DS where
    toPointND :: P4DS -> Cast P4DS
toPointND = P4DS -> Cast P4DS
P4DS -> P4DS
forall a b. Coercible a b => a -> b
coerce
    fromPointND :: Cast P4DS -> P4DS
fromPointND = Cast P4DS -> P4DS
P4DS -> P4DS
forall a b. Coercible a b => a -> b
coerce