beam-migrate 0.3.0.0 → 0.3.1.0

raw patch · 11 files changed

+127/−28 lines, 11 filesdep +uuid-typesdep −uuiddep ~basedep ~haskell-src-extsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: uuid-types

Dependencies removed: uuid

Dependency ranges changed: base, haskell-src-exts

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Database/Beam/Haskell/Syntax.hs +64/−14
• Database/Beam/Migrate/Actions.hs +10/−1
• Database/Beam/Migrate/Backend.hs +7/−1
• Database/Beam/Migrate/Checks.hs +4/−1
• Database/Beam/Migrate/Log.hs +1/−1
• Database/Beam/Migrate/SQL/Builder.hs +8/−1
• Database/Beam/Migrate/SQL/SQL92.hs +6/−1
• Database/Beam/Migrate/Serialization.hs +11/−2
• Database/Beam/Migrate/Types.hs +8/−2
• beam-migrate.cabal +4/−4

@@ -1,3 +1,7 @@+## 0.3.1.0++Add `Semigroup` instances to prepare for GHC 8.4 and Stackage nightly+ ## 0.3.0.0  * Re-introduce backend parameter as `Database` type class

@@ -1,5 +1,6 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-}  -- | Instances that allow us to use Haskell as a backend syntax. This allows us -- to use migrations defined a la 'Database.Beam.Migrate.SQL' to generate a beam@@ -22,10 +23,12 @@ import           Data.List (find, nub) import qualified Data.Map as M import           Data.Maybe-import           Data.Monoid import qualified Data.Set as S import           Data.String import qualified Data.Text as T+#if !MIN_VERSION_base(4, 11, 0)+import           Data.Semigroup+#endif  import qualified Language.Haskell.Exts as Hs @@ -46,6 +49,8 @@ data HsImport = HsImportAll | HsImportSome (S.Set (Hs.ImportSpec ()))   deriving (Show, Eq, Generic) instance Hashable HsImport+instance Semigroup HsImport where+  (<>) = mappend instance Monoid HsImport where   mempty = HsImportSome mempty   mappend HsImportAll _ = HsImportAll@@ -67,6 +72,8 @@   deriving (Show, Eq) instance Hashable HsImports where   hashWithSalt s (HsImports a) = hashWithSalt s (M.assocs a)+instance Semigroup HsImports where+  (<>) = mappend instance Monoid HsImports where   mempty = HsImports mempty   mappend (HsImports a) (HsImports b) =@@ -126,6 +133,8 @@   , hsSyntaxEntities  :: [ HsEntity ]   } +instance Semigroup HsAction where+  (<>) = mappend instance Monoid HsAction where   mempty = HsAction [] []   mappend (HsAction ma ea) (HsAction mb eb) =@@ -138,6 +147,8 @@   | HsBeamBackendConstrained [ HsBackendConstraint ]   | HsBeamBackendNone +instance Semigroup (HsBeamBackend f) where+  (<>) = mappend instance Monoid (HsBeamBackend f) where   mempty = HsBeamBackendConstrained []   mappend (HsBeamBackendSingle aTy aExp) (HsBeamBackendSingle bTy _)@@ -172,6 +183,9 @@     , hsTableConstraintDecls    :: [ HsDecl ]     } +instance Semigroup HsTableConstraintDecls where+  (<>) = mappend+ instance Monoid HsTableConstraintDecls where   mempty = HsTableConstraintDecls [] []   mappend (HsTableConstraintDecls ai ad) (HsTableConstraintDecls bi bd) =@@ -195,19 +209,47 @@ entityDbFieldName :: HsEntity -> String entityDbFieldName entity = "_" ++ getHsEntityName (hsEntityName entity) +derivingDecl :: [Hs.InstRule ()] -> Hs.Deriving ()+derivingDecl =+#if MIN_VERSION_haskell_src_exts(1,20,0)+  Hs.Deriving () Nothing+#else+  Hs.Deriving ()+#endif++dataDecl :: Hs.DeclHead ()+         -> [Hs.QualConDecl ()]+         -> Maybe (Hs.Deriving ())+         -> Hs.Decl ()+dataDecl declHead cons deriving_ =+#if MIN_VERSION_haskell_src_exts(1,20,0)+  Hs.DataDecl () (Hs.DataType ()) Nothing declHead cons (maybeToList deriving_)+#else+  Hs.DataDecl () (Hs.DataType ()) Nothing declHead cons deriving_+#endif++insDataDecl :: Hs.Type ()+            -> [Hs.QualConDecl ()]+            -> Maybe (Hs.Deriving ())+            -> Hs.InstDecl ()+insDataDecl declHead cons deriving_ =+#if MIN_VERSION_haskell_src_exts(1,20,0)+   Hs.InsData () (Hs.DataType ()) declHead cons (maybeToList deriving_)+#else+   Hs.InsData () (Hs.DataType ()) declHead cons deriving_+#endif+ databaseTypeDecl :: [ HsEntity ] -> Hs.Decl () databaseTypeDecl entities =-  Hs.DataDecl () (Hs.DataType ()) Nothing-              declHead [ conDecl ]-              [deriving_]+  dataDecl declHead [ conDecl ] (Just deriving_)   where     declHead = Hs.DHApp () (Hs.DHead () (Hs.Ident () "Db"))                            (Hs.UnkindedVar () (Hs.Ident () "entity"))     conDecl = Hs.QualConDecl () Nothing Nothing                 (Hs.RecDecl () (Hs.Ident () "Db") (mkField <$> entities))-    deriving_ = Hs.Deriving () Nothing [ Hs.IRule () Nothing Nothing $-                                         Hs.IHCon () $ Hs.UnQual () $-                                         Hs.Ident () "Generic" ]+    deriving_ = derivingDecl [ Hs.IRule () Nothing Nothing $+                               Hs.IHCon () $ Hs.UnQual () $+                               Hs.Ident () "Generic" ]      mkField entity = Hs.FieldDecl () [ Hs.Ident () (entityDbFieldName entity) ]                                      (buildHsDbField (hsEntityDbDecl entity) $@@ -381,6 +423,8 @@ data HsNone = HsNone deriving (Show, Eq, Ord, Generic) instance Hashable HsNone +instance Semigroup HsNone where+  (<>) = mappend instance Monoid HsNone where   mempty = HsNone   mappend _ _ = HsNone@@ -472,8 +516,7 @@        imports = foldMap (\(_, ty) -> hsTypeImports (hsColumnSchemaType ty)) fields -      tblDecl = Hs.DataDecl () (Hs.DataType ()) Nothing-                  tblDeclHead [ tblConDecl ] [deriving_]+      tblDecl = dataDecl tblDeclHead [ tblConDecl ] (Just deriving_)       tblDeclHead = Hs.DHApp () (Hs.DHead () (Hs.Ident () tyName))                                 (Hs.UnkindedVar () (Hs.Ident () "f"))       tblConDecl = Hs.QualConDecl () Nothing Nothing (Hs.RecDecl () (Hs.Ident () tyConName) tyConFieldDecls)@@ -485,7 +528,7 @@                                                    [ tyVarNamed "f"                                                    , hsTypeSyntax (hsColumnSchemaType ty) ])) fields -      deriving_ = Hs.Deriving () Nothing [ inst "Generic" ]+      deriving_ = derivingDecl [ inst "Generic" ]        tblBeamable = hsInstance "Beamable" [ tyConNamed tyName ] []       tblPun = Hs.TypeDecl () (Hs.DHead () (Hs.Ident () tyConName))@@ -516,7 +559,7 @@ instance IsSql92TableConstraintSyntax HsTableConstraint where   primaryKeyConstraintSyntax fields =     HsTableConstraint $ \tblNm tblFields ->-    let primaryKeyDataDecl = Hs.InsData () (Hs.DataType ()) primaryKeyType [ primaryKeyConDecl ] [ primaryKeyDeriving ]+    let primaryKeyDataDecl = insDataDecl primaryKeyType [ primaryKeyConDecl ] (Just primaryKeyDeriving)          tableTypeNm = tblNm <> "T"         tableTypeKeyNm = tblNm <> "Key"@@ -525,7 +568,7 @@          primaryKeyType = tyApp (tyConNamed "PrimaryKey") [ tyConNamed (T.unpack tableTypeNm), tyVarNamed "f" ]         primaryKeyConDecl  = Hs.QualConDecl () Nothing Nothing (Hs.ConDecl () (Hs.Ident () (T.unpack tableTypeKeyNm)) fieldTys)-        primaryKeyDeriving = Hs.Deriving () Nothing [ inst "Generic" ]+        primaryKeyDeriving = derivingDecl [ inst "Generic" ]          primaryKeyTypeDecl = Hs.TypeDecl () (Hs.DHead () (Hs.Ident () (T.unpack tableTypeKeyNm)))                                             (tyApp (tyConNamed "PrimaryKey")@@ -867,7 +910,12 @@     instHead = foldl (Hs.IHApp ()) (Hs.IHCon () (Hs.UnQual () (Hs.Ident () (T.unpack classNm)))) params  hsDerivingInstance :: T.Text -> [ Hs.Type () ] -> Hs.Decl ()-hsDerivingInstance classNm params = Hs.DerivDecl () Nothing Nothing (Hs.IRule () Nothing Nothing instHead)+hsDerivingInstance classNm params =+#if MIN_VERSION_haskell_src_exts(1,20,0)+  Hs.DerivDecl () Nothing Nothing (Hs.IRule () Nothing Nothing instHead)+#else+  Hs.DerivDecl () Nothing (Hs.IRule () Nothing Nothing instHead)+#endif   where     instHead = foldl (Hs.IHApp ()) (Hs.IHCon () (Hs.UnQual () (Hs.Ident () (T.unpack classNm)))) params @@ -958,7 +1006,9 @@ instance Hashable (Hs.ImportSpec ()) instance Hashable (Hs.Namespace ()) instance Hashable (Hs.CName ())+#if MIN_VERSION_haskell_src_exts(1,20,0) instance Hashable (Hs.DerivStrategy ()) instance Hashable (Hs.MaybePromotedName ())+#endif instance Hashable a => Hashable (S.Set a) where   hashWithSalt s a = hashWithSalt s (S.toList a)

@@ -4,6 +4,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE CPP #-}  -- | Data types and functions to discover sequences of DDL commands to go from -- one database state to another. Used for migration generation.@@ -101,12 +102,14 @@  import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS-import           Data.Monoid import qualified Data.PQueue.Min as PQ import qualified Data.Sequence as Seq import           Data.Text (Text) import qualified Data.Text as T import           Data.Typeable+#if !MIN_VERSION_base(4, 11, 0)+import           Data.Semigroup+#endif  import           GHC.Generics @@ -185,6 +188,9 @@     -- path through the graph.   } +instance Semigroup (PotentialAction cmd) where+  (<>) = mappend+ -- | 'PotentialAction's can represent edges or paths. Monadically combining two -- 'PotentialAction's results in the path between the source of the first and -- the destination of the second. 'mempty' here returns the action that does@@ -241,6 +247,9 @@ -- in the final database. newtype ActionProvider cmd   = ActionProvider { getPotentialActions :: ActionProviderFn cmd }++instance Semigroup (ActionProvider cmd) where+  (<>) = mappend  instance Monoid (ActionProvider cmd) where   mempty = ActionProvider (\_ _ -> [])

@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}  -- | Definitions of interest to those implement a new beam backend. --@@ -56,7 +57,9 @@   import qualified Data.ByteString.Lazy as BL-import           Data.Monoid+#if ! MIN_VERSION_base(4,11,0)+import           Data.Semigroup+#endif import           Data.Text (Text) import           Data.Time @@ -111,6 +114,9 @@ -- backends can choose to drop any predicate (simply return 'Nothing'). newtype HaskellPredicateConverter   = HaskellPredicateConverter (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)++instance Semigroup HaskellPredicateConverter where+  (<>) = mappend  -- | 'HaskellPredicateConverter's can be combined monoidally. instance Monoid HaskellPredicateConverter where

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-}  -- | Defines common 'DatabasePredicate's that are shared among backends module Database.Beam.Migrate.Checks where@@ -12,8 +13,10 @@ import Data.Aeson.Types (Parser, Value) import Data.Hashable (Hashable(..)) import Data.Text (Text)-import Data.Monoid ((<>)) import Data.Typeable (Typeable, cast)+#if !MIN_VERSION_base(4, 11, 0)+import           Data.Semigroup+#endif  import GHC.Generics (Generic) 

@@ -13,7 +13,7 @@ import Data.String (fromString) import Data.Text (Text) import Data.Time (LocalTime)-import Data.UUID (UUID)+import Data.UUID.Types (UUID)  data LogEntryT f   = LogEntry

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}  -- | DDL syntax instances for 'SqlSyntaxBuilder' module Database.Beam.Migrate.SQL.Builder where@@ -11,8 +12,11 @@  import           Data.ByteString.Builder (Builder, byteString, toLazyByteString) import qualified Data.ByteString.Lazy.Char8 as BCL-import           Data.Monoid+#if !MIN_VERSION_base(4, 11, 0)+import           Data.Semigroup+#endif + -- | Options for @CREATE TABLE@. Given as a separate ADT because the options may -- go in different places syntactically. --@@ -112,6 +116,9 @@   { _sqlConstraintAttributeTiming :: Maybe ConstraintAttributeTiming   , _sqlConstraintAttributeDeferrable :: Maybe Bool }   deriving (Show, Eq)++instance Semigroup SqlConstraintAttributesBuilder where+  (<>) = mappend  instance Monoid SqlConstraintAttributesBuilder where   mempty = SqlConstraintAttributesBuilder Nothing Nothing

@@ -1,4 +1,6 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+ -- | Finally-tagless encoding of SQL92 DDL commands. -- --  If you're writing a beam backend driver and you want to support migrations,@@ -12,6 +14,9 @@ import Data.Hashable import Data.Text (Text) import Data.Typeable+#if ! MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif  -- * Convenience type synonyms @@ -154,7 +159,7 @@                              -> Maybe (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)                              -> constraint -class (Monoid attrs, Typeable attrs) => IsSql92ConstraintAttributesSyntax attrs where+class (Semigroup attrs, Monoid attrs, Typeable attrs) => IsSql92ConstraintAttributesSyntax attrs where   initiallyDeferredAttributeSyntax :: attrs   initiallyImmediateAttributeSyntax :: attrs   notDeferrableAttributeSyntax :: attrs

@@ -1,5 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE CPP #-}  -- | Serialization and deserialization helpers for beam data types. --@@ -40,10 +41,12 @@ import           Data.Aeson.Types (Parser) import qualified Data.Dependent.Map as D import qualified Data.GADT.Compare as D-import           Data.Monoid ((<>)) import           Data.Text (Text, unpack) import           Data.Typeable (Typeable, (:~:)( Refl ), eqT, typeRep, typeOf) import qualified Data.Vector as V+#if !MIN_VERSION_base(4, 11, 0)+import           Data.Semigroup+#endif  -- * Serialization helpers @@ -119,7 +122,7 @@ newtype BeamSerializedConstraintAttributes   = BeamSerializedConstraintAttributes   { fromBeamSerializedConstraintAttributes :: [ Value ]-  } deriving (Show, Eq, Monoid)+  } deriving (Show, Eq, Monoid, Semigroup)  -- | 'IsSql92ColumnConstraintSyntax' type for JSON newtype BeamSerializedConstraint@@ -238,11 +241,17 @@   { beamArbitraryDeserializers :: D.DMap BeamDeserializerLabel BeamDeserializer   } +instance Semigroup (BeamDeserializer cmd) where+  (<>) = mappend+ instance Monoid (BeamDeserializer cmd) where   mempty = BeamDeserializer (const (const mzero))   mappend (BeamDeserializer a) (BeamDeserializer b) =     BeamDeserializer $ \d o ->     a d o <|> b d o++instance Semigroup (BeamDeserializers cmd) where+  (<>) = mappend  instance Monoid (BeamDeserializers cmd) where   mempty = BeamDeserializers mempty

@@ -2,6 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-}  module Database.Beam.Migrate.Types   ( -- * Checked database entities@@ -52,7 +53,9 @@ import Control.Arrow import Control.Category (Category) -import Data.Monoid+#if !MIN_VERSION_base(4, 11, 0)+import Data.Semigroup+#endif import Data.Text (Text)  -- * Migration types@@ -90,6 +93,9 @@     -- ^ The command keeps all data   deriving Show +instance Semigroup MigrationDataLoss where+    (<>) = mappend+ instance Monoid MigrationDataLoss where     mempty = MigrationKeepsData     mappend MigrationLosesData _ = MigrationLosesData@@ -145,7 +151,7 @@  -- | Given functions to render a migration step description and the underlying -- syntax, create a script for the given 'MigrationSteps'.-migrateScript :: forall syntax m a. Monoid m+migrateScript :: forall syntax m a. (Monoid m, Semigroup m)               => (Text -> m)               -- ^ Called at the beginning of each 'MigrationStep' with the step description               -> (syntax -> m)

@@ -1,5 +1,5 @@ name:                beam-migrate-version:             0.3.0.0+version:             0.3.1.0 synopsis:            SQL DDL support and migrations support library for Beam description:         This package provides type classes to allow backends to implement                      SQL DDL support for beam. This allows you to use beam syntax to@@ -59,7 +59,7 @@                        Database.Beam.Migrate.Types.CheckedEntities                        Database.Beam.Migrate.Types.Predicates -  build-depends:       base                 >=4.9     && <4.11,+  build-depends:       base                 >=4.9     && <5.0,                        beam-core            >=0.7     && <0.8,                        text                 >=1.2     && <1.3,                        aeson                >=0.11    && <1.3,@@ -76,12 +76,12 @@                        deepseq              >=1.4     && <1.5,                        ghc-prim             >=0.5     && <0.6,                        containers           >=0.5     && <0.6,-                       haskell-src-exts     >=1.20    && <1.21,+                       haskell-src-exts     >=1.18    && <1.21,                        pretty               >=1.1     && <1.2,                        dependent-map        >=0.2     && <0.3,                        dependent-sum        >=0.4     && <0.5,                        pqueue               >=1.3     && <1.5,-                       uuid                 >=1.3     && <1.4+                       uuid-types           >=1.0     && <1.1   default-language:    Haskell2010   default-extensions:  KindSignatures, OverloadedStrings, TypeFamilies, FlexibleContexts,                        StandaloneDeriving, GADTs, DeriveFunctor, RankNTypes, ScopedTypeVariables,