diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 164edd2b3caebecf3e1350c95ec61ad3de988cfc..d02d7d742ea44834e7ce204a23f7a5c294b88b58 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -247,7 +247,6 @@ ppData :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String] ppData dflags decl@DataDecl { tcdLName = name, tcdTyVars = tvs, tcdFixity = fixity, tcdDataDefn = defn } subdocs = out dflags (ppDataDefnHeader (pp_vanilla_decl_head name tvs fixity) defn) : concatMap (ppCtor dflags decl subdocs . unLoc) (dd_cons defn) - where ppData _ _ _ = panic "ppData" -- | for constructors, and named-fields... diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 2c57a913e5950407c9f2976506a486376acd957c..9d15b0fc91fd12d39bc31601ecb7997d8957260c 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -264,18 +264,20 @@ synifyTyCon _prr _coax tc where resultVar = tyConFamilyResVar_maybe tc mkFamDecl i = return $ FamDecl noExtField $ - FamilyDecl { fdExt = noAnn - , fdInfo = i - , fdTopLevel = TopLevel - , fdLName = synifyNameN tc - , fdTyVars = synifyTyVars (tyConVisibleTyVars tc) - , fdFixity = synifyFixity tc - , fdResultSig = - synifyFamilyResultSig resultVar (tyConResKind tc) - , fdInjectivityAnn = - synifyInjectivityAnn resultVar (tyConTyVars tc) - (tyConInjectivityInfo tc) - } + FamilyDecl + { fdExt = noAnn + , fdInfo = i + , fdTopLevel = TopLevel + , fdLName = synifyNameN tc + , fdTyVars = synifyTyVars (tyConVisibleTyVars tc) + , fdFixity = synifyFixity tc + , fdResultSig = synifyFamilyResultSig resultVar (tyConResKind tc) + , fdInjectivityAnn = + synifyInjectivityAnn + resultVar + (tyConTyVars tc) + (tyConInjectivityInfo tc) + } synifyTyCon _prr coax tc | Just ty <- synTyConRhs_maybe tc @@ -295,7 +297,7 @@ synifyTyCon _prr coax tc name = case coax of Just a -> synifyNameN a -- Data families are named according to their - -- CoAxioms, not their TyCons + -- CoAxioms, not their TyCons _ -> synifyNameN tc tyvars = synifyTyVars (tyConVisibleTyVars tc) kindSig = synifyDataTyConReturnKind tc @@ -359,18 +361,19 @@ synifyDataTyConReturnKind tc synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity -> Maybe (LInjectivityAnn GhcRn) -synifyInjectivityAnn Nothing _ _ = Nothing -synifyInjectivityAnn _ _ NotInjective = Nothing synifyInjectivityAnn (Just lhs) tvs (Injective inj) = let rhs = map (noLocA . tyVarName) (filterByList inj tvs) in Just $ noLocA $ InjectivityAnn noAnn (noLocA lhs) rhs +synifyInjectivityAnn _ _ _ = Nothing synifyFamilyResultSig :: Maybe Name -> Kind -> LFamilyResultSig GhcRn -synifyFamilyResultSig Nothing kind - | isLiftedTypeKind kind = noLocA $ NoSig noExtField - | otherwise = noLocA $ KindSig noExtField (synifyKindSig kind) +synifyFamilyResultSig Nothing kind + | isLiftedTypeKind kind + = noLocA $ NoSig noExtField + | otherwise + = noLocA $ KindSig noExtField (synifyKindSig kind) synifyFamilyResultSig (Just name) kind = - noLocA $ TyVarSig noExtField (noLocA $ KindedTyVar noAnn () (noLocA name) (synifyKindSig kind)) + noLocA $ TyVarSig noExtField (noLocA $ KindedTyVar noAnn () (noLocA name) (synifyKindSig kind)) -- User beware: it is your responsibility to pass True (use_gadt_syntax) -- for any constructor that would be misrepresented by omitting its @@ -605,6 +608,7 @@ synifyType _ vs (TyConApp tc tys) , rep `hasKey` boxedRepDataConKey , lev `hasKey` liftedDataConKey = noLocA (HsTyVar noAnn NotPromoted (noLocA liftedTypeKindTyConName)) + -- Use non-prefix tuple syntax where possible, because it looks nicer. | Just sort <- tyConTuple_maybe tc , tyConArity tc == tys_len @@ -614,16 +618,22 @@ synifyType _ vs (TyConApp tc tys) ConstraintTuple -> HsBoxedOrConstraintTuple UnboxedTuple -> HsUnboxedTuple) (map (synifyType WithinType vs) vis_tys) - | isUnboxedSumTyCon tc = noLocA $ HsSumTy noAnn (map (synifyType WithinType vs) vis_tys) + + | isUnboxedSumTyCon tc + = noLocA $ HsSumTy noAnn (map (synifyType WithinType vs) vis_tys) + | Just dc <- isPromotedDataCon_maybe tc , isTupleDataCon dc , dataConSourceArity dc == length vis_tys = noLocA $ HsExplicitTupleTy noExtField (map (synifyType WithinType vs) vis_tys) + -- ditto for lists - | getName tc == listTyConName, [ty] <- vis_tys = - noLocA $ HsListTy noAnn (synifyType WithinType vs ty) + | getName tc == listTyConName, [ty] <- vis_tys + = noLocA $ HsListTy noAnn (synifyType WithinType vs ty) + | tc == promotedNilDataCon, [] <- vis_tys = noLocA $ HsExplicitListTy noExtField IsPromoted [] + | tc == promotedConsDataCon , [ty1, ty2] <- vis_tys = let hTy = synifyType WithinType vs ty1 @@ -632,11 +642,13 @@ synifyType _ vs (TyConApp tc tys) -> noLocA $ HsExplicitListTy noExtField IsPromoted (hTy : tTy') | otherwise -> noLocA $ HsOpTy noAnn IsPromoted hTy (noLocA $ getName tc) tTy + -- ditto for implicit parameter tycons | tc `hasKey` ipClassKey , [name, ty] <- tys , Just x <- isStrLitTy name = noLocA $ HsIParamTy noAnn (noLocA $ HsIPName x) (synifyType WithinType vs ty) + -- and equalities | tc `hasKey` eqTyConKey , [ty1, ty2] <- tys @@ -645,6 +657,7 @@ synifyType _ vs (TyConApp tc tys) (synifyType WithinType vs ty1) (noLocA eqTyConName) (synifyType WithinType vs ty2) + -- and infix type operators | isSymOcc (nameOccName (getName tc)) , ty1:ty2:tys_rest <- vis_tys @@ -654,6 +667,7 @@ synifyType _ vs (TyConApp tc tys) (noLocA $ getName tc) (synifyType WithinType vs ty2)) tys_rest + -- Most TyCons: | otherwise = mk_app_tys (HsTyVar noAnn prom $ noLocA (getName tc)) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index a8fa272b01ed7684d929e8ccf5f769b0bf63096c..261bfb4f66fb707f4f1468e2bab1c1caa9bbb09e 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -151,7 +151,7 @@ createInterface1 flags unit_state mod_sum mod_iface ifaces inst_ifaces (instance mod_iface_docs <- case mi_docs mod_iface of Just docs -> pure docs Nothing -> do - warn $ showPpr dflags mdl ++ " has no docs in its .hi-file" + warn $ showPpr dflags mdl ++ " has no docs in its .hi file" pure emptyDocs -- Derive final options to use for haddocking this module doc_opts <- mkDocOpts (docs_haddock_opts mod_iface_docs) flags mdl @@ -477,8 +477,8 @@ unrestrictedModExports -> Module -- ^ Current Module -> IfaceMap -- ^ Already created interfaces -> InstIfaceMap -- ^ Interfaces in other packages - -> Avails -- ^ Modules to be exporte - -> [ModuleName] + -> Avails + -> [ModuleName] -- ^ Modules to be exported -> IfM m ([Module], Avails) -- ^ ( modules exported without restriction -- , remaining exports not included in any @@ -533,8 +533,8 @@ availExportItem -> OccEnv Name -- Default methods -> IfM m [ExportItem GhcRn] availExportItem - prr modMap thisMod warnings docMap argMap fixMap instIfaceMap - dflags availInfo defMeths + prr modMap thisMod warnings docMap argMap fixMap instIfaceMap dflags + availInfo defMeths = declWith availInfo where diff --git a/hoogle-test/src/Bug722/Bug722.hs b/hoogle-test/src/Bug722/Bug722.hs index ef7e9a2f3e2701147aac08b0c77d4318d8471db0..0a1acbd4f6d945408122976f699ed22f6d58de31 100644 --- a/hoogle-test/src/Bug722/Bug722.hs +++ b/hoogle-test/src/Bug722/Bug722.hs @@ -2,11 +2,13 @@ {-# LANGUAGE TypeOperators, TypeFamilies #-} module Bug722 where +import Data.Kind (Type) + class Foo a where (!@#) :: a -> a -> a infixl 4 !@# -type family (&*) :: * -> * -> * +type family (&*) :: Type -> Type -> Type infixr 3 &* data a :-& b = a :^& b diff --git a/hoogle-test/src/Bug806/Bug806.hs b/hoogle-test/src/Bug806/Bug806.hs index f2a9a0992e4303016e7514cd3ef107ed7fca4c98..2af59e025857a1a27809fa35585e51ce47c83a98 100644 --- a/hoogle-test/src/Bug806/Bug806.hs +++ b/hoogle-test/src/Bug806/Bug806.hs @@ -3,16 +3,17 @@ {-# LANGUAGE UndecidableInstances #-} module Bug806 where +import Data.Kind (Type) import Data.Proxy -- | 'F1' docs -type family F1 a b :: * -> * +type family F1 a b :: Type -> Type -- | 'F2' docs -type family F2 a b :: * -> * where +type family F2 a b :: Type -> Type where F2 Int b = Maybe F2 a b = [] -- | 'D' docs -data family D a :: * -> * +data family D a :: Type -> Type v :: Int v = 42 diff --git a/hoogle-test/src/Bug992/Bug992.hs b/hoogle-test/src/Bug992/Bug992.hs index 0b03964bacb694c887ac48bdf194c5415ee1fd22..83454c98c302102819b72dffcc0c176278833340 100644 --- a/hoogle-test/src/Bug992/Bug992.hs +++ b/hoogle-test/src/Bug992/Bug992.hs @@ -3,4 +3,6 @@ module Bug992 where -data K (m :: * -> *) = K +import Data.Kind (Type) + +data K (m :: Type -> Type) = K diff --git a/html-test/src/Bug294.hs b/html-test/src/Bug294.hs index 922b8ee7dfc0b25968108e6a67e18b68c6197614..4bd0bbe30e14f519a72dd1b50a4b88297129f3ec 100644 --- a/html-test/src/Bug294.hs +++ b/html-test/src/Bug294.hs @@ -10,11 +10,13 @@ module Bug294 ( A, problemField, problemField', gadtField , TP(ProblemCtor), DP(ProblemCtor'), TO'(PolyCtor)) where +import Data.Kind (Type) + data A class T t where - data TO t :: * - data TP t :: * + data TO t :: Type + data TP t :: Type t :: t @@ -22,17 +24,17 @@ instance T A where data TO A = TA { problemField :: A } data TP A = ProblemCtor A -data family DO t :: * -data family DP t :: * +data family DO t :: Type +data family DP t :: Type data instance DO A = DA { problemField' :: A } data instance DP A = ProblemCtor' A -data GADT :: * -> * where +data GADT :: Type -> Type where Ctor :: { gadtField :: A } -> GADT A class T' t where - data TO' t :: * + data TO' t :: Type instance T' a where data TO' a = PolyCtor diff --git a/html-test/src/Bug466.hs b/html-test/src/Bug466.hs index 697f0f75260998853d680ae8ca4e58993f0fdc19..3f0d3acf91d0a45ed179c0f4641df9df7805bcd9 100644 --- a/html-test/src/Bug466.hs +++ b/html-test/src/Bug466.hs @@ -2,8 +2,10 @@ {-# LANGUAGE DataKinds, TypeFamilies, StarIsType #-} module Bug466 where +import Data.Kind (Type) + class Cl a where - type Fam a :: [*] + type Fam a :: [Type] data X = X instance Cl X where diff --git a/html-test/src/Bug745.hs b/html-test/src/Bug574.hs similarity index 100% rename from html-test/src/Bug745.hs rename to html-test/src/Bug574.hs diff --git a/html-test/src/Bug647.hs b/html-test/src/Bug647.hs index 7f1b9544ed3558995331e347c18efb1c29b02eed..35330abc6cbd9485f601312f7524931583422152 100644 --- a/html-test/src/Bug647.hs +++ b/html-test/src/Bug647.hs @@ -2,6 +2,6 @@ module Bug647 where class Bug647 a where - f :: a -- ^ doc for arg1 - -> a -- ^ doc for arg2 - -> a -- ^ doc for arg3 \ No newline at end of file + f :: a -- ^ doc for arg1 + -> a -- ^ doc for arg2 + -> a -- ^ doc for arg3 \ No newline at end of file diff --git a/html-test/src/Bug85.hs b/html-test/src/Bug85.hs index 53979aee5f3a0436ea431e9182e55bdcb89e9c85..e226c69d84c0b5eb80b15865fa8c20f639c848c3 100644 --- a/html-test/src/Bug85.hs +++ b/html-test/src/Bug85.hs @@ -2,12 +2,14 @@ {-# LANGUAGE GADTs, KindSignatures #-} module Bug85 where +import Data.Kind (Type) + -- explicitly stated non-trivial kind -data Foo :: (* -> *) -> * -> * where +data Foo :: (Type -> Type) -> Type -> Type where Bar :: f x -> Foo f (f x) -- Just kind * but explicitly written -data Baz :: * where +data Baz :: Type where Baz' :: Baz -- No kind signature written down at all diff --git a/html-test/src/Bug923.hs b/html-test/src/Bug923.hs index 1d24a9f61efc74b0c8355f2da66bfbd5966307dc..68e1b1536362a0468da601401e91265b48597f52 100644 --- a/html-test/src/Bug923.hs +++ b/html-test/src/Bug923.hs @@ -2,8 +2,10 @@ {-# LANGUAGE KindSignatures, FlexibleInstances, GADTs, DataKinds #-} module Bug923 where +import Data.Kind (Type) + -- | A promoted tuple type -data T :: (* -> (*,*)) -> * where +data T :: (Type -> (Type,Type)) -> Type where T :: a -> T ('(,) a) -- | A promoted tuple type in an instance diff --git a/html-test/src/Bug975.hs b/html-test/src/Bug973.hs similarity index 100% rename from html-test/src/Bug975.hs rename to html-test/src/Bug973.hs diff --git a/html-test/src/BundledPatterns.hs b/html-test/src/BundledPatterns.hs index 420068ac0c9cbedb3204b35b2da836a697e33c92..6270e2cbda3484a4812ddb34cf66ac8aee10029c 100644 --- a/html-test/src/BundledPatterns.hs +++ b/html-test/src/BundledPatterns.hs @@ -3,6 +3,8 @@ ViewPatterns #-} module BundledPatterns (Vec(Nil,(:>)), RTree (LR,BR)) where +import Data.Kind (Type) + import GHC.TypeLits import Prelude hiding (head, tail) import Unsafe.Coerce @@ -12,7 +14,7 @@ import Unsafe.Coerce -- * Lists with their length encoded in their type -- * 'Vec'tor elements have an __ASCENDING__ subscript starting from 0 and -- ending at @'length' - 1@. -data Vec :: Nat -> * -> * where +data Vec :: Nat -> Type -> Type where Nil :: Vec 0 a Cons :: a -> Vec n a -> Vec (n + 1) a @@ -58,7 +60,7 @@ tail (_ `Cons` xs) = unsafeCoerce xs -- -- * Only has elements at the leaf of the tree -- * A tree of depth /d/ has /2^d/ elements. -data RTree :: Nat -> * -> * where +data RTree :: Nat -> Type -> Type where LR_ :: a -> RTree 0 a BR_ :: RTree d a -> RTree d a -> RTree (d+1) a diff --git a/html-test/src/ConstructorPatternExport.hs b/html-test/src/ConstructorPatternExport.hs index aa2971d6f83e7bd8c30f87da2adca80d743c42f6..eb04b29c2f50650d0de296b621e5c973db4bb040 100644 --- a/html-test/src/ConstructorPatternExport.hs +++ b/html-test/src/ConstructorPatternExport.hs @@ -12,6 +12,8 @@ module ConstructorPatternExport ( , pattern MyGADTCons ) where +import Data.Kind (Type) + data Foo a = FooCons String a data MyRec = MyRecCons { one :: Bool, two :: Int } @@ -20,7 +22,7 @@ data MyInfix a = String :+ a data Blub = forall b. Show b => BlubCons b -data MyGADT :: * -> * where +data MyGADT :: Type -> Type where MyGADTCons :: forall a. Eq a => a -> Int -> MyGADT (Maybe String) pattern MyGADTCons' :: () => forall a. Eq a => a -> Int -> MyGADT (Maybe String) diff --git a/html-test/src/DefaultAssociatedTypes.hs b/html-test/src/DefaultAssociatedTypes.hs index 68a587efcd433049ce4b0013a4cc5d25f0f26e25..aeaefc88c0e0f3b4a6ffbd639eccf02f4a81afec 100644 --- a/html-test/src/DefaultAssociatedTypes.hs +++ b/html-test/src/DefaultAssociatedTypes.hs @@ -3,13 +3,15 @@ module DefaultAssociatedTypes where +import Data.Kind (Type) + -- | Documentation for Foo. class Foo a where -- | Documentation for bar and baz. bar, baz :: a -> String -- | Doc for Qux - type Qux a :: * + type Qux a :: Type -- | Doc for default Qux type Qux a = [a] diff --git a/html-test/src/DeprecatedTypeFamily.hs b/html-test/src/DeprecatedTypeFamily.hs index 3d94cace9d9db2ed64354529bbc481219294cc3d..e161e101a44bbae17a57d1dfd855af6054a84e9b 100644 --- a/html-test/src/DeprecatedTypeFamily.hs +++ b/html-test/src/DeprecatedTypeFamily.hs @@ -2,9 +2,11 @@ {-# LANGUAGE TypeFamilies #-} module DeprecatedTypeFamily where +import Data.Kind (Type) + -- | some documentation -data family SomeTypeFamily k :: * -> * +data family SomeTypeFamily k :: Type -> Type {-# DEPRECATED SomeTypeFamily "SomeTypeFamily" #-} -data family SomeOtherTypeFamily k :: * -> * +data family SomeOtherTypeFamily k :: Type -> Type {-# DEPRECATED SomeOtherTypeFamily "SomeOtherTypeFamily" #-} diff --git a/html-test/src/FunArgs.hs b/html-test/src/FunArgs.hs index 9d7c19dc454c78825d38e7b3f5c3ace2865014b0..6c6a74e67878f99281bbb375cf43f6b05316d25a 100644 --- a/html-test/src/FunArgs.hs +++ b/html-test/src/FunArgs.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# LANGUAGE RankNTypes, DataKinds, TypeFamilies #-} +{-# LANGUAGE RankNTypes, DataKinds, TypeFamilies, TypeOperators #-} module FunArgs where f :: forall a. Ord a diff --git a/html-test/src/Operators.hs b/html-test/src/Operators.hs index 1d938ba6ecdd50cf4c24f0a0f086d65013d3e5e5..49682bfc8042887905195b8592c6d40a302cc536 100644 --- a/html-test/src/Operators.hs +++ b/html-test/src/Operators.hs @@ -5,6 +5,8 @@ -- | Test operators with or without fixity declarations module Operators where +import Data.Kind (Type) + -- | Operator with no fixity (+-) :: a -> a -> a a +- _ = a @@ -48,7 +50,7 @@ infix 9 ** class a ><> b | a -> b where -- Dec 2015: Added @a -> b@ functional dependency to clean up ambiguity -- See GHC #11264 - type a <>< b :: * + type a <>< b :: Type data a ><< b (>><), (<<>) :: a -> b -> () diff --git a/html-test/src/PatternSyns.hs b/html-test/src/PatternSyns.hs index e0da6d6b37188f1fa08b3c9de52054d478191009..5569e1ce8a828549d18abe769278b603225f3238 100644 --- a/html-test/src/PatternSyns.hs +++ b/html-test/src/PatternSyns.hs @@ -4,6 +4,8 @@ -- | Testing some pattern synonyms module PatternSyns where +import Data.Kind (Type) + -- | FooType doc data FooType x = FooCtor x @@ -23,7 +25,7 @@ data BlubType = forall x. Show x => BlubCtor x pattern Blub x = BlubCtor x -- | Doc for ('><') -data (a :: *) >< b = Empty +data (a :: Type) >< b = Empty -- | Pattern for 'Empty' pattern E = Empty diff --git a/html-test/src/PromotedTypes.hs b/html-test/src/PromotedTypes.hs index 624f9d5ad8dd471d41851f4e3a5dbf2f5e62d642..9b66a523d9077ca2eb9c5ee254e9d4e23325b263 100644 --- a/html-test/src/PromotedTypes.hs +++ b/html-test/src/PromotedTypes.hs @@ -7,20 +7,22 @@ module PromotedTypes where +import Data.Kind (Type) + data RevList a = RNil | RevList a :> a -data Pattern :: [*] -> * where +data Pattern :: [Type] -> Type where Nil :: Pattern '[] Cons :: Maybe h -> Pattern t -> Pattern (h ': t) -- Unlike (:), (:>) does not have to be quoted on type level. -data RevPattern :: RevList * -> * where +data RevPattern :: RevList Type -> Type where RevNil :: RevPattern RNil RevCons :: Maybe h -> RevPattern t -> RevPattern (t :> h) -data Tuple :: (*, *) -> * where +data Tuple :: (Type, Type) -> Type where Tuple :: a -> b -> Tuple '(a, b) diff --git a/html-test/src/SpuriousSuperclassConstraints.hs b/html-test/src/SpuriousSuperclassConstraints.hs index cb2049415a672cd97aca84458bf07b62a7b6d674..968f07945405d770714c9eb550c79943fa87517b 100644 --- a/html-test/src/SpuriousSuperclassConstraints.hs +++ b/html-test/src/SpuriousSuperclassConstraints.hs @@ -20,8 +20,9 @@ module SpuriousSuperclassConstraints where import Control.Applicative +import Data.Kind (Type) -data SomeType (f :: * -> *) a +data SomeType (f :: Type -> Type) a instance Functor (SomeType f) where fmap = undefined diff --git a/html-test/src/TypeFamilies.hs b/html-test/src/TypeFamilies.hs index d759af4fb2816e0b85cdfcfdf9d3555c52d05e76..18f161e325b4c4b6ba6969b0fb32b1207f34c4e3 100644 --- a/html-test/src/TypeFamilies.hs +++ b/html-test/src/TypeFamilies.hs @@ -4,6 +4,8 @@ -- | Doc for: module TypeFamilies module TypeFamilies where +import Data.Kind (Type) + import qualified TypeFamilies2 as TF -- | Doc for: data X @@ -35,7 +37,7 @@ type instance Foo X = Y type instance Foo Y = X -- | Doc for: data family Bat a -data family Bat (a :: k) :: * +data family Bat (a :: k) :: Type -- | Doc for: data instance Bat X data instance Bat X @@ -53,9 +55,9 @@ data instance Bat (z :: Z) where -- | Doc for: class Assoc a class Assoc a where -- | Doc for: data AssocD a - data AssocD a :: * + data AssocD a :: Type -- | Doc for: type AssocT a - type AssocT a :: * + type AssocT a :: Type -- | Doc for: instance Assoc X instance Assoc X where