Verified Commit 616ad975 authored by Camil Staps's avatar Camil Staps 🚀

Remove modules that are now in Platform

parent ac2c958c
[submodule "CleanPrettyPrint"]
path = CleanPrettyPrint
url = https://github.com/clean-cloogle/CleanPrettyPrint.git
[submodule "libcloogle"]
path = libcloogle
url = https://github.com/clean-cloogle/libcloogle.git
......
definition module Clean.Doc
/**
* Parsing and storing Clean documentation
*/
import StdGeneric
from StdOverloaded import class toString
from Data.Either import :: Either
from Data.GenDefault import generic gDefault
from Data.Maybe import :: Maybe
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
class docDescription d :: !d -> Maybe Description
class docComplexity d :: !d -> Maybe String
class docParams d :: !d -> [ParamDoc]
class docVars d :: !d -> [Description]
class docResults d :: !d -> [Description]
class docType d :: !d -> Maybe Type
class docThrows d :: !d -> [Description]
class docMembers d :: !d -> [Maybe ClassMemberDoc]
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 docPropertyTestWith d :: !d -> [PropertyVarInstantiation]
class docPropertyTestGenerators d :: !d -> [PropertyTestGenerator]
class docProperties d :: !d -> [Property]
/**
* Documentation of a Clean module.
*/
:: ModuleDoc =
{ description :: !Maybe Description
, property_bootstrap :: !Maybe MultiLineString //* For generating unit tests with clean-test
, 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`}}
}
instance docDescription ModuleDoc
instance docPropertyBootstrap ModuleDoc
instance docPropertyTestWith ModuleDoc
instance docPropertyTestGenerators ModuleDoc
derive gDefault ModuleDoc
/**
* Documentation of a Clean function.
*/
:: FunctionDoc =
{ description :: !Maybe Description
, complexity :: !Maybe String //* E.g. "O(n log n)"
, params :: ![ParamDoc] //* Descriptions of the parameters
, vars :: ![Description] //* Descriptions of the type variables (for generics)
, results :: ![Description] //* Descriptions of the result(s, for tuples)
, type :: !Maybe Type //* The type (for macros)
, throws :: ![Description] //* The exceptions it may throw (iTasks)
, properties :: ![Property] //* Properties of this function
, property_test_with :: ![PropertyVarInstantiation] //* With which types to test the properties
, preconditions :: ![String] //* Preconditions for the properties
}
instance docDescription FunctionDoc
instance docComplexity FunctionDoc
instance docParams FunctionDoc
instance docVars FunctionDoc
instance docResults FunctionDoc
instance docType FunctionDoc
instance docThrows FunctionDoc
instance docPropertyTestWith FunctionDoc
instance docProperties FunctionDoc
/**
* Documentation of a function parameter.
*/
:: ParamDoc =
{ name :: !Maybe String //* An optional name for the parameter
, description :: !Maybe Description //* An optional description
}
instance toString ParamDoc
instance docDescription ParamDoc
/**
* A property of a function.
* Typically, the property can be tested with Gast.
*
* - `ForAll`: the right-hand side (the third argument) holds for all values of
* the arguments (the second argument). The first argument is the name.
*/
:: Property
= ForAll !String ![(!String,!Type)] !String
/**
* When a property type contains type variables, a `PropertyVarInstantiation`
* can be used to instantiate those variables when generating test cases.
*/
:: PropertyVarInstantiation = PropertyVarInstantiation !(!String, !Type)
/**
* A test generator generates values of some type. The first argument of the
* constructor is the function type of the generator, for instance
* `[(k,v)] -> {{Map}} k v`. The second argument is the implementation, which
* should assume the generator is called `gen` (e.g.: `gen elems = ...`).
*/
:: PropertyTestGenerator = PropertyTestGenerator !Type !String
derive gDefault FunctionDoc, Property, PropertyVarInstantiation, PropertyTestGenerator
/**
* Documentation of a Clean class member.
* For an explanation of the fields, see the documentation on {{`FunctionDoc`}}.
*/
:: ClassMemberDoc =
{ description :: !Maybe Description
, complexity :: !Maybe String
, params :: ![ParamDoc]
, results :: ![Description]
, type :: !Maybe Type
, throws :: ![Description]
}
instance docDescription ClassMemberDoc
instance docComplexity ClassMemberDoc
instance docParams ClassMemberDoc
instance docResults ClassMemberDoc
instance docType ClassMemberDoc
instance docThrows ClassMemberDoc
derive gDefault ClassMemberDoc
/**
* Documentation of a Clean ADT constructor.
* For an explanation of the fields, see the documentation on {{`FunctionDoc`}}.
*/
:: ConstructorDoc =
{ description :: !Maybe Description
, params :: ![ParamDoc]
}
instance docDescription ConstructorDoc
instance docParams ConstructorDoc
derive gDefault ConstructorDoc
/**
* Documentation of a Clean class.
*/
:: ClassDoc =
{ description :: !Maybe Description
, vars :: ![Description] //* The type variables
, members :: ![Maybe ClassMemberDoc] //* Documentation on the members
}
instance docDescription ClassDoc
instance docVars ClassDoc
instance docMembers ClassDoc
derive gDefault ClassDoc
/**
* Documentation of a Clean type.
*/
:: TypeDoc =
{ description :: !Maybe Description
, vars :: ![Description] //* Type variables
, representation :: !Maybe (Maybe Description) //* For synonym types
, fields :: !Maybe [Maybe Description] //* For records
, constructors :: !Maybe [Maybe ConstructorDoc] //* For ADTs
}
instance docDescription TypeDoc
instance docVars TypeDoc
instance docFields TypeDoc
instance docConstructors TypeDoc
instance docRepresentation TypeDoc
derive gDefault TypeDoc
/**
* Description of a Clean syntax element
*/
:: Description :== String
/**
* Parse error for parsing Clean documentation; no documentation could be found
*/
:: ParseError
= MissingAsterisk !String //* At least one line did not start with a *
| MissingField !String //* A required field was missing
| UnknownError !String //* Another error
| InternalNoDataError
/**
* Parse warning while parsing Clean documentation; the parser has made a
* best-effort result nevertheless
*/
:: 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
| UnparsableType !String //* Could not parse a @type field as a type
/**
* Convert a ConstructorDoc to a FunctionDoc.
*/
constructorToFunctionDoc :: !ConstructorDoc -> FunctionDoc
/**
* Convert a FunctionDoc to a ClassMemberDoc.
*/
functionToClassMemberDoc :: !FunctionDoc -> ClassMemberDoc
/**
* Add a class member to an existing class definition
*
* @param The documentation to add the member to
* @param The documentation on the class member
* @result The new ClassDoc
*/
addClassMemberDoc :: !ClassDoc !(Maybe ClassMemberDoc) -> ClassDoc
/**
* Parse a single docstring, removing the asterisk and trimming whitespace.
*/
parseSingleLineDoc :: (String -> String)
/**
* Parse a documentation block. The magic happens in {{`docBlockToDoc`}}.
*/
parseDoc :: !String -> Either ParseError (!d, ![ParseWarning]) | docBlockToDoc{|*|} d
/**
* A documentation block.
* @representation An order list of key-value pairs. A key can occur multiple
* times. The description has key `description`.
*/
:: DocBlock :== [(!String, !String)]
/**
* The magic for {{`parseDoc`}}. Usually, a record type like {{`FunctionDoc`}}
* will derive a convenient parser. In some cases, it may be necessary to
* override the default, such as in the instance for {{`Type`}}, where parsing
* of the type happens.
* @var The thing to parse
*/
generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
derive docBlockToDoc UNIT, PAIR, EITHER, CONS, OBJECT, FIELD of d, RECORD
derive docBlockToDoc String, [], Maybe, Type
derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
/**
* Print a documentation block as a string. The magic happens in
* {{`docToDocBlock`}}.
*/
printDoc :: !d -> String | docToDocBlock{|*|} d
/**
* The magic for {{`printDoc`}}.
* @param If true, return a `Left`. If false, return a `Right`.
*/
generic docToDocBlock d :: Bool d -> Either [String] DocBlock
derive docToDocBlock ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
/**
* Trace a list of ParseWarnings like StdDebug might do it
*/
traceParseWarnings :: ![ParseWarning] !a -> a
/**
* Trace a ParseError like StdDebug might do it
*/
traceParseError :: !ParseError !a -> a
implementation module Clean.Doc
import _SystemArray
import StdBool
import StdChar
import StdDebug
from StdFunc import flip, o, twice
import StdList
import StdMisc
import StdOrdList
import StdString
import StdTuple
import Control.Applicative
import Control.Monad => qualified join
import Data.Either
import Data.Error
from Data.Func import $
import Data.Functor
import Data.GenDefault
import Data.List
import Data.Maybe
import Data.Tuple
from Text import <+,
class Text(join,split,trim,rtrim,replaceSubString,endsWith),
instance Text String, instance Text [Char]
import Text.Language
import Text.Parsers.Simple.ParserCombinators
from Clean.Types import :: Type, :: TypeRestriction
import qualified Clean.Types.Parse as T
from Clean.Types.Util import instance toString Type
gDefault{|Maybe|} _ = Nothing
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 docPropertyTestWith ModuleDoc where docPropertyTestWith d = d.ModuleDoc.property_test_with
instance docPropertyTestGenerators ModuleDoc where docPropertyTestGenerators d = d.property_test_generators
instance docDescription FunctionDoc where docDescription d = d.FunctionDoc.description
instance docComplexity FunctionDoc where docComplexity d = d.FunctionDoc.complexity
instance docParams FunctionDoc where docParams d = d.FunctionDoc.params
instance docVars FunctionDoc where docVars d = d.FunctionDoc.vars
instance docResults FunctionDoc where docResults d = d.FunctionDoc.results
instance docType FunctionDoc where docType d = d.FunctionDoc.type
instance docThrows FunctionDoc where docThrows d = d.FunctionDoc.throws
instance docProperties FunctionDoc where docProperties d = d.properties
instance docPropertyTestWith FunctionDoc where docPropertyTestWith d = d.FunctionDoc.property_test_with
instance docDescription ParamDoc where docDescription d = d.ParamDoc.description
instance docDescription ClassMemberDoc where docDescription d = d.ClassMemberDoc.description
instance docComplexity ClassMemberDoc where docComplexity d = d.ClassMemberDoc.complexity
instance docParams ClassMemberDoc where docParams d = d.ClassMemberDoc.params
instance docResults ClassMemberDoc where docResults d = d.ClassMemberDoc.results
instance docType ClassMemberDoc where docType d = d.ClassMemberDoc.type
instance docThrows ClassMemberDoc where docThrows d = d.ClassMemberDoc.throws
instance docDescription ConstructorDoc where docDescription d = d.ConstructorDoc.description
instance docParams ConstructorDoc where docParams d = d.ConstructorDoc.params
instance docDescription ClassDoc where docDescription d = d.ClassDoc.description
instance docVars ClassDoc where docVars d = d.ClassDoc.vars
instance docMembers ClassDoc where docMembers d = d.ClassDoc.members
instance docDescription TypeDoc where docDescription d = d.TypeDoc.description
instance docVars TypeDoc where docVars d = d.TypeDoc.vars
instance docFields TypeDoc where docFields d = d.TypeDoc.fields
instance docConstructors TypeDoc where docConstructors d = d.TypeDoc.constructors
instance docRepresentation TypeDoc where docRepresentation d = d.TypeDoc.representation
instance toString ParamDoc
where
toString pd=:{name=Just n,description=Just d} = n +++ ": " +++ d
toString {ParamDoc | description=Just d} = d
toString _ = ""
derive gDefault Type, TypeRestriction, ModuleDoc, FunctionDoc, ClassMemberDoc,
ConstructorDoc, ClassDoc, TypeDoc, Property, PropertyVarInstantiation,
MultiLineString, PropertyTestGenerator, ParamDoc
constructorToFunctionDoc :: !ConstructorDoc -> FunctionDoc
constructorToFunctionDoc d =
{ FunctionDoc
| gDefault{|*|}
& description = d.ConstructorDoc.description
, params = d.ConstructorDoc.params
}
functionToClassMemberDoc :: !FunctionDoc -> ClassMemberDoc
functionToClassMemberDoc d =
{ ClassMemberDoc
| description = d.FunctionDoc.description
, complexity = d.FunctionDoc.complexity
, params = d.FunctionDoc.params
, results = d.FunctionDoc.results
, type = d.FunctionDoc.type
, throws = d.FunctionDoc.throws
}
addClassMemberDoc :: !ClassDoc !(Maybe ClassMemberDoc) -> ClassDoc
addClassMemberDoc d m = {d & members=d.members ++ [m]}
parseSingleLineDoc :: (String -> String)
parseSingleLineDoc = toString o trim o dropWhile ((==) '*') o fromString
parseDoc :: !String -> Either ParseError (!d, ![ParseWarning]) | docBlockToDoc{|*|} d
parseDoc s = docBlockToDoc{|*|} (Left [s])
generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
docBlockToDoc{|String|} (Left []) = Left InternalNoDataError
docBlockToDoc{|String|} (Left ss) = Right (trim $ last ss, [])
docBlockToDoc{|[]|} fx (Left ss) = (\vws -> (map fst vws, flatten (map snd vws)) ) <$> mapM fx (map (Left o pure) ss)
docBlockToDoc{|Maybe|} fx (Left []) = Right (Nothing, [])
docBlockToDoc{|Maybe|} fx ss=:(Left _) = appFst Just <$> fx ss
docBlockToDoc{|UNIT|} _ = Right (UNIT, [])
docBlockToDoc{|PAIR|} fx fy db=:(Right _) = liftA2 (\(x,ws) (y,ws`) -> (PAIR x y, ws ++ ws`)) (fx db) (fy db)
docBlockToDoc{|FIELD of d|} fx (Right db) = case fx (Left [v \\ (k,v) <- db | k matches d.gfd_name]) of
Right (f, ws) -> Right (FIELD f, ws)
Left InternalNoDataError -> Left (MissingField d.gfd_name)
Left e -> Left e
where
(matches) infix 4 :: !String !String -> Bool
(matches) k name =
k` == name ||
pluralise English k` == name ||
k` == "return" && name == "result" ||
k` == "return" && name == "results"
where
k` = {if (c == '-') '_' c \\ c <-: k}
docBlockToDoc{|RECORD|} fx (Left [s]) = case parseDocBlock s of
Right (db, ws) -> case fx (Right db) of
Right (v, ws`) -> Right (RECORD v, ws ++ ws`)
Left e -> Left e
Left e -> Left e
docBlockToDoc{|RECORD|} fx doc = appFst RECORD <$> fx doc
docBlockToDoc{|CONS|} fx doc = appFst CONS <$> fx doc
docBlockToDoc{|EITHER|} fl fr doc = case fl doc of
Right (v, ws) -> Right (LEFT v, ws)
Left e -> case fr doc of
Right (v, ws) -> Right (RIGHT v, ws)
Left _ -> Left e
docBlockToDoc{|OBJECT|} fx doc = appFst OBJECT <$> fx doc
docBlockToDoc{|MultiLineString|} (Left [s]) = Right (MultiLine $ trimMultiLine $ split "\n" s, [])
docBlockToDoc{|ParamDoc|} (Left [s]) = case findName (fromString s) of
Just (name,rest) -> Right (
{ name = Just $ toString name
, description = case rest of
[] -> Nothing
_ -> Just $ toString rest
}, [])
_ -> Right ({name=Nothing, description=Just s}, [])
where
findName cs
# (name,cs) = span (\c -> isAlphanum c || c == '`') cs
| not (isEmpty name) && not (isEmpty cs) && hd cs == ':'
= Just (toString name, dropWhile isSpace (tl cs))
= Nothing
docBlockToDoc{|Type|} (Left []) = Left InternalNoDataError
docBlockToDoc{|Type|} (Left ss) = case [v \\ Just v <- map ('T'.parseType o fromString) ss] of
[] -> Left (UnknownError "no parsable type")
vs -> Right (last vs, [])
docBlockToDoc{|Property|} (Left [s]) = let [signature:property] = split "\n" s in
parseSignature signature >>= \(sig,ws1) ->
parseProperty property >>= \(prop,ws2) ->
Right (sig prop, ws1 ++ ws2)
where
parseSignature :: !String -> Either ParseError (!String -> Property, ![ParseWarning])
parseSignature s = case parse parser (fromString s) of
Left es -> Left (UnknownError "failed to parse property signature")
Right (name,args) -> Right (ForAll name args, [])
where
parser :: Parser Char (!String, ![(!String, !Type)])
parser = skipSpaces *>
pMany (pSatisfy ((<>) ':')) >>= \name ->
skipSpaces *> pToken ':' *>
((skipSpaces *> pToken 'A' *> pToken '.' *>
pMany
(skipSpaces *>
(liftA2 tuple
(toString <$> pMany (pSatisfy (not o isSpace)))
(pList [skipSpaces,pToken ':',pToken ':',skipSpaces] *> pTypeWithColonOrSemicolon)
) <* skipSpaces)) <|> skipSpaces *> pure []) >>= \args ->
pure (toString name, args)
skipSpaces = pMany (pSatisfy isSpace) *> pYield undef
pTypeWithColonOrSemicolon = (pMany (pSatisfy \c -> c <> ':' && c <> ';') <* pOneOf [':;'])
>>= \t -> case 'T'.parseType t of
Nothing -> pError "type could not be parsed"
Just t -> pure t
parseProperty :: ![String] -> Either ParseError (!String, ![ParseWarning])
parseProperty ss = Right (trimMultiLine ss, [])
docBlockToDoc{|PropertyVarInstantiation|} (Left [s]) = case split "=" s of
[var:type:[]] -> case 'T'.parseType (fromString type) of
Just t -> Right (PropertyVarInstantiation (trim var, t), [])
Nothing -> Left (UnknownError "type could not be parsed")
_ -> Left (UnknownError "property var instantiation could not be parsed")
docBlockToDoc{|PropertyTestGenerator|} (Left [s]) = case 'T'.parseType (fromString sig) of
Just t -> Right (PropertyTestGenerator t (trimMultiLine imp), [])
Nothing -> Left (UnknownError "type could not be parsed")
where
[sig:imp] = split "\n" s
derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ConstructorDoc,
ClassDoc, TypeDoc
printDoc :: !d -> String | docToDocBlock{|*|} d
printDoc d = join "\n * "
[ "/**"
: (case desc of
Nothing -> []
Just d -> [replaceSubString "\n" "\n * " d] ++ (if (isEmpty fields) [] [""])) ++
["@" +++ f +++ " " +++ replaceSubString "\n" "\n * " v \\ (f,v) <- fields]
] +++
"\n */"
where
(Right fields`) = docToDocBlock{|*|} False d
fields = filter ((<>) "description" o fst) fields`
desc = lookup "description" fields`
generic docToDocBlock a :: Bool a -> Either [String] DocBlock
docToDocBlock{|String|} True s = Left [s]
docToDocBlock{|[]|} fx True xs = Left [x \\ Left xs` <- map (fx True) xs, x <- xs`]
docToDocBlock{|Maybe|} fx True mb = case mb of
Nothing -> Left []
Just x -> fx True x
docToDocBlock{|PAIR|} fx fy False (PAIR x y) = Right (xs ++ ys)
where
(Right xs) = fx False x
(Right ys) = fy False y
docToDocBlock{|FIELD of d|} fx False (FIELD x) = Right [(name,x) \\ x <- xs]
where
(Left xs) = fx True x
name = {if (c=='_') '-' c \\ c <-: name`}
name`
| endsWith "ies" d.gfd_name = d.gfd_name % (0,size d.gfd_name-4) +++ "y"
| endsWith "s" d.gfd_name = d.gfd_name % (0,size d.gfd_name-2)
| otherwise = d.gfd_name
docToDocBlock{|RECORD|} fx False (RECORD x) = fx False x
docToDocBlock{|ParamDoc|} True pd = case pd.ParamDoc.name of
Nothing -> case pd.ParamDoc.description of
Nothing -> Left []
Just d -> Left [d]
Just n -> case pd.ParamDoc.description of
Nothing -> Left [n]
Just d -> Left [n +++ ": " +++ d]
docToDocBlock{|MultiLineString|} True (MultiLine s) = Left [s]
docToDocBlock{|Type|} True t = Left [toString t]
docToDocBlock{|Property|} True (ForAll name args impl) = Left
[name +++ ": A." +++ join "; " [a +++ " :: " <+ t \\ (a,t) <- args] +++ ":\n" +++ impl]
docToDocBlock{|PropertyVarInstantiation|} True (PropertyVarInstantiation (a,t)) = Left [a +++ " = " <+ t]
docToDocBlock{|PropertyTestGenerator|} True (PropertyTestGenerator t impl) = Left [t <+ "\n" +++ impl]
derive docToDocBlock ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
trimMultiLine :: ![String] -> String
trimMultiLine ss = join "\n" [s % (trimn, size s - 1) \\ s <- ss]
where
trimn = minList [i \\ Just i <- map (firstNonSpace 0) ss]
firstNonSpace :: !Int !String -> Maybe Int
firstNonSpace i s
| i >= size s = Nothing
| isSpace s.[i] = firstNonSpace (i+1) s
| otherwise = Just i
parseDocBlock :: !String -> Either ParseError (!DocBlock, ![ParseWarning])
parseDocBlock b = prepareString b >>= parsef
where
parsef :: ![[Char]] -> Either ParseError (!DocBlock, ![ParseWarning])
parsef [] = Right ([], [])
parsef lines = case span (\l -> isEmpty l || hd l <> '@') lines of
([], [ln]) = parseFields [ln]
([], rest) = appSnd (\ws -> [NoDescription:ws]) <$> parseFields rest
(desc, rest) = appFst (\d -> [("description", linesToString desc):d]) <$> parseFields rest
parseFields :: ![[Char]] -> Either ParseError (!DocBlock, ![ParseWarning])
parseFields []
= Right ([], [])
parseFields [['@':line]:rest]
= parseFields rest` >>=
\(d,ws) -> appSnd ((++) ws) <$> parseFs field desc d
where
(field, descline) = span (not o isSpace) line
(restdesc, rest`) = span (\l -> isEmpty l || hd l <> '@') rest
desc = flatten $ intersperse ['\n'] $ if (isEmpty descline) restdesc [tl descline:restdesc]
parseFs :: ![Char] ![Char] !DocBlock -> Either ParseError (!DocBlock, ![ParseWarning])
parseFs field val d = Right ([(toString field,toString (rtrim val)):d], [])
prepareString :: (String -> Either ParseError [[Char]])
prepareString = checkAsterisks o map trim o break '\n' o fromString
where
checkAsterisks :: ![[Char]] -> Either ParseError [[Char]]