Line.hs

module PostgresqlTypes.Line
  ( Line,

    -- * Accessors
    toA,
    toB,
    toC,

    -- * Constructors
    refineFromEquation,
    normalizeFromEquation,
  )
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 Test.QuickCheck as QuickCheck
import qualified TextBuilder

-- | PostgreSQL @line@ type. Infinite line in 2D plane.
--
-- The line is represented by the linear equation @Ax + By + C = 0@.
-- Stored as three @64@-bit floating point numbers (@A@, @B@, @C@).
--
-- [PostgreSQL docs](https://www.postgresql.org/docs/18/datatype-geometric.html#DATATYPE-LINE).
data Line
  = Line
      -- | A coefficient
      Double
      -- | B coefficient
      Double
      -- | C coefficient
      Double
  deriving stock (Eq, Ord)
  deriving (Show, Read, IsString) via (ViaIsScalar Line)

instance Arbitrary Line where
  arbitrary = do
    -- Ensure at least one of A or B is non-zero
    (a, b) <-
      QuickCheck.suchThat
        ((,) <$> arbitrary <*> arbitrary)
        (\(a, b) -> not (a == 0 && b == 0))
    c <- arbitrary
    pure (Line a b c)
  shrink (Line a b c) =
    [ Line a' b' c'
    | (a', b', c') <- shrink (a, b, c),
      not (a' == 0 && b' == 0) -- Ensure shrunk values are also valid
    ]

instance Hashable Line where
  hashWithSalt salt (Line a b c) =
    salt
      `hashWithSalt` castDoubleToWord64 a
      `hashWithSalt` castDoubleToWord64 b
      `hashWithSalt` castDoubleToWord64 c

instance IsScalar Line where
  schemaName = Tagged Nothing
  typeName = Tagged "line"
  baseOid = Tagged (Just 628)
  arrayOid = Tagged (Just 629)
  typeParams = Tagged []
  binaryEncoder (Line a b c) =
    mconcat
      [ Write.bWord64 (castDoubleToWord64 a),
        Write.bWord64 (castDoubleToWord64 b),
        Write.bWord64 (castDoubleToWord64 c)
      ]
  binaryDecoder = do
    a <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)
    b <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)
    c <- PtrPeeker.fixed (castWord64ToDouble <$> PtrPeeker.beUnsignedInt8)
    pure (Right (Line a b c))
  textualEncoder (Line a b c) =
    "{"
      <> TextBuilder.string (printf "%g" a)
      <> ","
      <> TextBuilder.string (printf "%g" b)
      <> ","
      <> TextBuilder.string (printf "%g" c)
      <> "}"
  textualDecoder = do
    _ <- Attoparsec.char '{'
    a <- Attoparsec.double
    _ <- Attoparsec.char ','
    b <- Attoparsec.double
    _ <- Attoparsec.char ','
    c <- Attoparsec.double
    _ <- Attoparsec.char '}'
    pure (Line a b c)

-- * Accessors

-- | Extract the A coefficient from Ax + By + C = 0.
toA :: Line -> Double
toA (Line a _ _) = a

-- | Extract the B coefficient from Ax + By + C = 0.
toB :: Line -> Double
toB (Line _ b _) = b

-- | Extract the C coefficient from Ax + By + C = 0.
toC :: Line -> Double
toC (Line _ _ c) = c

-- * Constructors

-- | Construct a PostgreSQL 'Line' from equation coefficients A, B, C with validation.
-- Returns 'Nothing' if both A and B are zero (invalid line).
refineFromEquation :: Double -> Double -> Double -> Maybe Line
refineFromEquation a b c = do
  when (a == 0 && b == 0) empty
  pure (Line a b c)

-- | Construct a PostgreSQL 'Line' from equation coefficients A, B, C.
-- Defaults to vertical line when A and B equal 0.
normalizeFromEquation :: Double -> Double -> Double -> Line
normalizeFromEquation a b c =
  if a == 0 && b == 0
    then Line 1 0 c
    else Line a b c