Coding style: Using StandaloneKindSignatures in GHC

Sebastian Graf sgraf1337 at gmail.com
Tue May 18 18:14:16 UTC 2021


Hi Baldur,

I'd be fine with declaring a SAKS whenever I'd need to specify a kind 
signature anyway.
But so far I never needed to specify a kind in the data types or type 
synonyms I declare.
I'd say that providing SAKS for types like `OrdList` or `State` where 
kinds are inferred just fine is overkill, but ultimately I won't fight 
if the majority likes to do that...

Sebastian

------ Originalnachricht ------
Von: "Baldur Blöndal" <baldurpet at gmail.com>
An: ghc-devs at haskell.org
Gesendet: 18.05.2021 19:58:18
Betreff: Coding style: Using StandaloneKindSignatures in GHC

>Discussion to permit use of StandaloneKindSignatures in the GHC coding
>style guide. I believe it increases the clarity of the code,
>especially as we move to fancier kinds.
>
>It is the only way we have for giving full signatures to type
>synonyms, type classes, type families and others. An example:
>
>     type Cat :: Type -> Type
>     type Cat ob = ob -> ob -> Type
>
>     type  Category :: forall ob. Cat ob -> Constraint
>     class Category cat where
>       id :: cat a a ..
>
>     type Proxy :: forall k. k -> Type
>     data Proxy a = Proxy
>
>     type Some :: forall k. (k -> Type) -> Type
>     data Some f where
>       Some :: f ex -> Some f
>
>     -- | The regular function type
>     type (->) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
>TYPE1 rep1 -> TYPE rep2 -> Type
>     type (->) = FUN 'Many
>
>This is in line with function definitions that are always given a
>top-level, standalone type signature (1) and not like we currently
>define type families/synonyms (2) by annotating each argument or not
>at all. Using -XStandaloneKindSignatures (3) matches (1)
>
>     -- (1)
>     curry :: ((a, b) -> c) -> (a -> b -> c)
>     curry f  x y = f (x, y)
>
>     -- (2)
>     type Curry (f :: (a, b) -> c) (x :: a) (y :: b) =  f '(x, y) :: c
>
>     -- (3)
>     type Curry :: ((a, b) -> c) -> (a -> b -> c)
>     type Curry f x y = f '(x, y)
>
>It covers an edgecase that `KindSignatures` don't. The only way for
>deriving to reference datatype arguments is if they are quantified by
>the declaration head -- `newtype Bin a ..`. StandaloneKindSignatures
>allows us to still provide a full signature. We could write `newtype
>Bin a :: Type -> Type` without it but not `newtype Bin :: Type -> Type
>-> Type`
>
>     type    Bin :: Type -> Type -> Type
>     newtype Bin a b = Bin (a -> a -> b)
>       deriving (Functor, Applicative)
>       via (->) a `Compose` (->) a
>
>Let me know what you think
>_______________________________________________
>ghc-devs mailing list
>ghc-devs at haskell.org
>http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs



More information about the ghc-devs mailing list