{-# LANGUAGE TemplateHaskell #-}
{-|
Module: IHP.Postgres.Polygon
Description: Adds support for the Postgres Polygon type
Copyright: (c) digitally induced GmbH, 2022
-}
module IHP.Postgres.Polygon 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 IHP.Postgres.Point

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

instance FromField Polygon where
    fromField :: FieldParser Polygon
fromField Field
f Maybe ByteString
v =
        if Field -> Oid
typeOid Field
f forall a. Eq a => a -> a -> Bool
/= $(inlineTypoid TI.polygon)
        then 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 -> 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 forall a. Parser a -> ByteString -> Either String a
parseOnly Parser ByteString Polygon
parsePolygon ByteString
bs of
                     Left  String
err -> 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 Polygon
val -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Polygon
val

parsePolygon :: Parser ByteString Polygon
parsePolygon :: Parser ByteString Polygon
parsePolygon = do
    ByteString -> Parser ByteString
string ByteString
"("
    [Point]
points <- Parser ByteString Point
parsePoint forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` (Char -> Parser Char
char Char
',')
    ByteString -> Parser ByteString
string ByteString
")"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Point] -> Polygon
Polygon [Point]
points

instance ToField Polygon where
    toField :: Polygon -> Action
toField = Polygon -> Action
serializePolygon

serializePolygon :: Polygon -> Action
serializePolygon :: Polygon -> Action
serializePolygon Polygon { [Point]
points :: [Point]
$sel:points:Polygon :: Polygon -> [Point]
points } = [Action] -> Action
Many forall a b. (a -> b) -> a -> b
$
    (Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
"polygon'"))forall a. a -> [a] -> [a]
:
    ( (forall a. a -> [a] -> [a]
intersperse (Builder -> Action
Plain forall a b. (a -> b) -> a -> b
$ Char -> Builder
char8 Char
',') forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Point -> Action
serializePoint' [Point]
points)
      forall w. Monoid w => w -> w -> w
++ [ Builder -> Action
Plain (Char -> Builder
char8 Char
'\'') ])
    where
        serializePoint' :: Point -> Action
        serializePoint' :: Point -> Action
serializePoint' Point { Double
$sel:x:Point :: Point -> Double
x :: Double
x, Double
$sel:y:Point :: Point -> Double
y :: Double
y } = [Action] -> Action
Many forall a b. (a -> b) -> a -> b
$
            [ Builder -> Action
Plain (Char -> Builder
char8 Char
'(')
            , forall a. ToField a => a -> Action
toField Double
x
            , Builder -> Action
Plain (Char -> Builder
char8 Char
',')
            , forall a. ToField a => a -> Action
toField Double
y
            , Builder -> Action
Plain (Char -> Builder
char8 Char
')')
            ]