graphql-engine/server/src-lib/Hasura/SQL/Value.hs

204 lines
5.9 KiB
Haskell
Raw Normal View History

2018-06-27 16:11:32 +03:00
{-# LANGUAGE OverloadedStrings #-}
module Hasura.SQL.Value where
import Hasura.SQL.GeoJSON
import Hasura.SQL.Time
import Hasura.SQL.Types
import qualified Database.PG.Query as Q
import qualified Database.PG.Query.PTI as PTI
import qualified Hasura.SQL.DML as S
import Data.Aeson
import Data.Aeson.Internal
import Data.Int
import Data.Scientific
import Data.Time
import Hasura.Prelude
2018-06-27 16:11:32 +03:00
import qualified Data.Aeson.Text as AE
import qualified Data.Aeson.Types as AT
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified PostgreSQL.Binary.Encoding as PE
-- Binary value. Used in prepared sq
data PGColValue
= PGValInteger !Int32
| PGValSmallInt !Int16
| PGValBigInt !Int64
| PGValFloat !Float
| PGValDouble !Double
| PGValNumeric !Scientific
| PGValBoolean !Bool
| PGValChar !Char
| PGValVarchar !T.Text
| PGValText !T.Text
| PGValDate !Day
| PGValTimeStampTZ !UTCTime
| PGValTimeTZ !ZonedTimeOfDay
| PGNull !PGColType
| PGValJSON !Q.JSON
| PGValJSONB !Q.JSONB
| PGValGeo !Geometry
| PGValUnknown !T.Text
deriving (Show, Eq)
txtEncoder :: PGColValue -> S.SQLExp
txtEncoder colVal = case colVal of
PGValInteger i -> S.SELit $ T.pack $ show i
PGValSmallInt i -> S.SELit $ T.pack $ show i
PGValBigInt i -> S.SELit $ T.pack $ show i
PGValFloat f -> S.SELit $ T.pack $ show f
PGValDouble d -> S.SELit $ T.pack $ show d
PGValNumeric sc -> S.SELit $ T.pack $ show sc
PGValBoolean b -> S.SELit $ bool "false" "true" b
PGValChar t -> S.SELit $ T.pack $ show t
PGValVarchar t -> S.SELit t
PGValText t -> S.SELit t
PGValDate d -> S.SELit $ T.pack $ showGregorian d
PGValTimeStampTZ u ->
S.SELit $ T.pack $ formatTime defaultTimeLocale "%FT%T%QZ" u
PGValTimeTZ (ZonedTimeOfDay tod tz) ->
S.SELit $ T.pack (show tod ++ timeZoneOffsetString tz)
PGNull _ ->
S.SEUnsafe "NULL"
PGValJSON (Q.JSON j) -> S.SELit $ TL.toStrict $
AE.encodeToLazyText j
PGValJSONB (Q.JSONB j) -> S.SELit $ TL.toStrict $
AE.encodeToLazyText j
PGValGeo o -> S.SELit $ TL.toStrict $
AE.encodeToLazyText o
PGValUnknown t -> S.SELit t
binEncoder :: PGColValue -> Q.PrepArg
binEncoder colVal = case colVal of
PGValInteger i ->
Q.toPrepVal i
PGValSmallInt i ->
Q.toPrepVal i
PGValBigInt i ->
Q.toPrepVal i
PGValFloat f ->
Q.toPrepVal f
PGValDouble d ->
Q.toPrepVal d
PGValNumeric sc ->
Q.toPrepVal sc
PGValBoolean b ->
Q.toPrepVal b
PGValChar t ->
Q.toPrepVal t
PGValVarchar t ->
Q.toPrepVal t
PGValText t ->
Q.toPrepVal t
PGValDate d ->
Q.toPrepVal d
PGValTimeStampTZ u ->
Q.toPrepVal u
PGValTimeTZ (ZonedTimeOfDay t z) ->
Q.toPrepValHelper PTI.timetz PE.timetz_int (t, z)
PGNull ty ->
(pgTypeOid ty, Nothing)
PGValJSON u ->
Q.toPrepVal u
PGValJSONB u ->
Q.toPrepVal u
PGValGeo o ->
Q.toPrepVal $ TL.toStrict $ AE.encodeToLazyText o
PGValUnknown t ->
(PTI.auto, Just (TE.encodeUtf8 t, PQ.Text))
parsePGValue' :: PGColType
-> Value
-> AT.Parser PGColValue
parsePGValue' ty Null =
return $ PGNull ty
parsePGValue' PGSmallInt val =
PGValSmallInt <$> parseJSON val
parsePGValue' PGInteger val =
PGValInteger <$> parseJSON val
parsePGValue' PGBigInt val =
PGValBigInt <$> parseJSON val
parsePGValue' PGSerial val =
PGValInteger <$> parseJSON val
parsePGValue' PGBigSerial val =
PGValBigInt <$> parseJSON val
parsePGValue' PGFloat val =
PGValFloat <$> parseJSON val
parsePGValue' PGDouble val =
PGValDouble <$> parseJSON val
parsePGValue' PGNumeric val =
PGValNumeric <$> parseJSON val
parsePGValue' PGBoolean val =
PGValBoolean <$> parseJSON val
parsePGValue' PGChar val =
PGValChar <$> parseJSON val
parsePGValue' PGVarchar val =
PGValVarchar <$> parseJSON val
parsePGValue' PGText val =
PGValText <$> parseJSON val
parsePGValue' PGDate val =
PGValDate <$> parseJSON val
parsePGValue' PGTimeStampTZ val =
PGValTimeStampTZ <$> parseJSON val
parsePGValue' PGTimeTZ val =
PGValTimeTZ <$> parseJSON val
parsePGValue' PGJSON val =
PGValJSON . Q.JSON <$> parseJSON val
parsePGValue' PGJSONB val =
PGValJSONB . Q.JSONB <$> parseJSON val
parsePGValue' PGGeometry val =
PGValGeo <$> parseJSON val
parsePGValue' PGGeography val =
PGValGeo <$> parseJSON val
parsePGValue' (PGUnknown _) (String t) =
return $ PGValUnknown t
parsePGValue' (PGUnknown tyName) _ =
fail $ "A string is expected for type : " ++ T.unpack tyName
parsePGValue :: PGColType -> Value -> AT.Parser PGColValue
parsePGValue pct val =
case val of
String t -> parsePGValue' pct val <|> return (PGValUnknown t)
_ -> parsePGValue' pct val
convToBin :: PGColType
-> Value
-> AT.Parser Q.PrepArg
convToBin ty val =
binEncoder <$> parsePGValue ty val
convToTxt :: PGColType
-> Value
-> AT.Parser S.SQLExp
convToTxt ty val =
txtEncoder <$> parsePGValue ty val
readEitherTxt :: (Read a) => T.Text -> Either String a
readEitherTxt = readEither . T.unpack
iresToEither :: IResult a -> Either String a
iresToEither (IError _ msg) = Left msg
iresToEither (ISuccess a) = return a
pgValFromJVal :: (FromJSON a) => Value -> Either String a
pgValFromJVal = iresToEither . ifromJSON
toPrepParam :: Int -> PGColType -> S.SQLExp
toPrepParam i pct =
if pct == PGGeometry || pct == PGGeography
then S.SEFnApp "ST_GeomFromGeoJSON" [S.SEPrep i] Nothing
else S.SEPrep i
pgColValueToInt :: PGColValue -> Maybe Int
pgColValueToInt (PGValInteger i) = Just $ fromIntegral i
pgColValueToInt (PGValSmallInt i) = Just $ fromIntegral i
pgColValueToInt (PGValBigInt i) = Just $ fromIntegral i
pgColValueToInt _ = Nothing