{- -----------------------------------------------------------------------------
Copyright 2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

module Test.Pragma (tests) where

import Control.Monad (when)
import Text.Regex.TDFA

import Base.CompilerError
import Base.TrackedErrors
import Parser.Pragma
import Parser.TextParser
import Test.Common
import Types.Pragma


tests :: [IO (TrackedErrors ())]
tests :: [IO (TrackedErrors ())]
tests = [
    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$ModuleOnly$" ((Pragma SourceContext -> [Pragma SourceContext])
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> TextParser [Pragma SourceContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma SourceContext
-> [Pragma SourceContext] -> [Pragma SourceContext]
forall a. a -> [a] -> [a]
:[]) ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaModuleOnly)
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaVisibility [SourceContext]
_ CodeVisibility
ModuleOnly] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$TestsOnly$" ((Pragma SourceContext -> [Pragma SourceContext])
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> TextParser [Pragma SourceContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma SourceContext
-> [Pragma SourceContext] -> [Pragma SourceContext]
forall a. a -> [a] -> [a]
:[]) ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaTestsOnly)
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaVisibility [SourceContext]
_ CodeVisibility
TestsOnly] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$SourceContext$" ((Pragma SourceContext -> [Pragma SourceContext])
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> TextParser [Pragma SourceContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma SourceContext
-> [Pragma SourceContext] -> [Pragma SourceContext]
forall a. a -> [a] -> [a]
:[]) ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaSourceContext)
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaSourceContext SourceContext
_] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$NoTrace$" ((Pragma SourceContext -> [Pragma SourceContext])
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> TextParser [Pragma SourceContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma SourceContext
-> [Pragma SourceContext] -> [Pragma SourceContext]
forall a. a -> [a] -> [a]
:[]) ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaNoTrace)
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaTracing [SourceContext]
_ TraceType
NoTrace] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$TraceCreation$" ((Pragma SourceContext -> [Pragma SourceContext])
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> TextParser [Pragma SourceContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma SourceContext
-> [Pragma SourceContext] -> [Pragma SourceContext]
forall a. a -> [a] -> [a]
:[]) ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaTraceCreation)
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaTracing [SourceContext]
_ TraceType
TraceCreation] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$Comment[ \"this is a pragma with args\" ]$" ((Pragma SourceContext -> [Pragma SourceContext])
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> TextParser [Pragma SourceContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma SourceContext
-> [Pragma SourceContext] -> [Pragma SourceContext]
forall a. a -> [a] -> [a]
:[]) ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaComment)
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaComment [SourceContext]
_ String
"this is a pragma with args"] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$ExprLookup[ \nMODULE_PATH /*comment*/\n ]$" ((Pragma SourceContext -> [Pragma SourceContext])
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> TextParser [Pragma SourceContext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pragma SourceContext
-> [Pragma SourceContext] -> [Pragma SourceContext]
forall a. a -> [a] -> [a]
:[]) ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaExprLookup)
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaExprLookup [SourceContext]
_ (MacroName String
"MODULE_PATH")] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"/*only comments*/" ([ParsecT CompilerMessage String Identity (Pragma SourceContext)]
-> TextParser [Pragma SourceContext]
forall a. [TextParser a] -> TextParser [a]
parsePragmas [ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaModuleOnly,ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaTestsOnly])
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$ModuleOnly$  // comment" ([ParsecT CompilerMessage String Identity (Pragma SourceContext)]
-> TextParser [Pragma SourceContext]
forall a. [TextParser a] -> TextParser [a]
parsePragmas [ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaTestsOnly,ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaModuleOnly])
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaVisibility [SourceContext]
_ CodeVisibility
ModuleOnly] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$TestsOnly$  /*comment*/" ([ParsecT CompilerMessage String Identity (Pragma SourceContext)]
-> TextParser [Pragma SourceContext]
forall a. [TextParser a] -> TextParser [a]
parsePragmas [ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaModuleOnly,ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaTestsOnly])
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaVisibility [SourceContext]
_ CodeVisibility
TestsOnly] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
"$TestsOnly$\n$TestsOnly$\n$ModuleOnly$" ([ParsecT CompilerMessage String Identity (Pragma SourceContext)]
-> TextParser [Pragma SourceContext]
forall a. [TextParser a] -> TextParser [a]
parsePragmas [ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaModuleOnly,ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaTestsOnly])
      (\[Pragma SourceContext]
e -> case [Pragma SourceContext]
e of
                  [PragmaVisibility [SourceContext]
_ CodeVisibility
TestsOnly,
                   PragmaVisibility [SourceContext]
_ CodeVisibility
TestsOnly,
                   PragmaVisibility [SourceContext]
_ CodeVisibility
ModuleOnly] -> Bool
True
                  [Pragma SourceContext]
_ -> Bool
False),

    String
-> String
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> IO (TrackedErrors ())
checkParseError String
"$ModuleOnly[ extra ]$" String
"does not allow arguments" ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaModuleOnly,

    String
-> String
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> IO (TrackedErrors ())
checkParseError String
"$TestsOnly[ extra ]$" String
"does not allow arguments" ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaTestsOnly,

    String
-> String
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> IO (TrackedErrors ())
checkParseError String
"$Comment$" String
"requires arguments" ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaComment,

    String
-> String
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> IO (TrackedErrors ())
checkParseError String
"$ExprLookup[ \"bad stuff\" ]$" String
"macro name" ParsecT CompilerMessage String Identity (Pragma SourceContext)
pragmaExprLookup
  ]

checkParsesAs :: String -> TextParser [Pragma SourceContext] -> ([Pragma SourceContext] -> Bool) -> IO (TrackedErrors ())
checkParsesAs :: String
-> TextParser [Pragma SourceContext]
-> ([Pragma SourceContext] -> Bool)
-> IO (TrackedErrors ())
checkParsesAs String
s TextParser [Pragma SourceContext]
p [Pragma SourceContext] -> Bool
m = TrackedErrors () -> IO (TrackedErrors ())
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
  let parsed :: TrackedErrors [Pragma SourceContext]
parsed = TextParser [Pragma SourceContext]
-> String -> String -> TrackedErrors [Pragma SourceContext]
forall a. TextParser a -> String -> String -> TrackedErrors a
readSingleWith TextParser [Pragma SourceContext]
p String
"(string)" String
s
  TrackedErrors [Pragma SourceContext] -> TrackedErrors ()
forall (m :: * -> *) a.
ErrorContextM m =>
TrackedErrorsT Identity a -> m ()
check TrackedErrors [Pragma SourceContext]
parsed
  [Pragma SourceContext]
e <- TrackedErrors [Pragma SourceContext]
parsed
  Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Pragma SourceContext] -> Bool
m [Pragma SourceContext]
e) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$
    String -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> TrackedErrors ()) -> String -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String
"No match in '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"':\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Pragma SourceContext] -> String
forall a. Show a => a -> String
show [Pragma SourceContext]
e
  where
    check :: TrackedErrorsT Identity a -> m ()
check TrackedErrorsT Identity a
c
      | TrackedErrorsT Identity a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity a
c = String -> m ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parse '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"':\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CompilerMessage -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrorsT Identity a
c)
      | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkParseError :: String -> String -> TextParser (Pragma SourceContext) -> IO (TrackedErrors ())
checkParseError :: String
-> String
-> ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> IO (TrackedErrors ())
checkParseError String
s String
m ParsecT CompilerMessage String Identity (Pragma SourceContext)
p = TrackedErrors () -> IO (TrackedErrors ())
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
  let parsed :: TrackedErrors (Pragma SourceContext)
parsed = ParsecT CompilerMessage String Identity (Pragma SourceContext)
-> String -> String -> TrackedErrors (Pragma SourceContext)
forall a. TextParser a -> String -> String -> TrackedErrors a
readSingleWith ParsecT CompilerMessage String Identity (Pragma SourceContext)
p String
"(string)" String
s
  TrackedErrors (Pragma SourceContext) -> TrackedErrors ()
forall (f :: * -> *) a.
(ErrorContextM f, Show a) =>
TrackedErrorsT Identity a -> f ()
check TrackedErrors (Pragma SourceContext)
parsed
  where
    check :: TrackedErrorsT Identity a -> f ()
check TrackedErrorsT Identity a
c
      | TrackedErrorsT Identity a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity a
c = do
          let text :: String
text = CompilerMessage -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrorsT Identity a
c)
          Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
text String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
m) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
            String -> f ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ String
"Expected pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in error output but got\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text
      | Bool
otherwise =
          String -> f ()
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> f ()) -> String -> f ()
forall a b. (a -> b) -> a -> b
$ String
"Expected write failure but got\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity a -> a
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrorsT Identity a
c)