Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add support for the PostgreSQL column "timestamptz"

  • Loading branch information...
commit 7c35b659d30d963e442f5fd4c3b7242f90d67960 1 parent fdc8303
@rekado rekado authored
View
71 persistent-postgresql/Database/Persist/Postgresql.hs
@@ -220,6 +220,7 @@ instance PGTF.ToField P where
toField (P (PersistDay d)) = PGTF.toField d
toField (P (PersistTimeOfDay t)) = PGTF.toField t
toField (P (PersistUTCTime t)) = PGTF.toField t
+ toField (P (PersistZonedTime t)) = PGTF.toField t
toField (P PersistNull) = PGTF.toField PG.Null
toField (P (PersistList l)) = PGTF.toField $ listToJSON l
toField (P (PersistMap m)) = PGTF.toField $ mapToJSON m
@@ -233,29 +234,30 @@ convertPV f = (fmap f .) . PGFF.fromField
-- FIXME: check if those are correct and complete.
getGetter :: PG.BuiltinType -> Getter PersistValue
-getGetter PG.Bool = convertPV PersistBool
-getGetter PG.Bytea = convertPV (PersistByteString . unBinary)
-getGetter PG.Char = convertPV PersistText
-getGetter PG.Name = convertPV PersistText
-getGetter PG.Int8 = convertPV PersistInt64
-getGetter PG.Int2 = convertPV PersistInt64
-getGetter PG.Int4 = convertPV PersistInt64
-getGetter PG.Text = convertPV PersistText
-getGetter PG.Xml = convertPV PersistText
-getGetter PG.Float4 = convertPV PersistDouble
-getGetter PG.Float8 = convertPV PersistDouble
-getGetter PG.Abstime = convertPV PersistUTCTime
-getGetter PG.Reltime = convertPV PersistUTCTime
-getGetter PG.Money = convertPV PersistDouble
-getGetter PG.Bpchar = convertPV PersistText
-getGetter PG.Varchar = convertPV PersistText
-getGetter PG.Date = convertPV PersistDay
-getGetter PG.Time = convertPV PersistTimeOfDay
-getGetter PG.Timestamp = convertPV PersistUTCTime
-getGetter PG.Bit = convertPV PersistInt64
-getGetter PG.Varbit = convertPV PersistInt64
-getGetter PG.Numeric = convertPV (PersistDouble . fromRational)
-getGetter PG.Void = \_ _ -> Ok PersistNull
+getGetter PG.Bool = convertPV PersistBool
+getGetter PG.Bytea = convertPV (PersistByteString . unBinary)
+getGetter PG.Char = convertPV PersistText
+getGetter PG.Name = convertPV PersistText
+getGetter PG.Int8 = convertPV PersistInt64
+getGetter PG.Int2 = convertPV PersistInt64
+getGetter PG.Int4 = convertPV PersistInt64
+getGetter PG.Text = convertPV PersistText
+getGetter PG.Xml = convertPV PersistText
+getGetter PG.Float4 = convertPV PersistDouble
+getGetter PG.Float8 = convertPV PersistDouble
+getGetter PG.Abstime = convertPV PersistUTCTime
+getGetter PG.Reltime = convertPV PersistUTCTime
+getGetter PG.Money = convertPV PersistDouble
+getGetter PG.Bpchar = convertPV PersistText
+getGetter PG.Varchar = convertPV PersistText
+getGetter PG.Date = convertPV PersistDay
+getGetter PG.Time = convertPV PersistTimeOfDay
+getGetter PG.Timestamp = convertPV PersistUTCTime
+getGetter PG.TimestampWithTimeZone = convertPV PersistZonedTime
+getGetter PG.Bit = convertPV PersistInt64
+getGetter PG.Varbit = convertPV PersistInt64
+getGetter PG.Numeric = convertPV (PersistDouble . fromRational)
+getGetter PG.Void = \_ _ -> Ok PersistNull
getGetter other = error $ "Postgresql.getGetter: type " ++
show other ++ " not supported."
@@ -406,17 +408,18 @@ getColumn getter tname [PersistText x, PersistText y, PersistText z, d] =
PersistNull -> Right Nothing
PersistText t -> Right $ Just t
_ -> Left $ pack $ "Invalid default column: " ++ show d
- getType "int4" = Right $ SqlInt32
- getType "int8" = Right $ SqlInteger
- getType "varchar" = Right $ SqlString
- getType "date" = Right $ SqlDay
- getType "bool" = Right $ SqlBool
- getType "timestamp" = Right $ SqlDayTime
- getType "float4" = Right $ SqlReal
- getType "float8" = Right $ SqlReal
- getType "bytea" = Right $ SqlBlob
- getType "time" = Right $ SqlTime
- getType a = Left $ "Unknown type: " `T.append` a
+ getType "int4" = Right $ SqlInt32
+ getType "int8" = Right $ SqlInteger
+ getType "varchar" = Right $ SqlString
+ getType "date" = Right $ SqlDay
+ getType "bool" = Right $ SqlBool
+ getType "timestamp" = Right $ SqlDayTime
+ getType "timestamptz" = Right $ SqlDayTime
+ getType "float4" = Right $ SqlReal
+ getType "float8" = Right $ SqlReal
+ getType "bytea" = Right $ SqlBlob
+ getType "time" = Right $ SqlTime
+ getType a = Left $ "Unknown type: " `T.append` a
getColumn _ _ x =
return $ Left $ pack $ "Invalid result from information_schema: " ++ show x
View
25 persistent/Database/Persist/Store.hs
@@ -55,6 +55,7 @@ import qualified Prelude
import Prelude hiding ((++), show)
import Data.Monoid (mappend)
import Data.Time (Day, TimeOfDay, UTCTime)
+import Data.Time.LocalTime (ZonedTime, zonedTimeToUTC, zonedTimeToLocalTime, zonedTimeZone)
import Data.ByteString.Char8 (ByteString, unpack)
import Control.Applicative
import Data.Typeable (Typeable)
@@ -122,6 +123,11 @@ instance E.Exception PersistException
instance Error PersistException where
strMsg = PersistError . T.pack
+instance Eq ZonedTime where
+ a /= b = zonedTimeToLocalTime a /= zonedTimeToLocalTime b || zonedTimeZone a /= zonedTimeZone b
+instance Ord ZonedTime where
+ a `compare` b = zonedTimeToUTC a `compare` zonedTimeToUTC b
+
-- | A raw value which can be stored in any backend and can be marshalled to
-- and from a 'PersistField'.
data PersistValue = PersistText T.Text
@@ -132,6 +138,7 @@ data PersistValue = PersistText T.Text
| PersistDay Day
| PersistTimeOfDay TimeOfDay
| PersistUTCTime UTCTime
+ | PersistZonedTime ZonedTime
| PersistNull
| PersistList [PersistValue]
| PersistMap [(T.Text, PersistValue)]
@@ -157,6 +164,7 @@ instance A.ToJSON PersistValue where
toJSON (PersistBool b) = A.Bool b
toJSON (PersistTimeOfDay t) = A.String $ T.cons 't' $ show t
toJSON (PersistUTCTime u) = A.String $ T.cons 'u' $ show u
+ toJSON (PersistZonedTime z) = A.String $ T.cons 'z' $ show z
toJSON (PersistDay d) = A.String $ T.cons 'd' $ show d
toJSON PersistNull = A.Null
toJSON (PersistList l) = A.Array $ V.fromList $ map A.toJSON l
@@ -172,6 +180,7 @@ instance A.FromJSON PersistValue where
$ B64.decode $ TE.encodeUtf8 t
Just ('t', t) -> fmap PersistTimeOfDay $ readMay t
Just ('u', t) -> fmap PersistUTCTime $ readMay t
+ Just ('z', t) -> fmap PersistZonedTime $ readMay t
Just ('d', t) -> fmap PersistDay $ readMay t
Just ('o', t) -> either (fail "Invalid base64") (return . PersistObjectId)
$ B64.decode $ TE.encodeUtf8 t
@@ -225,6 +234,7 @@ instance PersistField String where
fromPersistValue (PersistDay d) = Right $ Prelude.show d
fromPersistValue (PersistTimeOfDay d) = Right $ Prelude.show d
fromPersistValue (PersistUTCTime d) = Right $ Prelude.show d
+ fromPersistValue (PersistZonedTime z) = Right $ Prelude.show z
fromPersistValue PersistNull = Left "Unexpected null"
fromPersistValue (PersistBool b) = Right $ Prelude.show b
fromPersistValue (PersistList _) = Left "Cannot convert PersistList to String"
@@ -249,6 +259,7 @@ instance PersistField T.Text where
fromPersistValue (PersistDay d) = Right $ show d
fromPersistValue (PersistTimeOfDay d) = Right $ show d
fromPersistValue (PersistUTCTime d) = Right $ show d
+ fromPersistValue (PersistZonedTime z) = Right $ show z
fromPersistValue PersistNull = Left "Unexpected null"
fromPersistValue (PersistBool b) = Right $ show b
fromPersistValue (PersistList _) = Left "Cannot convert PersistList to Text"
@@ -372,6 +383,20 @@ instance PersistField UTCTime where
fromPersistValue x = Left $ "Expected UTCTime, received: " ++ show x
sqlType _ = SqlDayTime
+instance PersistField ZonedTime where
+ toPersistValue = PersistZonedTime
+ fromPersistValue (PersistZonedTime z) = Right z
+ fromPersistValue x@(PersistText t) =
+ case reads $ T.unpack t of
+ (z, _):_ -> Right z
+ _ -> Left $ "Expected ZonedTime, received " ++ show x
+ fromPersistValue x@(PersistByteString s) =
+ case reads $ unpack s of
+ (z, _):_ -> Right z
+ _ -> Left $ "Expected ZonedTime, received " ++ show x
+ fromPersistValue x = Left $ "Expected ZonedTime, received: " ++ show x
+ sqlType _ = SqlDayTime
+
instance PersistField a => PersistField (Maybe a) where
toPersistValue Nothing = PersistNull
toPersistValue (Just a) = toPersistValue a
Please sign in to comment.
Something went wrong with that request. Please try again.