{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -Wwarn #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}

-- |Parse a Section, a group of zero or more tests defined in a multiline comment or a sequence of one line comments.
module Ide.Plugin.Eval.Parse.Section (
    allSections,
    validSections,
    Section (..),
) where

import qualified Control.Applicative.Combinators.NonEmpty as NE
import Control.Monad.Combinators (
    many,
    optional,
    some,
    (<|>),
 )
import qualified Data.List.NonEmpty as NE
import Data.Maybe (catMaybes, fromMaybe)
import Ide.Plugin.Eval.Parse.Parser (
    Parser,
    runParser,
    satisfy,
 )
import Ide.Plugin.Eval.Parse.Token (
    Token (BlockOpen, blockFormat, blockLanguage, blockName),
    TokenS,
    isBlockClose,
    isBlockOpen,
    isCodeLine,
    isPropLine,
    isStatement,
    isTextLine,
    unsafeContent,
 )
import Ide.Plugin.Eval.Types (
    Format (SingleLine),
    Loc,
    Located (Located, located, location),
    Section (..),
    Test (Example, Property),
    hasTests,
    unLoc,
 )

type Tk = Loc TokenS

validSections :: [Tk] -> Either String [Section]
validSections :: [Tk] -> Either String [Section]
validSections = ((Section -> Bool) -> [Section] -> [Section]
forall a. (a -> Bool) -> [a] -> [a]
filter Section -> Bool
hasTests ([Section] -> [Section])
-> Either String [Section] -> Either String [Section]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either String [Section] -> Either String [Section])
-> ([Tk] -> Either String [Section])
-> [Tk]
-> Either String [Section]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tk] -> Either String [Section]
allSections

allSections :: [Tk] -> Either String [Section]
allSections :: [Tk] -> Either String [Section]
allSections = Parser Tk [Section] -> [Tk] -> Either String [Section]
forall t a. Show t => Parser t a -> [t] -> Either String a
runParser Parser Tk [Section]
sections

{-
>>> import Ide.Plugin.Eval.Parse.Token
>>> import  System.IO.Extra(readFileUTF8')
>>> testSource_ = runParser sections . tokensFrom
>>> testSource fp = testSource_ <$> readFileUTF8' fp

>>> testSource "plugins/default/src/Ide/Plugin/Eval/Test/TestGHC.hs"
Right [Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [Located {location = 36, located = Property {testline = " \\(l::[Bool]) -> reverse (reverse l) == l", testOutput = []}}], sectionLanguage = Plain, sectionFormat = MultiLine},Section {sectionName = "", sectionTests = [Located {location = 40, located = Example {testLines = " :set -XScopedTypeVariables -XExplicitForAll" :| [" import qualified Test.QuickCheck as Q11"," runProp11 p = Q11.quickCheckWithResult Q11.stdArgs p >>= return . Q11.output"," prop11 = \\(l::[Int]) -> reverse (reverse l) == l"," runProp11 prop11"], testOutput = []}},Located {location = 46, located = Property {testline = " \\(l::[Int]) -> reverse (reverse l) == l", testOutput = []}}], sectionLanguage = Plain, sectionFormat = MultiLine},Section {sectionName = "", sectionTests = [Located {location = 50, located = Example {testLines = " t" :| [], testOutput = []}}], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [Located {location = 55, located = Example {testLines = " run $ runEval \"3+2\"" :| [], testOutput = []}}], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [Located {location = 125, located = Example {testLines = " isStmt \"\"" :| [], testOutput = ["stmt = let x =33;print x"]}}], sectionLanguage = Haddock, sectionFormat = MultiLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = MultiLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine},Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = SingleLine}]

>>> testSource "test/testdata/eval/T11.hs"
Right [Section {sectionName = "", sectionTests = [Located {location = 2, located = Example {testLines = " :kind! a" :| [], testOutput = []}}], sectionLanguage = Plain, sectionFormat = SingleLine}]

>>> testSource "test/testdata/eval/T12.hs"
Right [Section {sectionName = "", sectionTests = [Located {location = 6, located = Example {testLines = " type N = 1" :| [" type M = 40"," :kind N + M + 1"], testOutput = []}}], sectionLanguage = Plain, sectionFormat = SingleLine}]

>>> testSource_ $ "{"++"-\n       -" ++ "}"
Right [Section {sectionName = "", sectionTests = [], sectionLanguage = Plain, sectionFormat = MultiLine}]
-}
sections :: Parser Tk [Section]
sections :: Parser Tk [Section]
sections =
    [Maybe Section] -> [Section]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Section] -> [Section])
-> Parser Tk [Maybe Section] -> Parser Tk [Section]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk (Maybe Section) -> Parser Tk [Maybe Section]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Maybe Section -> [Tk] -> Maybe Section
forall a b. a -> b -> a
const Maybe Section
forall a. Maybe a
Nothing ([Tk] -> Maybe Section)
-> Parser Tk [Tk] -> Parser Tk (Maybe Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk Tk -> Parser Tk [Tk]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser Tk Tk
code Parser Tk (Maybe Section)
-> Parser Tk (Maybe Section) -> Parser Tk (Maybe Section)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Section -> Maybe Section
forall a. a -> Maybe a
Just (Section -> Maybe Section)
-> Parser Tk Section -> Parser Tk (Maybe Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk Section
section)

section :: Parser Tk Section
section :: Parser Tk Section
section = Parser Tk Section
sectionBody Parser Tk Section
-> (Section -> Parser Tk Section) -> Parser Tk Section
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Section -> Parser Tk Section
sectionEnd

sectionBody :: Parser Tk Section
sectionBody :: Parser Tk Section
sectionBody =
    ( \(Tk -> Token String
forall l a. Located l a -> a
unLoc -> BlockOpen{Maybe String
Language
Format
blockFormat :: Format
blockLanguage :: Language
blockName :: Maybe String
blockName :: forall s. Token s -> Maybe s
blockLanguage :: forall s. Token s -> Language
blockFormat :: forall s. Token s -> Format
..}) [Maybe (Loc Test)]
ts ->
        String -> [Loc Test] -> Language -> Format -> Section
Section (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
blockName) ([Maybe (Loc Test)] -> [Loc Test]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Loc Test)]
ts) Language
blockLanguage Format
blockFormat
    )
        (Tk -> [Maybe (Loc Test)] -> Section)
-> Parser Tk Tk -> Parser Tk ([Maybe (Loc Test)] -> Section)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk Tk
open Parser Tk ([Maybe (Loc Test)] -> Section)
-> Parser Tk [Maybe (Loc Test)] -> Parser Tk Section
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Tk (Maybe (Loc Test)) -> Parser Tk [Maybe (Loc Test)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Loc Test -> Maybe (Loc Test)
forall a. a -> Maybe a
Just (Loc Test -> Maybe (Loc Test))
-> Parser Tk (Loc Test) -> Parser Tk (Maybe (Loc Test))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk (Loc Test)
example Parser Tk (Maybe (Loc Test))
-> Parser Tk (Maybe (Loc Test)) -> Parser Tk (Maybe (Loc Test))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Loc Test -> Maybe (Loc Test)
forall a. a -> Maybe a
Just (Loc Test -> Maybe (Loc Test))
-> Parser Tk (Loc Test) -> Parser Tk (Maybe (Loc Test))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk (Loc Test)
property Parser Tk (Maybe (Loc Test))
-> Parser Tk (Maybe (Loc Test)) -> Parser Tk (Maybe (Loc Test))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Loc Test) -> [Tk] -> Maybe (Loc Test)
forall a b. a -> b -> a
const Maybe (Loc Test)
forall a. Maybe a
Nothing ([Tk] -> Maybe (Loc Test))
-> Parser Tk [Tk] -> Parser Tk (Maybe (Loc Test))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk [Tk]
doc)

sectionEnd :: Section -> Parser Tk Section
sectionEnd :: Section -> Parser Tk Section
sectionEnd Section
s
    | Section -> Format
sectionFormat Section
s Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
SingleLine = Parser Tk Tk -> Parser Tk (Maybe Tk)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Tk Tk
code Parser Tk (Maybe Tk) -> Parser Tk Section -> Parser Tk Section
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Section -> Parser Tk Section
forall (m :: * -> *) a. Monad m => a -> m a
return Section
s
    | Bool
otherwise = Parser Tk Tk
close Parser Tk Tk -> Parser Tk Section -> Parser Tk Section
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Section -> Parser Tk Section
forall (m :: * -> *) a. Monad m => a -> m a
return Section
s

-- section = do
--   s <-
--     maybe
--       (Section "" [] Plain SingleLine)
--       ( \(Located _ BlockOpen {..}) ->
--           Section (fromMaybe "" blockName) [] blockLanguage blockFormat
--       )
--       <$> optional open
--   ts <- many (Just <$> example <|> Just <$> property <|> const Nothing <$> doc)
--   optional close
--   return $ s {sectionTests = catMaybes ts}

-- singleSection :: Parser Tk Section
-- singleSection = (\ts -> Section "" (catMaybes ts) Plain SingleLine) <$> tests

-- tests :: Parser Tk [Maybe (Loc Test)]
-- tests = some (Just <$> example <|> Just <$> property <|> const Nothing <$> doc)

doc :: Parser Tk [Tk]
doc :: Parser Tk [Tk]
doc = Parser Tk Tk -> Parser Tk [Tk]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser Tk Tk
text

example, property :: Parser Tk (Loc Test)
property :: Parser Tk (Loc Test)
property =
    ( \(Located Line
l Token String
p) [Tk]
rs ->
        Line -> Test -> Loc Test
forall l a. l -> a -> Located l a
Located Line
l (String -> [String] -> Test
Property (Token String -> String
forall a. Token a -> a
unsafeContent Token String
p) (Token String -> String
forall a. Token a -> a
unsafeContent (Token String -> String) -> (Tk -> Token String) -> Tk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tk -> Token String
forall l a. Located l a -> a
located (Tk -> String) -> [Tk] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tk]
rs))
    )
        (Tk -> [Tk] -> Loc Test)
-> Parser Tk Tk -> Parser Tk ([Tk] -> Loc Test)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk Tk
prop
        Parser Tk ([Tk] -> Loc Test)
-> Parser Tk [Tk] -> Parser Tk (Loc Test)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Tk Tk -> Parser Tk [Tk]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Tk Tk
nonEmptyText
example :: Parser Tk (Loc Test)
example =
    ( \NonEmpty Tk
es [Tk]
rs ->
        Line -> Test -> Loc Test
forall l a. l -> a -> Located l a
Located
            (Tk -> Line
forall l a. Located l a -> l
location (NonEmpty Tk -> Tk
forall a. NonEmpty a -> a
NE.head NonEmpty Tk
es))
            (NonEmpty String -> [String] -> Test
Example (Token String -> String
forall a. Token a -> a
unsafeContent (Token String -> String) -> (Tk -> Token String) -> Tk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tk -> Token String
forall l a. Located l a -> a
located (Tk -> String) -> NonEmpty Tk -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Tk
es) (Token String -> String
forall a. Token a -> a
unsafeContent (Token String -> String) -> (Tk -> Token String) -> Tk -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tk -> Token String
forall l a. Located l a -> a
located (Tk -> String) -> [Tk] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tk]
rs))
    )
        (NonEmpty Tk -> [Tk] -> Loc Test)
-> Parser Tk (NonEmpty Tk) -> Parser Tk ([Tk] -> Loc Test)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Tk Tk -> Parser Tk (NonEmpty Tk)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NE.some Parser Tk Tk
statement
        Parser Tk ([Tk] -> Loc Test)
-> Parser Tk [Tk] -> Parser Tk (Loc Test)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Tk Tk -> Parser Tk [Tk]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Tk Tk
nonEmptyText

open, close, statement, nonEmptyText, text, prop, code :: Parser Tk Tk
statement :: Parser Tk Tk
statement = (Token String -> Bool) -> Parser Tk Tk
forall b. (b -> Bool) -> Parser (Loc b) (Loc b)
is Token String -> Bool
forall s. Token s -> Bool
isStatement
text :: Parser Tk Tk
text = (Token String -> Bool) -> Parser Tk Tk
forall b. (b -> Bool) -> Parser (Loc b) (Loc b)
is Token String -> Bool
forall s. Token s -> Bool
isTextLine
prop :: Parser Tk Tk
prop = (Token String -> Bool) -> Parser Tk Tk
forall b. (b -> Bool) -> Parser (Loc b) (Loc b)
is Token String -> Bool
forall s. Token s -> Bool
isPropLine
open :: Parser Tk Tk
open = (Token String -> Bool) -> Parser Tk Tk
forall b. (b -> Bool) -> Parser (Loc b) (Loc b)
is Token String -> Bool
forall s. Token s -> Bool
isBlockOpen
close :: Parser Tk Tk
close = (Token String -> Bool) -> Parser Tk Tk
forall b. (b -> Bool) -> Parser (Loc b) (Loc b)
is Token String -> Bool
forall s. Token s -> Bool
isBlockClose
code :: Parser Tk Tk
code = (Token String -> Bool) -> Parser Tk Tk
forall b. (b -> Bool) -> Parser (Loc b) (Loc b)
is Token String -> Bool
forall s. Token s -> Bool
isCodeLine
nonEmptyText :: Parser Tk Tk
nonEmptyText = (Token String -> Bool) -> Parser Tk Tk
forall b. (b -> Bool) -> Parser (Loc b) (Loc b)
is (\Token String
l -> Token String -> Bool
forall s. Token s -> Bool
isTextLine Token String
l Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Token String -> String
forall a. Token a -> a
unsafeContent Token String
l)))

is :: (b -> Bool) -> Parser (Loc b) (Loc b)
is :: (b -> Bool) -> Parser (Loc b) (Loc b)
is b -> Bool
p = (Loc b -> Bool) -> Parser (Loc b) (Loc b)
forall t. (t -> Bool) -> Parser t t
satisfy (b -> Bool
p (b -> Bool) -> (Loc b -> b) -> Loc b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc b -> b
forall l a. Located l a -> a
unLoc)