module Test.DocTest.Parse (
DocTest(..),
Expression,
Interaction,
parseComment,
) where
import Test.DocTest.Location (Located(Located), unLoc)
import Test.DocTest.Base
import Data.List (stripPrefix, isPrefixOf, tails)
import Data.Maybe (fromMaybe, isJust)
import Data.Char (isSpace)
import Control.Arrow (second)
import Control.Monad (msum)
import Control.Applicative ((<$>), (<|>))
data DocTest = Example Expression ExpectedResult | Property Expression
deriving (DocTest -> DocTest -> Bool
(DocTest -> DocTest -> Bool)
-> (DocTest -> DocTest -> Bool) -> Eq DocTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocTest -> DocTest -> Bool
== :: DocTest -> DocTest -> Bool
$c/= :: DocTest -> DocTest -> Bool
/= :: DocTest -> DocTest -> Bool
Eq, Int -> DocTest -> ShowS
[DocTest] -> ShowS
DocTest -> Expression
(Int -> DocTest -> ShowS)
-> (DocTest -> Expression) -> ([DocTest] -> ShowS) -> Show DocTest
forall a.
(Int -> a -> ShowS)
-> (a -> Expression) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocTest -> ShowS
showsPrec :: Int -> DocTest -> ShowS
$cshow :: DocTest -> Expression
show :: DocTest -> Expression
$cshowList :: [DocTest] -> ShowS
showList :: [DocTest] -> ShowS
Show)
type Expression = String
type Interaction = (Expression, ExpectedResult)
data Prompt = ExamplePrompt | PropPrompt
parseComment :: [Located pos String] -> [Located pos DocTest]
= [Located pos Expression] -> [Located pos DocTest]
forall pos. [Located pos Expression] -> [Located pos DocTest]
go
where
examplePrompt :: String
examplePrompt :: Expression
examplePrompt = Expression
">>>"
propPrompt :: String
propPrompt :: Expression
propPrompt = Expression
"prop>"
maybePrompt ::
Located pos String -> Maybe (String, (Prompt, Located pos String))
maybePrompt :: forall pos.
Located pos Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
maybePrompt (Located pos
loc Expression
line) =
(\(Expression
indentation, Expression
str) ->
((Prompt, Located pos Expression)
-> (Expression, (Prompt, Located pos Expression)))
-> Maybe (Prompt, Located pos Expression)
-> Maybe (Expression, (Prompt, Located pos Expression))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Expression
indentation) (Maybe (Prompt, Located pos Expression)
-> Maybe (Expression, (Prompt, Located pos Expression)))
-> Maybe (Prompt, Located pos Expression)
-> Maybe (Expression, (Prompt, Located pos Expression))
forall a b. (a -> b) -> a -> b
$
(,) Prompt
ExamplePrompt (Located pos Expression -> (Prompt, Located pos Expression))
-> (Expression -> Located pos Expression)
-> Expression
-> (Prompt, Located pos Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pos -> Expression -> Located pos Expression
forall pos a. pos -> a -> Located pos a
Located pos
loc (Expression -> (Prompt, Located pos Expression))
-> Maybe Expression -> Maybe (Prompt, Located pos Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Expression -> Maybe Expression
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix Expression
examplePrompt Expression
str
Maybe (Prompt, Located pos Expression)
-> Maybe (Prompt, Located pos Expression)
-> Maybe (Prompt, Located pos Expression)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(,) Prompt
PropPrompt (Located pos Expression -> (Prompt, Located pos Expression))
-> (Expression -> Located pos Expression)
-> Expression
-> (Prompt, Located pos Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. pos -> Expression -> Located pos Expression
forall pos a. pos -> a -> Located pos a
Located pos
loc (Expression -> (Prompt, Located pos Expression))
-> Maybe Expression -> Maybe (Prompt, Located pos Expression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> Expression -> Maybe Expression
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix Expression
propPrompt Expression
str)
((Expression, Expression)
-> Maybe (Expression, (Prompt, Located pos Expression)))
-> (Expression -> (Expression, Expression))
-> Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Char -> Bool) -> Expression -> (Expression, Expression)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace
(Expression
-> Maybe (Expression, (Prompt, Located pos Expression)))
-> Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
forall a b. (a -> b) -> a -> b
$ Expression
line
isClosingLine :: Located pos String -> Bool
isClosingLine :: forall pos. Located pos Expression -> Bool
isClosingLine = Expression -> Expression -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf Expression
":}" (Expression -> Bool)
-> (Located pos Expression -> Expression)
-> Located pos Expression
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS
-> (Located pos Expression -> Expression)
-> Located pos Expression
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located pos Expression -> Expression
forall pos a. Located pos a -> a
unLoc
isBlankLine :: Located pos String -> Bool
isBlankLine :: forall pos. Located pos Expression -> Bool
isBlankLine = Expression -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Expression -> Bool)
-> (Located pos Expression -> Expression)
-> Located pos Expression
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS
-> (Located pos Expression -> Expression)
-> Located pos Expression
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located pos Expression -> Expression
forall pos a. Located pos a -> a
unLoc
isEndOfInteraction :: Located pos String -> Bool
isEndOfInteraction :: forall pos. Located pos Expression -> Bool
isEndOfInteraction Located pos Expression
x = Maybe (Expression, (Prompt, Located pos Expression)) -> Bool
forall a. Maybe a -> Bool
isJust (Located pos Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
forall pos.
Located pos Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
maybePrompt Located pos Expression
x) Bool -> Bool -> Bool
|| Located pos Expression -> Bool
forall pos. Located pos Expression -> Bool
isBlankLine Located pos Expression
x
go :: [Located pos Expression] -> [Located pos DocTest]
go [Located pos Expression]
xs =
case (Located pos Expression
-> Maybe (Expression, (Prompt, Located pos Expression)))
-> [Located pos Expression]
-> Maybe
((Expression, (Prompt, Located pos Expression)),
[Located pos Expression])
forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
dropWhileNothing Located pos Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
forall pos.
Located pos Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
maybePrompt [Located pos Expression]
xs of
Maybe
((Expression, (Prompt, Located pos Expression)),
[Located pos Expression])
Nothing -> []
Just ((Expression
ind, (Prompt
prompt, firstLine :: Located pos Expression
firstLine@(Located pos
loc Expression
firstLineStr))), [Located pos Expression]
rest) ->
let firstLineUnindented :: Expression
firstLineUnindented = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace Expression
firstLineStr in
case Expression -> Expression -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf Expression
":{" Expression
firstLineUnindented of
Bool
False -> Prompt
-> Expression
-> Located pos Expression
-> [Located pos Expression]
-> [Located pos DocTest]
cont Prompt
prompt Expression
ind Located pos Expression
firstLine [Located pos Expression]
rest
Bool
True ->
case ([Located pos Expression]
-> ([Located pos Expression], [Located pos Expression]))
-> ([Located pos Expression], [Located pos Expression])
-> ([Located pos Expression],
([Located pos Expression], [Located pos Expression]))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Int
-> [Located pos Expression]
-> ([Located pos Expression], [Located pos Expression])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1) (([Located pos Expression], [Located pos Expression])
-> ([Located pos Expression],
([Located pos Expression], [Located pos Expression])))
-> ([Located pos Expression], [Located pos Expression])
-> ([Located pos Expression],
([Located pos Expression], [Located pos Expression]))
forall a b. (a -> b) -> a -> b
$ (Located pos Expression -> Bool)
-> [Located pos Expression]
-> ([Located pos Expression], [Located pos Expression])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Located pos Expression -> Bool
forall pos. Located pos Expression -> Bool
isClosingLine [Located pos Expression]
rest of
([Located pos Expression]
ys,([Located pos Expression]
closing,[Located pos Expression]
zs)) ->
Prompt
-> Expression
-> Located pos Expression
-> [Located pos Expression]
-> [Located pos DocTest]
cont Prompt
prompt Expression
ind
(pos -> Expression -> Located pos Expression
forall pos a. pos -> a -> Located pos a
Located pos
loc (Expression -> Located pos Expression)
-> Expression -> Located pos Expression
forall a b. (a -> b) -> a -> b
$ [Expression] -> Expression
unlines ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$
Expression
firstLineUnindented Expression -> [Expression] -> [Expression]
forall a. a -> [a] -> [a]
: (Located pos Expression -> Expression)
-> [Located pos Expression] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map Located pos Expression -> Expression
forall pos a. Located pos a -> a
unLoc ([Located pos Expression]
ys[Located pos Expression]
-> [Located pos Expression] -> [Located pos Expression]
forall a. [a] -> [a] -> [a]
++[Located pos Expression]
closing))
[Located pos Expression]
zs
cont :: Prompt
-> Expression
-> Located pos Expression
-> [Located pos Expression]
-> [Located pos DocTest]
cont Prompt
prompt Expression
ind expr :: Located pos Expression
expr@(Located pos
loc Expression
exprStr) [Located pos Expression]
rest =
case Prompt
prompt of
Prompt
PropPrompt -> (Expression -> DocTest)
-> Located pos Expression -> Located pos DocTest
forall a b. (a -> b) -> Located pos a -> Located pos b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression -> DocTest
Property Located pos Expression
expr Located pos DocTest
-> [Located pos DocTest] -> [Located pos DocTest]
forall a. a -> [a] -> [a]
: [Located pos Expression] -> [Located pos DocTest]
go [Located pos Expression]
rest
Prompt
ExamplePrompt ->
let ([Located pos Expression]
ys,[Located pos Expression]
zs) = (Located pos Expression -> Bool)
-> [Located pos Expression]
-> ([Located pos Expression], [Located pos Expression])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Located pos Expression -> Bool
forall pos. Located pos Expression -> Bool
isEndOfInteraction [Located pos Expression]
rest
in pos -> DocTest -> Located pos DocTest
forall pos a. pos -> a -> Located pos a
Located pos
loc
(Expression -> ExpectedResult -> DocTest
Example Expression
exprStr (ExpectedResult -> DocTest) -> ExpectedResult -> DocTest
forall a b. (a -> b) -> a -> b
$ (Expression -> ExpectedLine) -> [Expression] -> ExpectedResult
forall a b. (a -> b) -> [a] -> [b]
map Expression -> ExpectedLine
mkExpectedLine ([Expression] -> ExpectedResult) -> [Expression] -> ExpectedResult
forall a b. (a -> b) -> a -> b
$ Expression -> [Located pos Expression] -> [Expression]
forall pos. Expression -> [Located pos Expression] -> [Expression]
unindent Expression
ind [Located pos Expression]
ys)
Located pos DocTest
-> [Located pos DocTest] -> [Located pos DocTest]
forall a. a -> [a] -> [a]
:
[Located pos Expression] -> [Located pos DocTest]
go [Located pos Expression]
zs
dropWhileNothing :: (a -> Maybe b) -> [a] -> Maybe (b, [a])
dropWhileNothing :: forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
dropWhileNothing a -> Maybe b
f =
[Maybe (b, [a])] -> Maybe (b, [a])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (b, [a])] -> Maybe (b, [a]))
-> ([a] -> [Maybe (b, [a])]) -> [a] -> Maybe (b, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([a] -> Maybe (b, [a])) -> [[a]] -> [Maybe (b, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\[a]
at -> case [a]
at of [] -> Maybe (b, [a])
forall a. Maybe a
Nothing; a
a:[a]
as -> (b -> (b, [a])) -> Maybe b -> Maybe (b, [a])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> [a] -> (b, [a])) -> [a] -> b -> (b, [a])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) [a]
as) (a -> Maybe b
f a
a)) ([[a]] -> [Maybe (b, [a])])
-> ([a] -> [[a]]) -> [a] -> [Maybe (b, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[a] -> [[a]]
forall a. [a] -> [[a]]
tails
unindent :: String -> [Located pos String] -> [String]
unindent :: forall pos. Expression -> [Located pos Expression] -> [Expression]
unindent Expression
pre = (Located pos Expression -> Expression)
-> [Located pos Expression] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map (Expression -> ShowS
tryStripPrefix Expression
pre ShowS
-> (Located pos Expression -> Expression)
-> Located pos Expression
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located pos Expression -> Expression
forall pos a. Located pos a -> a
unLoc)
tryStripPrefix :: String -> String -> String
tryStripPrefix :: Expression -> ShowS
tryStripPrefix Expression
prefix Expression
ys = Expression -> Maybe Expression -> Expression
forall a. a -> Maybe a -> a
fromMaybe Expression
ys (Maybe Expression -> Expression) -> Maybe Expression -> Expression
forall a b. (a -> b) -> a -> b
$ Expression -> Expression -> Maybe Expression
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix Expression
prefix Expression
ys
mkExpectedLine :: String -> ExpectedLine
mkExpectedLine :: Expression -> ExpectedLine
mkExpectedLine Expression
x = case Expression
x of
Expression
"<BLANKLINE>" -> [LineChunk] -> ExpectedLine
ExpectedLine [Expression -> LineChunk
LineChunk Expression
""]
Expression
"..." -> ExpectedLine
WildCardLine
Expression
_ -> [LineChunk] -> ExpectedLine
ExpectedLine ([LineChunk] -> ExpectedLine) -> [LineChunk] -> ExpectedLine
forall a b. (a -> b) -> a -> b
$ Expression -> [LineChunk]
mkLineChunks Expression
x
mkLineChunks :: String -> [LineChunk]
mkLineChunks :: Expression -> [LineChunk]
mkLineChunks = (Int, Expression, [LineChunk]) -> [LineChunk]
finish ((Int, Expression, [LineChunk]) -> [LineChunk])
-> (Expression -> (Int, Expression, [LineChunk]))
-> Expression
-> [LineChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
-> (Int, Expression, [LineChunk])
-> (Int, Expression, [LineChunk]))
-> (Int, Expression, [LineChunk])
-> Expression
-> (Int, Expression, [LineChunk])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char
-> (Int, Expression, [LineChunk]) -> (Int, Expression, [LineChunk])
go (Int
0, [], [])
where
mkChunk :: String -> [LineChunk]
mkChunk :: Expression -> [LineChunk]
mkChunk Expression
"" = []
mkChunk Expression
x = [Expression -> LineChunk
LineChunk Expression
x]
go :: Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk])
go :: Char
-> (Int, Expression, [LineChunk]) -> (Int, Expression, [LineChunk])
go Char
'.' (Int
count, Expression
acc, [LineChunk]
res) = if Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
then (Int
0, Expression
"", LineChunk
WildCardChunk LineChunk -> [LineChunk] -> [LineChunk]
forall a. a -> [a] -> [a]
: Expression -> [LineChunk]
mkChunk Expression
acc [LineChunk] -> [LineChunk] -> [LineChunk]
forall a. [a] -> [a] -> [a]
++ [LineChunk]
res)
else (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Expression
acc, [LineChunk]
res)
go Char
c (Int
count, Expression
acc, [LineChunk]
res) = if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then (Int
0, Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char -> Expression
forall a. Int -> a -> [a]
replicate Int
count Char
'.' Expression -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression
acc, [LineChunk]
res)
else (Int
0, Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Expression
acc, [LineChunk]
res)
finish :: (Int, Expression, [LineChunk]) -> [LineChunk]
finish (Int
count, Expression
acc, [LineChunk]
res) = Expression -> [LineChunk]
mkChunk (Int -> Char -> Expression
forall a. Int -> a -> [a]
replicate Int
count Char
'.' Expression -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression
acc) [LineChunk] -> [LineChunk] -> [LineChunk]
forall a. [a] -> [a] -> [a]
++ [LineChunk]
res