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]
parseComment :: forall pos. [Located pos Expression] -> [Located pos DocTest]
parseComment = 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