Aeson-2.x compatibility and fix for new Read(UTCTime)

dbmigrations.cabal

@@ -86,7 +86,7 @@ Library
     configurator >= 0.2,
     split >= 0.2.2,
     HUnit >= 1.2,
-    aeson < 2,
+    aeson,
     unordered-containers
 
   Hs-Source-Dirs:    src

src/Database/Schema/Migrations/Filesystem.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables, OverloadedStrings #-}
 -- |This module provides a type for interacting with a
 -- filesystem-backed 'MigrationStore'.
 module Database.Schema.Migrations.Filesystem
@@ -28,7 +28,6 @@ import Control.Monad ( filterM )
 import Control.Exception ( Exception(..), throw, catch )
 
 import Data.Aeson as J (Object, Value(String, Null))
-import Data.HashMap.Strict as M (toList)
 import Data.Yaml
 
 import Database.Schema.Migrations.Migration
@@ -38,6 +37,18 @@ import Database.Schema.Migrations.Migration
 import Database.Schema.Migrations.Filesystem.Serialize
 import Database.Schema.Migrations.Store
 
+#if MIN_VERSION_aeson(2, 0, 0)
+import Data.Aeson.Key (Key, toText)
+import Data.Aeson.KeyMap as M (toList)
+#else
+import Data.HashMap.Strict as M (toList)
+
+type Key = Text
+
+toText :: Key -> Text
+toText = id
+#endif
+
 type FieldProcessor = Text -> Migration -> Maybe Migration
 
 data FilesystemStoreSettings = FSStore { storePath :: FilePath }
@@ -127,9 +138,9 @@ migrationFromPath path = do
 getFields :: J.Object -> [(Text, Text)]
 getFields mp = map toPair $ M.toList mp
     where
-      toPair :: (Text, Value) -> (Text, Text)
-      toPair (k, J.String v) = (cs k, cs v)
-      toPair (k, J.Null) = (cs k, cs ("" :: String))
+      toPair :: (Key, Value) -> (Text, Text)
+      toPair (k, J.String v) = (toText k, cs v)
+      toPair (k, J.Null) = (toText k, cs ("" :: String))
       toPair (k, v) = throwFS $ "Error in YAML input; expected string key and string value, got " ++ (show (k, v))
 getFields _ = throwFS "Error in YAML input; expected mapping"
 
@@ -164,6 +175,7 @@ fieldProcessors = [ ("Created", setTimestamp )
 setTimestamp :: FieldProcessor
 setTimestamp value m = do
   ts <- case readTimestamp value of
+          ((t, ""):_) -> Right t
           [(t, _)] -> return t
           _ -> fail "expected one valid parse"
   return $ m { mTimestamp = Just ts }