Verified Commit 64a2efb9 authored by Camil Staps's avatar Camil Staps 🚀

Update for new platform

parent a37156c9
...@@ -53,7 +53,7 @@ from syntax import :: ClassDef{class_args,class_context,class_ident,class_pos}, ...@@ -53,7 +53,7 @@ from syntax import :: ClassDef{class_args,class_context,class_ident,class_pos},
AbstractTypeSpec,NewTypeCons,MoreConses), AbstractTypeSpec,NewTypeCons,MoreConses),
:: SymbolTable, :: SymbolTableEntry, :: SymbolType, :: Type, :: BITVECT, :: SymbolTable, :: SymbolTableEntry, :: SymbolType, :: Type, :: BITVECT,
:: TypeContext, :: TypeDef{td_ident,td_pos,td_rhs}, :: TypeVar, :: TypeContext, :: TypeDef{td_ident,td_pos,td_rhs}, :: TypeVar,
:: ParsedConstructor{pc_cons_ident}, :: ParsedSelector{ps_selector_ident}, :: ParsedConstructor{pc_cons_ident}, :: ParsedSelector{ps_field_ident},
:: ParsedImport, :: Import{import_module} :: ParsedImport, :: Import{import_module}
import Clean.PrettyPrint import Clean.PrettyPrint
...@@ -475,7 +475,7 @@ findModuleContents include_locals path w ...@@ -475,7 +475,7 @@ findModuleContents include_locals path w
Ok (dcl,_) -> case dclcomments of Ok (dcl,_) -> case dclcomments of
Error _ -> (zero, dcl.mod_defs, emptyCollectedComments) Error _ -> (zero, dcl.mod_defs, emptyCollectedComments)
Ok comments -> let coll = collectComments comments dcl in Ok comments -> let coll = collectComments comments dcl in
( {zero & me_documentation=docParseResultToMaybe (const True) =<< parseDoc <$> getComment dcl.mod_ident coll} ( {zero & me_documentation=docParseResultToMaybe (const True) =<< parseDoc <$> getComment dcl coll}
, dcl.mod_defs , dcl.mod_defs
, coll , coll
) )
...@@ -572,7 +572,7 @@ where ...@@ -572,7 +572,7 @@ where
pd_rewriterules :: !Bool ![ParsedDefinition] !CollectedComments -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)] pd_rewriterules :: !Bool ![ParsedDefinition] !CollectedComments -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
pd_rewriterules dcl defs comments pd_rewriterules dcl defs comments
= [( setLine dcl pos {LocationInModule | zero & name=Just id.id_name} = [( setLine dcl pos {LocationInModule | zero & name=Just id.id_name}
, let doc = findDoc hideIsUsedReturn id comments in , let doc = findDoc hideIsUsedReturn pd comments in
trace_type_warning id trace_type_warning id
{ zero { zero
& fe_kind=Macro & fe_kind=Macro
...@@ -619,7 +619,7 @@ where ...@@ -619,7 +619,7 @@ where
& fe_type=Just $ 'T'.toType gen_type & fe_type=Just $ 'T'.toType gen_type
, fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars , fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars
, fe_representation=Just $ cpp gen , fe_representation=Just $ cpp gen
, fe_documentation=findDoc hideIsUsedReturn id comments , fe_documentation=findDoc hideIsUsedReturn gen comments
, fe_derivations=Just [] , fe_derivations=Just []
} }
, 'S'.newSet , 'S'.newSet
...@@ -632,7 +632,7 @@ where ...@@ -632,7 +632,7 @@ where
& fe_type=Just $ 'T'.toType t & fe_type=Just $ 'T'.toType t
, fe_priority = 'T'.toMaybePriority p , fe_priority = 'T'.toMaybePriority p
, fe_representation = Just $ cpp ts , fe_representation = Just $ cpp ts
, fe_documentation = findDoc hideIsUsedReturn id comments , fe_documentation = findDoc hideIsUsedReturn ts comments
} }
, (idents ICExpression [pd \\ pd=:(PD_Function _ id _ _ _ _) <- defs | id.id_name == id_name]).globals , (idents ICExpression [pd \\ pd=:(PD_Function _ id _ _ _ _) <- defs | id.id_name == id_name]).globals
) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- defs] ) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- defs]
...@@ -660,7 +660,7 @@ where ...@@ -660,7 +660,7 @@ where
& fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro & fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro
, fe_representation=(fst <$> lookup n macros) <|> fe.fe_representation , fe_representation=(fst <$> lookup n macros) <|> fe.fe_representation
, fe_documentation=if (isSingleFunction typespecs id) , fe_documentation=if (isSingleFunction typespecs id)
((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn id comments) ((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn pd comments)
fe.fe_documentation fe.fe_documentation
} }
members = [(f,updateRepresentation f et,ids) \\ ({LocationInModule | name=Just f}, et, ids) <- typespecs] members = [(f,updateRepresentation f et,ids) \\ ({LocationInModule | name=Just f}, et, ids) <- typespecs]
...@@ -670,24 +670,24 @@ where ...@@ -670,24 +670,24 @@ where
(map 'T'.toTypeVar class_args) (map 'T'.toTypeVar class_args)
(all (\(_,fe,_) -> fe.fe_kind == Macro) members) (all (\(_,fe,_) -> fe.fe_kind == Macro) members)
(flatten $ map 'T'.toTypeContext class_context) (flatten $ map 'T'.toTypeContext class_context)
(parseClassDoc typespecs id comments) (parseClassDoc typespecs pd comments)
, members , members
) )
\\ PD_Class {class_ident=id=:{id_name},class_pos,class_args,class_context} clsdefs <- defs \\ pd=:(PD_Class {class_ident=id=:{id_name},class_pos,class_args,class_context} clsdefs) <- defs
] ]
where where
// When the class has one member with the same name as the class, use // When the class has one member with the same name as the class, use
// the class documentation as the function's documentation. This is the // the class documentation as the function's documentation. This is the
// case for classes like `class zero a :: a`, which do not have a where // case for classes like `class zero a :: a`, which do not have a where
// clause and hence no other place for the function's documentation. // clause and hence no other place for the function's documentation.
parseClassDoc :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident !CollectedComments -> Maybe ClassDoc parseClassDoc :: [(LocationInModule, 'CDB'.FunctionEntry, a)] ParsedDefinition !CollectedComments -> Maybe ClassDoc
parseClassDoc members id comments parseClassDoc members pd=:(PD_Class {class_ident=id} _) comments
| isSingleFunction members id = flip addClassMemberDoc | isSingleFunction members id = flip addClassMemberDoc
(functionToClassMemberDoc <$> findDoc hideIsUsedReturn id comments) (functionToClassMemberDoc <$> findDoc hideIsUsedReturn pd comments)
<$> findDoc hideFunctionOnClass id comments <$> findDoc hideFunctionOnClass pd comments
| otherwise = flip (foldl addClassMemberDoc) | otherwise = flip (foldl addClassMemberDoc)
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe,_) <- members] [functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe,_) <- members]
<$> findDoc hideIsUsedReturn id comments <$> findDoc hideIsUsedReturn pd comments
isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool
isSingleFunction members id = length members == 1 isSingleFunction members id = length members == 1
...@@ -703,8 +703,8 @@ where ...@@ -703,8 +703,8 @@ where
= [let name = 'T'.td_name td in = [let name = 'T'.td_name td in
( setLine dcl ptd.td_pos {LocationInModule | zero & name=Just name} ( setLine dcl ptd.td_pos {LocationInModule | zero & name=Just name}
, 'CDB'.toTypeDefEntry NoLocation td $ Just $ findRhsDoc ptd $ fromMaybe gDefault{|*|} $ , 'CDB'.toTypeDefEntry NoLocation td $ Just $ findRhsDoc ptd $ fromMaybe gDefault{|*|} $
findDoc (const True) ptd.td_ident comments findDoc (const True) pd comments
) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]] ) \\ pd=:(PD_Type ptd) <- defs, td <- ['T'.toTypeDef ptd]]
where where
findRhsDoc :: !ParsedTypeDef -> TypeDoc -> TypeDoc findRhsDoc :: !ParsedTypeDef -> TypeDoc -> TypeDoc
findRhsDoc {td_rhs=ConsList cs} = addConses cs findRhsDoc {td_rhs=ConsList cs} = addConses cs
...@@ -717,7 +717,7 @@ where ...@@ -717,7 +717,7 @@ where
addFields [ps:fs] doc = {doc` & fields=Just [d:fromMaybe [] doc`.fields]} addFields [ps:fs] doc = {doc` & fields=Just [d:fromMaybe [] doc`.fields]}
where where
doc` = addFields fs doc doc` = addFields fs doc
d = parseSingleLineDoc <$> getComment ps.ps_selector_ident comments d = parseSingleLineDoc <$> getComment ps comments
addConses :: ![ParsedConstructor] !TypeDoc -> TypeDoc addConses :: ![ParsedConstructor] !TypeDoc -> TypeDoc
addConses [] doc addConses [] doc
...@@ -725,7 +725,7 @@ where ...@@ -725,7 +725,7 @@ where
addConses [pc:cs] doc = {doc` & constructors=Just [d:fromMaybe [] doc`.constructors]} addConses [pc:cs] doc = {doc` & constructors=Just [d:fromMaybe [] doc`.constructors]}
where where
doc` = addConses cs doc doc` = addConses cs doc
d = docParseResultToMaybe (const True) =<< parseDoc <$> getComment pc.pc_cons_ident comments d = docParseResultToMaybe (const True) =<< parseDoc <$> getComment pc comments
toLine :: Position -> 'CDB'.LineNr toLine :: Position -> 'CDB'.LineNr
toLine (FunPos _ l _) = Just l toLine (FunPos _ l _) = Just l
...@@ -742,7 +742,7 @@ where ...@@ -742,7 +742,7 @@ where
hideIsUsedReturn :: ParseWarning -> Bool hideIsUsedReturn :: ParseWarning -> Bool
hideIsUsedReturn w = not $ isUsedReturn w hideIsUsedReturn w = not $ isUsedReturn w
findDoc :: (ParseWarning -> Bool) Ident CollectedComments -> Maybe d | docBlockToDoc{|*|} d findDoc :: (ParseWarning -> Bool) a CollectedComments -> Maybe d | docBlockToDoc{|*|} d & commentIndex a
findDoc showw id coll = getComment id coll >>= \doc -> docParseResultToMaybe showw $ parseDoc doc findDoc showw id coll = getComment id coll >>= \doc -> docParseResultToMaybe showw $ parseDoc doc
isUsedReturn :: ParseWarning -> Bool isUsedReturn :: ParseWarning -> Bool
......
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