module Test.DocTest.Parse (
DocTest(..),
Expression,
Interaction,
parseComment,
) where
import Test.DocTest.Location (Located(Located), unLoc)
import Test.DocTest.Base
import qualified Data.List.HT as ListHT
import Data.List (stripPrefix, isPrefixOf)
import Data.Maybe (fromMaybe, isJust)
import Data.Char (isSpace)
import Control.Arrow (second)
import Control.Applicative ((<$>), (<|>))
data DocTest = Example Expression ExpectedResult | Property Expression
deriving (DocTest -> DocTest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocTest -> DocTest -> Bool
$c/= :: DocTest -> DocTest -> Bool
== :: DocTest -> DocTest -> Bool
$c== :: DocTest -> DocTest -> Bool
Eq, Int -> DocTest -> ShowS
[DocTest] -> ShowS
DocTest -> Expression
forall a.
(Int -> a -> ShowS)
-> (a -> Expression) -> ([a] -> ShowS) -> Show a
showList :: [DocTest] -> ShowS
$cshowList :: [DocTest] -> ShowS
show :: DocTest -> Expression
$cshow :: DocTest -> Expression
showsPrec :: Int -> DocTest -> ShowS
$cshowsPrec :: Int -> DocTest -> ShowS
Show)
type Expression = String
type Interaction = (Expression, ExpectedResult)
data Prompt = ExamplePrompt | PropPrompt
parseComment :: [Located pos String] -> [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) ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) Expression
indentation) forall a b. (a -> b) -> a -> b
$
(,) Prompt
ExamplePrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pos a. pos -> a -> Located pos a
Located pos
loc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix Expression
examplePrompt Expression
str
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(,) Prompt
PropPrompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pos a. pos -> a -> Located pos a
Located pos
loc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix Expression
propPrompt Expression
str)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace
forall a b. (a -> b) -> a -> b
$ Expression
line
isClosingLine :: Located pos String -> Bool
isClosingLine :: forall pos. Located pos Expression -> Bool
isClosingLine = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf Expression
":}" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pos a. Located pos a -> a
unLoc
isBlankLine :: Located pos String -> Bool
isBlankLine :: forall pos. Located pos Expression -> Bool
isBlankLine = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Maybe a -> Bool
isJust (forall pos.
Located pos Expression
-> Maybe (Expression, (Prompt, Located pos Expression))
maybePrompt Located pos Expression
x) Bool -> Bool -> 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 forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a])
ListHT.dropWhileNothing 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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace Expression
firstLineStr in
case 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 forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. Int -> [a] -> ([a], [a])
splitAt Int
1) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
break 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
(forall pos a. pos -> a -> Located pos a
Located pos
loc forall a b. (a -> b) -> a -> b
$ [Expression] -> Expression
unlines forall a b. (a -> b) -> a -> b
$
Expression
firstLineUnindented forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall pos a. Located pos a -> a
unLoc ([Located pos Expression]
ysforall 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expression -> DocTest
Property Located pos Expression
expr 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break forall pos. Located pos Expression -> Bool
isEndOfInteraction [Located pos Expression]
rest
in forall pos a. pos -> a -> Located pos a
Located pos
loc
(Expression -> ExpectedResult -> DocTest
Example Expression
exprStr forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expression -> ExpectedLine
mkExpectedLine forall a b. (a -> b) -> a -> b
$ forall pos. Expression -> [Located pos Expression] -> [Expression]
unindent Expression
ind [Located pos Expression]
ys)
forall a. a -> [a] -> [a]
:
[Located pos Expression] -> [Located pos DocTest]
go [Located pos Expression]
zs
unindent :: String -> [Located pos String] -> [String]
unindent :: forall pos. Expression -> [Located pos Expression] -> [Expression]
unindent Expression
pre = forall a b. (a -> b) -> [a] -> [b]
map (Expression -> ShowS
tryStripPrefix Expression
pre forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pos a. Located pos a -> a
unLoc)
tryStripPrefix :: String -> String -> String
tryStripPrefix :: Expression -> ShowS
tryStripPrefix Expression
prefix Expression
ys = forall a. a -> Maybe a -> a
fromMaybe Expression
ys forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ Expression -> [LineChunk]
mkLineChunks Expression
x
mkLineChunks :: String -> [LineChunk]
mkLineChunks :: Expression -> [LineChunk]
mkLineChunks = (Int, Expression, [LineChunk]) -> [LineChunk]
finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Eq a => a -> a -> Bool
== Int
2
then (Int
0, Expression
"", LineChunk
WildCardChunk forall a. a -> [a] -> [a]
: Expression -> [LineChunk]
mkChunk Expression
acc forall a. [a] -> [a] -> [a]
++ [LineChunk]
res)
else (Int
count 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 forall a. Ord a => a -> a -> Bool
> Int
0
then (Int
0, Char
c forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
count Char
'.' forall a. [a] -> [a] -> [a]
++ Expression
acc, [LineChunk]
res)
else (Int
0, Char
c forall a. a -> [a] -> [a]
: Expression
acc, [LineChunk]
res)
finish :: (Int, Expression, [LineChunk]) -> [LineChunk]
finish (Int
count, Expression
acc, [LineChunk]
res) = Expression -> [LineChunk]
mkChunk (forall a. Int -> a -> [a]
replicate Int
count Char
'.' forall a. [a] -> [a] -> [a]
++ Expression
acc) forall a. [a] -> [a] -> [a]
++ [LineChunk]
res