Add kindedVar and take type parameters as HsTyVarBndr'. (#61)

Previously functions like `class'` and `data'` took their
type variables as `OccNameStr` which let them be passed
as overloaded strings; for example, `data' "Maybe" ["a"] ...`.
Now, they take them as `HsTyVarBndr'`, the same as `forall'`,
and can be constructed with, for example,
`data' "Maybe" [bvar "a"] ...`.

This approach lets them be constructed with either `bvar` (for regular
variables) or `kindedVar` (for kind signatures).

Original patch by ersran9@.

ChangeLog.md

@@ -1,5 +1,16 @@
 # Changelog for haskell-syntax
 
+# 0.4.0.0
+
+## Breaking Changes
+- Functions defining types and classes now take their
+  type parameters as `HsTyVarBndr'` rather than `OccNameStr`.
+  To construct a `HsTyVarBndr'`, use either `bvar` or `kindedVar`.
+  Affects: `class'`, `type'`, `newtype'`, and `data'`.
+
+## Other Changes
+- Add `kindedVar`.
+
 ## 0.3.0.0
 - Add `occNameToStr` and `nameToStr` to convert from the GHC types.
 - Make `listPromotedTy` emit the promoted form `'[..]`,

package.yaml

@@ -5,7 +5,7 @@
 # https://developers.google.com/open-source/licenses/bsd
 
 name:                ghc-source-gen
-version:             0.3.0.0
+version:             0.4.0.0
 github:              "google/ghc-source-gen"
 license:             BSD3
 author:              "Judah Jacobson"

src/GHC/SourceGen/Decl.hs

@@ -128,7 +128,7 @@ funDep = ClassFunDep
 -- > in class'
 -- >      [var "Real" @@ a, var "Enum" @@ a]
 -- >      "Integral"
--- >      ["a"]
+-- >      [bvar "a"]
 -- >      [ typeSig "divMod" $ a --> a --> tuple [a, a]
 -- >      , typeSig "div" $ a --> a --> a
 -- >      , funBind "div"
@@ -138,7 +138,7 @@ funDep = ClassFunDep
 class'
     :: [HsType'] -- ^ Context
     -> OccNameStr -- ^ Class name
-    -> [OccNameStr] -- ^ Type parameters
+    -> [HsTyVarBndr'] -- ^ Type parameters
     -> [ClassDecl] -- ^ Class declarations
     -> HsDecl'
 class' context name vars decls
@@ -246,8 +246,8 @@ tyFamInst name params ty = tyFamInstD
 --
 -- > type A a b = B b a
 -- > =====
--- > type' "A" ["a", "b"] $ var "B" @@ var "b" @@ var "a"
-type' :: OccNameStr -> [OccNameStr] -> HsType' -> HsDecl'
+-- > type' "A" [bvar "a", bvar "b"] $ var "B" @@ var "b" @@ var "a"
+type' :: OccNameStr -> [HsTyVarBndr'] -> HsType' -> HsDecl'
 type' name vars t =
     noExt TyClD $ withPlaceHolder $ noExt SynDecl (typeRdrName $ unqual name)
         (mkQTyVars vars)
@@ -257,7 +257,7 @@ type' name vars t =
 newOrDataType
     :: NewOrData
     -> OccNameStr
-    -> [OccNameStr]
+    -> [HsTyVarBndr']
     -> [ConDecl']
     -> [HsDerivingClause']
     -> HsDecl'
@@ -276,10 +276,10 @@ newOrDataType newOrData name vars conDecls derivs
 --
 -- > newtype Const a b = Const a deriving Eq
 -- > =====
--- > newtype' "Const" ["a", "b"]
+-- > newtype' "Const" [bvar "a", bvar "b"]
 -- >    (conDecl "Const" [var "a"])
 -- >    [var "Show"]
-newtype' :: OccNameStr -> [OccNameStr] -> ConDecl' -> [HsDerivingClause'] -> HsDecl'
+newtype' :: OccNameStr -> [HsTyVarBndr'] -> ConDecl' -> [HsDerivingClause'] -> HsDecl'
 newtype' name vars conD = newOrDataType NewType name vars [conD]
 
 -- | A data declaration.
@@ -287,12 +287,12 @@ newtype' name vars conD = newOrDataType NewType name vars [conD]
 -- > data Either a b = Left a | Right b
 -- >    deriving Show
 -- > =====
--- > data' "Either" ["a", "b"]
+-- > data' "Either" [bvar "a", bvar "b"]
 -- >   [ conDecl "Left" [var "a"]
 -- >   , conDecl "Right" [var "b"]
 -- >   ]
 -- >   [var "Show"]
-data' :: OccNameStr -> [OccNameStr] -> [ConDecl'] -> [HsDerivingClause'] -> HsDecl'
+data' :: OccNameStr -> [HsTyVarBndr'] -> [ConDecl'] -> [HsDerivingClause'] -> HsDecl'
 data' = newOrDataType DataType
 
 -- | Declares a Haskell-98-style prefix constructor for a data or type

src/GHC/SourceGen/Syntax/Internal.hs

@@ -193,6 +193,9 @@ type IE' = IE RdrName
 
 -- | A type variable binding, as it is represented after the parsing step.
 --
+-- Construct with either 'GHC.SourceGen.Overloaded.bVar' (for regular type
+-- variables) or `GHC.SourceGen.Type.kindedVar` (for kind signatures).
+--
 -- Instances:
 --
 -- * 'GHC.SourceGen.Overloaded.BVar'

src/GHC/SourceGen/Type.hs

@@ -16,6 +16,7 @@ module GHC.SourceGen.Type
     , forall'
     , HsTyVarBndr'
     , (==>)
+    , kindedVar
     ) where
 
 import Data.String (fromString)
@@ -71,3 +72,12 @@ forall' ts = noExt HsForAllTy (map builtLoc ts) . builtLoc
 (==>) cs = noExt HsQualTy (builtLoc (map builtLoc cs)) . builtLoc
 
 infixr 0 ==>
+
+-- | A type variable with a kind signature.
+--
+-- > x :: A
+-- > =====
+-- > kindedVar "x" (var "A")
+kindedVar :: OccNameStr -> HsType' -> HsTyVarBndr'
+kindedVar v t = noExt KindedTyVar (typeRdrName $  UnqualStr v)
+                        (builtLoc t)

src/GHC/SourceGen/Type/Internal.hs

@@ -11,13 +11,11 @@ import HsTypes
 import SrcLoc (Located, unLoc)
 
 import GHC.SourceGen.Syntax.Internal
-import GHC.SourceGen.Name.Internal
 
-mkQTyVars :: [OccNameStr] -> LHsQTyVars'
+mkQTyVars :: [HsTyVarBndr'] -> LHsQTyVars'
 mkQTyVars vars =  withPlaceHolder
                 $ noExt (withPlaceHolder HsQTvs)
-                $ map (builtLoc . noExt UserTyVar . typeRdrName . UnqualStr)
-                    vars
+                $ map builtLoc vars
 
 sigType :: HsType' -> LHsSigType'
 sigType = implicitBndrs . builtLoc

tests/pprint_examples.hs

@@ -116,26 +116,26 @@ test3 = pprint $ module' Nothing Nothing []
     , typeSig "g" $ op (var "A" @@ var "x") "*"
                         (op (var "B" @@ var "y") "+"
                                  (var "C" @@ var "z"))
-    , class' [var "A" @@ var "a"] "B" ["b", "b'"]
+    , class' [var "A" @@ var "a"] "B" [bvar "b", bvar "b'"]
         [ typeSig "f" $ var "b" --> var "b'"
         , funBind "f" $ match [] $ var "id"
         ]
-    , class' [] "F" ["a", "b", "c"]
+    , class' [] "F" [bvar "a", bvar "b", bvar "c"]
         [ funDep ["a", "b"] ["c"]
         , funDep ["a"] ["b", "c"]
         ]
-    , class' [] "Ident" ["a", "b"]
+    , class' [] "Ident" [bvar "a", bvar "b"]
         [ funDep ["a"] ["b"]
         , funDep ["b"] ["a"]
         , typeSig "ident" $ var "a" --> var "b"
         ]
-    , type' "A" ["b", "c"] $ var "D"
-    , data' "A" ["b", "c"]
+    , type' "A" [bvar "b", bvar "c"] $ var "D"
+    , data' "A" [bvar "b", bvar "c"]
         [ prefixCon "A" [field (var "b"), field (var "c")]
         , prefixCon "D" []
         ]
         [deriving' [var "X", var "Y"]]
-    , newtype' "A" ["b", "c"] (prefixCon "A" [field (var "b")])
+    , newtype' "A" [bvar "b", bvar "c"] (prefixCon "A" [field (var "b")])
         [deriving' [var "X", var "Y"]]
     , instance' (var "A" @@ var "b" @@ var "c")
         [ typeSig "f" $ var "b" --> var "c"
@@ -145,7 +145,7 @@ test3 = pprint $ module' Nothing Nothing []
       in class'
            [var "Real" @@ a, var "Enum" @@ a]
            "Integral"
-           ["a"]
+           [bvar "a"]
            [ typeSig "divMod" $ a --> a --> tuple [a, a]
            , typeSig "div" $ a --> a --> a
            , funBind "div"
@@ -159,7 +159,7 @@ test3 = pprint $ module' Nothing Nothing []
             , match [conP "False" []] $ string "False"
             ]
         ]
-    , data' "X" ["b"]
+    , data' "X" [bvar "b"]
         [ prefixCon "X"
             [ field $ var "A" @@ var "b"
             , strict $ field $ var "A" @@ var "b"

tests/pprint_test.hs

@@ -279,6 +279,28 @@ declsTest dflags = testGroup "Decls"
         [ "pattern F a b = G b a"
             :~ patSynBind "F" ["a", "b"] $ conP "G" [bvar "b", bvar "a"]
         ]
+   , test "dataDecl"
+        [ "data Either a b\n  = Left a | Right b\n  deriving Show"
+            :~ data' "Either" [bvar "a", bvar "b"]
+               [ prefixCon "Left" [field $ var "a"]
+               , prefixCon "Right" [field $ var "b"]
+               ] $ [deriving' [var "Show"]]
+        , "data Either a (b :: Type)\n  = Left a | Right b\n  deriving Show"
+            :~ data' "Either" [bvar "a", kindedVar "b" (var "Type")]
+               [ prefixCon "Left" [field $ var "a"]
+               , prefixCon "Right" [field $ var "b"]
+               ] $ [deriving' [var "Show"]]
+        ]
+    , test "newtypeDecl"
+        [ "newtype Const a b\n  = Const a\n  deriving Show"
+            :~ newtype' "Const" [bvar "a", bvar "b"]
+               (prefixCon "Const" [field $ var "a"])
+               $ [deriving' [var "Show"]]
+        , "newtype Const a (b :: Type)\n  = Const a\n  deriving Show"
+            :~ newtype' "Const" [bvar "a", kindedVar "b" (var "Type")]
+               (prefixCon "Const" [field $ var "a"])
+               [deriving' [var "Show"]]
+        ]
     ]
   where
     test = testDecls dflags