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


-- Cf. utility-ht:Data.List.HT
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