{- -----------------------------------------------------------------------------
Copyright 2020-2021,2023 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.ParseMetadata (tests) where

import Control.Monad (when)

import Base.CompilerError
import Base.Positional
import Base.TrackedErrors
import Cli.CompileOptions
import Cli.Programs (VersionHash(..))
import Module.CompileMetadata
import Module.ParseMetadata
import System.FilePath
import Test.Common
import Types.Procedure
import Types.TypeCategory
import Types.TypeInstance


hugeCompileMetadata :: CompileMetadata  -- testfiles/module-cache.txt
hugeCompileMetadata :: CompileMetadata
hugeCompileMetadata = CompileMetadata {
    cmVersionHash :: VersionHash
cmVersionHash = String -> VersionHash
VersionHash String
"0123456789ABCDEFabcdef",
    cmRoot :: String
cmRoot = String
"/home/project",
    cmPath :: String
cmPath = String
"/home/project/special",
    cmExtra :: [String]
cmExtra = [
      String
"extra1",
      String
"extra2"
    ],
    cmPublicNamespace :: Namespace
cmPublicNamespace = String -> Namespace
StaticNamespace String
"public_ABCDEF",
    cmPrivateNamespace :: Namespace
cmPrivateNamespace = String -> Namespace
StaticNamespace String
"private_ABCDEF",
    cmPublicDeps :: [String]
cmPublicDeps = [
      String
"/home/project/public-dep1",
      String
"/home/project/public-dep2"
    ],
    cmPrivateDeps :: [String]
cmPrivateDeps = [
      String
"/home/project/private-dep1",
      String
"/home/project/private-dep2"
    ],
    cmPublicCategories :: [CategoryName]
cmPublicCategories = [
      String -> CategoryName
CategoryName String
"MyCategory",
      String -> CategoryName
CategoryName String
"MyOtherCategory"
    ],
    cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [
      String -> CategoryName
CategoryName String
"PrivateCategory",
      String -> CategoryName
CategoryName String
"PrivateOtherCategory"
    ],
    cmPublicSubdirs :: [String]
cmPublicSubdirs = [
      String
"/home/project/special/subdir1",
      String
"/home/project/special/subdir2"
    ],
    cmPrivateSubdirs :: [String]
cmPrivateSubdirs = [
      String
"/home/project/special/subdir1",
      String
"/home/project/special/subdir2"
    ],
    cmPublicFiles :: [String]
cmPublicFiles = [
      String
"/home/project/special/category1.0rp",
      String
"/home/project/special/category2.0rp"
    ],
    cmPrivateFiles :: [String]
cmPrivateFiles = [
      String
"/home/project/special/category1.0rx",
      String
"/home/project/special/category2.0rx"
    ],
    cmTestFiles :: [String]
cmTestFiles = [
      String
"/home/project/special/category1.0rt",
      String
"/home/project/special/category2.0rt"
    ],
    cmHxxFiles :: [String]
cmHxxFiles = [
      String
"/home/project/special/category1.hpp",
      String
"/home/project/special/category2.hpp"
    ],
    cmCxxFiles :: [String]
cmCxxFiles = [
      String
"/home/project/special/category1.cpp",
      String
"/home/project/special/category2.cpp"
    ],
    cmBinaries :: [String]
cmBinaries = [
      String
"/home/project/special/binary1",
      String
"/home/project/special/binary2"
    ],
    cmLibraries :: [String]
cmLibraries = [
      String
"/home/project/special/library1",
      String
"/home/project/special/library2"
    ],
    cmLinkFlags :: [String]
cmLinkFlags = [
      String
"-lm",
      String
"-ldl"
    ],
    cmObjectFiles :: [ObjectFile]
cmObjectFiles = [
      CategoryObjectFile {
        cofCategory :: CategoryIdentifier
cofCategory = CategoryIdentifier {
          ciPath :: String
ciPath = String
"/home/project/special",
          ciCategory :: CategoryName
ciCategory = String -> CategoryName
CategoryName String
"SpecialCategory",
          ciNamespace :: Namespace
ciNamespace = String -> Namespace
StaticNamespace String
"public_ABCDEF"
        },
        cofRequires :: [CategoryIdentifier]
cofRequires = [
          CategoryIdentifier {
            ciPath :: String
ciPath = String
"/home/project/private-dep1",
            ciCategory :: CategoryName
ciCategory = String -> CategoryName
CategoryName String
"PrivateCategory",
            ciNamespace :: Namespace
ciNamespace = Namespace
NoNamespace
          },
          UnresolvedCategory {
            ucCategory :: CategoryName
ucCategory = String -> CategoryName
CategoryName String
"UnresolvedCategory"
          }
        ],
        cofFiles :: [String]
cofFiles = [
          String
"/home/project/special/object1.o",
          String
"/home/project/special/object1.o"
        ]
      }
    ]
  }

hugeModuleConfig :: ModuleConfig  -- testfiles/module-config.txt
hugeModuleConfig :: ModuleConfig
hugeModuleConfig = ModuleConfig {
    mcRoot :: String
mcRoot = String
"/home/projects",
    mcPath :: String
mcPath = String
"special",
    mcExtra :: [String]
mcExtra = [
      String
"extra1",
      String
"extra2"
    ],
    mcExprMap :: [(MacroName, Expression SourceContext)]
mcExprMap = [],
    mcPublicDeps :: [String]
mcPublicDeps = [
      String
"/home/project/public-dep1",
      String
"/home/project/public-dep2"
    ],
    mcPrivateDeps :: [String]
mcPrivateDeps = [
      String
"/home/project/private-dep1",
      String
"/home/project/private-dep2"
    ],
    mcExtraFiles :: [ExtraSource]
mcExtraFiles = [
      CategorySource {
        csSource :: String
csSource = String
"extra1.cpp",
        csCategories :: [CategoryName]
csCategories = [
          String -> CategoryName
CategoryName String
"Category1",
          String -> CategoryName
CategoryName String
"Category2"
        ],
        csRequires :: [CategoryName]
csRequires = [
          String -> CategoryName
CategoryName String
"DepCategory1",
          String -> CategoryName
CategoryName String
"DepCategory2"
        ]
      },
      OtherSource {
        osSource :: String
osSource = String
"extra2.cpp"
      }
    ],
    mcCategories :: [(CategoryName, CategorySpec SourceContext)]
mcCategories = [
      (String -> CategoryName
CategoryName String
"Category1",CategorySpec {
        csContext :: [SourceContext]
csContext = [],
        csRefines :: [ValueRefine SourceContext]
csRefines = [
          forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine [] (CategoryName -> InstanceParams -> TypeInstance
TypeInstance (String -> CategoryName
CategoryName String
"Base1") (forall a. [a] -> Positional a
Positional [])),
          forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine [] (CategoryName -> InstanceParams -> TypeInstance
TypeInstance (String -> CategoryName
CategoryName String
"Base2") (forall a. [a] -> Positional a
Positional []))
        ],
        csDefines :: [ValueDefine SourceContext]
csDefines = [
          forall c. [c] -> DefinesInstance -> ValueDefine c
ValueDefine [] (CategoryName -> InstanceParams -> DefinesInstance
DefinesInstance (String -> CategoryName
CategoryName String
"Base3") (forall a. [a] -> Positional a
Positional [])),
          forall c. [c] -> DefinesInstance -> ValueDefine c
ValueDefine [] (CategoryName -> InstanceParams -> DefinesInstance
DefinesInstance (String -> CategoryName
CategoryName String
"Base4") (forall a. [a] -> Positional a
Positional []))
        ]
      }),
      (String -> CategoryName
CategoryName String
"Category2",CategorySpec {
        csContext :: [SourceContext]
csContext = [],
        csRefines :: [ValueRefine SourceContext]
csRefines = [
          forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine [] (CategoryName -> InstanceParams -> TypeInstance
TypeInstance (String -> CategoryName
CategoryName String
"Base1") (forall a. [a] -> Positional a
Positional [])),
          forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine [] (CategoryName -> InstanceParams -> TypeInstance
TypeInstance (String -> CategoryName
CategoryName String
"Base2") (forall a. [a] -> Positional a
Positional []))
        ],
        csDefines :: [ValueDefine SourceContext]
csDefines = [
          forall c. [c] -> DefinesInstance -> ValueDefine c
ValueDefine [] (CategoryName -> InstanceParams -> DefinesInstance
DefinesInstance (String -> CategoryName
CategoryName String
"Base3") (forall a. [a] -> Positional a
Positional [])),
          forall c. [c] -> DefinesInstance -> ValueDefine c
ValueDefine [] (CategoryName -> InstanceParams -> DefinesInstance
DefinesInstance (String -> CategoryName
CategoryName String
"Base4") (forall a. [a] -> Positional a
Positional []))
        ]
      })
    ],
    mcExtraPaths :: [String]
mcExtraPaths = [
      String
"extra1",
      String
"extra2"
    ],
    mcMode :: CompileMode
mcMode = CompileIncremental {
      ciLinkFlags :: [String]
ciLinkFlags = [
        String
"-lm",
        String
"-ldl"
      ]
    }
  }

tests :: [IO (TrackedErrors ())]
tests :: [IO (TrackedErrors ())]
tests = [
    forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (TrackedErrors ())
checkWriteThenRead CompileMetadata
hugeCompileMetadata,

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad hash" forall a b. (a -> b) -> a -> b
$ CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = String -> VersionHash
VersionHash String
"bad hash",
      cmRoot :: String
cmRoot = String
"/home/project",
      cmPath :: String
cmPath = String
"/home/project/special",
      cmExtra :: [String]
cmExtra = [],
      cmPublicNamespace :: Namespace
cmPublicNamespace = Namespace
NoNamespace,
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = Namespace
NoNamespace,
      cmPublicDeps :: [String]
cmPublicDeps = [],
      cmPrivateDeps :: [String]
cmPrivateDeps = [],
      cmPublicCategories :: [CategoryName]
cmPublicCategories = [],
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [],
      cmPublicSubdirs :: [String]
cmPublicSubdirs = [],
      cmPrivateSubdirs :: [String]
cmPrivateSubdirs = [],
      cmPublicFiles :: [String]
cmPublicFiles = [],
      cmPrivateFiles :: [String]
cmPrivateFiles = [],
      cmTestFiles :: [String]
cmTestFiles = [],
      cmHxxFiles :: [String]
cmHxxFiles = [],
      cmCxxFiles :: [String]
cmCxxFiles = [],
      cmBinaries :: [String]
cmBinaries = [],
      cmLibraries :: [String]
cmLibraries = [],
      cmLinkFlags :: [String]
cmLinkFlags = [],
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad namespace" forall a b. (a -> b) -> a -> b
$ CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = String -> VersionHash
VersionHash String
"0123456789ABCDEFabcdef",
      cmRoot :: String
cmRoot = String
"/home/project",
      cmPath :: String
cmPath = String
"/home/project/special",
      cmExtra :: [String]
cmExtra = [],
      cmPublicNamespace :: Namespace
cmPublicNamespace = String -> Namespace
StaticNamespace String
"bad namespace",
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = Namespace
NoNamespace,
      cmPublicDeps :: [String]
cmPublicDeps = [],
      cmPrivateDeps :: [String]
cmPrivateDeps = [],
      cmPublicCategories :: [CategoryName]
cmPublicCategories = [],
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [],
      cmPublicSubdirs :: [String]
cmPublicSubdirs = [],
      cmPrivateSubdirs :: [String]
cmPrivateSubdirs = [],
      cmPublicFiles :: [String]
cmPublicFiles = [],
      cmPrivateFiles :: [String]
cmPrivateFiles = [],
      cmTestFiles :: [String]
cmTestFiles = [],
      cmHxxFiles :: [String]
cmHxxFiles = [],
      cmCxxFiles :: [String]
cmCxxFiles = [],
      cmBinaries :: [String]
cmBinaries = [],
      cmLibraries :: [String]
cmLibraries = [],
      cmLinkFlags :: [String]
cmLinkFlags = [],
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad namespace" forall a b. (a -> b) -> a -> b
$ CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = String -> VersionHash
VersionHash String
"0123456789ABCDEFabcdef",
      cmRoot :: String
cmRoot = String
"/home/project",
      cmPath :: String
cmPath = String
"/home/project/special",
      cmExtra :: [String]
cmExtra = [],
      cmPublicNamespace :: Namespace
cmPublicNamespace = Namespace
NoNamespace,
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = String -> Namespace
StaticNamespace String
"bad namespace",
      cmPublicDeps :: [String]
cmPublicDeps = [],
      cmPrivateDeps :: [String]
cmPrivateDeps = [],
      cmPublicCategories :: [CategoryName]
cmPublicCategories = [],
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [],
      cmPublicSubdirs :: [String]
cmPublicSubdirs = [],
      cmPrivateSubdirs :: [String]
cmPrivateSubdirs = [],
      cmPublicFiles :: [String]
cmPublicFiles = [],
      cmPrivateFiles :: [String]
cmPrivateFiles = [],
      cmTestFiles :: [String]
cmTestFiles = [],
      cmHxxFiles :: [String]
cmHxxFiles = [],
      cmCxxFiles :: [String]
cmCxxFiles = [],
      cmBinaries :: [String]
cmBinaries = [],
      cmLibraries :: [String]
cmLibraries = [],
      cmLinkFlags :: [String]
cmLinkFlags = [],
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad category" forall a b. (a -> b) -> a -> b
$ CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = String -> VersionHash
VersionHash String
"0123456789ABCDEFabcdef",
      cmRoot :: String
cmRoot = String
"/home/project",
      cmPath :: String
cmPath = String
"/home/project/special",
      cmExtra :: [String]
cmExtra = [],
      cmPublicNamespace :: Namespace
cmPublicNamespace = Namespace
NoNamespace,
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = Namespace
NoNamespace,
      cmPublicDeps :: [String]
cmPublicDeps = [],
      cmPrivateDeps :: [String]
cmPrivateDeps = [],
      cmPublicCategories :: [CategoryName]
cmPublicCategories = [
        String -> CategoryName
CategoryName String
"bad category"
      ],
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [],
      cmPublicSubdirs :: [String]
cmPublicSubdirs = [],
      cmPrivateSubdirs :: [String]
cmPrivateSubdirs = [],
      cmPublicFiles :: [String]
cmPublicFiles = [],
      cmPrivateFiles :: [String]
cmPrivateFiles = [],
      cmTestFiles :: [String]
cmTestFiles = [],
      cmHxxFiles :: [String]
cmHxxFiles = [],
      cmCxxFiles :: [String]
cmCxxFiles = [],
      cmBinaries :: [String]
cmBinaries = [],
      cmLibraries :: [String]
cmLibraries = [],
      cmLinkFlags :: [String]
cmLinkFlags = [],
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad category" forall a b. (a -> b) -> a -> b
$ CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = String -> VersionHash
VersionHash String
"0123456789ABCDEFabcdef",
      cmRoot :: String
cmRoot = String
"/home/project",
      cmPath :: String
cmPath = String
"/home/project/special",
      cmExtra :: [String]
cmExtra = [],
      cmPublicNamespace :: Namespace
cmPublicNamespace = Namespace
NoNamespace,
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = Namespace
NoNamespace,
      cmPublicDeps :: [String]
cmPublicDeps = [],
      cmPrivateDeps :: [String]
cmPrivateDeps = [],
      cmPublicCategories :: [CategoryName]
cmPublicCategories = [],
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [
        String -> CategoryName
CategoryName String
"bad category"
      ],
      cmPublicSubdirs :: [String]
cmPublicSubdirs = [],
      cmPrivateSubdirs :: [String]
cmPrivateSubdirs = [],
      cmPublicFiles :: [String]
cmPublicFiles = [],
      cmPrivateFiles :: [String]
cmPrivateFiles = [],
      cmTestFiles :: [String]
cmTestFiles = [],
      cmHxxFiles :: [String]
cmHxxFiles = [],
      cmCxxFiles :: [String]
cmCxxFiles = [],
      cmBinaries :: [String]
cmBinaries = [],
      cmLibraries :: [String]
cmLibraries = [],
      cmLinkFlags :: [String]
cmLinkFlags = [],
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = []
    },

    forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (TrackedErrors ())
checkWriteThenRead ModuleConfig
hugeModuleConfig,

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"empty.+map" forall a b. (a -> b) -> a -> b
$ ModuleConfig {
      mcRoot :: String
mcRoot = String
"/home/projects",
      mcPath :: String
mcPath = String
"special",
      mcExtra :: [String]
mcExtra = [],
      mcExprMap :: [(MacroName, Expression SourceContext)]
mcExprMap = [(String -> MacroName
MacroName String
"MACRO",forall c. ValueLiteral c -> Expression c
Literal (forall c. [c] -> String -> ValueLiteral c
StringLiteral [] String
"something"))],
      mcPublicDeps :: [String]
mcPublicDeps = [],
      mcPrivateDeps :: [String]
mcPrivateDeps = [],
      mcExtraFiles :: [ExtraSource]
mcExtraFiles = [],
      mcCategories :: [(CategoryName, CategorySpec SourceContext)]
mcCategories = [],
      mcExtraPaths :: [String]
mcExtraPaths = [],
      mcMode :: CompileMode
mcMode = CompileIncremental {
        ciLinkFlags :: [String]
ciLinkFlags = []
      }
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad category" forall a b. (a -> b) -> a -> b
$ CategorySource {
      csSource :: String
csSource = String
"extra1.cpp",
      csCategories :: [CategoryName]
csCategories = [
        String -> CategoryName
CategoryName String
"bad category"
      ],
      csRequires :: [CategoryName]
csRequires = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad category" forall a b. (a -> b) -> a -> b
$ CategorySource {
      csSource :: String
csSource = String
"extra1.cpp",
      csCategories :: [CategoryName]
csCategories = [],
      csRequires :: [CategoryName]
csRequires = [
        String -> CategoryName
CategoryName String
"bad category"
      ]
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad category" forall a b. (a -> b) -> a -> b
$ CategoryIdentifier {
      ciPath :: String
ciPath = String
"/home/project/special",
      ciCategory :: CategoryName
ciCategory = String -> CategoryName
CategoryName String
"bad category",
      ciNamespace :: Namespace
ciNamespace = Namespace
NoNamespace
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad namespace" forall a b. (a -> b) -> a -> b
$ CategoryIdentifier {
      ciPath :: String
ciPath = String
"/home/project/special",
      ciCategory :: CategoryName
ciCategory = String -> CategoryName
CategoryName String
"SpecialCategory",
      ciNamespace :: Namespace
ciNamespace = String -> Namespace
StaticNamespace String
"bad namespace"
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad category" forall a b. (a -> b) -> a -> b
$ UnresolvedCategory {
      ucCategory :: CategoryName
ucCategory = String -> CategoryName
CategoryName String
"bad category"
    },

    forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (TrackedErrors ())
checkWriteThenRead forall a b. (a -> b) -> a -> b
$ CompileBinary {
      cbCategory :: CategoryName
cbCategory = String -> CategoryName
CategoryName String
"SpecialCategory",
      cbFunction :: FunctionName
cbFunction = String -> FunctionName
FunctionName String
"specialFunction",
      cbLinker :: LinkerMode
cbLinker = LinkerMode
LinkStatic,
      cbOutputName :: String
cbOutputName = String
"binary",
      cbLinkFlags :: [String]
cbLinkFlags = []
    },

    forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (TrackedErrors ())
checkWriteThenRead forall a b. (a -> b) -> a -> b
$ CompileBinary {
      cbCategory :: CategoryName
cbCategory = String -> CategoryName
CategoryName String
"SpecialCategory",
      cbFunction :: FunctionName
cbFunction = String -> FunctionName
FunctionName String
"specialFunction",
      cbLinker :: LinkerMode
cbLinker = LinkerMode
LinkDynamic,
      cbOutputName :: String
cbOutputName = String
"binary",
      cbLinkFlags :: [String]
cbLinkFlags = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad category" forall a b. (a -> b) -> a -> b
$ CompileBinary {
      cbCategory :: CategoryName
cbCategory = String -> CategoryName
CategoryName String
"bad category",
      cbFunction :: FunctionName
cbFunction = String -> FunctionName
FunctionName String
"specialFunction",
      cbLinker :: LinkerMode
cbLinker = LinkerMode
LinkDynamic,
      cbOutputName :: String
cbOutputName = String
"binary",
      cbLinkFlags :: [String]
cbLinkFlags = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"bad function" forall a b. (a -> b) -> a -> b
$ CompileBinary {
      cbCategory :: CategoryName
cbCategory = String -> CategoryName
CategoryName String
"SpecialCategory",
      cbFunction :: FunctionName
cbFunction = String -> FunctionName
FunctionName String
"bad function",
      cbLinker :: LinkerMode
cbLinker = LinkerMode
LinkDynamic,
      cbOutputName :: String
cbOutputName = String
"binary",
      cbLinkFlags :: [String]
cbLinkFlags = []
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"compile mode" forall a b. (a -> b) -> a -> b
$ CompileFast {
      cfCategory :: CategoryName
cfCategory = String -> CategoryName
CategoryName String
"SpecialCategory",
      cfFunction :: FunctionName
cfFunction = String -> FunctionName
FunctionName String
"specialFunction",
      cfSource :: String
cfSource = String
"source.0rx"
    },

    forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (TrackedErrors ())
checkWriteThenRead forall a b. (a -> b) -> a -> b
$ CompileIncremental {
      ciLinkFlags :: [String]
ciLinkFlags = [
        String
"-lm",
        String
"-ldl"
      ]
    },

    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"compile mode" forall a b. (a -> b) -> a -> b
$ ExecuteTests { etInclude :: [String]
etInclude = [], etCallLog :: Maybe String
etCallLog = forall a. Maybe a
Nothing },
    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"compile mode" forall a b. (a -> b) -> a -> b
$ CompileMode
CompileRecompile,
    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"compile mode" forall a b. (a -> b) -> a -> b
$ CompileMode
CompileRecompileRecursive,
    forall a. ConfigFormat a => String -> a -> IO (TrackedErrors ())
checkWriteFail String
"compile mode" forall a b. (a -> b) -> a -> b
$ CompileMode
CreateTemplates,

    forall a.
(Show a, ConfigFormat a) =>
String -> (a -> Bool) -> IO (TrackedErrors ())
checkParsesAs (String
"testfiles" String -> String -> String
</> String
"macro-config.txt")
      (\ModuleConfig
m -> case ModuleConfig -> [(MacroName, Expression SourceContext)]
mcExprMap ModuleConfig
m of
                  [(MacroName String
"MY_MACRO",
                    Expression [SourceContext]
_ (BuiltinCall [SourceContext]
_
                      (FunctionCall [SourceContext]
_ FunctionName
BuiltinRequire (Positional [])
                        (Positional [(Maybe (CallArgLabel SourceContext)
Nothing,Expression [SourceContext]
_ (UnambiguousLiteral (EmptyLiteral [SourceContext]
_)) [])]))) []),
                   (MacroName String
"MY_OTHER_MACRO",
                    Expression [SourceContext]
_
                      (TypeCall [SourceContext]
_ TypeInstanceOrParam
_
                        (FunctionCall [SourceContext]
_ (FunctionName String
"execute") (Positional [])
                        (Positional [(Maybe (CallArgLabel SourceContext)
Nothing,Expression [SourceContext]
_ (UnambiguousLiteral (StringLiteral [SourceContext]
_ String
"this is a string\n")) [])]))) [])
                    ] -> Bool
True
                  [(MacroName, Expression SourceContext)]
_ -> Bool
False),

    forall a.
(Show a, ConfigFormat a) =>
String -> (a -> Bool) -> IO (TrackedErrors ())
checkParsesAs (String
"testfiles" String -> String -> String
</> String
"module-config.txt") (forall a. Eq a => a -> a -> Bool
== ModuleConfig
hugeModuleConfig),

    forall a.
(Show a, ConfigFormat a) =>
String -> (a -> Bool) -> IO (TrackedErrors ())
checkParsesAs (String
"testfiles" String -> String -> String
</> String
"module-cache.txt") (forall a. Eq a => a -> a -> Bool
== CompileMetadata
hugeCompileMetadata)
  ]

checkParsesAs :: (Show a, ConfigFormat a) => String -> (a -> Bool) -> IO (TrackedErrors ())
checkParsesAs :: forall a.
(Show a, ConfigFormat a) =>
String -> (a -> Bool) -> IO (TrackedErrors ())
checkParsesAs String
f a -> Bool
m = do
  String
contents <- String -> IO String
loadFile String
f
  let parsed :: TrackedErrorsT Identity a
parsed = forall a (m :: * -> *).
(ConfigFormat a, ErrorContextM m) =>
String -> String -> m a
autoReadConfig String
f String
contents
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. ErrorContextM m => m a -> String -> m ()
check TrackedErrorsT Identity a
parsed String
contents
  where
    check :: m a -> String -> m ()
check m a
x String
contents = do
      a
x' <- m a
x forall (m :: * -> *) a. ErrorContextM m => m a -> String -> m a
<!! String
"While parsing " forall a. [a] -> [a] -> [a]
++ String
f
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ a -> Bool
m a
x') forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Failed to match after write/read\n" forall a. [a] -> [a] -> [a]
++
                       String
"Unparsed:\n" forall a. [a] -> [a] -> [a]
++ String
contents forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++
                       String
"Parsed:\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x' forall a. [a] -> [a] -> [a]
++ String
"\n"