microlens-th 0.4.3.8 → 0.4.3.9

raw patch · 6 files changed

+146/−24 lines, 6 filesdep +taggeddep ~th-abstractionPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: tagged

Dependency ranges changed: th-abstraction

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• microlens-th.cabal +6/−6
• src/Lens/Micro/TH.hs +10/−9
• src/Lens/Micro/TH/Internal.hs +72/−9
• test/T917.hs +53/−0
• test/templates.hs +1/−0

@@ -1,3 +1,7 @@+# 0.4.3.9++* Port lens commit [66e199ee](https://github.com/ekmett/lens/commit/66e199ee07f1aaf589faa2a8c661f6a722679959), fixing lens issue [#945](https://github.com/ekmett/lens/pull/945) — "Make the TH machinery handle PolyKinds more robustly".+ # 0.4.3.8  * Fixup.

@@ -1,5 +1,5 @@ name:                microlens-th-version:             0.4.3.8+version:             0.4.3.9 synopsis:            Automatic generation of record lenses for microlens description:   This package lets you automatically generate lenses for data types; code was extracted from the lens package, and therefore generated lenses are fully compatible with ones generated by lens (and can be used both from lens and microlens).@@ -24,8 +24,8 @@                      GHC==8.2.2                      GHC==8.4.4                      GHC==8.6.5-                     GHC==8.8.1-                     GHC==8.10.1+                     GHC==8.8.4+                     GHC==8.10.3  source-repository head   type:                git@@ -42,7 +42,7 @@                      , transformers                      -- lens has >=2.4, but GHC 7.4 shipped with 2.7                      , template-haskell >=2.7 && <2.18-                     , th-abstraction >=0.4 && <0.5+                     , th-abstraction >=0.4.1 && <0.5    ghc-options:     -Wall -fwarn-tabs@@ -55,10 +55,10 @@ test-suite templates   type: exitcode-stdio-1.0   main-is: templates.hs-  other-modules: T799+  other-modules: T799 T917   ghc-options: -Wall -threaded   hs-source-dirs: test -  build-depends: base, microlens, microlens-th+  build-depends: base, microlens, microlens-th, tagged    default-language: Haskell2010

@@ -744,9 +744,9 @@                      return (concat decss)    where-  tyName = D.datatypeName info-  s      = D.datatypeType info-  cons   = D.datatypeCons info+  tyName = D.datatypeName     info+  s      = datatypeTypeKinded info+  cons   = D.datatypeCons     info    -- Traverse the field labels of a normalized constructor   normFieldLabels :: Traversal [(Name,[(a,Type)])] [(Name,[(b,Type)])] a b@@ -805,12 +805,13 @@   let ss   = map (stabToS . (^. _2._2)) defs   (sub,s') <- unifyTypes (s : ss)   c <- newName "c"-  let vars = toListOf typeVars s'+  let vars     = D.freeVariablesWellScoped [s']+      varNames = map D.tvName vars       fd   | null vars = []-           | otherwise = [FunDep [c] vars]+           | otherwise = [FunDep [c] varNames]  -  classD (cxt[]) className (map D.plainTV (c:vars)) fd+  classD (cxt[]) className (D.plainTV c:vars) fd     $ sigD methodName (return (''Lens' `conAppsT` [VarT c, s']))     : concat       [ [sigD defName (return ty)@@ -819,7 +820,7 @@         inlinePragma defName       | (TopName defName, (_, stab, _)) <- defs       , let body = appsE [varE '(.), varE methodName, varE defName]-      , let ty   = quantifyType' (Set.fromList (c:vars))+      , let ty   = quantifyType' (Set.fromList (c:varNames))                                  (stabToContext stab)                  $ stabToOptic stab `conAppsT`                        [VarT c, applyTypeSubst sub (stabToA stab)]@@ -840,8 +841,8 @@     : map return (concat methodss)    where-  instanceHead = className `conAppsT` (s : map VarT vars)-  vars         = toListOf typeVars s+  instanceHead = className `conAppsT` (s : map tvbToType vars)+  vars         = D.freeVariablesWellScoped [s]   rules'       = rules { _generateSigs    = False                        , _generateClasses = False                        }

@@ -33,9 +33,12 @@   substTypeVars,    -- * Miscellaneous utilities+  datatypeTypeKinded,   inlinePragma,   conAppsT,   quantifyType, quantifyType',+  tvbToType,+  unSigT,    -- * Lens functions   elemOf,@@ -50,11 +53,12 @@ import           Data.Map (Map) import qualified Data.Set as Set import           Data.Set (Set)-import           Data.List (nub) import           Data.Maybe import           Lens.Micro import           Language.Haskell.TH import           Language.Haskell.TH.Datatype.TyVarBndr+import qualified Language.Haskell.TH.Datatype as D+import qualified Language.Haskell.TH.Datatype.TyVarBndr as D  #if __GLASGOW_HASKELL__ < 710 import           Control.Applicative@@ -209,20 +213,79 @@ conAppsT :: Name -> [Type] -> Type conAppsT conName = foldl AppT (ConT conName) --- | Template Haskell wants type variables declared in a forall, so we find--- all free type variables in a given type and declare them.+-- Construct a 'Type' using the datatype's type constructor and type+-- parameters. Unlike 'D.datatypeType', kind signatures are preserved to+-- some extent. (See the comments for 'dropSigsIfNonDataFam' below for more+-- details on this.)+datatypeTypeKinded :: D.DatatypeInfo -> Type+datatypeTypeKinded di+  = foldl AppT (ConT (D.datatypeName di))+  $ dropSigsIfNonDataFam+  $ D.datatypeInstTypes di+  where+    {-+    In an effort to prevent users from having to enable KindSignatures every+    time that they use lens' TH functionality, we strip off reified kind+    annotations from when:++    1. The kind of a type does not contain any kind variables. If it *does*+       contain kind variables, we want to preserve them so that we can generate+       type signatures that preserve the dependency order of kind and type+       variables. (The data types in test/T917.hs contain examples where this+       is important.) This will require enabling `PolyKinds`, but since+       `PolyKinds` implies `KindSignatures`, we can at least accomplish two+       things at once.+    2. The data type is not an instance of a data family. We make an exception+       for data family instances, since the presence or absence of a kind+       annotation can be the difference between typechecking or not.+       (See T917DataFam in tests/T917.hs for an example.) Moreover, the+       `TypeFamilies` extension implies `KindSignatures`.+    -}+    dropSigsIfNonDataFam :: [Type] -> [Type]+    dropSigsIfNonDataFam+      | isDataFamily (D.datatypeVariant di) = id+      | otherwise                           = map dropSig++    dropSig :: Type -> Type+    dropSig (SigT t k) | null (D.freeVariables k) = t+    dropSig t                                     = t++-- | Template Haskell wants type variables declared in a forall, so+-- we find all free type variables in a given type and declare them. quantifyType :: Cxt -> Type -> Type quantifyType = quantifyType' Set.empty --- | This function works like 'quantifyType' except that it takes a list of--- variables to exclude from quantification.+-- | This function works like 'quantifyType' except that it takes+-- a list of variables to exclude from quantification. quantifyType' :: Set Name -> Cxt -> Type -> Type quantifyType' exclude c t = ForallT vs c t   where-    vs = map plainTVSpecified-       $ filter (`Set.notMember` exclude)-       $ nub -- stable order-       $ toListOf typeVars t+  vs = filter (\tvb -> D.tvName tvb `Set.notMember` exclude)+     $ D.changeTVFlags D.SpecifiedSpec+     $ D.freeVariablesWellScoped (t:concatMap predTypes c) -- stable order++  predTypes :: Pred -> [Type]+#if MIN_VERSION_template_haskell(2,10,0)+  predTypes p = [p]+#else+  predTypes (ClassP _ ts)  = ts+  predTypes (EqualP t1 t2) = [t1, t2]+#endif++-- | Convert a 'TyVarBndr' into its corresponding 'Type'.+tvbToType :: D.TyVarBndr_ flag -> Type+tvbToType = D.elimTV VarT (SigT . VarT)++-- | Peel off a kind signature from a Type (if it has one).+unSigT :: Type -> Type+unSigT (SigT t _) = t+unSigT t          = t++isDataFamily :: D.DatatypeVariant -> Bool+isDataFamily D.Datatype        = False+isDataFamily D.Newtype         = False+isDataFamily D.DataInstance    = True+isDataFamily D.NewtypeInstance = True  ---------------------------------------------------------------------------- -- Lens functions which would've been in Lens.Micro if it wasn't “micro”

@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif+module T917 where++import Lens.Micro.TH+import Data.Proxy++#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806+import Data.Kind+#endif++-- Doesn't compile on GHC 7.4 at all+#if __GLASGOW_HASKELL__ >= 706++-- Like Data.Functor.Const, but redfined to ensure that it is poly-kinded+-- across all versions of GHC, not just 8.0++newtype Constant a (b :: k) = Constant a++data family   T917DataFam (a :: k)+data instance T917DataFam (a :: *) = MkT917DataFam { _unT917DataFam :: Proxy a }+$(makeLenses 'MkT917DataFam)+#endif++{-+data T917OneA (a :: k -> *) (b :: k -> *) = MkT917OneA+data T917OneB a b = MkT917OneB (T917OneA a (Const b))+$(makePrisms ''T917OneB)++data T917TwoA (a :: k -> *) (b :: k -> *) = MkT917TwoA+data T917TwoB a b = MkT917TwoB (T917TwoA a (Const b))+$(makeClassyPrisms ''T917TwoB)+-}++#if __GLASGOW_HASKELL__ >= 800+{-+data T917GadtOne (a :: k) where+  MkT917GadtOne :: T917GadtOne (a :: *)+$(makePrisms ''T917GadtOne)++data T917GadtTwo (a :: k) where+  MkT917GadtTwo :: T917GadtTwo (a :: *)+$(makePrisms ''T917GadtTwo)+-}+#endif

@@ -27,6 +27,7 @@ import Lens.Micro import Lens.Micro.TH import T799 ()+import T917 ()  data Bar a b c = Bar { _baz :: (a, b) } makeLenses ''Bar