Verified Commit 93825a1c authored by Camil Staps's avatar Camil Staps 🚀

Parse documentation; index macro/generic/normal function documentation

parent b15e540d
definition module Doc
from Data.Either import :: Either
from Data.Maybe import :: Maybe
:: Documentation
= ModuleDoc (Maybe Description)
| FunctionDoc (Maybe Description) [ParamDoc] [VarDoc] (Maybe ResultDoc)
| ClassDoc (Maybe Description) [VarDoc] [ClassMemberDoc]
| TypeDoc (Maybe Description) [VarDoc] (Maybe TypeRhsDoc)
| ConstructorDoc (Maybe Description) [ParamDoc]
:: ClassMemberDoc
= ClassMemberDoc (Maybe Description) [ParamDoc] (Maybe ResultDoc)
:: TypeRhsDoc
= ADTDoc [Documentation] // Only uses ConstructorDoc
| RecordDoc [RecordFieldDoc]
| SynonymDoc (Maybe Description)
:: ParamDoc :== Description
:: VarDoc :== Description
:: ResultDoc :== Description
:: RecordFieldDoc :== Description
:: Description :== String
:: ParseError
= MissingAsterisk // At least one line did not start with a *
| IllegalState String // Incorrect usage of this module
:: ParseWarning
= UnknownField String // Unknown @-field
| IllegalField String // This @-field is not allowed in this docblock
| NoDescription // The main description is missing
| UsedReturn // Used @return instead of @result
| SkippedLine String // Skipped an unparseable line
getDocDescription :: Documentation -> Maybe Description
getParamDocs :: Documentation -> [ParamDoc]
getVarDocs :: Documentation -> [ParamDoc]
getResultDoc :: Documentation -> Maybe String
parseModuleDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseFunctionDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseClassDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseAbstractTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseSynonymTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseADTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseRecordTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseConstructorDoc :: String Documentation
-> Either ParseError (Documentation, [ParseWarning])
// Second argument should be a TypeDoc with an ADTDoc
traceParseWarnings :: [ParseWarning] !a -> a
traceParseError :: ParseError !a -> a
implementation module Doc
import StdChar
import StdDebug
from StdFunc import flip, o, twice
import StdList
import StdMisc
import StdString
import Control.Monad
import Data.Either
from Data.Func import $
import Data.Functor
import Data.List
import Data.Maybe
import Data.Tuple
:: DocField
= Param String
| Var String
| Result String
| Field String
| Representation String
:: FieldUpdateFunction :==
DocField Documentation -> Either ParseError (Documentation, [ParseWarning])
fieldName :: DocField -> String
fieldName (Param _) = "param"
fieldName (Var _) = "var"
fieldName (Result _) = "result"
fieldName (Field _) = "field"
fieldName (Representation _) = "representation"
getDocDescription :: Documentation -> Maybe Description
getDocDescription (ModuleDoc d) = d
getDocDescription (FunctionDoc d _ _ _) = d
getDocDescription (ClassDoc d _ _) = d
getDocDescription (TypeDoc d _ _) = d
getDocDescription (ConstructorDoc d _) = d
getParamDocs :: Documentation -> [ParamDoc]
getParamDocs (FunctionDoc _ ps _ _) = ps
getParamDocs (ConstructorDoc _ ps) = ps
getParamDocs _ = []
getVarDocs :: Documentation -> [ParamDoc]
getVarDocs (FunctionDoc _ _ vs _) = vs
getVarDocs (ClassDoc _ vs _) = vs
getVarDocs (TypeDoc _ vs _) = vs
getVarDocs _ = []
getResultDoc :: Documentation -> Maybe String
getResultDoc (FunctionDoc _ _ _ r) = r
getResultDoc _ = Nothing
parseModuleDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseModuleDoc = parseDocBlock $ ModuleDoc Nothing
parseFunctionDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseFunctionDoc = parseDocBlock $ FunctionDoc Nothing [] [] Nothing
parseClassDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseClassDoc = parseDocBlock $ ClassDoc Nothing [] []
parseAbstractTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseAbstractTypeDoc = parseDocBlock $ TypeDoc Nothing [] Nothing
parseSynonymTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseSynonymTypeDoc = parseDocBlock $ TypeDoc Nothing [] $ Just $ SynonymDoc Nothing
parseADTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseADTypeDoc = parseDocBlock $ TypeDoc Nothing [] $ Just $ ADTDoc []
parseRecordTypeDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseRecordTypeDoc = parseDocBlock $ TypeDoc Nothing [] $ Just $ RecordDoc []
parseConstructorDoc :: String Documentation
-> Either ParseError (Documentation, [ParseWarning])
parseConstructorDoc s (TypeDoc d vs (Just (ADTDoc cs)))
= appFst (TypeDoc d vs o Just o ADTDoc o (\c -> [c:cs]))
<$> parseDocBlock (ConstructorDoc Nothing []) s
updateDesc :: [[Char]] Documentation -> Documentation
updateDesc desc doc = case doc of
FunctionDoc _ ps vs r = FunctionDoc desc` ps vs r
ModuleDoc _ = ModuleDoc desc`
ClassDoc _ vs cms = ClassDoc desc` vs cms
TypeDoc _ vs rhs = TypeDoc desc` vs rhs
where
desc` = Just $ toString $ flatten $ intersperse ['\n'] desc
parseDocBlock :: Documentation String
-> Either ParseError (Documentation, [ParseWarning])
parseDocBlock doc block = prepareString block >>= parsef
where
parsef :: [[Char]] -> Either ParseError (Documentation, [ParseWarning])
parsef [] = Right (doc, [])
parsef lines = case span ((<>) '@' o hd) lines of
([], rest) = appSnd (\ws -> [NoDescription:ws]) <$> parseFields doc rest
(desc, rest) = appFst (updateDesc desc) <$> parseFields doc rest
parseFields :: Documentation [[Char]]
-> Either ParseError (Documentation, [ParseWarning])
parseFields org []
= Right (org, [])
parseFields org [['@':'p':'a':'r':'a':'m':desc]:rest]
= concatWarnings upd (Param $ prepField desc) =<< parseFields org rest
parseFields org [['@':'r':'e':'s':'u':'l':'t':desc]:rest]
= concatWarnings upd (Result $ prepField desc) =<< parseFields org rest
parseFields org [['@':'r':'e':'t':'u':'r':'n':desc]:rest]
= appSnd ((++) [UsedReturn]) <$>
(concatWarnings upd (Result $ prepField desc) =<< parseFields org rest)
parseFields org [['@':'v':'a':'r':desc]:rest]
= concatWarnings upd (Var $ prepField desc) =<< parseFields org rest
parseFields org [['@':'f':'i':'e':'l':'d':desc]:rest]
= concatWarnings upd (Field $ prepField desc) =<< parseFields org rest
parseFields org [['@':'r':'e':'p':'r':'e':'s':'e':'n':'t':'a':'t':'i':'o':'n':desc]:rest]
= concatWarnings upd (Representation $ prepField desc) =<< parseFields org rest
parseFields org [['@':line]:rest]
= appSnd ((++) [UnknownField $ toString $ takeWhile (not o isSpace) line])
<$> parseFields org rest
parseFields org [line:rest]
= appSnd ((++) [SkippedLine $ toString line]) <$> parseFields org rest
upd :: DocField Documentation
-> Either ParseError (Documentation, [ParseWarning])
upd (Param d) (FunctionDoc t ps vs r) = Right (FunctionDoc t [d:ps] vs r, [])
upd (Result d) (FunctionDoc t ps vs _) = Right (FunctionDoc t ps vs (Just d), [])
upd (Var d) (FunctionDoc t ps vs r) = Right (FunctionDoc t ps [d:vs] r, [])
upd (Param d) (ConstructorDoc t ps) = Right (ConstructorDoc t [d:ps], [])
upd (Var d) (ClassDoc t vs ms) = Right (ClassDoc t [d:vs] ms, [])
upd (Var d) (TypeDoc t vs rhs) = Right (TypeDoc t [d:vs] rhs, [])
upd (Field d) (TypeDoc t vs (Just (RecordDoc fs)))
= Right (TypeDoc t vs $ Just $ RecordDoc [d:fs], [])
upd (Representation d) (TypeDoc t vs (Just (SynonymDoc _)))
= Right (TypeDoc t vs $ Just $ SynonymDoc $ Just d, [])
upd f doc = Right (doc, [IllegalField $ fieldName f])
prepField :: ([Char] -> String)
prepField = toString o trim
concatWarnings :: FieldUpdateFunction DocField (Documentation, [ParseWarning])
-> Either ParseError (Documentation, [ParseWarning])
concatWarnings f df (doc, ws) = appSnd ((++) ws) <$> f df doc
prepareString :: String -> Either ParseError [[Char]]
prepareString s
= filter (not o isEmpty) <$>
( checkAsterisks
$ filter (not o isEmpty)
$ map (twice (reverse o trim))
$ break '\n'
$ fromString s
)
where
checkAsterisks :: [[Char]] -> Either ParseError [[Char]]
checkAsterisks lines
| all ((==) '*' o hd) lines = Right $ map (trim o tl) lines
| otherwise = Left MissingAsterisk
break :: a -> [a] -> [[a]] | == a
break e = foldr f []
where
f x [] = if (x == e) [] [[x]]
f x [y:ys] = if (x == e) [[]:y:ys] [[x:y]:ys]
trim = dropWhile isSpace
instance toString ParseWarning
where
toString (UnknownField f) = "Doc warning: unknown field '" +++ f +++ "'"
toString (IllegalField f) = "Doc warning: illegal field '" +++ f +++ "'"
toString NoDescription = "Doc warning: missing description"
toString UsedReturn = "Doc warning: @return is deprecated, use @result"
toString (SkippedLine l) = "Doc warning: skipped line '" +++ l +++ "'"
instance toString ParseError
where
toString MissingAsterisk = "Doc error: missing leading asterisk"
toString (IllegalState s) = "Doc error: illegal state: " +++ s
traceParseWarnings :: [ParseWarning] !a -> a
traceParseWarnings [] x = x
traceParseWarnings [w:ws] x
| trace_tn w = traceParseWarnings ws x
| otherwise = undef
traceParseError :: ParseError !a -> a
traceParseError e x
| trace_tn e = x
| otherwise = undef
......@@ -23,6 +23,7 @@ from Text import class Text(concat,indexOf,toLowerCase,split),
import TypeDB
import Type
import Cloogle
import Doc
search :: !Request !TypeDB -> [Result]
search {unify,name,className,typeName,modules,libraries,page,include_builtins,include_core} db_org
......@@ -102,6 +103,7 @@ makeModuleResult mbName (lib, mod, info)
, documentation = Nothing
}
, { module_is_core = info.is_core
, module_doc = getDocDescription =<< info.mod_documentation
}
)
......@@ -202,10 +204,12 @@ makeMacroResult mbName (Location lib mod line iclline m) mac
, distance
= if (isNothing mbName) -100 (levenshtein` (fromJust mbName) m)
, builtin = Nothing
, documentation = mac.macro_extras.te_documentation
, documentation = getDocDescription =<< mac.macro_extras.te_documentation
}
, { macro_name = m
, macro_representation = mac.macro_as_string
, macro_param_doc = getParamDocs <$> mac.macro_extras.te_documentation
, macro_result_doc = getResultDoc =<< mac.macro_extras.te_documentation
}
)
......@@ -221,7 +225,7 @@ makeFunctionResult
, modul = mod
, distance = distance
, builtin = builtin
, documentation = tes.te_documentation
, documentation = getDocDescription =<< tes.te_documentation
}
, { func = fromJust (tes.te_representation <|>
(pure $ concat $ print False (fname,et)))
......@@ -237,8 +241,11 @@ makeFunctionResult
, generic_derivations
= let derivs = getDerivations fname db in
const (sortBy (\(a,_) (b,_) -> a < b)
[(s, map loc ls) \\ (_,s,ls) <- derivs]) <$>
[(s, map loc ls) \\ (_,s,ls) <- derivs]) <$>
tes.te_generic_vars
, param_doc = getParamDocs <$> tes.te_documentation
, generic_var_doc = getVarDocs <$> tes.te_documentation
, result_doc = getResultDoc =<< tes.te_documentation
}
)
where
......
......@@ -13,15 +13,18 @@ from GenEq import generic gEq
from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
::ClassContext, ::ClassRestriction, ::ClassOrGeneric, ::Priority
from Doc import ::Documentation
:: TypeDB
:: TypeExtras = { te_priority :: Maybe Priority
, te_isconstructor :: Bool
, te_isrecordfield :: Bool
, te_generic_vars :: Maybe [TypeVar]
, te_representation :: Maybe String
, te_documentation :: Maybe FunctionDocumentation
}
:: TypeExtras
= { te_priority :: Maybe Priority
, te_isconstructor :: Bool
, te_isrecordfield :: Bool
, te_generic_vars :: Maybe [TypeVar]
, te_representation :: Maybe String
, te_documentation :: Maybe Documentation
}
:: ExtendedType = ET Type TypeExtras
......@@ -32,7 +35,10 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
:: Location = Location Library Module LineNr LineNr Name
| Builtin Name
:: ModuleInfo = { is_core :: Bool }
:: ModuleInfo
= { is_core :: Bool
, mod_documentation :: Maybe Documentation
}
:: Name :== String
:: Library :== String
......@@ -40,8 +46,6 @@ from Type import ::Type, ::TypeVar, ::TVAssignment, ::TypeDef, class print(..),
:: Class :== String
:: LineNr :== Maybe Int
:: FunctionDocumentation :== String
instance zero TypeDB
instance zero TypeExtras
instance zero ModuleInfo
......
......@@ -19,6 +19,8 @@ import GenLexOrd
// CleanTypeUnifier
import Type
import Doc
:: TypeDB
= { // Base maps
functionmap :: Map Location ExtendedType
......@@ -40,13 +42,14 @@ printersperse ia a bs = intercalate (print False a) (map (print ia) bs)
(--) a b = print False a ++ print False b
derive gEq ClassOrGeneric, Location, Type, TypeExtras, Priority,
ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor, Kind, Macro
ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor, Kind, Macro,
Documentation, TypeRhsDoc, ClassMemberDoc
derive JSONEncode ClassOrGeneric, Location, Type, TypeDB, TypeExtras,
Priority, ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor,
Kind, Macro, ModuleInfo
Kind, Macro, ModuleInfo, Documentation, TypeRhsDoc, ClassMemberDoc
derive JSONDecode ClassOrGeneric, Location, Type, TypeDB, TypeExtras,
Priority, ExtendedType, TypeDef, TypeDefRhs, RecordField, Constructor,
Kind, Macro, ModuleInfo
Kind, Macro, ModuleInfo, Documentation, TypeRhsDoc, ClassMemberDoc
instance zero TypeDB
where
......@@ -82,7 +85,8 @@ where
, te_documentation = Nothing
}
instance zero ModuleInfo where zero = {is_core = False}
instance zero ModuleInfo
where zero = {is_core = False, mod_documentation=Nothing}
instance print TypeExtras
where
......
......@@ -48,10 +48,11 @@ from Type import instance == Type,
class print(print), instance print Type, instance print Priority
import qualified TypeDB as DB
from TypeDB import :: Macro{macro_as_string,macro_extras},
:: Location(Location), filterLocations,
:: ModuleInfo{is_core}, :: FunctionDocumentation,
:: Location(Location), filterLocations, :: ModuleInfo{is_core},
:: TypeExtras{te_generic_vars,te_isconstructor,te_isrecordfield,te_priority,te_representation,te_documentation},
instance zero TypeExtras, instance zero ModuleInfo
from Doc import :: Documentation, :: ParseWarning(UsedReturn), :: ParseError,
parseFunctionDoc, traceParseError, traceParseWarnings
// Exclude Root Library Check for core Base module
findModules :: ![String] !String !'DB'.Library ('DB'.Module -> Bool) !String !*World
......@@ -94,7 +95,7 @@ getModuleTypes root mod lib iscore db w
# db = 'DB'.putTypes typedefs db
# db = 'DB'.putFunctions (flatten $ map constructor_functions typedefs) db
# db = 'DB'.putFunctions (flatten $ map record_functions typedefs) db
# db = 'DB'.putFunctions (pd_generics lib modname dcl.mod_defs icl) db
# db = 'DB'.putFunctions (pd_generics lib modname dcl.mod_defs icl symbols) db
# db = 'DB'.putDerivationss (pd_derivations lib modname dcl.mod_defs) db
# db = 'DB'.putMacros (pd_macros lib modname dcl.mod_defs symbols) db
# db = 'DB'.putModule lib modname {zero & is_core=iscore} db
......@@ -112,7 +113,11 @@ where
pd_macros lib mod dcl st
= [( 'DB'.Location lib mod (toLine pos) Nothing id.id_name
, { macro_as_string = priostring id +++ cpp pd
, macro_extras = {zero & te_priority = findPrio id >>= 'T'.toMaybePriority, te_documentation = findDoc id st}
, macro_extras =
{ zero
& te_priority = findPrio id >>= 'T'.toMaybePriority
, te_documentation = findDoc parseFunctionDoc id st
}
}
) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- dcl]
where
......@@ -137,14 +142,15 @@ where
, [('T'.toType gc_type, cpp gc_type, 'DB'.Location lib mod (toLine gc_pos) Nothing "")]
) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]
pd_generics :: String String [ParsedDefinition] (Maybe ParsedModule)
pd_generics :: String String [ParsedDefinition] (Maybe ParsedModule) SymbolTable
-> [('DB'.Location, 'DB'.ExtendedType)]
pd_generics lib mod dcl icl
pd_generics lib mod dcl icl st
= [( 'DB'.Location lib mod (toLine gen_pos) (findIclLine id_name =<< icl) id_name
, 'DB'.ET ('T'.toType gen_type)
{zero & te_generic_vars=Just $ map 'T'.toTypeVar gen_vars
, te_representation=Just $ cpp gen}
) \\ gen=:(PD_Generic {gen_ident={id_name},gen_pos,gen_type,gen_vars}) <- dcl]
, te_representation=Just $ cpp gen
, te_documentation = findDoc parseFunctionDoc id st}
) \\ gen=:(PD_Generic {gen_ident=id=:{id_name},gen_pos,gen_type,gen_vars}) <- dcl]
where
findIclLine :: String ParsedModule -> Maybe Int
findIclLine name {mod_defs=pms}
......@@ -160,7 +166,7 @@ where
, 'DB'.ET ('T'.toType t)
{ zero & te_priority = 'T'.toMaybePriority p
, te_representation = Just $ cpp ts
, te_documentation = findDoc id st}
, te_documentation = findDoc parseFunctionDoc id st}
) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- dcl]
where
findIclLine :: String ParsedModule -> Maybe Int
......@@ -233,11 +239,6 @@ where
toLine (LinePos _ l) = Just l
toLine _ = Nothing
findDoc :: Ident SymbolTable -> Maybe FunctionDocumentation
findDoc {id_info} st = case sreadPtr id_info st of
{ste_doc=Yes doc} = Just doc
_ = Nothing
readModule :: Bool *World -> *(Either String ParsedModule, SymbolTable, *World)
readModule icl w
# ht = newHashTable newHeap
......@@ -257,6 +258,15 @@ where
# (b1,b2,pm,ht,f,fs) = wantModule f s b1 i p b2 ht io fs
= ((b1,b2,pm,ht,f),fs)
findDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
Ident SymbolTable -> Maybe Documentation
findDoc parse {id_info} st = case sreadPtr id_info st of
{ste_doc=Yes doc} = case parse doc of
(Right (doc,ws)) = traceParseWarnings (filter (not o isUsedReturn) ws) (Just doc)
(Left e) = traceParseError e Nothing
_ = Nothing
where isUsedReturn UsedReturn = True; isUsedReturn _ = False
constructor_functions :: ('DB'.Location, 'DB'.TypeDef)
-> [('DB'.Location, 'DB'.ExtendedType)]
constructor_functions ('DB'.Builtin _, td)
......
Subproject commit bdcb93a5690f9b7f77f894834ef8b6044b6c9253
Subproject commit f5c802b031bf8de328d3155d17ce082b3ee6c156
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