packages feed

generic-deriving 1.10.6 → 1.10.7

raw patch · 7 files changed

+362/−358 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,3 +1,7 @@+# 1.10.7+* Renamed internal modules to avoid using apostrophes (averting this bug:+  https://github.com/haskell/cabal/issues/3631)+ # 1.10.6 * A new `base-4-9` Cabal flag was added to more easily facilitate installing   `generic-deriving` with manually installed versions of `template-haskell`.
generic-deriving.cabal view
@@ -1,5 +1,5 @@ name:                   generic-deriving-version:                1.10.6+version:                1.10.7 synopsis:               Generic programming library for generalised deriving. description: @@ -69,10 +69,10 @@                         Paths_generic_deriving   if flag(base-4-9)     build-depends:      base >= 4.9 && < 5-    other-modules:      Generics.Deriving.TH.Post4'9+    other-modules:      Generics.Deriving.TH.Post4_9   else     build-depends:      base >= 4.3 && < 4.9-    other-modules:      Generics.Deriving.TH.Pre4'9+    other-modules:      Generics.Deriving.TH.Pre4_9    build-depends:        containers       >= 0.1 && < 0.6                       , ghc-prim                   < 1
src/Generics/Deriving/TH.hs view
@@ -91,9 +91,9 @@  import           Generics.Deriving.TH.Internal #if MIN_VERSION_base(4,9,0)-import           Generics.Deriving.TH.Post4'9+import           Generics.Deriving.TH.Post4_9 #else-import           Generics.Deriving.TH.Pre4'9+import           Generics.Deriving.TH.Pre4_9 #endif  import           Language.Haskell.TH.Lib
− src/Generics/Deriving/TH/Post4'9.hs 
@@ -1,137 +0,0 @@-{- |-Module      :  Generics.Deriving.TH.Post4'9-Copyright   :  (c) 2008--2009 Universiteit Utrecht-License     :  BSD3--Maintainer  :  generics@haskell.org-Stability   :  experimental-Portability :  non-portable--Template Haskell machinery for the type-literal-based variant of GHC-generics introduced in @base-4.9@.--}--module Generics.Deriving.TH.Post4'9 (-      deriveMeta-    , deriveData-    , deriveConstructors-    , deriveSelectors-    , mkMetaDataType-    , mkMetaConsType-    , mkMetaSelType-    , SelStrictInfo(..)-    , reifySelStrictInfo-  ) where--import Data.Maybe (fromMaybe)--import Generics.Deriving.TH.Internal--import Language.Haskell.TH.Lib-import Language.Haskell.TH.Syntax--mkMetaDataType :: DataVariety -> Name -> Bool -> Q Type-mkMetaDataType _ n isNewtype =-           promotedT metaDataDataName-    `appT` litT (strTyLit (nameBase n))-    `appT` litT (strTyLit m)-    `appT` litT (strTyLit pkg)-    `appT` promoteBool isNewtype-  where-    m, pkg :: String-    m   = fromMaybe (error "Cannot fetch module name!")  (nameModule n)-    pkg = fromMaybe (error "Cannot fetch package name!") (namePackage n)--mkMetaConsType :: DataVariety -> Name -> Name -> Bool -> Bool -> Q Type-mkMetaConsType _ _ n conIsRecord conIsInfix = do-    mbFi <- reifyFixity n-    promotedT metaConsDataName-      `appT` litT (strTyLit (nameBase n))-      `appT` fixityIPromotedType mbFi conIsInfix-      `appT` promoteBool conIsRecord--promoteBool :: Bool -> Q Type-promoteBool True  = promotedT trueDataName-promoteBool False = promotedT falseDataName--fixityIPromotedType :: Maybe Fixity -> Bool -> Q Type-fixityIPromotedType mbFi True =-           promotedT infixIDataName-    `appT` promoteAssociativity a-    `appT` litT (numTyLit (toInteger n))-  where-    Fixity n a = fromMaybe defaultFixity mbFi-fixityIPromotedType _ False = promotedT prefixIDataName--promoteAssociativity :: FixityDirection -> Q Type-promoteAssociativity InfixL = promotedT leftAssociativeDataName-promoteAssociativity InfixR = promotedT rightAssociativeDataName-promoteAssociativity InfixN = promotedT notAssociativeDataName--mkMetaSelType :: DataVariety -> Name -> Name -> Maybe Name -> SelStrictInfo -> Q Type-mkMetaSelType _ _ _ mbF (SelStrictInfo su ss ds) =-    let mbSelNameT = case mbF of-            Just f  -> promotedT justDataName `appT` litT (strTyLit (nameBase f))-            Nothing -> promotedT nothingDataName-    in promotedT metaSelDataName-        `appT` mbSelNameT-        `appT` promoteSourceUnpackedness su-        `appT` promoteSourceStrictness ss-        `appT` promoteDecidedStrictness ds--data SelStrictInfo = SelStrictInfo SourceUnpackedness SourceStrictness DecidedStrictness--promoteSourceUnpackedness :: SourceUnpackedness -> Q Type-promoteSourceUnpackedness NoSourceUnpackedness = promotedT noSourceUnpackednessDataName-promoteSourceUnpackedness SourceNoUnpack       = promotedT sourceNoUnpackDataName-promoteSourceUnpackedness SourceUnpack         = promotedT sourceUnpackDataName--promoteSourceStrictness :: SourceStrictness -> Q Type-promoteSourceStrictness NoSourceStrictness = promotedT noSourceStrictnessDataName-promoteSourceStrictness SourceLazy         = promotedT sourceLazyDataName-promoteSourceStrictness SourceStrict       = promotedT sourceStrictDataName--promoteDecidedStrictness :: DecidedStrictness -> Q Type-promoteDecidedStrictness DecidedLazy   = promotedT decidedLazyDataName-promoteDecidedStrictness DecidedStrict = promotedT decidedStrictDataName-promoteDecidedStrictness DecidedUnpack = promotedT decidedUnpackDataName--reifySelStrictInfo :: Name -> [Bang] -> Q [SelStrictInfo]-reifySelStrictInfo conName bangs = do-    dcdStrs <- reifyConStrictness conName-    let (srcUnpks, srcStrs) = unzip $ map splitBang bangs-    return $ zipWith3 SelStrictInfo srcUnpks srcStrs dcdStrs--splitBang :: Bang -> (SourceUnpackedness, SourceStrictness)-splitBang (Bang su ss) = (su, ss)---- | Given the type and the name (as string) for the type to derive,--- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'--- instances.------ On GHC 7.11 and up, this functionality is no longer used in GHC generics,--- so this function generates no declarations.-deriveMeta :: Name -> Q [Dec]-deriveMeta _ = return []---- | Given a datatype name, derive a datatype and instance of class 'Datatype'.------ On GHC 7.11 and up, this functionality is no longer used in GHC generics,--- so this function generates no declarations.-deriveData :: Name -> Q [Dec]-deriveData _ = return []---- | Given a datatype name, derive datatypes and--- instances of class 'Constructor'.------ On GHC 7.11 and up, this functionality is no longer used in GHC generics,--- so this function generates no declarations.-deriveConstructors :: Name -> Q [Dec]-deriveConstructors _ = return []---- | Given a datatype name, derive datatypes and instances of class 'Selector'.------ On GHC 7.11 and up, this functionality is no longer used in GHC generics,--- so this function generates no declarations.-deriveSelectors :: Name -> Q [Dec]-deriveSelectors _ = return []
+ src/Generics/Deriving/TH/Post4_9.hs view
@@ -0,0 +1,137 @@+{- |+Module      :  Generics.Deriving.TH.Post4_9+Copyright   :  (c) 2008--2009 Universiteit Utrecht+License     :  BSD3++Maintainer  :  generics@haskell.org+Stability   :  experimental+Portability :  non-portable++Template Haskell machinery for the type-literal-based variant of GHC+generics introduced in @base-4.9@.+-}++module Generics.Deriving.TH.Post4_9 (+      deriveMeta+    , deriveData+    , deriveConstructors+    , deriveSelectors+    , mkMetaDataType+    , mkMetaConsType+    , mkMetaSelType+    , SelStrictInfo(..)+    , reifySelStrictInfo+  ) where++import Data.Maybe (fromMaybe)++import Generics.Deriving.TH.Internal++import Language.Haskell.TH.Lib+import Language.Haskell.TH.Syntax++mkMetaDataType :: DataVariety -> Name -> Bool -> Q Type+mkMetaDataType _ n isNewtype =+           promotedT metaDataDataName+    `appT` litT (strTyLit (nameBase n))+    `appT` litT (strTyLit m)+    `appT` litT (strTyLit pkg)+    `appT` promoteBool isNewtype+  where+    m, pkg :: String+    m   = fromMaybe (error "Cannot fetch module name!")  (nameModule n)+    pkg = fromMaybe (error "Cannot fetch package name!") (namePackage n)++mkMetaConsType :: DataVariety -> Name -> Name -> Bool -> Bool -> Q Type+mkMetaConsType _ _ n conIsRecord conIsInfix = do+    mbFi <- reifyFixity n+    promotedT metaConsDataName+      `appT` litT (strTyLit (nameBase n))+      `appT` fixityIPromotedType mbFi conIsInfix+      `appT` promoteBool conIsRecord++promoteBool :: Bool -> Q Type+promoteBool True  = promotedT trueDataName+promoteBool False = promotedT falseDataName++fixityIPromotedType :: Maybe Fixity -> Bool -> Q Type+fixityIPromotedType mbFi True =+           promotedT infixIDataName+    `appT` promoteAssociativity a+    `appT` litT (numTyLit (toInteger n))+  where+    Fixity n a = fromMaybe defaultFixity mbFi+fixityIPromotedType _ False = promotedT prefixIDataName++promoteAssociativity :: FixityDirection -> Q Type+promoteAssociativity InfixL = promotedT leftAssociativeDataName+promoteAssociativity InfixR = promotedT rightAssociativeDataName+promoteAssociativity InfixN = promotedT notAssociativeDataName++mkMetaSelType :: DataVariety -> Name -> Name -> Maybe Name -> SelStrictInfo -> Q Type+mkMetaSelType _ _ _ mbF (SelStrictInfo su ss ds) =+    let mbSelNameT = case mbF of+            Just f  -> promotedT justDataName `appT` litT (strTyLit (nameBase f))+            Nothing -> promotedT nothingDataName+    in promotedT metaSelDataName+        `appT` mbSelNameT+        `appT` promoteSourceUnpackedness su+        `appT` promoteSourceStrictness ss+        `appT` promoteDecidedStrictness ds++data SelStrictInfo = SelStrictInfo SourceUnpackedness SourceStrictness DecidedStrictness++promoteSourceUnpackedness :: SourceUnpackedness -> Q Type+promoteSourceUnpackedness NoSourceUnpackedness = promotedT noSourceUnpackednessDataName+promoteSourceUnpackedness SourceNoUnpack       = promotedT sourceNoUnpackDataName+promoteSourceUnpackedness SourceUnpack         = promotedT sourceUnpackDataName++promoteSourceStrictness :: SourceStrictness -> Q Type+promoteSourceStrictness NoSourceStrictness = promotedT noSourceStrictnessDataName+promoteSourceStrictness SourceLazy         = promotedT sourceLazyDataName+promoteSourceStrictness SourceStrict       = promotedT sourceStrictDataName++promoteDecidedStrictness :: DecidedStrictness -> Q Type+promoteDecidedStrictness DecidedLazy   = promotedT decidedLazyDataName+promoteDecidedStrictness DecidedStrict = promotedT decidedStrictDataName+promoteDecidedStrictness DecidedUnpack = promotedT decidedUnpackDataName++reifySelStrictInfo :: Name -> [Bang] -> Q [SelStrictInfo]+reifySelStrictInfo conName bangs = do+    dcdStrs <- reifyConStrictness conName+    let (srcUnpks, srcStrs) = unzip $ map splitBang bangs+    return $ zipWith3 SelStrictInfo srcUnpks srcStrs dcdStrs++splitBang :: Bang -> (SourceUnpackedness, SourceStrictness)+splitBang (Bang su ss) = (su, ss)++-- | Given the type and the name (as string) for the type to derive,+-- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'+-- instances.+--+-- On GHC 7.11 and up, this functionality is no longer used in GHC generics,+-- so this function generates no declarations.+deriveMeta :: Name -> Q [Dec]+deriveMeta _ = return []++-- | Given a datatype name, derive a datatype and instance of class 'Datatype'.+--+-- On GHC 7.11 and up, this functionality is no longer used in GHC generics,+-- so this function generates no declarations.+deriveData :: Name -> Q [Dec]+deriveData _ = return []++-- | Given a datatype name, derive datatypes and+-- instances of class 'Constructor'.+--+-- On GHC 7.11 and up, this functionality is no longer used in GHC generics,+-- so this function generates no declarations.+deriveConstructors :: Name -> Q [Dec]+deriveConstructors _ = return []++-- | Given a datatype name, derive datatypes and instances of class 'Selector'.+--+-- On GHC 7.11 and up, this functionality is no longer used in GHC generics,+-- so this function generates no declarations.+deriveSelectors :: Name -> Q [Dec]+deriveSelectors _ = return []
− src/Generics/Deriving/TH/Pre4'9.hs 
@@ -1,216 +0,0 @@-{-# LANGUAGE CPP #-}--{- |-Module      :  Generics.Deriving.TH.Pre4'9-Copyright   :  (c) 2008--2009 Universiteit Utrecht-License     :  BSD3--Maintainer  :  generics@haskell.org-Stability   :  experimental-Portability :  non-portable--Template Haskell machinery for the proxy datatype variant of GHC generics-used up until @base-4.9@.--}--module Generics.Deriving.TH.Pre4'9 (-      deriveMeta-    , deriveData-    , deriveConstructors-    , deriveSelectors-    , mkMetaDataType-    , mkMetaConsType-    , mkMetaSelType-    , SelStrictInfo-    , reifySelStrictInfo-  ) where--import Data.List (intercalate)-import Data.Maybe (fromMaybe)--import Generics.Deriving.TH.Internal--import Language.Haskell.TH.Lib-import Language.Haskell.TH.Syntax---- | Given the type and the name (as string) for the type to derive,--- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'--- instances.-deriveMeta :: Name -> Q [Dec]-deriveMeta n =-  do a <- deriveData n-     b <- deriveConstructors n-     c <- deriveSelectors n-     return (a ++ b ++ c)---- | Given a datatype name, derive a datatype and instance of class 'Datatype'.-deriveData :: Name -> Q [Dec]-deriveData = dataInstance---- | Given a datatype name, derive datatypes and--- instances of class 'Constructor'.-deriveConstructors :: Name -> Q [Dec]-deriveConstructors = constrInstance---- | Given a datatype name, derive datatypes and instances of class 'Selector'.-deriveSelectors :: Name -> Q [Dec]-deriveSelectors = selectInstance--dataInstance :: Name -> Q [Dec]-dataInstance n = do-  i <- reifyDataInfo n-  case i of-    Left  _                    -> return []-    Right (n', isNT, _, _, dv) -> mkInstance n' dv isNT-  where-    mkInstance n' dv isNT = do-      ds <- mkDataData dv n'-      is <- mkDataInstance dv n' isNT-      return $ [ds,is]--constrInstance :: Name -> Q [Dec]-constrInstance n = do-  i <- reifyDataInfo n-  case i of-    Left  _               -> return []-    Right (n', _, _, cs, dv) -> mkInstance n' cs dv-  where-    mkInstance n' cs dv = do-      ds <- mapM (mkConstrData dv n') cs-      is <- mapM (mkConstrInstance dv n') cs-      return $ ds ++ is--selectInstance :: Name -> Q [Dec]-selectInstance n = do-  i <- reifyDataInfo n-  case i of-    Left  _               -> return []-    Right (n', _, _, cs, dv) -> mkInstance n' cs dv-  where-    mkInstance n' cs dv = do-      ds <- mapM (mkSelectData dv n') cs-      is <- mapM (mkSelectInstance dv n') cs-      return $ concat (ds ++ is)--mkDataData :: DataVariety -> Name -> Q Dec-mkDataData dv n = dataD (cxt []) (genName dv [n]) []-#if MIN_VERSION_template_haskell(2,11,0)-                        Nothing [] (cxt [])-#else-                        [] []-#endif--mkConstrData :: DataVariety -> Name -> Con -> Q Dec-mkConstrData dv dt (NormalC n _) =-  dataD (cxt []) (genName dv [dt, n]) []-#if MIN_VERSION_template_haskell(2,11,0)-        Nothing [] (cxt [])-#else-        [] []-#endif-mkConstrData dv dt (RecC n f) =-  mkConstrData dv dt (NormalC n (map shrink f))-mkConstrData dv dt (InfixC t1 n t2) =-  mkConstrData dv dt (NormalC n [t1,t2])-mkConstrData _ _ con = gadtError con--mkSelectData :: DataVariety -> Name -> Con -> Q [Dec]-mkSelectData dv dt (RecC n fs) = return (map one fs)-  where one (f, _, _) = DataD [] (genName dv [dt, n, f]) []-#if MIN_VERSION_template_haskell(2,11,0)-                              Nothing-#endif-                              [] []-mkSelectData _ _ _ = return []--mkDataInstance :: DataVariety -> Name -> Bool -> Q Dec-mkDataInstance dv n isNewtype =-  instanceD (cxt []) (appT (conT datatypeTypeName) (mkMetaDataType dv n isNewtype)) $-    [ funD datatypeNameValName [clause [wildP] (normalB (stringE (nameBase n))) []]-    , funD moduleNameValName   [clause [wildP] (normalB (stringE name)) []]-    ]-#if MIN_VERSION_base(4,7,0)- ++ if isNewtype-       then [funD isNewtypeValName [clause [wildP] (normalB (conE trueDataName)) []]]-       else []-#endif-  where-    name = fromMaybe (error "Cannot fetch module name!") (nameModule n)--liftFixity :: Fixity -> Q Exp-liftFixity (Fixity n a) = conE infixDataName-    `appE` liftAssociativity a-    `appE` lift n--liftAssociativity :: FixityDirection -> Q Exp-liftAssociativity InfixL = conE leftAssociativeDataName-liftAssociativity InfixR = conE rightAssociativeDataName-liftAssociativity InfixN = conE notAssociativeDataName--mkConstrInstance :: DataVariety -> Name -> Con -> Q Dec-mkConstrInstance dv dt (NormalC n _) = mkConstrInstanceWith dv dt n False False []-mkConstrInstance dv dt (RecC    n _) =-    mkConstrInstanceWith dv dt n True False-      [funD conIsRecordValName [clause [wildP] (normalB (conE trueDataName)) []]]-mkConstrInstance dv dt (InfixC _ n _) = do-    i <- reify n-#if MIN_VERSION_template_haskell(2,11,0)-    fi <- case i of-                  DataConI{} -> fromMaybe defaultFixity `fmap` reifyFixity n-#else-    let fi = case i of-                  DataConI _ _ _ f -> f-#endif-                  _ -> error $ "Not a data constructor name: " ++ show n-    mkConstrInstanceWith dv dt n False True-      [funD conFixityValName [clause [wildP] (normalB (liftFixity fi)) []]]-mkConstrInstance _ _ con = gadtError con--mkConstrInstanceWith :: DataVariety-                     -> Name-                     -> Name-                     -> Bool-                     -> Bool-                     -> [Q Dec]-                     -> Q Dec-mkConstrInstanceWith dv dt n isRecord isInfix extra =-  instanceD-    (cxt [])-    (appT (conT constructorTypeName) (mkMetaConsType dv dt n isRecord isInfix))-    (funD conNameValName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)--mkSelectInstance :: DataVariety -> Name -> Con -> Q [Dec]-mkSelectInstance dv dt (RecC n fs) = mapM (one . fst3) fs where-  one :: Name -> Q Dec-  one f =-    instanceD (cxt []) (appT (conT selectorTypeName) (mkMetaSelType dv dt n (Just f) ()))-      [funD selNameValName [clause [wildP]-        (normalB (litE (stringL (nameBase f)))) []]]-mkSelectInstance _ _ _ = return []--genName :: DataVariety -> [Name] -> Name-genName dv ns = mkName-              . showsDataVariety dv-              . intercalate "_"-              . consQualName-              $ map (sanitizeName . nameBase) ns-  where-    consQualName :: [String] -> [String]-    consQualName = case ns of-        []  -> id-        n:_ -> (showNameQual n :)--mkMetaDataType :: DataVariety -> Name -> Bool -> Q Type-mkMetaDataType dv n _ = conT $ genName dv [n]--mkMetaConsType :: DataVariety -> Name -> Name -> Bool -> Bool -> Q Type-mkMetaConsType dv dt n _ _ = conT $ genName dv [dt, n]--mkMetaSelType :: DataVariety -> Name -> Name -> Maybe Name -> SelStrictInfo -> Q Type-mkMetaSelType dv dt n (Just f) () = conT $ genName dv [dt, n, f]-mkMetaSelType _  _  _ Nothing  () = conT noSelectorTypeName--type SelStrictInfo = ()--reifySelStrictInfo :: Name -> [Strict] -> Q [SelStrictInfo]-reifySelStrictInfo _ bangs = return (map (const ()) bangs)
+ src/Generics/Deriving/TH/Pre4_9.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE CPP #-}++{- |+Module      :  Generics.Deriving.TH.Pre4_9+Copyright   :  (c) 2008--2009 Universiteit Utrecht+License     :  BSD3++Maintainer  :  generics@haskell.org+Stability   :  experimental+Portability :  non-portable++Template Haskell machinery for the proxy datatype variant of GHC generics+used up until @base-4.9@.+-}++module Generics.Deriving.TH.Pre4_9 (+      deriveMeta+    , deriveData+    , deriveConstructors+    , deriveSelectors+    , mkMetaDataType+    , mkMetaConsType+    , mkMetaSelType+    , SelStrictInfo+    , reifySelStrictInfo+  ) where++import Data.List (intercalate)+import Data.Maybe (fromMaybe)++import Generics.Deriving.TH.Internal++import Language.Haskell.TH.Lib+import Language.Haskell.TH.Syntax++-- | Given the type and the name (as string) for the type to derive,+-- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'+-- instances.+deriveMeta :: Name -> Q [Dec]+deriveMeta n =+  do a <- deriveData n+     b <- deriveConstructors n+     c <- deriveSelectors n+     return (a ++ b ++ c)++-- | Given a datatype name, derive a datatype and instance of class 'Datatype'.+deriveData :: Name -> Q [Dec]+deriveData = dataInstance++-- | Given a datatype name, derive datatypes and+-- instances of class 'Constructor'.+deriveConstructors :: Name -> Q [Dec]+deriveConstructors = constrInstance++-- | Given a datatype name, derive datatypes and instances of class 'Selector'.+deriveSelectors :: Name -> Q [Dec]+deriveSelectors = selectInstance++dataInstance :: Name -> Q [Dec]+dataInstance n = do+  i <- reifyDataInfo n+  case i of+    Left  _                    -> return []+    Right (n', isNT, _, _, dv) -> mkInstance n' dv isNT+  where+    mkInstance n' dv isNT = do+      ds <- mkDataData dv n'+      is <- mkDataInstance dv n' isNT+      return $ [ds,is]++constrInstance :: Name -> Q [Dec]+constrInstance n = do+  i <- reifyDataInfo n+  case i of+    Left  _               -> return []+    Right (n', _, _, cs, dv) -> mkInstance n' cs dv+  where+    mkInstance n' cs dv = do+      ds <- mapM (mkConstrData dv n') cs+      is <- mapM (mkConstrInstance dv n') cs+      return $ ds ++ is++selectInstance :: Name -> Q [Dec]+selectInstance n = do+  i <- reifyDataInfo n+  case i of+    Left  _               -> return []+    Right (n', _, _, cs, dv) -> mkInstance n' cs dv+  where+    mkInstance n' cs dv = do+      ds <- mapM (mkSelectData dv n') cs+      is <- mapM (mkSelectInstance dv n') cs+      return $ concat (ds ++ is)++mkDataData :: DataVariety -> Name -> Q Dec+mkDataData dv n = dataD (cxt []) (genName dv [n]) []+#if MIN_VERSION_template_haskell(2,11,0)+                        Nothing [] (cxt [])+#else+                        [] []+#endif++mkConstrData :: DataVariety -> Name -> Con -> Q Dec+mkConstrData dv dt (NormalC n _) =+  dataD (cxt []) (genName dv [dt, n]) []+#if MIN_VERSION_template_haskell(2,11,0)+        Nothing [] (cxt [])+#else+        [] []+#endif+mkConstrData dv dt (RecC n f) =+  mkConstrData dv dt (NormalC n (map shrink f))+mkConstrData dv dt (InfixC t1 n t2) =+  mkConstrData dv dt (NormalC n [t1,t2])+mkConstrData _ _ con = gadtError con++mkSelectData :: DataVariety -> Name -> Con -> Q [Dec]+mkSelectData dv dt (RecC n fs) = return (map one fs)+  where one (f, _, _) = DataD [] (genName dv [dt, n, f]) []+#if MIN_VERSION_template_haskell(2,11,0)+                              Nothing+#endif+                              [] []+mkSelectData _ _ _ = return []++mkDataInstance :: DataVariety -> Name -> Bool -> Q Dec+mkDataInstance dv n isNewtype =+  instanceD (cxt []) (appT (conT datatypeTypeName) (mkMetaDataType dv n isNewtype)) $+    [ funD datatypeNameValName [clause [wildP] (normalB (stringE (nameBase n))) []]+    , funD moduleNameValName   [clause [wildP] (normalB (stringE name)) []]+    ]+#if MIN_VERSION_base(4,7,0)+ ++ if isNewtype+       then [funD isNewtypeValName [clause [wildP] (normalB (conE trueDataName)) []]]+       else []+#endif+  where+    name = fromMaybe (error "Cannot fetch module name!") (nameModule n)++liftFixity :: Fixity -> Q Exp+liftFixity (Fixity n a) = conE infixDataName+    `appE` liftAssociativity a+    `appE` lift n++liftAssociativity :: FixityDirection -> Q Exp+liftAssociativity InfixL = conE leftAssociativeDataName+liftAssociativity InfixR = conE rightAssociativeDataName+liftAssociativity InfixN = conE notAssociativeDataName++mkConstrInstance :: DataVariety -> Name -> Con -> Q Dec+mkConstrInstance dv dt (NormalC n _) = mkConstrInstanceWith dv dt n False False []+mkConstrInstance dv dt (RecC    n _) =+    mkConstrInstanceWith dv dt n True False+      [funD conIsRecordValName [clause [wildP] (normalB (conE trueDataName)) []]]+mkConstrInstance dv dt (InfixC _ n _) = do+    i <- reify n+#if MIN_VERSION_template_haskell(2,11,0)+    fi <- case i of+                  DataConI{} -> fromMaybe defaultFixity `fmap` reifyFixity n+#else+    let fi = case i of+                  DataConI _ _ _ f -> f+#endif+                  _ -> error $ "Not a data constructor name: " ++ show n+    mkConstrInstanceWith dv dt n False True+      [funD conFixityValName [clause [wildP] (normalB (liftFixity fi)) []]]+mkConstrInstance _ _ con = gadtError con++mkConstrInstanceWith :: DataVariety+                     -> Name+                     -> Name+                     -> Bool+                     -> Bool+                     -> [Q Dec]+                     -> Q Dec+mkConstrInstanceWith dv dt n isRecord isInfix extra =+  instanceD+    (cxt [])+    (appT (conT constructorTypeName) (mkMetaConsType dv dt n isRecord isInfix))+    (funD conNameValName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)++mkSelectInstance :: DataVariety -> Name -> Con -> Q [Dec]+mkSelectInstance dv dt (RecC n fs) = mapM (one . fst3) fs where+  one :: Name -> Q Dec+  one f =+    instanceD (cxt []) (appT (conT selectorTypeName) (mkMetaSelType dv dt n (Just f) ()))+      [funD selNameValName [clause [wildP]+        (normalB (litE (stringL (nameBase f)))) []]]+mkSelectInstance _ _ _ = return []++genName :: DataVariety -> [Name] -> Name+genName dv ns = mkName+              . showsDataVariety dv+              . intercalate "_"+              . consQualName+              $ map (sanitizeName . nameBase) ns+  where+    consQualName :: [String] -> [String]+    consQualName = case ns of+        []  -> id+        n:_ -> (showNameQual n :)++mkMetaDataType :: DataVariety -> Name -> Bool -> Q Type+mkMetaDataType dv n _ = conT $ genName dv [n]++mkMetaConsType :: DataVariety -> Name -> Name -> Bool -> Bool -> Q Type+mkMetaConsType dv dt n _ _ = conT $ genName dv [dt, n]++mkMetaSelType :: DataVariety -> Name -> Name -> Maybe Name -> SelStrictInfo -> Q Type+mkMetaSelType dv dt n (Just f) () = conT $ genName dv [dt, n, f]+mkMetaSelType _  _  _ Nothing  () = conT noSelectorTypeName++type SelStrictInfo = ()++reifySelStrictInfo :: Name -> [Strict] -> Q [SelStrictInfo]+reifySelStrictInfo _ bangs = return (map (const ()) bangs)