module PostgresqlTypes.Lseg
  ( Lseg (..),

    -- * Accessors
    toX1,
    toY1,
    toX2,
    toY2,

    -- * Constructors
    fromEndpoints,
  )
where

import qualified Data.Attoparsec.Text as Attoparsec
import GHC.Float (castDoubleToWord64, castWord64ToDouble)
import PostgresqlTypes.Algebra
import PostgresqlTypes.Prelude
import PostgresqlTypes.Via
import qualified PtrPeeker
import qualified PtrPoker.Write as Write
import qualified TextBuilder

-- | PostgreSQL @lseg@ type. Line segment in 2D plane.
--
-- The line segment is defined by two endpoints, each with (@x@,@y@) coordinates.
-- Stored as four @64@-bit floating point numbers: (@x1@, @y1@, @x2@, @y2@).
--
-- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-geometric.html#DATATYPE-LSEG).
data Lseg
  = Lseg
      -- | X coordinate of first endpoint
      Double
      -- | Y coordinate of first endpoint
      Double
      -- | X coordinate of second endpoint
      Double
      -- | Y coordinate of second endpoint
      Double
  deriving stock (Lseg -> Lseg -> Bool
(Lseg -> Lseg -> Bool) -> (Lseg -> Lseg -> Bool) -> Eq Lseg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Lseg -> Lseg -> Bool
== :: Lseg -> Lseg -> Bool
$c/= :: Lseg -> Lseg -> Bool
/= :: Lseg -> Lseg -> Bool
Eq, Eq Lseg
Eq Lseg =>
(Lseg -> Lseg -> Ordering)
-> (Lseg -> Lseg -> Bool)
-> (Lseg -> Lseg -> Bool)
-> (Lseg -> Lseg -> Bool)
-> (Lseg -> Lseg -> Bool)
-> (Lseg -> Lseg -> Lseg)
-> (Lseg -> Lseg -> Lseg)
-> Ord Lseg
Lseg -> Lseg -> Bool
Lseg -> Lseg -> Ordering
Lseg -> Lseg -> Lseg
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
$ccompare :: Lseg -> Lseg -> Ordering
compare :: Lseg -> Lseg -> Ordering
$c< :: Lseg -> Lseg -> Bool
< :: Lseg -> Lseg -> Bool
$c<= :: Lseg -> Lseg -> Bool
<= :: Lseg -> Lseg -> Bool
$c> :: Lseg -> Lseg -> Bool
> :: Lseg -> Lseg -> Bool
$c>= :: Lseg -> Lseg -> Bool
>= :: Lseg -> Lseg -> Bool
$cmax :: Lseg -> Lseg -> Lseg
max :: Lseg -> Lseg -> Lseg
$cmin :: Lseg -> Lseg -> Lseg
min :: Lseg -> Lseg -> Lseg
Ord)
  deriving (Int -> Lseg -> ShowS
[Lseg] -> ShowS
Lseg -> String
(Int -> Lseg -> ShowS)
-> (Lseg -> String) -> ([Lseg] -> ShowS) -> Show Lseg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Lseg -> ShowS
showsPrec :: Int -> Lseg -> ShowS
$cshow :: Lseg -> String
show :: Lseg -> String
$cshowList :: [Lseg] -> ShowS
showList :: [Lseg] -> ShowS
Show, ReadPrec [Lseg]
ReadPrec Lseg
Int -> ReadS Lseg
ReadS [Lseg]
(Int -> ReadS Lseg)
-> ReadS [Lseg] -> ReadPrec Lseg -> ReadPrec [Lseg] -> Read Lseg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Lseg
readsPrec :: Int -> ReadS Lseg
$creadList :: ReadS [Lseg]
readList :: ReadS [Lseg]
$creadPrec :: ReadPrec Lseg
readPrec :: ReadPrec Lseg
$creadListPrec :: ReadPrec [Lseg]
readListPrec :: ReadPrec [Lseg]
Read, String -> Lseg
(String -> Lseg) -> IsString Lseg
forall a. (String -> a) -> IsString a
$cfromString :: String -> Lseg
fromString :: String -> Lseg
IsString) via (ViaIsScalar Lseg)

instance Arbitrary Lseg where
  arbitrary :: Gen Lseg
arbitrary = Double -> Double -> Double -> Double -> Lseg
Lseg (Double -> Double -> Double -> Double -> Lseg)
-> Gen Double -> Gen (Double -> Double -> Double -> Lseg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
arbitrary Gen (Double -> Double -> Double -> Lseg)
-> Gen Double -> Gen (Double -> Double -> Lseg)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Double
forall a. Arbitrary a => Gen a
arbitrary Gen (Double -> Double -> Lseg)
-> Gen Double -> Gen (Double -> Lseg)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Double
forall a. Arbitrary a => Gen a
arbitrary Gen (Double -> Lseg) -> Gen Double -> Gen Lseg
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Double
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Lseg -> [Lseg]
shrink (Lseg Double
x1 Double
y1 Double
x2 Double
y2) =
    [Double -> Double -> Double -> Double -> Lseg
Lseg Double
x1' Double
y1' Double
x2' Double
y2' | (Double
x1', Double
y1', Double
x2', Double
y2') <- (Double, Double, Double, Double)
-> [(Double, Double, Double, Double)]
forall a. Arbitrary a => a -> [a]
shrink (Double
x1, Double
y1, Double
x2, Double
y2)]

instance Hashable Lseg where
  hashWithSalt :: Int -> Lseg -> Int
hashWithSalt Int
salt (Lseg Double
x1 Double
y1 Double
x2 Double
y2) =
    Int
salt
      Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Double -> Word64
castDoubleToWord64 Double
x1
      Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Double -> Word64
castDoubleToWord64 Double
y1
      Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Double -> Word64
castDoubleToWord64 Double
x2
      Int -> Word64 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Double -> Word64
castDoubleToWord64 Double
y2

instance IsScalar Lseg where
  schemaName :: Tagged Lseg (Maybe Text)
schemaName = Maybe Text -> Tagged Lseg (Maybe Text)
forall {k} (s :: k) b. b -> Tagged s b
Tagged Maybe Text
forall a. Maybe a
Nothing
  typeName :: Tagged Lseg Text
typeName = Text -> Tagged Lseg Text
forall {k} (s :: k) b. b -> Tagged s b
Tagged Text
"lseg"
  baseOid :: Tagged Lseg (Maybe Word32)
baseOid = Maybe Word32 -> Tagged Lseg (Maybe Word32)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
601)
  arrayOid :: Tagged Lseg (Maybe Word32)
arrayOid = Maybe Word32 -> Tagged Lseg (Maybe Word32)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
1018)
  typeParams :: Tagged Lseg [Text]
typeParams = [Text] -> Tagged Lseg [Text]
forall {k} (s :: k) b. b -> Tagged s b
Tagged []
  binaryEncoder :: Lseg -> Write
binaryEncoder (Lseg Double
x1 Double
y1 Double
x2 Double
y2) =
    [Write] -> Write
forall a. Monoid a => [a] -> a
mconcat
      [ Word64 -> Write
Write.bWord64 (Double -> Word64
castDoubleToWord64 Double
x1),
        Word64 -> Write
Write.bWord64 (Double -> Word64
castDoubleToWord64 Double
y1),
        Word64 -> Write
Write.bWord64 (Double -> Word64
castDoubleToWord64 Double
x2),
        Word64 -> Write
Write.bWord64 (Double -> Word64
castDoubleToWord64 Double
y2)
      ]
  binaryDecoder :: Variable (Either DecodingError Lseg)
binaryDecoder = do
    Double
x1 <- Fixed Double -> Variable Double
forall a. Fixed a -> Variable a
PtrPeeker.fixed (Word64 -> Double
castWord64ToDouble (Word64 -> Double) -> Fixed Word64 -> Fixed Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed Word64
PtrPeeker.beUnsignedInt8)
    Double
y1 <- Fixed Double -> Variable Double
forall a. Fixed a -> Variable a
PtrPeeker.fixed (Word64 -> Double
castWord64ToDouble (Word64 -> Double) -> Fixed Word64 -> Fixed Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed Word64
PtrPeeker.beUnsignedInt8)
    Double
x2 <- Fixed Double -> Variable Double
forall a. Fixed a -> Variable a
PtrPeeker.fixed (Word64 -> Double
castWord64ToDouble (Word64 -> Double) -> Fixed Word64 -> Fixed Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed Word64
PtrPeeker.beUnsignedInt8)
    Double
y2 <- Fixed Double -> Variable Double
forall a. Fixed a -> Variable a
PtrPeeker.fixed (Word64 -> Double
castWord64ToDouble (Word64 -> Double) -> Fixed Word64 -> Fixed Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fixed Word64
PtrPeeker.beUnsignedInt8)
    pure (Lseg -> Either DecodingError Lseg
forall a b. b -> Either a b
Right (Double -> Double -> Double -> Double -> Lseg
Lseg Double
x1 Double
y1 Double
x2 Double
y2))
  textualEncoder :: Lseg -> TextBuilder
textualEncoder (Lseg Double
x1 Double
y1 Double
x2 Double
y2) =
    TextBuilder
"[("
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
TextBuilder.string (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%g" Double
x1)
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
","
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
TextBuilder.string (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%g" Double
y1)
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"),"
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"("
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
TextBuilder.string (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%g" Double
x2)
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
","
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
TextBuilder.string (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%g" Double
y2)
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
")]"
  textualDecoder :: Parser Lseg
textualDecoder = do
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
'['
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
'('
    Double
x1 <- Parser Text Double
Attoparsec.double
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
','
    Double
y1 <- Parser Text Double
Attoparsec.double
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
')'
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
','
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
'('
    Double
x2 <- Parser Text Double
Attoparsec.double
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
','
    Double
y2 <- Parser Text Double
Attoparsec.double
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
')'
    Char
_ <- Char -> Parser Text Char
Attoparsec.char Char
']'
    pure (Double -> Double -> Double -> Double -> Lseg
Lseg Double
x1 Double
y1 Double
x2 Double
y2)

-- * Accessors

-- | Extract the X coordinate of the first endpoint.
toX1 :: Lseg -> Double
toX1 :: Lseg -> Double
toX1 (Lseg Double
x1 Double
_ Double
_ Double
_) = Double
x1

-- | Extract the Y coordinate of the first endpoint.
toY1 :: Lseg -> Double
toY1 :: Lseg -> Double
toY1 (Lseg Double
_ Double
y1 Double
_ Double
_) = Double
y1

-- | Extract the X coordinate of the second endpoint.
toX2 :: Lseg -> Double
toX2 :: Lseg -> Double
toX2 (Lseg Double
_ Double
_ Double
x2 Double
_) = Double
x2

-- | Extract the Y coordinate of the second endpoint.
toY2 :: Lseg -> Double
toY2 :: Lseg -> Double
toY2 (Lseg Double
_ Double
_ Double
_ Double
y2) = Double
y2

-- * Constructors

-- | Construct a PostgreSQL 'Lseg' from endpoint coordinates.
fromEndpoints :: Double -> Double -> Double -> Double -> Lseg
fromEndpoints :: Double -> Double -> Double -> Double -> Lseg
fromEndpoints Double
x1 Double
y1 Double
x2 Double
y2 = Double -> Double -> Double -> Double -> Lseg
Lseg Double
x1 Double
y1 Double
x2 Double
y2