Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
clean-and-itasks
clean-platform
Commits
55e5c7e5
Verified
Commit
55e5c7e5
authored
Jul 11, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add Clean.Doc, Clean.Parse, Clean.Parse.Comments
parent
4c8fac90
Pipeline
#12831
passed with stage
in 1 minute and 37 seconds
Changes
7
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
1061 additions
and
0 deletions
+1061
-0
src/libraries/OS-Independent/Clean/Doc.dcl
src/libraries/OS-Independent/Clean/Doc.dcl
+267
-0
src/libraries/OS-Independent/Clean/Doc.icl
src/libraries/OS-Independent/Clean/Doc.icl
+298
-0
src/libraries/OS-Independent/Clean/Parse.dcl
src/libraries/OS-Independent/Clean/Parse.dcl
+24
-0
src/libraries/OS-Independent/Clean/Parse.icl
src/libraries/OS-Independent/Clean/Parse.icl
+74
-0
src/libraries/OS-Independent/Clean/Parse/Comments.dcl
src/libraries/OS-Independent/Clean/Parse/Comments.dcl
+32
-0
src/libraries/OS-Independent/Clean/Parse/Comments.icl
src/libraries/OS-Independent/Clean/Parse/Comments.icl
+363
-0
tests/linux64/test.icl
tests/linux64/test.icl
+3
-0
No files found.
src/libraries/OS-Independent/Clean/Doc.dcl
0 → 100644
View file @
55e5c7e5
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
/**
* 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
src/libraries/OS-Independent/Clean/Doc.icl
0 → 100644
View file @
55e5c7e5
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
),
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
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
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
]]
checkAsterisks
[[
'*'
:
line
]]
=
Right
[
safetl
line
]
checkAsterisks
[
line
]
=
Right
[
line
]
checkAsterisks
lines
|
all
(\
l
->
isEmpty
l
||
hd
l
==
'*'
)
lines
=
Right
$
map
(
safetl
o
dropWhile
((==)
'*'
))
lines
=
Left
$
MissingAsterisk
$
toString
$
hd
$
filter
(\
l
->
not
(
isEmpty
l
)
&&
hd
l
<>
'*'
)
lines
safetl
::
![
a
]
->
[
a
]
safetl
[]
=
[]
safetl
[_:
xs
]
=
xs
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
]
linesToString
::
([[
Char
]]
->
String
)
linesToString
=
toString
o
flatten
o
intersperse
[
'
\n
'
]
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
(
UnparsableType
t
)
=
"Doc warning: could not parse type '"
+++
t
+++
"'"
instance
toString
ParseError
where
toString
(
MissingAsterisk
l
)
=
"Doc error: missing leading asterisk in '"
+++
l
+++
"'"
toString
(
MissingField
f
)
=
"Doc error: required field '"
+++
f
+++
"' was missing"
toString
(
UnknownError
e
)
=
"Doc error: "
+++
e