{-# LANGUAGE TemplateHaskell #-}
{-|
Module: IHP.Postgres.Point
Description: Adds support for the Postgres Point type
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.Postgres.Point where

import GHC.Float
import BasicPrelude

import qualified Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.ToField
import Database.PostgreSQL.Simple.FromField
import qualified Database.PostgreSQL.Simple.Types
import           Database.PostgreSQL.Simple.TypeInfo as TI
import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI
import           Database.PostgreSQL.Simple.TypeInfo.Macro as TI
import           Data.ByteString.Builder (byteString, char8)
import           Data.Attoparsec.ByteString.Char8 hiding (Result, char8)

-- | Represents a Postgres Point
--
-- See https://www.postgresql.org/docs/9.5/datatype-geometric.html
data Point = Point { Point -> Double
x :: Double, Point -> Double
y :: Double }
    deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq, Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show, Eq Point
Eq Point
-> (Point -> Point -> Ordering)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Bool)
-> (Point -> Point -> Point)
-> (Point -> Point -> Point)
-> Ord Point
Point -> Point -> Bool
Point -> Point -> Ordering
Point -> Point -> Point
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
min :: Point -> Point -> Point
$cmin :: Point -> Point -> Point
max :: Point -> Point -> Point
$cmax :: Point -> Point -> Point
>= :: Point -> Point -> Bool
$c>= :: Point -> Point -> Bool
> :: Point -> Point -> Bool
$c> :: Point -> Point -> Bool
<= :: Point -> Point -> Bool
$c<= :: Point -> Point -> Bool
< :: Point -> Point -> Bool
$c< :: Point -> Point -> Bool
compare :: Point -> Point -> Ordering
$ccompare :: Point -> Point -> Ordering
$cp1Ord :: Eq Point
Ord)

instance FromField Point where
    fromField :: FieldParser Point
fromField Field
f Maybe ByteString
v =
        if Field -> Oid
typeOid Field
f Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
/= $(inlineTypoid TI.point)
        then (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Point
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
f String
""
        else case Maybe ByteString
v of
               Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Point
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
f String
""
               Just ByteString
bs ->
                   case Parser Point -> ByteString -> Either String Point
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser Point
parser ByteString
bs of
                     Left  String
err -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion Point
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed Field
f String
err
                     Right Point
val -> Point -> Conversion Point
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point
val
      where
        parser :: Parser Point
parser = do
            ByteString -> Parser ByteString
string ByteString
"("
            Double
x <- Parser Double
double
            ByteString -> Parser ByteString
string ByteString
","
            Double
y <- Parser Double
double
            ByteString -> Parser ByteString
string ByteString
")"
            Point -> Parser Point
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point -> Parser Point) -> Point -> Parser Point
forall a b. (a -> b) -> a -> b
$ Point :: Double -> Double -> Point
Point { Double
x :: Double
$sel:x:Point :: Double
x, Double
y :: Double
$sel:y:Point :: Double
y }

instance ToField Point where
    toField :: Point -> Action
toField Point { Double
x :: Double
$sel:x:Point :: Point -> Double
x, Double
y :: Double
$sel:y:Point :: Point -> Double
y } = [Action] -> Action
Many ([Action] -> Action) -> [Action] -> Action
forall a b. (a -> b) -> a -> b
$
        (Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
"point(")) Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:
        (Double -> Action
forall a. ToField a => a -> Action
toField Double
x) Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:
        (Builder -> Action
Plain (Char -> Builder
char8 Char
',')) Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:
        (Double -> Action
forall a. ToField a => a -> Action
toField Double
y) Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:
        [Builder -> Action
Plain (Char -> Builder
char8 Char
')')]