Added basic support for Point types in DataSync

digitallyinduced · Feb 4, 2022 · 1c38e4a · 1c38e4a
1 parent df18327
commit 1c38e4a
Show file tree

Hide file tree

Showing 4 changed files with 33 additions and 1 deletion.
diff --git a/IHP/DataSync/DynamicQuery.hs b/IHP/DataSync/DynamicQuery.hs
@@ -26,6 +26,7 @@ data DynamicValue
     | BoolValue !Bool
     | UUIDValue !UUID
     | DateTimeValue !UTCTime
+    | PointValue !Point
     | Null
     deriving (Show, Eq)
 
@@ -84,6 +85,7 @@ instance {-# OVERLAPS #-} ToJSON [Field] where
             fieldValueToJSON (BoolValue value) = toJSON value
             fieldValueToJSON (UUIDValue value) = toJSON value
             fieldValueToJSON (DateTimeValue value) = toJSON value
+            fieldValueToJSON (PointValue value) = toJSON value
             fieldValueToJSON IHP.DataSync.DynamicQuery.Null = toJSON Data.Aeson.Null
 
 instance PG.FromField Field where
@@ -101,6 +103,7 @@ instance PG.FromField Field where
                 <|> (UUIDValue <$> PG.fromField field fieldValue')
                 <|> (DoubleValue <$> PG.fromField field fieldValue')
                 <|> (DateTimeValue <$> PG.fromField field fieldValue')
+                <|> (PointValue <$> PG.fromField field fieldValue')
                 <|> (PG.fromField @PG.Null field fieldValue' >> pure IHP.DataSync.DynamicQuery.Null)
                 <|> fromFieldCustomEnum field fieldValue'
 

diff --git a/IHP/DataSync/DynamicQueryCompiler.hs b/IHP/DataSync/DynamicQueryCompiler.hs
@@ -82,6 +82,7 @@ compileCondition (LiteralExpression literal) = ("?", [toValue literal])
         toValue (BoolValue bool) = PG.toField bool
         toValue (UUIDValue uuid) = PG.toField uuid
         toValue (DateTimeValue utcTime) = PG.toField utcTime
+        toValue (PointValue point) = PG.toField point
         toValue Null = PG.toField PG.Null
 
 compileOperator :: ConditionOperator -> PG.Query

diff --git a/IHP/DataSync/REST/Controller.hs b/IHP/DataSync/REST/Controller.hs
@@ -198,4 +198,22 @@ aesonValueToPostgresValue (Number value) = case Scientific.floatingOrInteger val
     Left (floating :: Double) -> PG.toField floating
     Right (integer :: Integer) -> PG.toField integer
 aesonValueToPostgresValue Data.Aeson.Null = PG.toField PG.Null
-aesonValueToPostgresValue object@(Object values) = PG.toField (toJSON object)
+aesonValueToPostgresValue object@(Object values) = 
+    let
+        tryDecodeAsPoint :: Maybe Point
+        tryDecodeAsPoint = do
+                xValue <- HashMap.lookup "x" values
+                yValue <- HashMap.lookup "y" values
+                x <- case xValue of
+                        Number number -> pure (Scientific.toRealFloat number)
+                        otherwise -> Nothing 
+                y <- case yValue of
+                        Number number -> pure (Scientific.toRealFloat number)
+                        otherwise -> Nothing 
+                pure Point { x, y }
+    in
+        -- This is really hacky and is mostly duck typing. We should refactor this in the future to
+        -- become more type aware by passing the DDL of the table to 'aesonValueToPostgresValue'.
+        if HashMap.size values == 2
+            then fromMaybe (PG.toField $ toJSON object) (PG.toField <$> tryDecodeAsPoint)
+            else PG.toField (toJSON object)
diff --git a/IHP/Postgres/Point.hs b/IHP/Postgres/Point.hs
@@ -16,6 +16,7 @@ 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
 
 -- | Represents a Postgres Point
 --
@@ -59,3 +60,12 @@ serializePoint Point { x, y } = Many
     , toField y
     , Plain (char8 ')')
     ]
+
+
+instance FromJSON Point where
+    parseJSON = withObject "Point" $ \v -> Point
+        <$> v .: "x"
+        <*> v .: "y"
+
+instance ToJSON Point where
+    toJSON Point { x, y } = object [ "x" .= x, "y" .= y ]