Support list test generators (closes #8)

src/testproperties.icl

@@ -341,14 +341,17 @@ where
 
 			argtypes = map snd args
 
-	generators = [("gast_generator_" <+ i,type,imp) \\ i <- [0..]
-		& PropertyTestGenerator type imp <- fromMaybe [] (docPropertyTestGenerators <$> mod_doc)]
+	generators = [("gast_generator_" <+ i,ptg) \\ i <- [0..] & ptg <- fromMaybe [] (docPropertyTestGenerators <$> mod_doc)]
 	generators_string = join "\n\n" $ map makeGenerator $ generators
 	where
 		makeGenerator :: NamedTestGenerator -> String
-		makeGenerator (name, t, imp) = join "\n"
-			[ name +++ " :: " <+ t
-			, name +++ imp % (3, size imp - 1)
+		makeGenerator (name, ptg) = case ptg of
+			PTG_Function t imp -> mkgen name t (imp % (3, size imp-1))
+			PTG_List t imp     -> mkgen name (Type "_List" [t]) (" = " +++ imp)
+
+		mkgen name type imp = join "\n"
+			[ name +++ " :: " <+ type
+			, name +++ imp
 			]
 
 	start = join "\n\t"
@@ -364,7 +367,13 @@ where
 	, gp_implementation :: !String
 	}
 
-:: NamedTestGenerator :== (String, Type, String)
+:: NamedTestGenerator :== (String, PropertyTestGenerator)
+
+:: GeneratedArgument =
+	{ ga_name :: !String // argument name
+	, ga_expr :: !String // expression (for PTG_Function)
+	, ga_ptg  :: !Maybe NamedTestGenerator // the generator used
+	}
 
 generateProperties :: ![PropertyVarInstantiation] ![NamedTestGenerator] !String !FunctionDoc -> [GeneratedProperty]
 generateProperties pvis generators fname doc =
@@ -394,10 +403,10 @@ where
 		, gp_implementation = join "\n"
 			[ tname +++ " :: Property"
 			, tname +++ " = name \"" +++ fname +++ ": " +++ name` +++ "\""
-			, "\t(" +++ lambda +++ join " " [name`` +++ "`":map snd3 ts`] +++ ")"
+			, "\t(" +++ join " " lambdas +++ join " " [name`` +++ "`":[ga.ga_expr \\ ga <- gas]] +++ {')' \\ _ <- lambdas} +++ ")"
 			, "where"
 			, "\t" +++ name`` +++ "` :: " +++ toString type`
-			, "\t" +++ join " " [name`` +++ "`":map fst3 ts`] +++ " = (True" +++ concat [" /\\ _pre" <+ i \\ i <- [1..] & pre <- preconditions] +++ ") ==> _p"
+			, "\t" +++ join " " [name`` +++ "`":[ga.ga_name \\ ga <- gas]] +++ " = (True" +++ concat [" /\\ _pre" <+ i \\ i <- [1..] & pre <- preconditions] +++ ") ==> _p"
 			, "\twhere"
 			, "\t\t_p = " +++ replaceSubString "\n" "\n\t\t\t" imp
 			: ["\t\t_pre" <+ i <+ " = " +++ s \\ s <- preconditions & i <- [1..]]
@@ -407,18 +416,37 @@ where
 		tname = fname +++ "_" +++ name``
 		name`` = fixname name`
 		name` = if (i == 1) name (name +++ "_" +++ toString i)
-		type  = fromJust $ assignAll vis $ Func (map thd3 ts`) (Type "Property" []) []
 		type` = fromJust $ assignAll vis $ Func (map snd ts) (Type "Property" []) []
 
-		ts` = map resolveGenerators ts
-		lambda = case ts` of
-			[] -> ""
-			_  -> "\\" +++ join " " (map fst3 ts`) +++ " -> "
+		gas = map resolveGenerators ts
+		where
+			resolveGenerators :: (String,Type) -> GeneratedArgument
+			resolveGenerators (arg,t) =
+				case [(n,i,ntg) \\ ntg=:(n,PTG_Function (Func [i] r _) _) <- generators | r == t] of
+					[(n,i,ntg):_] ->
+						{ ga_name = arg
+						, ga_expr = "(" +++ n +++ " " +++ arg +++ ")"
+						, ga_ptg  = Just ntg
+						}
+					[] -> case [(n,ntg) \\ ntg=:(n,PTG_List r _) <- generators | r == t] of
+						[(n,ntg):_] ->
+							{ ga_name = arg
+							, ga_expr = arg
+							, ga_ptg  = Just ntg
+							}
+						[] ->
+							{ ga_name = arg
+							, ga_expr = arg
+							, ga_ptg  = Nothing
+							}
 
-		resolveGenerators :: (String,Type) -> (String,String,Type)
-		resolveGenerators (arg,t) = case [(n,i) \\ (n,Func [i] r _,_) <- generators | r == t] of
-			[(n,i):_] -> (arg,"(" +++ n +++ " " +++ arg +++ ")",i)
-			[]        -> (arg,arg,t)
+		lambdas = map makeLambda gas
+		where
+			makeLambda :: GeneratedArgument -> String
+			makeLambda ga = case ga.ga_ptg of
+				Just (gen,PTG_List _ _)
+					-> "ForEach " +++ gen +++ " (\\" +++ ga.ga_name +++ "->"
+					-> "\\" +++ ga.ga_name +++ "->("
 
 		fixname :: String -> String
 		fixname s = {if (isAlphanum c) c '_' \\ c <-: s}