Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module deals with validating API changelogs and migrating JSON data between different versions of a schema.
Synopsis
- migrateDataDump :: (Read db, Read rec, Read fld) => (API, Version) -> (API, VersionExtra) -> APIChangelog -> CustomMigrations Object Value db rec fld -> TypeName -> DataChecks -> Value -> Either MigrateFailure (Value, [MigrateWarning])
- migrateDataDump' :: (Read db, Read rec, Read fld) => (API, Version) -> (API, VersionExtra) -> APIChangelog -> CustomMigrations Record Value db rec fld -> TypeName -> DataChecks -> Value -> Either MigrateFailure (Value, [MigrateWarning])
- validateChanges :: (Read db, Read rec, Read fld) => (API, Version) -> (API, VersionExtra) -> APIChangelog -> CustomMigrations o v db rec fld -> TypeName -> DataChecks -> Either ValidateFailure [ValidateWarning]
- dataMatchesAPI :: TypeName -> API -> Value -> Either (ValueError, Position) ()
- data DataChecks
- data APIChangelog
- type APIWithChangelog = (API, APIChangelog)
- data APIChange
- = ChAddType TypeName NormTypeDecl
- | ChDeleteType TypeName
- | ChRenameType TypeName TypeName
- | ChAddField TypeName FieldName APIType (Maybe DefaultValue)
- | ChDeleteField TypeName FieldName
- | ChRenameField TypeName FieldName FieldName
- | ChChangeField TypeName FieldName APIType MigrationTag
- | ChAddUnionAlt TypeName FieldName APIType
- | ChDeleteUnionAlt TypeName FieldName
- | ChRenameUnionAlt TypeName FieldName FieldName
- | ChAddEnumVal TypeName FieldName
- | ChDeleteEnumVal TypeName FieldName
- | ChRenameEnumVal TypeName FieldName FieldName
- | ChCustomType TypeName MigrationTag
- | ChCustomAll MigrationTag
- data VersionExtra
- showVersionExtra :: VersionExtra -> String
- changelogStartVersion :: APIChangelog -> Version
- changelogVersion :: APIChangelog -> VersionExtra
- data CustomMigrations o v db ty fld = CustomMigrations {
- databaseMigration :: db -> o -> Either ValueError o
- databaseMigrationSchema :: db -> NormAPI -> Either ApplyFailure (Maybe NormAPI)
- typeMigration :: ty -> v -> Either ValueError v
- typeMigrationSchema :: ty -> NormTypeDecl -> Either ApplyFailure (Maybe NormTypeDecl)
- fieldMigration :: fld -> v -> Either ValueError v
- mkRecordMigration :: (Object -> Either ValueError Object) -> Value -> Either ValueError Value
- mkRecordMigration' :: (Record -> Either ValueError Record) -> Value -> Either ValueError Value
- mkRecordMigrationSchema :: TypeName -> (NormRecordType -> Either ApplyFailure (Maybe NormRecordType)) -> NormTypeDecl -> Either ApplyFailure (Maybe NormTypeDecl)
- noDataChanges :: a -> Either ValueError a
- noSchemaChanges :: a -> Either ApplyFailure (Maybe a)
- generateMigrationKinds :: APIChangelog -> String -> String -> String -> Q [Dec]
- type MigrationTag = String
- type NormAPI = Map TypeName NormTypeDecl
- data NormTypeDecl
- type NormRecordType = Map FieldName APIType
- type NormUnionType = Map FieldName APIType
- type NormEnumType = Set FieldName
- apiNormalForm :: API -> NormAPI
- declNF :: Spec -> NormTypeDecl
- data MigrateFailure
- type MigrateWarning = ValidateWarning
- data ValidateFailure
- = ChangelogOutOfOrder { }
- | CannotDowngrade { }
- | ApiInvalid { }
- | ChangelogEntryInvalid { }
- | ChangelogIncomplete { }
- data ValidateWarning
- data ApplyFailure
- = TypeExists { }
- | TypeDoesNotExist { }
- | TypeWrongKind { }
- | TypeInUse { }
- | TypeMalformed { }
- | DeclMalformed { }
- | FieldExists { }
- | FieldDoesNotExist { }
- | FieldBadDefaultValue { }
- | DefaultMissing { }
- | TableChangeError { }
- data TypeKind
- data MergeResult a b
- = OnlyInLeft a
- | InBoth a b
- | OnlyInRight b
- data ValueError
- prettyMigrateFailure :: MigrateFailure -> String
- prettyValidateFailure :: ValidateFailure -> String
- prettyValueError :: ValueError -> String
- prettyValueErrorPosition :: (ValueError, Position) -> String
Documentation
:: (Read db, Read rec, Read fld) | |
=> (API, Version) | Starting schema and version |
-> (API, VersionExtra) | Ending schema and version |
-> APIChangelog | Log of changes, containing both versions |
-> CustomMigrations Object Value db rec fld | Custom migration functions |
-> TypeName | Name of the dataset's type |
-> DataChecks | How thoroughly to validate changes |
-> Value | Dataset to be migrated |
-> Either MigrateFailure (Value, [MigrateWarning]) |
Migrate a dataset from one version of an API schema to another. The data must be described by a named type, the name of which is assumed not to change.
The db
, rec
and fld
types must be enumerations of all the
custom migration tags in the changelog, as generated by
generateMigrationKind
.
:: (Read db, Read rec, Read fld) | |
=> (API, Version) | Starting schema and version |
-> (API, VersionExtra) | Ending schema and version |
-> APIChangelog | Log of changes, containing both versions |
-> CustomMigrations Record Value db rec fld | Custom migration functions |
-> TypeName | Name of the dataset's type |
-> DataChecks | How thoroughly to validate changes |
-> Value | Dataset to be migrated |
-> Either MigrateFailure (Value, [MigrateWarning]) |
Validating changelogs
:: (Read db, Read rec, Read fld) | |
=> (API, Version) | Starting schema and version |
-> (API, VersionExtra) | Ending schema and version |
-> APIChangelog | Changelog to be validated |
-> CustomMigrations o v db rec fld | Custom migration functions |
-> TypeName | Name of the dataset's type |
-> DataChecks | How thoroughly to validate changes |
-> Either ValidateFailure [ValidateWarning] |
Check that a changelog adequately describes how to migrate from one version to another.
dataMatchesAPI :: TypeName -> API -> Value -> Either (ValueError, Position) () Source #
Check that a dataset matches an API, which is necessary for succesful migration. The name of the dataset's type must be specified.
data DataChecks Source #
When to validate the data against the schema (each level implies the preceding levels):
NoChecks | Not at all |
CheckStartAndEnd | At start and end of the migration |
CheckCustom | After custom migrations |
CheckAll | After every change |
Instances
Eq DataChecks Source # | |
Defined in Data.API.Changes (==) :: DataChecks -> DataChecks -> Bool # (/=) :: DataChecks -> DataChecks -> Bool # | |
Ord DataChecks Source # | |
Defined in Data.API.Changes compare :: DataChecks -> DataChecks -> Ordering # (<) :: DataChecks -> DataChecks -> Bool # (<=) :: DataChecks -> DataChecks -> Bool # (>) :: DataChecks -> DataChecks -> Bool # (>=) :: DataChecks -> DataChecks -> Bool # max :: DataChecks -> DataChecks -> DataChecks # min :: DataChecks -> DataChecks -> DataChecks # |
Changelog representation
data APIChangelog Source #
An API changelog, consisting of a list of versions with the
changes from one version to the next. The versions must be in
descending order (according to the Ord
Version
instance).
ChangesUpTo VersionExtra [APIChange] APIChangelog | The changes from the previous version up to this version. |
ChangesStart Version | The initial version |
Instances
Eq APIChangelog Source # | |
Defined in Data.API.Changes.Types (==) :: APIChangelog -> APIChangelog -> Bool # (/=) :: APIChangelog -> APIChangelog -> Bool # | |
Show APIChangelog Source # | |
Defined in Data.API.Changes.Types showsPrec :: Int -> APIChangelog -> ShowS # show :: APIChangelog -> String # showList :: [APIChangelog] -> ShowS # |
type APIWithChangelog = (API, APIChangelog) Source #
A single change within a changelog
data VersionExtra Source #
Represents either a released version (with a version number) or the version under development, which is newer than any release
Instances
Eq VersionExtra Source # | |
Defined in Data.API.Changes.Types (==) :: VersionExtra -> VersionExtra -> Bool # (/=) :: VersionExtra -> VersionExtra -> Bool # | |
Ord VersionExtra Source # | |
Defined in Data.API.Changes.Types compare :: VersionExtra -> VersionExtra -> Ordering # (<) :: VersionExtra -> VersionExtra -> Bool # (<=) :: VersionExtra -> VersionExtra -> Bool # (>) :: VersionExtra -> VersionExtra -> Bool # (>=) :: VersionExtra -> VersionExtra -> Bool # max :: VersionExtra -> VersionExtra -> VersionExtra # min :: VersionExtra -> VersionExtra -> VersionExtra # | |
Show VersionExtra Source # | |
Defined in Data.API.Changes.Types showsPrec :: Int -> VersionExtra -> ShowS # show :: VersionExtra -> String # showList :: [VersionExtra] -> ShowS # | |
PP VersionExtra Source # | |
Defined in Data.API.Changes.Types pp :: VersionExtra -> String Source # |
changelogStartVersion :: APIChangelog -> Version Source #
The earliest version in the changelog
changelogVersion :: APIChangelog -> VersionExtra Source #
The latest version in the changelog
Custom migrations
data CustomMigrations o v db ty fld Source #
Custom migrations used in the changelog must be implemented in Haskell, and supplied in this record. There are three kinds:
- Whole-database migrations, which may arbitrarily change the API schema and the data to match;
- Type migrations, which may change the schema of a single type; and
- Single field migrations, which may change only the type of the field (with the new type specified in the changelog).
For database and type migrations, if the schema is unchanged, the
corresponding function should return Nothing
.
The db
, ty
and fld
parameters should be instantiated with
the enumeration types generated by generateMigrationKinds
, which
correspond to the exact set of custom migration tags used in the
changelog.
CustomMigrations | |
|
mkRecordMigration :: (Object -> Either ValueError Object) -> Value -> Either ValueError Value Source #
Lift a custom record migration to work on arbitrary values
mkRecordMigration' :: (Record -> Either ValueError Record) -> Value -> Either ValueError Value Source #
mkRecordMigrationSchema :: TypeName -> (NormRecordType -> Either ApplyFailure (Maybe NormRecordType)) -> NormTypeDecl -> Either ApplyFailure (Maybe NormTypeDecl) Source #
Lift a schema change on record types to work on arbitrary type declarations
noDataChanges :: a -> Either ValueError a Source #
Use for databaseMigration
, typeMigration
or fieldMigration
to indicate that changes to the data are not required
noSchemaChanges :: a -> Either ApplyFailure (Maybe a) Source #
Use for databaseMigrationSchema
or typeMigrationSchema
to
indicate that the schema should not be changed
generateMigrationKinds :: APIChangelog -> String -> String -> String -> Q [Dec] Source #
Generate enumeration datatypes corresponding to the custom migrations used in an API migration changelog.
type MigrationTag = String Source #
Within the changelog, custom migrations are represented as strings, so we have less type-safety.
API normal forms
type NormAPI = Map TypeName NormTypeDecl Source #
The API type has too much extra info for us to be able to simply compare
them with (==)
. Our strategy is to strip out ancillary information and
normalise into a canonical form, and then we can use a simple (==)
compare.
Our normalised API discards most of the details of each type, keeping just essential information about each type. We discard order of types and fields, so we can use just associative maps.
data NormTypeDecl Source #
The normal or canonical form for a type declaration, an APINode
.
Equality of the normal form indicates equivalence of APIs.
We track all types.
NRecordType NormRecordType | |
NUnionType NormUnionType | |
NEnumType NormEnumType | |
NTypeSynonym APIType | |
NNewtype BasicType |
Instances
Eq NormTypeDecl Source # | |
Defined in Data.API.NormalForm (==) :: NormTypeDecl -> NormTypeDecl -> Bool # (/=) :: NormTypeDecl -> NormTypeDecl -> Bool # | |
Show NormTypeDecl Source # | |
Defined in Data.API.NormalForm showsPrec :: Int -> NormTypeDecl -> ShowS # show :: NormTypeDecl -> String # showList :: [NormTypeDecl] -> ShowS # | |
NFData NormTypeDecl Source # | |
Defined in Data.API.NormalForm rnf :: NormTypeDecl -> () # | |
PPLines NormTypeDecl Source # | |
Defined in Data.API.NormalForm ppLines :: NormTypeDecl -> [String] Source # |
type NormRecordType = Map FieldName APIType Source #
The canonical form of a record type is a map from fields to values...
type NormUnionType = Map FieldName APIType Source #
...similarly a union is a map from fields to alternatives...
type NormEnumType = Set FieldName Source #
...and an enum is a set of values.
apiNormalForm :: API -> NormAPI Source #
Compute the normal form of an API, discarding extraneous information.
declNF :: Spec -> NormTypeDecl Source #
Compute the normal form of a single type declaration.
Migration errors
data MigrateFailure Source #
Instances
Eq MigrateFailure Source # | |
Defined in Data.API.Error (==) :: MigrateFailure -> MigrateFailure -> Bool # (/=) :: MigrateFailure -> MigrateFailure -> Bool # | |
Show MigrateFailure Source # | |
Defined in Data.API.Error showsPrec :: Int -> MigrateFailure -> ShowS # show :: MigrateFailure -> String # showList :: [MigrateFailure] -> ShowS # | |
PPLines MigrateFailure Source # | |
Defined in Data.API.Error ppLines :: MigrateFailure -> [String] Source # |
type MigrateWarning = ValidateWarning Source #
data ValidateFailure Source #
Errors that may be discovered when validating a changelog
ChangelogOutOfOrder | the changelog must be in descending order of versions |
CannotDowngrade | forbid migrating from one version to an earlier version |
ApiInvalid | an API uses types that are not declared |
ChangelogEntryInvalid | changelog entry does not apply |
ChangelogIncomplete | changelog is incomplete (ie all entries apply ok but result isn't the target api) |
Instances
Eq ValidateFailure Source # | |
Defined in Data.API.Error (==) :: ValidateFailure -> ValidateFailure -> Bool # (/=) :: ValidateFailure -> ValidateFailure -> Bool # | |
Show ValidateFailure Source # | |
Defined in Data.API.Error showsPrec :: Int -> ValidateFailure -> ShowS # show :: ValidateFailure -> String # showList :: [ValidateFailure] -> ShowS # | |
PPLines ValidateFailure Source # | |
Defined in Data.API.Error ppLines :: ValidateFailure -> [String] Source # |
data ValidateWarning Source #
Instances
Show ValidateWarning Source # | |
Defined in Data.API.Error showsPrec :: Int -> ValidateWarning -> ShowS # show :: ValidateWarning -> String # showList :: [ValidateWarning] -> ShowS # |
data ApplyFailure Source #
Errors that may occur applying a single API change
TypeExists | for adding or renaming type |
TypeDoesNotExist | for deleting or renaming a type |
TypeWrongKind | e.g. it's not a record type |
TypeInUse | cannot delete/modify types that are still used |
TypeMalformed | type refers to a non-existent type |
| |
DeclMalformed | decl refers to a non-existent type |
FieldExists | for adding or renaming a field |
FieldDoesNotExist | for deleting or renaming a field |
FieldBadDefaultValue | for adding a field, must be a default value compatible with the type |
DefaultMissing | for adding a field to a table |
TableChangeError | custom error in tableChange |
Instances
Eq ApplyFailure Source # | |
Defined in Data.API.Error (==) :: ApplyFailure -> ApplyFailure -> Bool # (/=) :: ApplyFailure -> ApplyFailure -> Bool # | |
Show ApplyFailure Source # | |
Defined in Data.API.Error showsPrec :: Int -> ApplyFailure -> ShowS # show :: ApplyFailure -> String # showList :: [ApplyFailure] -> ShowS # | |
PPLines ApplyFailure Source # | |
Defined in Data.API.Error ppLines :: ApplyFailure -> [String] Source # |
data MergeResult a b Source #
OnlyInLeft a | |
InBoth a b | |
OnlyInRight b |
Instances
(Eq a, Eq b) => Eq (MergeResult a b) Source # | |
Defined in Data.API.Utils (==) :: MergeResult a b -> MergeResult a b -> Bool # (/=) :: MergeResult a b -> MergeResult a b -> Bool # | |
(Show a, Show b) => Show (MergeResult a b) Source # | |
Defined in Data.API.Utils showsPrec :: Int -> MergeResult a b -> ShowS # show :: MergeResult a b -> String # showList :: [MergeResult a b] -> ShowS # |
data ValueError Source #
Errors that can be discovered when migrating data values
JSONError JSONError | Data doesn't match schema |
CustomMigrationError String Value | Error generated during custom migration |
InvalidAPI ApplyFailure | An API change was invalid |
Instances
Eq ValueError Source # | |
Defined in Data.API.Error (==) :: ValueError -> ValueError -> Bool # (/=) :: ValueError -> ValueError -> Bool # | |
Show ValueError Source # | |
Defined in Data.API.Error showsPrec :: Int -> ValueError -> ShowS # show :: ValueError -> String # showList :: [ValueError] -> ShowS # | |
PPLines ValueError Source # | |
Defined in Data.API.Error ppLines :: ValueError -> [String] Source # |
prettyValueError :: ValueError -> String Source #
prettyValueErrorPosition :: (ValueError, Position) -> String Source #