Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
G
gargantext-ihaskell
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
gargantext-ihaskell
Commits
99e31d00
Commit
99e31d00
authored
Jan 08, 2014
by
Andrew Gibiansky
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
adding tests for the pager
parent
c4c864ae
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
23 additions
and
9 deletions
+23
-9
Hspec.hs
src/Hspec.hs
+23
-9
No files found.
src/Hspec.hs
View file @
99e31d00
...
@@ -45,14 +45,21 @@ is string blockType = do
...
@@ -45,14 +45,21 @@ is string blockType = do
eval
string
=
do
eval
string
=
do
outputAccum
<-
newIORef
[]
outputAccum
<-
newIORef
[]
let
publish
evalResult
=
modifyIORef
outputAccum
(
outputs
evalResult
:
)
pagerAccum
<-
newIORef
[]
let
publish
evalResult
=
case
evalResult
of
IntermediateResult
{}
->
return
()
FinalResult
outs
page
->
do
modifyIORef
outputAccum
(
outs
:
)
modifyIORef
pagerAccum
(
page
:
)
getTemporaryDirectory
>>=
setCurrentDirectory
getTemporaryDirectory
>>=
setCurrentDirectory
let
state
=
defaultKernelState
{
getLintStatus
=
LintOff
}
let
state
=
defaultKernelState
{
getLintStatus
=
LintOff
}
interpret
False
$
Eval
.
evaluate
state
string
publish
interpret
False
$
Eval
.
evaluate
state
string
publish
out
<-
readIORef
outputAccum
out
<-
readIORef
outputAccum
return
$
reverse
out
pagerOut
<-
readIORef
pagerAccum
return
(
reverse
out
,
unlines
$
reverse
pagerOut
)
becomes
string
expected
=
do
evaluationComparing
comparison
string
=
do
let
indent
(
' '
:
x
)
=
1
+
indent
x
let
indent
(
' '
:
x
)
=
1
+
indent
x
indent
_
=
0
indent
_
=
0
empty
=
null
.
strip
empty
=
null
.
strip
...
@@ -60,8 +67,10 @@ becomes string expected = do
...
@@ -60,8 +67,10 @@ becomes string expected = do
minIndent
=
minimum
(
map
indent
stringLines
)
minIndent
=
minimum
(
map
indent
stringLines
)
newString
=
unlines
$
map
(
drop
minIndent
)
stringLines
newString
=
unlines
$
map
(
drop
minIndent
)
stringLines
eval
newString
>>=
comparison
eval
newString
>>=
comparison
becomes
string
expected
=
evaluationComparing
comparison
string
where
where
comparison
results
=
do
comparison
(
results
,
pageOut
)
=
do
when
(
length
results
/=
length
expected
)
$
when
(
length
results
/=
length
expected
)
$
expectationFailure
$
"Expected result to have "
++
show
(
length
expected
)
expectationFailure
$
"Expected result to have "
++
show
(
length
expected
)
++
" results. Got "
++
show
results
++
" results. Got "
++
show
results
...
@@ -70,9 +79,14 @@ becomes string expected = do
...
@@ -70,9 +79,14 @@ becomes string expected = do
isPlain
_
=
False
isPlain
_
=
False
forM_
(
zip
results
expected
)
$
\
(
result
,
expected
)
->
forM_
(
zip
results
expected
)
$
\
(
result
,
expected
)
->
case
find
isPlain
result
of
case
extractPlain
result
of
Just
(
Display
PlainText
str
)
->
str
`
shouldBe
`
expected
""
->
expectationFailure
$
"No plain-text output in "
++
show
result
++
"
\n
Expected: "
++
expected
Nothing
->
expectationFailure
$
"No plain-text output in "
++
show
result
str
->
str
`
shouldBe
`
expected
pages
string
expected
=
evaluationComparing
comparison
string
where
comparison
(
results
,
pageOut
)
=
strip
pageOut
`
shouldBe
`
strip
(
unlines
expected
)
completes
string
expected
=
completionTarget
newString
cursorloc
`
shouldBe
`
expected
completes
string
expected
=
completionTarget
newString
cursorloc
`
shouldBe
`
expected
where
(
newString
,
cursorloc
)
=
case
elemIndex
'*'
string
of
where
(
newString
,
cursorloc
)
=
case
elemIndex
'*'
string
of
...
@@ -80,7 +94,7 @@ completes string expected = completionTarget newString cursorloc `shouldBe` expe
...
@@ -80,7 +94,7 @@ completes string expected = completionTarget newString cursorloc `shouldBe` expe
Just
idx
->
(
replace
"*"
""
string
,
idx
)
Just
idx
->
(
replace
"*"
""
string
,
idx
)
completionEvent
::
String
->
[
String
]
->
Interpreter
(
String
,
[
String
])
completionEvent
::
String
->
[
String
]
->
Interpreter
(
String
,
[
String
])
completionEvent
string
expected
=
do
completionEvent
string
expected
=
complete
newString
cursorloc
complete
newString
cursorloc
where
(
newString
,
cursorloc
)
=
case
elemIndex
'*'
string
of
where
(
newString
,
cursorloc
)
=
case
elemIndex
'*'
string
of
Nothing
->
error
"Expected cursor written as '*'."
Nothing
->
error
"Expected cursor written as '*'."
...
@@ -273,7 +287,7 @@ evalTests = do
...
@@ -273,7 +287,7 @@ evalTests = do
it
"evaluates directives"
$
do
it
"evaluates directives"
$
do
":typ 3"
`
becomes
`
[
"forall a. Num a => a"
]
":typ 3"
`
becomes
`
[
"forall a. Num a => a"
]
":in String"
`
becom
es
`
[
"type String = [Char]
\t
-- Defined in `GHC.Base'"
]
":in String"
`
pag
es
`
[
"type String = [Char]
\t
-- Defined in `GHC.Base'"
]
parserTests
=
do
parserTests
=
do
layoutChunkerTests
layoutChunkerTests
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment