{-# LANGUAGE TemplateHaskell #-}
module IHP.Postgres.Point where
import GHC.Float
import BasicPrelude
import Database.PostgreSQL.Simple.ToField
import Database.PostgreSQL.Simple.FromField
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, Parser(..))
import Data.Attoparsec.Internal.Types (Parser)
import Data.Aeson
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
parsePoint 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
parsePoint :: Parser ByteString Point
parsePoint :: Parser Point
parsePoint = do
ByteString -> Parser ByteString
string ByteString
"("
Double
x <- Parser ByteString Double
doubleOrNaN
ByteString -> Parser ByteString
string ByteString
","
Double
y <- Parser ByteString Double
doubleOrNaN
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 }
where
doubleOrNaN :: Parser ByteString Double
doubleOrNaN = Parser ByteString Double
double Parser ByteString Double
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"NaN" Parser ByteString
-> Parser ByteString Double -> Parser ByteString Double
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Double -> Parser ByteString Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parser ByteString Double)
-> Double -> Parser ByteString Double
forall a b. (a -> b) -> a -> b
$ Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0))
instance ToField Point where
toField :: Point -> Action
toField = Point -> Action
serializePoint
serializePoint :: Point -> Action
serializePoint :: Point -> Action
serializePoint Point { Double
x :: Double
$sel:x:Point :: Point -> Double
x, Double
y :: Double
$sel:y:Point :: Point -> Double
y } = [Action] -> Action
Many
[ Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
"point(")
, Double -> Action
forall a. ToField a => a -> Action
toField Double
x
, Builder -> Action
Plain (Char -> Builder
char8 Char
',')
, Double -> Action
forall a. ToField a => a -> Action
toField Double
y
, Builder -> Action
Plain (Char -> Builder
char8 Char
')')
]
instance FromJSON Point where
parseJSON :: Value -> Parser Point
parseJSON = String -> (Object -> Parser Point) -> Value -> Parser Point
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Point" ((Object -> Parser Point) -> Value -> Parser Point)
-> (Object -> Parser Point) -> Value -> Parser Point
forall a b. (a -> b) -> a -> b
$ \Object
v -> Double -> Double -> Point
Point
(Double -> Double -> Point)
-> Parser Double -> Parser (Double -> Point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"x"
Parser (Double -> Point) -> Parser Double -> Parser Point
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"y"
instance ToJSON Point where
toJSON :: Point -> Value
toJSON Point { Double
x :: Double
$sel:x:Point :: Point -> Double
x, Double
y :: Double
$sel:y:Point :: Point -> Double
y } = [Pair] -> Value
object [ Text
"x" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
x, Text
"y" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
y ]