Parse UTCTime with 8601 format yesodweb#339

snoyberg · snoyberg · commit 35e6408de1ee · 2014-12-23T12:12:48.000+02:00
diff --git a/persistent-sqlite/persistent-sqlite.cabal b/persistent-sqlite/persistent-sqlite.cabal
@@ -1,5 +1,5 @@
 name:            persistent-sqlite
-version:         2.1.1.1
+version:         2.1.1.2
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
diff --git a/persistent-sqlite/test/Spec.hs b/persistent-sqlite/test/Spec.hs
@@ -28,3 +28,9 @@ main = hspec $ do
         insert . Test $ read "2014-11-30 05:15:25.123"
         [Single x] <- rawSql "select strftime('%s%f',time) from test" []
         liftIO $ x `shouldBe` Just ("141732452525.123" :: String)
+    it "issue #339" $ asIO $ runSqlite ":memory:" $ do
+        runMigration migrateAll
+        now <- liftIO getCurrentTime
+        tid <- insert $ Test now
+        Just (Test now') <- get tid
+        liftIO $ now' `shouldBe` now
diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md
@@ -1,3 +1,7 @@
+## 2.1.1.3
+
+Parse UTCTime in 8601 format [#339](https://github.com/yesodweb/persistent/issues/339)
+
 ## 2.1.1.1
 
 Support for monad-control 1.0
diff --git a/persistent/Database/Persist/Class/PersistField.hs b/persistent/Database/Persist/Class/PersistField.hs
@@ -15,7 +15,7 @@ module Database.Persist.Class.PersistField
     ) where
 
 import Database.Persist.Types.Base
-import Data.Time (Day(..), TimeOfDay, UTCTime)
+import Data.Time (Day(..), TimeOfDay, UTCTime, parseTime)
 #ifdef HIGH_PRECISION_DATE
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 #endif
@@ -48,6 +48,12 @@ import qualified Data.Map as M
 import qualified Data.Text.Encoding as TE
 import qualified Data.Vector as V
 
+#if MIN_VERSION_time(1,5,0)
+import Data.Time (defaultTimeLocale)
+#else
+import System.Locale (defaultTimeLocale)
+#endif
+
 -- | A value which can be marshalled to and from a 'PersistValue'.
 class PersistField a where
     toPersistValue :: a -> PersistValue
@@ -221,7 +227,12 @@ instance PersistField UTCTime where
     fromPersistValue x@(PersistText t)  =
         case reads $ T.unpack t of
             (d, _):_ -> Right d
-            _ -> Left $ T.pack $ "Expected UTCTime, received " ++ show x
+            _ ->
+                case parse8601 $ T.unpack t of
+                    Nothing -> Left $ T.pack $ "Expected UTCTime, received " ++ show x
+                    Just x -> Right x
+      where
+        parse8601 = parseTime defaultTimeLocale "%FT%T%Q"
     fromPersistValue x@(PersistByteString s) =
         case reads $ unpack s of
             (d, _):_ -> Right d
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
@@ -1,5 +1,5 @@
 name:            persistent
-version:         2.1.1.2
+version:         2.1.1.3
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -26,6 +26,7 @@ library
                    , bytestring               >= 0.9
                    , transformers             >= 0.2.1
                    , time                     >= 1.1.4
+                   , old-locale
                    , text                     >= 0.8
                    , containers               >= 0.2
                    , conduit                  >= 1.0
