{- -----------------------------------------------------------------------------
Copyright 2019-2021 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.Common (
  checkDefinesFail,
  checkDefinesSuccess,
  checkEquals,
  checkParseError,
  checkParseMatch,
  checkTypeFail,
  checkWriteFail,
  checkWriteThenRead,
  checkTypeSuccess,
  containsAtLeast,
  containsAtMost,
  containsExactly,
  containsNoDuplicates,
  forceParse,
  loadFile,
  parseFilterMap,
  parseTestWithFilters,
  readMulti,
  readSingle,
  readSingleWith,
  runAllTests,
  showFilters,
  showParams,
) where

import Control.Monad (when)
import Data.Either
import Data.List
import System.Exit
import System.FilePath
import System.IO
import Text.Regex.TDFA
import qualified Data.Map as Map
import qualified Data.Set as Set

import Base.CompilerError
import Base.CompilerMessage
import Base.TrackedErrors
import Module.ParseMetadata (ConfigFormat,autoReadConfig,autoWriteConfig)
import Parser.Common
import Parser.TextParser
import Parser.TypeInstance ()
import Types.TypeInstance


runAllTests :: [IO (TrackedErrors ())] -> IO ()
runAllTests :: [IO (TrackedErrors ())] -> IO ()
runAllTests [IO (TrackedErrors ())]
ts = do
  [TrackedErrors ()]
results <- [IO (TrackedErrors ())] -> IO [TrackedErrors ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [IO (TrackedErrors ())]
ts
  let ([(Int, CompilerMessage)]
es,[()]
ps) = [Either (Int, CompilerMessage) ()]
-> ([(Int, CompilerMessage)], [()])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (Int, CompilerMessage) ()]
 -> ([(Int, CompilerMessage)], [()]))
-> [Either (Int, CompilerMessage) ()]
-> ([(Int, CompilerMessage)], [()])
forall a b. (a -> b) -> a -> b
$ (Int -> TrackedErrors () -> Either (Int, CompilerMessage) ())
-> [Int]
-> [TrackedErrors ()]
-> [Either (Int, CompilerMessage) ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> TrackedErrors () -> Either (Int, CompilerMessage) ()
forall a b. a -> TrackedErrors b -> Either (a, CompilerMessage) b
numberError ([Int
1..] :: [Int]) [TrackedErrors ()]
results
  ((Int, CompilerMessage) -> IO ())
-> [(Int, CompilerMessage)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
n,CompilerMessage
e) -> Handle -> String -> IO ()
hPutStr Handle
stderr (String
"Test " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CompilerMessage -> String
forall a. Show a => a -> String
show CompilerMessage
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")) [(Int, CompilerMessage)]
es
  Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show ([()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [()]
ps) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests passed + " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   Int -> String
forall a. Show a => a -> String
show ([(Int, CompilerMessage)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, CompilerMessage)]
es) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" tests failed\n"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Int, CompilerMessage)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, CompilerMessage)]
es) IO ()
forall a. IO a
exitFailure

numberError :: a -> TrackedErrors b -> Either (a,CompilerMessage) b
numberError :: forall a b. a -> TrackedErrors b -> Either (a, CompilerMessage) b
numberError a
n TrackedErrors b
c
  | TrackedErrors b -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors b
c = (a, CompilerMessage) -> Either (a, CompilerMessage) b
forall a b. a -> Either a b
Left (a
n,TrackedErrors b -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrors b
c)
  | Bool
otherwise        = b -> Either (a, CompilerMessage) b
forall a b. b -> Either a b
Right (TrackedErrors b -> b
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrors b
c)

forceParse :: ParseFromSource a => String -> a
forceParse :: forall a. ParseFromSource a => String -> a
forceParse String
s = TrackedErrors a -> a
forall a. TrackedErrors a -> a
getCompilerSuccess (TrackedErrors a -> a) -> TrackedErrors a -> a
forall a b. (a -> b) -> a -> b
$ TextParser a -> String -> String -> TrackedErrors a
forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> String -> String -> m a
runTextParser TextParser a
forall a. ParseFromSource a => TextParser a
sourceParser String
"(string)" String
s

readSingle :: ParseFromSource a => String -> String -> TrackedErrors a
readSingle :: forall a. ParseFromSource a => String -> String -> TrackedErrors a
readSingle  = TextParser a -> String -> String -> TrackedErrors a
forall a. TextParser a -> String -> String -> TrackedErrors a
readSingleWith TextParser a
forall a. ParseFromSource a => TextParser a
sourceParser

readSingleWith :: TextParser a -> String -> String -> TrackedErrors a
readSingleWith :: forall a. TextParser a -> String -> String -> TrackedErrors a
readSingleWith TextParser a
p = TextParser a -> String -> String -> TrackedErrorsT Identity a
forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> String -> String -> m a
runTextParser (ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
-> TextParser a
-> TextParser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT CompilerMessage String Identity ()
nullParse ParsecT CompilerMessage String Identity ()
endOfDoc TextParser a
p)

readMulti :: ParseFromSource a => String -> String -> TrackedErrors [a]
readMulti :: forall a.
ParseFromSource a =>
String -> String -> TrackedErrors [a]
readMulti String
f String
s = TextParser [a] -> String -> String -> TrackedErrorsT Identity [a]
forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> String -> String -> m a
runTextParser (ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
-> TextParser [a]
-> TextParser [a]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT CompilerMessage String Identity ()
optionalSpace ParsecT CompilerMessage String Identity ()
endOfDoc (ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity () -> TextParser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT CompilerMessage String Identity a
forall a. ParseFromSource a => TextParser a
sourceParser ParsecT CompilerMessage String Identity ()
optionalSpace)) String
f String
s

parseFilterMap :: [(String,[String])] -> TrackedErrors ParamFilters
parseFilterMap :: [(String, [String])] -> TrackedErrors ParamFilters
parseFilterMap [(String, [String])]
pa = do
  [(ParamName, [TypeFilter])]
pa2 <- ((String, [String])
 -> TrackedErrorsT Identity (ParamName, [TypeFilter]))
-> [(String, [String])]
-> TrackedErrorsT Identity [(ParamName, [TypeFilter])]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (String, [String])
-> TrackedErrorsT Identity (ParamName, [TypeFilter])
forall {b}.
ParseFromSource b =>
(String, [String]) -> TrackedErrorsT Identity (ParamName, [b])
parseFilters [(String, [String])]
pa
  ParamFilters -> TrackedErrors ParamFilters
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamFilters -> TrackedErrors ParamFilters)
-> ParamFilters -> TrackedErrors ParamFilters
forall a b. (a -> b) -> a -> b
$ [(ParamName, [TypeFilter])] -> ParamFilters
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ParamName, [TypeFilter])]
pa2
  where
    parseFilters :: (String, [String]) -> TrackedErrorsT Identity (ParamName, [b])
parseFilters (String
n,[String]
fs) = do
      [b]
fs2 <- (String -> TrackedErrorsT Identity b)
-> [String] -> TrackedErrorsT Identity [b]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (String -> String -> TrackedErrorsT Identity b
forall a. ParseFromSource a => String -> String -> TrackedErrors a
readSingle String
"(string)") [String]
fs
      (ParamName, [b]) -> TrackedErrorsT Identity (ParamName, [b])
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParamName
ParamName String
n,[b]
fs2)

parseTestWithFilters :: ParseFromSource a => [(String,[String])] -> [String] -> TrackedErrors ([a],ParamFilters)
parseTestWithFilters :: forall a.
ParseFromSource a =>
[(String, [String])]
-> [String] -> TrackedErrors ([a], ParamFilters)
parseTestWithFilters [(String, [String])]
pa [String]
xs = do
  [a]
ts <- (String -> TrackedErrorsT Identity a)
-> [String] -> TrackedErrorsT Identity [a]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (String -> String -> TrackedErrorsT Identity a
forall a. ParseFromSource a => String -> String -> TrackedErrors a
readSingle String
"(string)") [String]
xs
  ParamFilters
pa2 <- [(String, [String])] -> TrackedErrors ParamFilters
parseFilterMap [(String, [String])]
pa
  ([a], ParamFilters) -> TrackedErrors ([a], ParamFilters)
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
ts,ParamFilters
pa2)

parseTestWithParams :: ParseFromSource a => [String] -> [String] -> TrackedErrors ([a],Set.Set ParamName)
parseTestWithParams :: forall a.
ParseFromSource a =>
[String] -> [String] -> TrackedErrors ([a], Set ParamName)
parseTestWithParams [String]
ps [String]
xs = do
  [a]
ts <- (String -> TrackedErrorsT Identity a)
-> [String] -> TrackedErrorsT Identity [a]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (String -> String -> TrackedErrorsT Identity a
forall a. ParseFromSource a => String -> String -> TrackedErrors a
readSingle String
"(string)") [String]
xs
  ([a], Set ParamName) -> TrackedErrors ([a], Set ParamName)
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
ts,[ParamName] -> Set ParamName
forall a. Ord a => [a] -> Set a
Set.fromList ([ParamName] -> Set ParamName) -> [ParamName] -> Set ParamName
forall a b. (a -> b) -> a -> b
$ (String -> ParamName) -> [String] -> [ParamName]
forall a b. (a -> b) -> [a] -> [b]
map String -> ParamName
ParamName [String]
ps)

showFilters :: [(String,[String])] -> String
showFilters :: [(String, [String])] -> String
showFilters [(String, [String])]
pa = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, [String]) -> [String])
-> [(String, [String])] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (String, [String]) -> [String]
expand [(String, [String])]
pa) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]" where
  expand :: (String, [String]) -> [String]
expand (String
n,[String]
ps) = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
p -> String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p) [String]
ps

showParams :: [String] -> String
showParams :: [String] -> String
showParams [String]
ps = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
ps String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

checkTypeSuccess :: TypeResolver r => r -> [String] -> String -> TrackedErrors ()
checkTypeSuccess :: forall r.
TypeResolver r =>
r -> [String] -> String -> TrackedErrors ()
checkTypeSuccess r
r [String]
pa String
x = do
  ([GeneralInstance
t],Set ParamName
pa2) <- [String]
-> [String] -> TrackedErrors ([GeneralInstance], Set ParamName)
forall a.
ParseFromSource a =>
[String] -> [String] -> TrackedErrors ([a], Set ParamName)
parseTestWithParams [String]
pa [String
x]
  TrackedErrors () -> TrackedErrors ()
forall {m :: * -> *} {a}. ErrorContextM m => m a -> m a
check (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ r -> Set ParamName -> GeneralInstance -> TrackedErrors ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r Set ParamName
pa2 GeneralInstance
t
  where
    prefix :: String
prefix = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showParams [String]
pa
    check :: m a -> m a
check m a
x2 = m a
x2 m a -> String -> m a
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!! String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"

checkTypeFail :: TypeResolver r => r -> [String] -> String -> TrackedErrors ()
checkTypeFail :: forall r.
TypeResolver r =>
r -> [String] -> String -> TrackedErrors ()
checkTypeFail r
r [String]
pa String
x = do
  ([GeneralInstance
t],Set ParamName
pa2) <- [String]
-> [String] -> TrackedErrors ([GeneralInstance], Set ParamName)
forall a.
ParseFromSource a =>
[String] -> [String] -> TrackedErrors ([a], Set ParamName)
parseTestWithParams [String]
pa [String
x]
  TrackedErrors () -> TrackedErrors ()
forall a. TrackedErrors a -> TrackedErrors ()
check (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ r -> Set ParamName -> GeneralInstance -> TrackedErrors ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> GeneralInstance -> m ()
validateGeneralInstance r
r Set ParamName
pa2 GeneralInstance
t
  where
    prefix :: String
prefix = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showParams [String]
pa
    check :: TrackedErrors a -> TrackedErrors ()
    check :: forall a. TrackedErrors a -> TrackedErrors ()
check TrackedErrors a
c
      | TrackedErrors a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors a
c = () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> TrackedErrors ()) -> String -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Expected failure\n"

checkDefinesSuccess :: TypeResolver r => r -> [String] -> String -> TrackedErrors ()
checkDefinesSuccess :: forall r.
TypeResolver r =>
r -> [String] -> String -> TrackedErrors ()
checkDefinesSuccess r
r [String]
pa String
x = do
  ([DefinesInstance
t],Set ParamName
pa2) <- [String]
-> [String] -> TrackedErrors ([DefinesInstance], Set ParamName)
forall a.
ParseFromSource a =>
[String] -> [String] -> TrackedErrors ([a], Set ParamName)
parseTestWithParams [String]
pa [String
x]
  TrackedErrors () -> TrackedErrors ()
forall {m :: * -> *} {a}. ErrorContextM m => m a -> m a
check (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ r -> Set ParamName -> DefinesInstance -> TrackedErrors ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> DefinesInstance -> m ()
validateDefinesInstance r
r Set ParamName
pa2 DefinesInstance
t
  where
    prefix :: String
prefix = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showParams [String]
pa
    check :: m a -> m a
check m a
x2 = m a
x2 m a -> String -> m a
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!! String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"

checkDefinesFail :: TypeResolver r => r -> [String] -> String -> TrackedErrors ()
checkDefinesFail :: forall r.
TypeResolver r =>
r -> [String] -> String -> TrackedErrors ()
checkDefinesFail r
r [String]
pa String
x = do
  ([DefinesInstance
t],Set ParamName
pa2) <- [String]
-> [String] -> TrackedErrors ([DefinesInstance], Set ParamName)
forall a.
ParseFromSource a =>
[String] -> [String] -> TrackedErrors ([a], Set ParamName)
parseTestWithParams [String]
pa [String
x]
  TrackedErrors () -> TrackedErrors ()
forall a. TrackedErrors a -> TrackedErrors ()
check (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ r -> Set ParamName -> DefinesInstance -> TrackedErrors ()
forall (m :: * -> *) r.
(CollectErrorsM m, TypeResolver r) =>
r -> Set ParamName -> DefinesInstance -> m ()
validateDefinesInstance r
r Set ParamName
pa2 DefinesInstance
t
  where
    prefix :: String
prefix = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showParams [String]
pa
    check :: TrackedErrors a -> TrackedErrors ()
    check :: forall a. TrackedErrors a -> TrackedErrors ()
check TrackedErrors a
c
      | TrackedErrors a -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors a
c = () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise = String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> TrackedErrors ()) -> String -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Expected failure\n"

containsExactly :: (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly :: forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsExactly [a]
actual [a]
expected = do
  [a] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> TrackedErrors ()
containsNoDuplicates [a]
actual
  [a] -> [a] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsAtLeast [a]
actual [a]
expected
  [a] -> [a] -> TrackedErrors ()
forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsAtMost [a]
actual [a]
expected

containsNoDuplicates :: (Ord a, Show a) => [a] -> TrackedErrors ()
containsNoDuplicates :: forall a. (Ord a, Show a) => [a] -> TrackedErrors ()
containsNoDuplicates [a]
expected =
  (([a] -> TrackedErrors ()) -> [[a]] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ [a] -> TrackedErrors ()
forall {m :: * -> *} {a}. (ErrorContextM m, Show a) => [a] -> m ()
checkSingle ([[a]] -> TrackedErrors ()) -> [[a]] -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
expected) TrackedErrors () -> String -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!! [a] -> String
forall a. Show a => a -> String
show [a]
expected
  where
    checkSingle :: [a] -> m ()
checkSingle xa :: [a]
xa@(a
x:a
_:[a]
_) =
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Item " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" occurs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xa) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" times"
    checkSingle [a]
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

containsAtLeast :: (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsAtLeast :: forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsAtLeast [a]
actual [a]
expected =
  ((a -> TrackedErrors ()) -> [a] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Set a -> a -> TrackedErrors ()
forall {a} {m :: * -> *}.
(Ord a, ErrorContextM m, Show a) =>
Set a -> a -> m ()
checkInActual (Set a -> a -> TrackedErrors ()) -> Set a -> a -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
actual) [a]
expected) TrackedErrors () -> String -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
        [a] -> String
forall a. Show a => a -> String
show [a]
actual String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (actual) vs. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (expected)"
  where
    checkInActual :: Set a -> a -> m ()
checkInActual Set a
va a
v =
      if a
v a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
va
         then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Item " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" was expected but not present"

containsAtMost :: (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsAtMost :: forall a. (Ord a, Show a) => [a] -> [a] -> TrackedErrors ()
containsAtMost [a]
actual [a]
expected =
  ((a -> TrackedErrors ()) -> [a] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Set a -> a -> TrackedErrors ()
forall {a} {m :: * -> *}.
(Ord a, ErrorContextM m, Show a) =>
Set a -> a -> m ()
checkInExpected (Set a -> a -> TrackedErrors ()) -> Set a -> a -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
expected) [a]
actual) TrackedErrors () -> String -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!!
        [a] -> String
forall a. Show a => a -> String
show [a]
actual String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (actual) vs. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (expected)"
  where
    checkInExpected :: Set a -> a -> m ()
checkInExpected Set a
va a
v =
      if a
v a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
va
         then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Item " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is unexpected"

checkEquals :: (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals :: forall a. (Eq a, Show a) => a -> a -> TrackedErrors ()
checkEquals a
actual a
expected
  | a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected = () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> TrackedErrors ()) -> String -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual

loadFile :: String -> IO String
loadFile :: String -> IO String
loadFile String
f = String -> IO String
readFile (String
"src" String -> String -> String
</> String
"Test" String -> String -> String
</> String
f)

checkParseMatch :: Show a => String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch :: forall a.
Show a =>
String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
checkParseMatch String
s TextParser a
p a -> Bool
m = TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
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 a
parsed = TextParser a -> String -> String -> TrackedErrors a
forall a. TextParser a -> String -> String -> TrackedErrors a
readSingleWith TextParser a
p String
"(string)" String
s
  TrackedErrors a -> TrackedErrors ()
forall {m :: * -> *} {a}.
ErrorContextM m =>
TrackedErrorsT Identity a -> m ()
check TrackedErrors a
parsed
  a
e <- TrackedErrors a
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
$ a -> Bool
m a
e) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$
    String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
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]
++ a -> String
forall a. Show a => a -> String
show a
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 a. String -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

checkParseError :: Show a => String -> String -> TextParser a -> IO (TrackedErrors ())
checkParseError :: forall a.
Show a =>
String -> String -> TextParser a -> IO (TrackedErrors ())
checkParseError String
s String
m TextParser a
p = TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
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 a
parsed = TextParser a -> String -> String -> TrackedErrors a
forall a. TextParser a -> String -> String -> TrackedErrors a
readSingleWith TextParser a
p String
"(string)" String
s
  TrackedErrors a -> TrackedErrors ()
forall {f :: * -> *} {a}.
(ErrorContextM f, Show a) =>
TrackedErrorsT Identity a -> f ()
check TrackedErrors a
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 a. String -> f a
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 a. String -> f a
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)

checkWriteThenRead :: (Eq a, Show a, ConfigFormat a) => a -> IO (TrackedErrors ())
checkWriteThenRead :: forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (TrackedErrors ())
checkWriteThenRead a
m = TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
  String
text <- (String -> String)
-> TrackedErrorsT Identity String -> TrackedErrorsT Identity String
forall a b.
(a -> b) -> TrackedErrorsT Identity a -> TrackedErrorsT Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
spamComments (TrackedErrorsT Identity String -> TrackedErrorsT Identity String)
-> TrackedErrorsT Identity String -> TrackedErrorsT Identity String
forall a b. (a -> b) -> a -> b
$ a -> TrackedErrorsT Identity String
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m String
autoWriteConfig a
m
  a
m' <- String -> String -> TrackedErrorsT Identity a
forall a (m :: * -> *).
(ConfigFormat a, ErrorContextM m) =>
String -> String -> m a
autoReadConfig String
"(string)" String
text TrackedErrorsT Identity a -> String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!! String
"Serialized >>>\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n<<< Serialized\n\n"
  Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
m' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
m) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$
    String -> TrackedErrors ()
forall a. String -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> TrackedErrors ()) -> String -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to match after write/read\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
"Before:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
"After:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
m' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
"Intermediate:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
text where
   spamComments :: String -> String
spamComments = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" // spam") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

checkWriteFail :: ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail :: forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
p a
m = TrackedErrors () -> IO (TrackedErrors ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> IO (TrackedErrors ()))
-> TrackedErrors () -> IO (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
  let m' :: TrackedErrorsT Identity String
m' = a -> TrackedErrorsT Identity String
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m String
autoWriteConfig a
m
  TrackedErrorsT Identity String -> TrackedErrors ()
forall {f :: * -> *}.
ErrorContextM f =>
TrackedErrorsT Identity String -> f ()
check TrackedErrorsT Identity String
m'
  where
    check :: TrackedErrorsT Identity String -> f ()
check TrackedErrorsT Identity String
c
      | TrackedErrorsT Identity String -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity String
c = do
          let text :: String
text = CompilerMessage -> String
forall a. Show a => a -> String
show (TrackedErrorsT Identity String -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrorsT Identity String
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
p) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
            String -> f ()
forall a. String -> f a
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
p 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 a. String -> f a
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]
++ TrackedErrorsT Identity String -> String
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrorsT Identity String
c