From 966792329e8e0f68dfc45e0a45c474a2a20222f3 Mon Sep 17 00:00:00 2001
From: patrick brisbin <pbrisbin@gmail.com>
Date: Tue, 3 Jan 2023 13:37:38 -0500
Subject: [PATCH] Use custom UTCTime type to retain Show/Read format

There's no functional need for this, using the JSON representation
would've been readable enough, but there are going to be tons of
migration files in the wild with these simplified values.

We could write encoding at JSON and a decoder that accepts either, but
I'm not sure it's worth it vs just using a completely custom newtype.
---
 src/Database/Schema/Migrations/Filesystem.hs | 26 +++++++++++++++++---
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/src/Database/Schema/Migrations/Filesystem.hs b/src/Database/Schema/Migrations/Filesystem.hs
index e6df932..b6c6238 100644
--- a/src/Database/Schema/Migrations/Filesystem.hs
+++ b/src/Database/Schema/Migrations/Filesystem.hs
@@ -20,10 +20,10 @@ import Data.String.Conversions ( cs, (<>) )
 
 import Data.Typeable ( Typeable )
 import Data.Time.Clock ( UTCTime )
-import Data.Time () -- for UTCTime Show instance
+import Data.Time ( defaultTimeLocale, formatTime, parseTimeM )
 import qualified Data.Map as Map
 
-import Control.Applicative ( (<$>) )
+import Control.Applicative ( (<$>), (<|>) )
 import Control.Monad ( filterM )
 import Control.Exception ( Exception(..), throw, catch )
 
@@ -109,7 +109,7 @@ migrationFromPath path = do
 
 -- | TODO: re-use this for the generation side too
 data MigrationYaml = MigrationYaml
-    { myCreated :: Maybe UTCTime
+    { myCreated :: Maybe UTCTimeYaml
     , myDescription :: Maybe Text
     , myApply :: Text
     , myRevert :: Maybe Text
@@ -134,10 +134,28 @@ jsonOptions = defaultOptions
 
 migrationYamlToMigration :: Text -> MigrationYaml -> Migration
 migrationYamlToMigration theId my = Migration
-    { mTimestamp = myCreated my
+    { mTimestamp = unUTCTimeYaml <$> myCreated my
     , mId = theId
     , mDesc = myDescription my
     , mApply = myApply my
     , mRevert = myRevert my
     , mDeps = T.words $ myDepends my
     }
+
+newtype UTCTimeYaml = UTCTimeYaml
+    { unUTCTimeYaml :: UTCTime
+    }
+
+instance FromJSON UTCTimeYaml where
+    parseJSON = withText "UTCTime"
+        $ maybe (fail "Unable to parse UTCTime") (pure . UTCTimeYaml)
+        . parseTimeM True defaultTimeLocale utcTimeYamlFormat
+        . cs
+
+instance ToJSON UTCTimeYaml where
+    toJSON = toJSON . formatTime defaultTimeLocale utcTimeYamlFormat . unUTCTimeYaml
+    toEncoding = toEncoding . formatTime defaultTimeLocale utcTimeYamlFormat . unUTCTimeYaml
+
+-- Keeps things as the old Show/Read-based format, e.g "2009-04-15 10:02:06 UTC"
+utcTimeYamlFormat :: String
+utcTimeYamlFormat = "%F %T UTC"