Add preliminary support for @invariant (see #1)

.gitlab-ci.yml

@@ -6,5 +6,3 @@ build:
     - apt-get install -y -qq build-essential subversion
   script:
     - make
-variables:
-  GIT_SUBMODULE_STRATEGY: recursive

testproperties.icl

@@ -31,7 +31,7 @@ import Text.Language
 import Clean.Doc
 import Clean.Parse
 import Clean.Parse.Comments
-import Clean.Types.Util => qualified :: Priority
+import Clean.Types.Util => qualified :: Priority, :: TypeDef
 
 from syntax import
 	:: FunKind,
@@ -39,12 +39,15 @@ from syntax import
 	:: Ident{id_name},
 	:: Module{mod_defs,mod_ident},
 	:: Optional,
-	:: ParsedDefinition(PD_Function,PD_TypeSpec),
+	:: ParsedDefinition(PD_Function,PD_Type,PD_TypeSpec),
 	:: ParsedExpr,
+	:: ParsedTypeDef,
 	:: Position,
 	:: Priority,
 	:: Rhs,
-	:: SymbolType
+	:: RhsDefsOfType,
+	:: SymbolType,
+	:: TypeDef{td_ident}
 
 :: Options =
 	{ directory        :: !FilePath
@@ -236,6 +239,10 @@ handleModule opts fp w
 			[(pd,id) \\ pd=:(PD_TypeSpec pos id _ _ _) <- dcldefs],
 		Just docstring <- [getComment pd documentation],
 		Right (doc,_) <- [parseDoc docstring]]
+	[(id.id_name,doc) \\
+		pd=:(PD_Type {td_ident=id}) <- dcldefs,
+		Just docstring <- [getComment pd documentation],
+		Right (doc,_) <- [parseDoc docstring]]
 // Write properties
 | nprops == 0 = w
 # w = output INFO
@@ -281,8 +288,9 @@ where
 	interleave g [x:xs] = [g,x:interleave g xs]
 
 generatePropertyModule :: !String !String ![String] ![String] !(Maybe ModuleDoc)
-	![(!String,!FunctionDoc)] -> (!Int, !Real, !String)
-generatePropertyModule testmodname modname print_options test_options mod_doc fes
+	![(!String, !FunctionDoc)] ![(!String, !TypeDoc)]
+	-> (!Int, !Real, !String)
+generatePropertyModule testmodname modname print_options test_options mod_doc fes tes
 	= (length props, coverage, tests)
 where
 	n_props = length props
@@ -295,6 +303,7 @@ where
 		, "import " +++ modname
 		, bootstrap
 		, generators_string
+		, invariants
 		, start
 		: [gp.gp_implementation \\ gp <- props]
 		]
@@ -305,6 +314,21 @@ where
 
 	bootstrap = fromMaybe "" (docPropertyBootstrap =<< mod_doc)
 
+	invariants = join "\n\n" $ concatMap (\(_,td) -> map invariant td.TypeDoc.invariants) tes
+	where
+		invariant :: Property -> String
+		invariant (ForAll name args impl) =
+			name +++ " :: " <+ Func (map noContext argtypes) (Type "Property" []) (concatMap context argtypes) <+ "\n" +++
+			name +++ concat [" " +++ a \\ (a,_) <- args] +++ " =\n\t" +++
+			replaceSubString "\n" "\n\t" impl
+		where
+			noContext (Func [] t _) = t
+			noContext t = t
+			context (Func [] _ c) = c
+			context _ = []
+
+			argtypes = map snd args
+
 	generators = [("gast_generator_" <+ i,type,imp) \\ i <- [0..]
 		& PropertyTestGenerator type imp <- fromMaybe [] (docPropertyTestGenerators <$> mod_doc)]
 	generators_string = join "\n\n" $ map makeGenerator $ generators