[quickcheck: improve instance Arbitrary Type
Helmut Grohne <grohne@cs.uni-bonn.de>**20150309120623
 Ignore-this: cf9254a6ad445251e779d554d9449696
 
 Now the generated Types have kind * and they do kind-check now.
] 
<
[simplify isTuple and isAnyTuple without TemplateHaskell
Helmut Grohne <grohne@cs.uni-bonn.de>**20140717084230
 Ignore-this: 3bb9e59d15a53053c78df69001431229
] 
[work around unhandled runtime error passing by catchError
Helmut Grohne <grohne@cs.uni-bonn.de>**20140108073945
 Ignore-this: 60b21165b086517cb697ed19c7fe368e
] 
[use throwError where possible
Helmut Grohne <grohne@cs.uni-bonn.de>**20140108091026
 Ignore-this: e06ab5b6869087360b7a19fc56a8c2c4
 Since the use of fail changed in past GHC releases, part of the code base now
 uses throwError instead. The biggest part is the introduction of an Error e
 requirement to many of the functions to be able to use throwError. As a side
 effect of this change, interactive igor2 no longer dies on a syntax error.
] 
[simplify the data type Type
Helmut Grohne <grohne@cs.uni-bonn.de>**20150209153158
 Ignore-this: 7e09228772a1b15bc375449fc28502cf
 
 Remove constructors ArrowT, ListT and TupleT. These can also be represented as
 compositions of AppT and ConT. Re-define their lower-case constructors suitably
 and improve pretty-printing to cover for these cases.
] 
[introduce abbreviations for ConT ''SomeType
Helmut Grohne <grohne@cs.uni-bonn.de>**20150309120412
 Ignore-this: 64a67504fd0dcf02ce0b8c1ef97f933d
 
  * Allows using these constructors in modules that do not enable TH.
  * Simplifies refactoring of the ConT constructor (e.g. adding kinds).
] 
> hunk ./src/Tests.hs 12
+import qualified Data.Set as S
hunk ./src/Tests.hs 22
+data Kind = Star | Arrow Kind Kind deriving (Eq, Ord)
+infixr 9 `Arrow`
+
+instance Show Kind where
+  showsPrec _ Star = ('*':)
+  showsPrec _ (x `Arrow` y) = ('(':) . shows x . (" -> "++) . shows y . (')':)
+
+instance QC.Arbitrary Kind where
+ -- only generate kinds k such that simpleTypes (Star `Arrow` k) != []
+ arbitrary = QC.elements [Star, Star `Arrow` Star]
+
+simpleTypes :: Kind -> [Type]
+simpleTypes Star = [boolCon, intCon, tupleCon 0]
+simpleTypes (Star `Arrow` Star) = [listCon, maybeCon]
+simpleTypes (Star `Arrow` Star `Arrow` Star) = [arrowCon, eitherCon, tupleCon 2]
+simpleTypes _ = []
+
+genType :: S.Set Name -> Kind -> Int -> QC.Gen Type
+genType visible kind size = if null gens then error "huh?" else QC.oneof gens
+  where simple    = simpleTypes kind ++ if kind == Star then map VarT (S.toList visible) else []
+        conssimple = if null simple then id else (QC.elements simple:)
+        genforall = do n <- QC.suchThat QC.arbitrary (`S.notMember` visible)
+                       t <- genType (S.insert n visible) kind (pred size)
+                       return $ ForallT [n] [] t
+        consforall = if size > 0 then (genforall:) else id
+        genapp    = do argkind <- QC.arbitrary `QC.suchThat` (not . null . simpleTypes . (`Arrow` kind))
+                       arg <- genType visible argkind (size `div` 2)
+                       con <- genType visible (argkind `Arrow` kind) (size `div` 2)
+                       return $ AppT con arg
+        consapp   = if size <= 0 || (null . simpleTypes $ Star `Arrow` kind) then id else (genapp:)
+        gens      = conssimple . consforall $ consapp []
+
hunk ./src/Tests.hs 55
-  arbitrary = QC.sized arbType
-    where arbType 0 = QC.elements [VarT, ConT] <*> QC.arbitrary
-          arbType n = QC.oneof [arbType 0, AppT <$> arbType (n `div` 2) <*> arbType (n `div` 2)]
+  arbitrary = QC.sized $ genType S.empty Star
+
hunk ./src/Tests.hs 60
-  shrink (ConT n)        = map ConT (QC.shrink n)
+  shrink (ConT n)        = []