{- -----------------------------------------------------------------------------
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.ParseMetadata (tests) where

import Control.Monad (when)
import Text.Regex.TDFA -- Not safe!

import Base.CompileError
import Base.CompileInfo
import Cli.CompileOptions
import Cli.Programs (VersionHash(..))
import Module.CompileMetadata
import Module.ParseMetadata
import System.FilePath
import Test.Common
import Types.Positional
import Types.Procedure
import Types.TypeCategory (FunctionName(..),Namespace(..))
import Types.TypeInstance (CategoryName(..))

tests :: [IO (CompileInfo ())]
tests :: [IO (CompileInfo ())]
tests = [
    CompileMetadata -> IO (CompileInfo ())
forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (CompileInfo ())
checkWriteThenRead (CompileMetadata -> IO (CompileInfo ()))
-> CompileMetadata -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileMetadata :: VersionHash
-> FilePath
-> Namespace
-> Namespace
-> [FilePath]
-> [FilePath]
-> [CategoryName]
-> [CategoryName]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [ObjectFile]
-> CompileMetadata
CompileMetadata {
      cmVersionHash :: VersionHash
cmVersionHash = FilePath -> VersionHash
VersionHash FilePath
"0123456789ABCDEFabcdef",
      cmPath :: FilePath
cmPath = FilePath
"/home/project/special",
      cmPublicNamespace :: Namespace
cmPublicNamespace = FilePath -> Namespace
StaticNamespace FilePath
"public_ABCDEF",
      cmPrivateNamespace :: Namespace
cmPrivateNamespace = FilePath -> Namespace
StaticNamespace FilePath
"private_ABCDEF",
      cmPublicDeps :: [FilePath]
cmPublicDeps = [
        FilePath
"/home/project/public-dep1",
        FilePath
"/home/project/public-dep2"
      ],
      cmPrivateDeps :: [FilePath]
cmPrivateDeps = [
        FilePath
"/home/project/private-dep1",
        FilePath
"/home/project/private-dep2"
      ],
      cmPublicCategories :: [CategoryName]
cmPublicCategories = [
        FilePath -> CategoryName
CategoryName FilePath
"MyCategory",
        FilePath -> CategoryName
CategoryName FilePath
"MyOtherCategory"
      ],
      cmPrivateCategories :: [CategoryName]
cmPrivateCategories = [
        FilePath -> CategoryName
CategoryName FilePath
"PrivateCategory",
        FilePath -> CategoryName
CategoryName FilePath
"PrivateOtherCategory"
      ],
      cmPublicSubdirs :: [FilePath]
cmPublicSubdirs = [
        FilePath
"/home/project/special/subdir1",
        FilePath
"/home/project/special/subdir2"
      ],
      cmPrivateSubdirs :: [FilePath]
cmPrivateSubdirs = [
        FilePath
"/home/project/special/subdir1",
        FilePath
"/home/project/special/subdir2"
      ],
      cmPublicFiles :: [FilePath]
cmPublicFiles = [
        FilePath
"/home/project/special/category1.0rp",
        FilePath
"/home/project/special/category2.0rp"
      ],
      cmPrivateFiles :: [FilePath]
cmPrivateFiles = [
        FilePath
"/home/project/special/category1.0rx",
        FilePath
"/home/project/special/category2.0rx"
      ],
      cmTestFiles :: [FilePath]
cmTestFiles = [
        FilePath
"/home/project/special/category1.0rt",
        FilePath
"/home/project/special/category2.0rt"
      ],
      cmHxxFiles :: [FilePath]
cmHxxFiles = [
        FilePath
"/home/project/special/category1.hpp",
        FilePath
"/home/project/special/category2.hpp"
      ],
      cmCxxFiles :: [FilePath]
cmCxxFiles = [
        FilePath
"/home/project/special/category1.cpp",
        FilePath
"/home/project/special/category2.cpp"
      ],
      cmBinaries :: [FilePath]
cmBinaries = [
        FilePath
"/home/project/special/binary1",
        FilePath
"/home/project/special/binary2"
      ],
      cmLinkFlags :: [FilePath]
cmLinkFlags = [
        FilePath
"-lm",
        FilePath
"-ldl"
      ],
      cmObjectFiles :: [ObjectFile]
cmObjectFiles = [
        CategoryObjectFile :: CategoryIdentifier
-> [CategoryIdentifier] -> [FilePath] -> ObjectFile
CategoryObjectFile {
          cofCategory :: CategoryIdentifier
cofCategory = CategoryIdentifier :: FilePath -> CategoryName -> Namespace -> CategoryIdentifier
CategoryIdentifier {
            ciPath :: FilePath
ciPath = FilePath
"/home/project/special",
            ciCategory :: CategoryName
ciCategory = FilePath -> CategoryName
CategoryName FilePath
"SpecialCategory",
            ciNamespace :: Namespace
ciNamespace = FilePath -> Namespace
StaticNamespace FilePath
"public_ABCDEF"
          },
          cofRequires :: [CategoryIdentifier]
cofRequires = [
            CategoryIdentifier :: FilePath -> CategoryName -> Namespace -> CategoryIdentifier
CategoryIdentifier {
              ciPath :: FilePath
ciPath = FilePath
"/home/project/private-dep1",
              ciCategory :: CategoryName
ciCategory = FilePath -> CategoryName
CategoryName FilePath
"PrivateCategory",
              ciNamespace :: Namespace
ciNamespace = Namespace
NoNamespace
            },
            UnresolvedCategory :: CategoryName -> CategoryIdentifier
UnresolvedCategory {
              ucCategory :: CategoryName
ucCategory = FilePath -> CategoryName
CategoryName FilePath
"UnresolvedCategory"
            }
          ],
          cofFiles :: [FilePath]
cofFiles = [
            FilePath
"/home/project/special/object1.o",
            FilePath
"/home/project/special/object1.o"
          ]
        }
      ]
    },

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

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

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

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

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

    ModuleConfig -> IO (CompileInfo ())
forall a.
(Eq a, Show a, ConfigFormat a) =>
a -> IO (CompileInfo ())
checkWriteThenRead (ModuleConfig -> IO (CompileInfo ()))
-> ModuleConfig -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ ModuleConfig :: FilePath
-> FilePath
-> [(FilePath, Expression SourcePos)]
-> [FilePath]
-> [FilePath]
-> [ExtraSource]
-> [FilePath]
-> CompileMode
-> ModuleConfig
ModuleConfig {
      mcRoot :: FilePath
mcRoot = FilePath
"/home/projects",
      mcPath :: FilePath
mcPath = FilePath
"special",
      mcExprMap :: [(FilePath, Expression SourcePos)]
mcExprMap = [],
      mcPublicDeps :: [FilePath]
mcPublicDeps = [
        FilePath
"/home/project/public-dep1",
        FilePath
"/home/project/public-dep2"
      ],
      mcPrivateDeps :: [FilePath]
mcPrivateDeps = [
        FilePath
"/home/project/private-dep1",
        FilePath
"/home/project/private-dep2"
      ],
      mcExtraFiles :: [ExtraSource]
mcExtraFiles = [
        CategorySource :: FilePath -> [CategoryName] -> [CategoryName] -> ExtraSource
CategorySource {
          csSource :: FilePath
csSource = FilePath
"extra1.cpp",
          csCategories :: [CategoryName]
csCategories = [
            FilePath -> CategoryName
CategoryName FilePath
"Category1",
            FilePath -> CategoryName
CategoryName FilePath
"Category2"
          ],
          csRequires :: [CategoryName]
csRequires = [
            FilePath -> CategoryName
CategoryName FilePath
"DepCategory1",
            FilePath -> CategoryName
CategoryName FilePath
"DepCategory2"
          ]
        },
        OtherSource :: FilePath -> ExtraSource
OtherSource {
          osSource :: FilePath
osSource = FilePath
"extra2.cpp"
        }
      ],
      mcExtraPaths :: [FilePath]
mcExtraPaths = [
        FilePath
"extra1",
        FilePath
"extra2"
      ],
      mcMode :: CompileMode
mcMode = CompileIncremental :: [FilePath] -> CompileMode
CompileIncremental {
        ciLinkFlags :: [FilePath]
ciLinkFlags = [
          FilePath
"-lm",
          FilePath
"-ldl"
        ]
      }
    },

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

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

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

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

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

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

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

    FilePath -> CompileMode -> IO (CompileInfo ())
forall a. ConfigFormat a => FilePath -> a -> IO (CompileInfo ())
checkWriteFail FilePath
"bad category" (CompileMode -> IO (CompileInfo ()))
-> CompileMode -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileBinary :: CategoryName
-> FunctionName -> FilePath -> [FilePath] -> CompileMode
CompileBinary {
      cbCategory :: CategoryName
cbCategory = FilePath -> CategoryName
CategoryName FilePath
"bad category",
      cbFunction :: FunctionName
cbFunction = FilePath -> FunctionName
FunctionName FilePath
"specialFunction",
      cbOutputName :: FilePath
cbOutputName = FilePath
"binary",
      cbLinkFlags :: [FilePath]
cbLinkFlags = []
    },

    FilePath -> CompileMode -> IO (CompileInfo ())
forall a. ConfigFormat a => FilePath -> a -> IO (CompileInfo ())
checkWriteFail FilePath
"bad function" (CompileMode -> IO (CompileInfo ()))
-> CompileMode -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileBinary :: CategoryName
-> FunctionName -> FilePath -> [FilePath] -> CompileMode
CompileBinary {
      cbCategory :: CategoryName
cbCategory = FilePath -> CategoryName
CategoryName FilePath
"SpecialCategory",
      cbFunction :: FunctionName
cbFunction = FilePath -> FunctionName
FunctionName FilePath
"bad function",
      cbOutputName :: FilePath
cbOutputName = FilePath
"binary",
      cbLinkFlags :: [FilePath]
cbLinkFlags = []
    },

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

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

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

    FilePath -> (ModuleConfig -> Bool) -> IO (CompileInfo ())
forall a.
(Show a, ConfigFormat a) =>
FilePath -> (a -> Bool) -> IO (CompileInfo ())
checkParsesAs (FilePath
"testfiles" FilePath -> FilePath -> FilePath
</> FilePath
"module-config.txt")
      (\ModuleConfig
m -> case ModuleConfig -> [(FilePath, Expression SourcePos)]
mcExprMap ModuleConfig
m of
                  [(FilePath
"MY_MACRO",
                    Expression [SourcePos]
_ (BuiltinCall [SourcePos]
_
                      (FunctionCall [SourcePos]
_ FunctionName
BuiltinRequire (Positional [])
                        (Positional [Literal (EmptyLiteral [SourcePos]
_)]))) []),
                   (FilePath
"MY_OTHER_MACRO",
                    Expression [SourcePos]
_
                      (TypeCall [SourcePos]
_ TypeInstanceOrParam
_
                        (FunctionCall [SourcePos]
_ (FunctionName FilePath
"execute") (Positional [])
                          (Positional [Literal (StringLiteral [SourcePos]
_ FilePath
"this is a string\n")]))) [])
                    ] -> Bool
True
                  [(FilePath, Expression SourcePos)]
_ -> Bool
False)
  ]

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

checkWriteFail :: ConfigFormat a => String -> a -> IO (CompileInfo ())
checkWriteFail :: FilePath -> a -> IO (CompileInfo ())
checkWriteFail FilePath
p a
m = CompileInfo () -> IO (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> IO (CompileInfo ()))
-> CompileInfo () -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ do
  let m' :: CompileInfoT Identity FilePath
m' = a -> CompileInfoT Identity FilePath
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
a -> m FilePath
autoWriteConfig a
m
  CompileInfoT Identity FilePath -> CompileInfo ()
forall (f :: * -> *).
CompileErrorM f =>
CompileInfoT Identity FilePath -> f ()
check CompileInfoT Identity FilePath
m'
  where
    check :: CompileInfoT Identity FilePath -> f ()
check CompileInfoT Identity FilePath
c
      | CompileInfoT Identity FilePath -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfoT Identity FilePath
c = do
          let text :: FilePath
text = CompileMessage -> FilePath
forall a. Show a => a -> FilePath
show (CompileInfoT Identity FilePath -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileError CompileInfoT Identity FilePath
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
$ FilePath
text FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
p) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
            FilePath -> f ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> f ()) -> FilePath -> f ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Expected pattern " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in error output but got\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
text
      | Bool
otherwise =
          FilePath -> f ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> f ()) -> FilePath -> f ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Expected write failure but got\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CompileInfoT Identity FilePath -> FilePath
forall a. CompileInfo a -> a
getCompileSuccess CompileInfoT Identity FilePath
c

checkParsesAs :: (Show a, ConfigFormat a) => String -> (a -> Bool) -> IO (CompileInfo ())
checkParsesAs :: FilePath -> (a -> Bool) -> IO (CompileInfo ())
checkParsesAs FilePath
f a -> Bool
m = do
  FilePath
contents <- FilePath -> IO FilePath
loadFile FilePath
f
  let parsed :: CompileInfoT Identity a
parsed = FilePath -> FilePath -> CompileInfoT Identity a
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
FilePath -> FilePath -> m a
autoReadConfig FilePath
f FilePath
contents
  CompileInfo () -> IO (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> IO (CompileInfo ()))
-> CompileInfo () -> IO (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ CompileInfoT Identity a -> FilePath -> CompileInfo ()
forall (m :: * -> *). CompileErrorM m => m a -> FilePath -> m ()
check CompileInfoT Identity a
parsed FilePath
contents
  where
    check :: m a -> FilePath -> m ()
check m a
x FilePath
contents = do
      a
x' <- m a
x m a -> FilePath -> m a
forall (m :: * -> *) a. CompileErrorM m => m a -> FilePath -> m a
<!! (FilePath
"While parsing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f)
      Bool -> m () -> m ()
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
x') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> m ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to match after write/read\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                       FilePath
"Unparsed:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
contents FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                       FilePath
"Parsed:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
x' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"