Verified Commit 906de3a6 authored by Camil Staps's avatar Camil Staps 🚀

Add preliminary support for @invariant (see #1)

parent 60d53df2
......@@ -6,5 +6,3 @@ build:
- apt-get install -y -qq build-essential subversion
script:
- make
variables:
GIT_SUBMODULE_STRATEGY: recursive
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment