Skip to content

Commit

Permalink
Use custom UTCTime type to retain Show/Read format
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
pbrisbin committed Jan 3, 2023
1 parent 72b1f3a commit 9667923
Showing 1 changed file with 22 additions and 4 deletions.
26 changes: 22 additions & 4 deletions src/Database/Schema/Migrations/Filesystem.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 )

Expand Down Expand Up @@ -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
Expand All @@ -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"

0 comments on commit 9667923

Please sign in to comment.