diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# 0.2.0 + +* Compatibility with GHC 8.2 and 8.4. + +* Dropped compatibility with 7.8 and 7.10. + # 0.1.0.0 First release. diff --git a/lib/Data/SafeCopy/Migrate.hs b/lib/Data/SafeCopy/Migrate.hs --- a/lib/Data/SafeCopy/Migrate.hs +++ b/lib/Data/SafeCopy/Migrate.hs @@ -1,17 +1,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} --- Hack for bug in older Cabal versions -#ifndef MIN_VERSION_template_haskell -#define MIN_VERSION_template_haskell(x,y,z) 1 -#endif - -- | This is a mess, sorry. This code was extracted from another project. -- -- Currently 'changelog' is the most useful function here – see its @@ -42,11 +36,8 @@ import qualified Data.SafeCopy.Internal as S import Language.Haskell.TH.Syntax as TH import Language.Haskell.TH.Quote -#if MIN_VERSION_template_haskell(2,8,0) import Language.Haskell.TH hiding (Kind) -#else -import Language.Haskell.TH hiding (Kind(..)) -#endif +import Language.Haskell.TH.Datatype import Language.Haskell.Meta (parseExp) import qualified Data.Map as M import Data.Map (Map) @@ -180,11 +171,7 @@ -- First, 'reify' it. See documentation for 'reify' to understand why we -- use 'lookupValueName' here (if we just do @reify newTyName@, we might -- get the constructor instead). -#if MIN_VERSION_template_haskell(2,11,0) TyConI (DataD _cxt _name _vars _kind cons _deriving) <- do -#else - TyConI (DataD _cxt _name _vars cons _deriving) <- do -#endif mbReallyTyName <- lookupTypeName (nameBase newTyName) case mbReallyTyName of Just reallyTyName -> reify reallyTyName @@ -195,10 +182,8 @@ fail "changelog: can't yet work with types with context" unless (null _vars) $ fail "changelog: can't yet work with types with variables" -#if MIN_VERSION_template_haskell(2,11,0) unless (isNothing _kind) $ fail "changelog: can't yet work with types with kinds" -#endif -- We assume that the type is a single-constructor record. con <- case cons of [x] -> return x @@ -240,19 +225,16 @@ -- Then we construct the record constructor: -- FooRec_v3 { a_v3 :: String, b_v3 :: Bool } let oldRec = recC (mkOld recName) - [_varStrictType (mkOld fName) - (_strictType _notStrict fType) + [varBangType (mkOld fName) + (bangType _notStrict fType) | (fName, fType) <- M.toList oldFields] -- And the data type: -- data Foo_v3 = FooRec_v3 {...} - let oldTypeDecl = dataD (cxt []) -- no context - oldTyName -- name of old type - [] -- no variables -#if MIN_VERSION_template_haskell(2,11,0) - Nothing -- no explicit kind -#endif - [oldRec] -- one constructor - _noDeriving -- not deriving anything + let oldTypeDecl = dataDCompat (cxt []) -- no context + oldTyName -- name of old type + [] -- no variables + [oldRec] -- one constructor + [] -- not deriving anything -- Next we generate the migration instance. It has two inner declarations. -- First declaration – “type MigrateFrom Foo = Foo_v3”: @@ -320,20 +302,14 @@ -> Q [Dec] genVer tyName ver constructors = do -- Get information about the new version of the datatype -#if MIN_VERSION_template_haskell(2,11,0) TyConI (DataD _cxt _name _vars _kind cons _deriving) <- reify tyName -#else - TyConI (DataD _cxt _name _vars cons _deriving) <- reify tyName -#endif --- Let's do some checks first + -- Let's do some checks first unless (null _cxt) $ fail "genVer: can't yet work with types with context" unless (null _vars) $ fail "genVer: can't yet work with types with variables" -#if MIN_VERSION_template_haskell(2,11,0) unless (isNothing _kind) $ fail "genVer: can't yet work with types with kinds" -#endif let oldName n = mkName (nameBase n ++ "_v" ++ show ver) @@ -348,8 +324,8 @@ let customConstructor conName fields = recC (oldName (mkName conName)) - [_varStrictType (oldName (mkName fName)) - (_strictType _notStrict fType) + [varBangType (oldName (mkName fName)) + (bangType _notStrict fType) | (fName, fType) <- fields] cons' <- for constructors $ \genCons -> @@ -357,21 +333,17 @@ Copy conName -> copyConstructor conName Custom conName fields -> customConstructor conName fields - decl <- dataD + decl <- dataDCompat -- no context (cxt []) -- name of our type (e.g. SomeType_v3 if the previous version was 3) (oldName tyName) -- no variables [] -#if MIN_VERSION_template_haskell(2,11,0) - -- no explicit kind - Nothing -#endif -- constructors (map return cons') -- not deriving anything - _noDeriving + [] return [decl] -- | A type for migrating constructors from an old version of a sum datatype. @@ -392,20 +364,14 @@ -> Q Exp migrateVer tyName ver constructors = do -- Get information about the new version of the datatype -#if MIN_VERSION_template_haskell(2,11,0) TyConI (DataD _cxt _name _vars _kind cons _deriving) <- reify tyName -#else - TyConI (DataD _cxt _name _vars cons _deriving) <- reify tyName -#endif -- Let's do some checks first unless (null _cxt) $ fail "migrateVer: can't yet work with types with context" unless (null _vars) $ fail "migrateVer: can't yet work with types with variables" -#if MIN_VERSION_template_haskell(2,11,0) unless (isNothing _kind) $ fail "migrateVer: can't yet work with types with kinds" -#endif let oldName n = mkName (nameBase n ++ "_v" ++ show ver) @@ -448,37 +414,21 @@ internalDeriveSafeCopySorted' :: Version a -> Name -> Name -> Info -> Q [Dec] internalDeriveSafeCopySorted' versionId kindName tyName info = case info of -#if MIN_VERSION_template_haskell(2,11,0) TyConI (DataD context _name tyvars _kind cons _derivs) -#else - TyConI (DataD context _name tyvars cons _derivs) -#endif | length cons > 255 -> fail $ "Can't derive SafeCopy instance for: " ++ show tyName ++ ". The datatype must have less than 256 constructors." | otherwise -> worker context tyvars (zip [0..] cons) -#if MIN_VERSION_template_haskell(2,11,0) TyConI (NewtypeD context _name tyvars _kind con _derivs) -> -#else - TyConI (NewtypeD context _name tyvars con _derivs) -> -#endif worker context tyvars [(0, con)] FamilyI _ insts -> do decs <- forM insts $ \inst -> case inst of -#if MIN_VERSION_template_haskell(2,11,0) DataInstD context _name ty _kind cons _derivs -> -#else - DataInstD context _name ty cons _derivs -> -#endif worker' (foldl appT (conT tyName) (map return ty)) context [] (zip [0..] cons) -#if MIN_VERSION_template_haskell(2,11,0) NewtypeInstD context _name ty _kind con _derivs -> -#else - NewtypeInstD context _name ty con _derivs -> -#endif worker' (foldl appT (conT tyName) (map return ty)) context [] [(0, con)] _ -> fail $ "Can't derive SafeCopy instance for: " ++ show (tyName, inst) return $ concat decs @@ -487,11 +437,7 @@ worker = worker' (conT tyName) worker' tyBase context tyvars cons = let ty = foldl appT tyBase [ varT $ S.tyVarName var | var <- tyvars ] -#if MIN_VERSION_template_haskell(2,10,0) safeCopyClass args = foldl appT (conT ''SafeCopy) args -#else - safeCopyClass args = classP ''SafeCopy args -#endif in (:[]) <$> instanceD (cxt $ [safeCopyClass [varT $ S.tyVarName var] | var <- tyvars] ++ map return context) (conT ''SafeCopy `appT` ty) [ mkPutCopySorted cons @@ -553,48 +499,21 @@ , show (length cons) , " constructors. Maybe your data is corrupted?" ] -sortFields :: [VarStrictType] -> [VarStrictType] -- We sort by length and then lexicographically, so that relative ordering -- would be preserved when version suffix is added – otherwise these fields -- would be sorted in different order after adding a suffix: -- -- foo fooBar_v3 -- fooBar foo_v3 +sortFields :: [VarStrictType] -> [VarStrictType] sortFields = sortOn (\(n, _, _) -> (length (nameBase n), nameBase n)) ---------------------------------------------------------------------------- -- Compatibility ---------------------------------------------------------------------------- -#if MIN_VERSION_template_haskell(2,11,0) _NotStrict :: Bang _NotStrict = Bang NoSourceUnpackedness NoSourceStrictness _notStrict :: Q Bang _notStrict = bang noSourceUnpackedness noSourceStrictness - -_varStrictType :: Name -> BangTypeQ -> VarBangTypeQ -_varStrictType = varBangType - -_strictType :: Q Bang -> TypeQ -> BangTypeQ -_strictType = bangType - -_noDeriving :: CxtQ -_noDeriving = cxt [] -#else - -_NotStrict :: Strict -_NotStrict = NotStrict - -_notStrict :: Q Strict -_notStrict = notStrict - -_varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ -_varStrictType = varStrictType - -_strictType :: Q Strict -> TypeQ -> StrictTypeQ -_strictType = strictType - -_noDeriving :: [Name] -_noDeriving = [] -#endif diff --git a/safecopy-migrate.cabal b/safecopy-migrate.cabal --- a/safecopy-migrate.cabal +++ b/safecopy-migrate.cabal @@ -1,15 +1,16 @@ name: safecopy-migrate -version: 0.1.0.0 +version: 0.2.0 synopsis: Making SafeCopy migrations easier description: - Making SafeCopy migrations easier + A sort of a creepy language for describing @SafeCopy@ migrations + and having types derived from them automatically. homepage: http://github.com/aelve/safecopy-migrate bug-reports: http://github.com/aelve/safecopy-migrate/issues license: PublicDomain author: Artyom maintainer: yom@artyom.me category: Data -tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3 build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10 @@ -30,7 +31,8 @@ haskell-src-meta, microlens, safecopy, - template-haskell, + template-haskell >= 2.11, + th-abstraction, uniplate ghc-options: -Wall -fno-warn-unused-do-bind hs-source-dirs: lib