Commit b340957d authored by Camil Staps's avatar Camil Staps 🐧

Clean.Doc: add PropertyBootstrapDoc type which parses an option header

parent 96bc3947
Pipeline #34180 failed with stage
in 58 seconds
......@@ -17,7 +17,7 @@ from Clean.Types import :: Type
* A wrapper around the {{`String`}} type which makes sure that multi-line
* documentation blocks get trimmed w.r.t. whitespace.
*/
:: MultiLineString = MultiLine !String
:: MultiLineString =: MultiLine String
class docDescription d :: !d -> Maybe Description
class docComplexity d :: !d -> Maybe String
......@@ -31,7 +31,7 @@ class docFields d :: !d -> Maybe [Maybe Description]
class docConstructors d :: !d -> Maybe [Maybe ConstructorDoc]
class docRepresentation d :: !d -> Maybe (Maybe Description)
class docPropertyBootstrap d :: !d -> Maybe String
class docPropertyBootstrap d :: !d -> Maybe PropertyBootstrapDoc
class docPropertyTestWith d :: !d -> [PropertyVarInstantiation]
class docPropertyTestGenerators d :: !d -> [PropertyTestGenerator]
class docProperties d :: !d -> [Property]
......@@ -42,7 +42,7 @@ class docPreconditions d :: !d -> [String]
*/
:: ModuleDoc =
{ description :: !Maybe Description
, property_bootstrap :: !Maybe MultiLineString //* For generating unit tests with clean-test
, property_bootstrap :: !Maybe PropertyBootstrapDoc //* For generating unit tests with clean-test-properties
, property_test_with :: ![PropertyVarInstantiation] //* With which types to test the properties
, property_test_generators :: ![PropertyTestGenerator]
//* Functions to generate values of types for which Gast's {{`ggen`}} is not good enough, like {{`Map`}}
......@@ -52,7 +52,14 @@ instance docDescription ModuleDoc
instance docPropertyBootstrap ModuleDoc
instance docPropertyTestWith ModuleDoc
instance docPropertyTestGenerators ModuleDoc
derive gDefault ModuleDoc
derive gDefault ModuleDoc, PropertyBootstrapDoc
//* Belongs to `property_bootstrap` in `ModuleDoc`.
:: PropertyBootstrapDoc =
{ bootstrap_content :: !MultiLineString
, bootstrap_without_default_imports :: !Bool
//* Don't generate a default set of imports (e.g. to avoid name clashes with Gast)
}
/**
* Documentation of a Clean function.
......
......@@ -37,7 +37,7 @@ fromMultiLine :: !MultiLineString -> String
fromMultiLine (MultiLine s) = s
instance docDescription ModuleDoc where docDescription d = d.ModuleDoc.description
instance docPropertyBootstrap ModuleDoc where docPropertyBootstrap d = fromMultiLine <$> d.property_bootstrap
instance docPropertyBootstrap ModuleDoc where docPropertyBootstrap d = d.property_bootstrap
instance docPropertyTestWith ModuleDoc where docPropertyTestWith d = d.ModuleDoc.property_test_with
instance docPropertyTestGenerators ModuleDoc where docPropertyTestGenerators d = d.property_test_generators
......@@ -87,7 +87,7 @@ where
toString _ = ""
derive gDefault Type, TypeRestriction, ModuleDoc, FunctionDoc, InstanceDoc, TypeContext,
ClassMemberDoc, ConstructorDoc, ClassDoc, TypeDoc, Property,
ClassMemberDoc, ConstructorDoc, ClassDoc, TypeDoc, Property, PropertyBootstrapDoc,
PropertyVarInstantiation, MultiLineString, PropertyTestGenerator, ParamDoc
constructorToFunctionDoc :: !ConstructorDoc -> FunctionDoc
......@@ -158,7 +158,7 @@ docBlockToDoc{|EITHER|} fl fr doc = case fl doc of
Left _ -> Left e
docBlockToDoc{|OBJECT|} fx doc = appFst (\x -> OBJECT x) <$> fx doc
docBlockToDoc{|MultiLineString|} (Left [s]) = Right (MultiLine $ trimMultiLine $ split "\n" s, [])
docBlockToDoc{|MultiLineString|} (Left [s]) = Right (MultiLine (trimMultiLine $ split "\n" s), [])
docBlockToDoc{|MultiLineString|} _ = abort "error in docBlockToDoc{|MultiLineString|}\n"
docBlockToDoc{|ParamDoc|} (Left [s]) = case findName (fromString s) of
......@@ -183,6 +183,25 @@ docBlockToDoc{|Type|} (Left ss) = case [v \\ Just v <- map (parseType o fromStri
vs -> Right (last vs, [])
docBlockToDoc{|Type|} _ = abort "error in docBlockToDoc{|Type|}\n"
docBlockToDoc{|PropertyBootstrapDoc|} (Left [s]) =
let [opts:content] = split "\n" s in
parseOpts opts >>= \(no_imports,ws) -> pure
(
{ bootstrap_content = MultiLine (trimMultiLine content)
, bootstrap_without_default_imports = no_imports
}
, ws
)
where
parseOpts opts = case opts of
"without default imports" ->
Right (True,[])
"" ->
Right (False,[])
_ ->
Left (UnknownError "illegal header for property-bootstrap field")
docBlockToDoc{|PropertyBootstrapDoc|} _ = abort "error in docBlockToDoc{|PropertyBootstrapDoc|}\n"
docBlockToDoc{|Property|} (Left [s]) = let [signature:property] = split "\n" s in
parseSignature signature >>= \(sig,ws1) ->
parseProperty property >>= \(prop,ws2) ->
......@@ -297,6 +316,9 @@ docToDocBlock{|MultiLineString|} True (MultiLine s) = Left [s]
docToDocBlock{|MultiLineString|} _ _ = abort "error in docToDocBlock{|MultiLineString|}\n"
docToDocBlock{|Type|} True t = Left [toString t]
docToDocBlock{|Type|} _ _ = abort "error in docToDocBlock{|Type|}\n"
docToDocBlock{|PropertyBootstrapDoc|} True bs_doc = Left $ [ if bs_doc.bootstrap_without_default_imports " without default imports" ""
: map ((+++) " ") $ split "\n" $ fromMultiLine bs_doc.bootstrap_content
]
docToDocBlock{|Property|} True (ForAll name args impl) = Left
[name +++ ": A." +++ join "; " [a +++ " :: " <+ t \\ (a,t) <- args] +++ ":\n" +++ impl]
docToDocBlock{|Property|} _ _ = abort "error in docToDocBlock{|Property|}\n"
......
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