{- -----------------------------------------------------------------------------
Copyright 2020-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]

{-# LANGUAGE FlexibleInstances #-}

module Module.ParseMetadata (
  ConfigFormat(..),
  autoReadConfig,
  autoWriteConfig,
  indent,
  indents,
  parseList,
  parseOptional,
  parseQuoted,
  parseRequired,
  prependFirst,
  structClose,
  structOpen,
) where

import Control.Applicative.Permutations
import Control.Monad (when)

import Base.CompilerError
import Cli.CompileOptions
import Cli.Programs (VersionHash(..))
import Module.CompileMetadata
import Parser.Common
import Parser.Procedure ()
import Parser.TextParser
import Parser.TypeCategory ()
import Parser.TypeInstance ()
import Text.Regex.TDFA
import Types.Procedure (Expression,MacroName)
import Types.TypeCategory
import Types.TypeInstance (CategoryName(..))


class ConfigFormat a where
  readConfig :: TextParser a
  writeConfig :: CollectErrorsM m => a -> m [String]

autoReadConfig :: (ConfigFormat a, ErrorContextM m) => String -> String -> m a
autoReadConfig :: forall a (m :: * -> *).
(ConfigFormat a, ErrorContextM m) =>
String -> String -> m a
autoReadConfig String
f String
s = forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> String -> String -> m a
runTextParser (forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
optionalSpace TextParser ()
endOfDoc forall a. ConfigFormat a => TextParser a
readConfig) String
f String
s

autoWriteConfig ::  (ConfigFormat a, CollectErrorsM m) => a -> m String
autoWriteConfig :: forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m String
autoWriteConfig = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig

structOpen :: TextParser ()
structOpen :: TextParser ()
structOpen = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"{")

structClose :: TextParser ()
structClose :: TextParser ()
structClose = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"}")

indents :: [String] -> [String]
indents :: [String] -> [String]
indents = forall a b. (a -> b) -> [a] -> [b]
map String -> String
indent

indent :: String -> String
indent :: String -> String
indent = (String
"  " forall a. [a] -> [a] -> [a]
++)

prependFirst :: String -> [String] -> [String]
prependFirst :: String -> [String] -> [String]
prependFirst String
s0 (String
s:[String]
ss) = (String
s0 forall a. [a] -> [a] -> [a]
++ String
s)forall a. a -> [a] -> [a]
:[String]
ss
prependFirst String
s0 [String]
_      = [String
s0]

validateCategoryName :: ErrorContextM m => CategoryName -> m ()
validateCategoryName :: forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName CategoryName
c =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CategoryName
c forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[A-Z][A-Za-z0-9]*$") forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Invalid category name: \"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
c forall a. [a] -> [a] -> [a]
++ String
"\""

validateFunctionName :: ErrorContextM m => FunctionName -> m ()
validateFunctionName :: forall (m :: * -> *). ErrorContextM m => FunctionName -> m ()
validateFunctionName FunctionName
f =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show FunctionName
f forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[a-z][A-Za-z0-9]*$") forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Invalid function name: \"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FunctionName
f forall a. [a] -> [a] -> [a]
++ String
"\""

validateHash :: ErrorContextM m => VersionHash -> m ()
validateHash :: forall (m :: * -> *). ErrorContextM m => VersionHash -> m ()
validateHash VersionHash
h =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show VersionHash
h forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[A-Za-z0-9]+$") forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Version hash must be a hex string: \"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show VersionHash
h forall a. [a] -> [a] -> [a]
++ String
"\""

parseHash :: TextParser VersionHash
parseHash :: TextParser VersionHash
parseHash = forall a. String -> TextParser a -> TextParser a
labeled String
"version hash" forall a b. (a -> b) -> a -> b
$ forall a. TextParser a -> TextParser a
sepAfter (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> VersionHash
VersionHash forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar)

maybeShowNamespace :: ErrorContextM m => String -> Namespace -> m [String]
maybeShowNamespace :: forall (m :: * -> *).
ErrorContextM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
l (StaticNamespace String
ns) = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String
ns forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[A-Za-z][A-Za-z0-9_]*$") forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM forall a b. (a -> b) -> a -> b
$ String
"Invalid category namespace: \"" forall a. [a] -> [a] -> [a]
++ String
ns forall a. [a] -> [a] -> [a]
++ String
"\""
  forall (m :: * -> *) a. Monad m => a -> m a
return [String
l forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
ns]
maybeShowNamespace String
_ Namespace
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []

parseNamespace :: TextParser Namespace
parseNamespace :: TextParser Namespace
parseNamespace = forall a. String -> TextParser a -> TextParser a
labeled String
"namespace" forall a b. (a -> b) -> a -> b
$ do
  Char
b <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
  String
e <- forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Namespace
StaticNamespace (Char
bforall a. a -> [a] -> [a]
:String
e)

parseQuoted :: TextParser String
parseQuoted :: TextParser String
parseQuoted = forall a. String -> TextParser a -> TextParser a
labeled String
"quoted string" forall a b. (a -> b) -> a -> b
$ do
  String -> TextParser ()
string_ String
"\""
  String
ss <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CompilerMessage String Identity Char
stringChar (String -> TextParser ()
string_ String
"\"")
  TextParser ()
optionalSpace
  forall (m :: * -> *) a. Monad m => a -> m a
return String
ss

parseList :: TextParser a -> TextParser [a]
parseList :: forall a. TextParser a -> TextParser [a]
parseList TextParser a
p = forall a. String -> TextParser a -> TextParser a
labeled String
"list" forall a b. (a -> b) -> a -> b
$ do
  forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"[")
  [a]
xs <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (forall a. TextParser a -> TextParser a
sepAfter TextParser a
p) (String -> TextParser ()
string_ String
"]")
  TextParser ()
optionalSpace
  forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs

parseOptional :: String -> a -> TextParser a -> Permutation (TextParser) a
parseOptional :: forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
l a
def TextParser a
p = forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault a
def forall a b. (a -> b) -> a -> b
$ do
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
l)
    TextParser a
p

parseRequired :: String -> TextParser a -> Permutation (TextParser) a
parseRequired :: forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
l TextParser a
p = forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation forall a b. (a -> b) -> a -> b
$ do
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
l)
    TextParser a
p

instance ConfigFormat CompileMetadata where
  readConfig :: TextParser CompileMetadata
readConfig = forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ VersionHash
-> String
-> String
-> [String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata
CompileMetadata
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"version_hash:"       TextParser VersionHash
parseHash
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"root:"               TextParser String
parseQuoted
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"path:"               TextParser String
parseQuoted
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extra_paths:"        [] (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"public_namespace:"   Namespace
NoNamespace TextParser Namespace
parseNamespace
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"private_namespace:"  Namespace
NoNamespace TextParser Namespace
parseNamespace
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_deps:"        (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_deps:"       (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_categories:"  (forall a. TextParser a -> TextParser [a]
parseList forall a. ParseFromSource a => TextParser a
sourceParser)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_categories:" (forall a. TextParser a -> TextParser [a]
parseList forall a. ParseFromSource a => TextParser a
sourceParser)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_subdirs:"     (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_subdirs:"    (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_files:"       (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_files:"      (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"test_files:"         (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"hxx_files:"          (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"cxx_files:"          (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"binaries:"           (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"libraries:"          (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"link_flags:"         (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"object_files:"       (forall a. TextParser a -> TextParser [a]
parseList forall a. ConfigFormat a => TextParser a
readConfig)
  writeConfig :: forall (m :: * -> *).
CollectErrorsM m =>
CompileMetadata -> m [String]
writeConfig (CompileMetadata VersionHash
h String
p String
d [String]
ee Namespace
ns1 Namespace
ns2 [String]
is [String]
is2 [CategoryName]
cs1 [CategoryName]
cs2 [String]
ds1 [String]
ds2 [String]
ps [String]
xs [String]
ts [String]
hxx [String]
cxx [String]
bs [String]
ls [String]
lf [ObjectFile]
os) = do
    forall (m :: * -> *). ErrorContextM m => VersionHash -> m ()
validateHash VersionHash
h
    [String]
ns1' <- forall (m :: * -> *).
ErrorContextM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"public_namespace:"  Namespace
ns1
    [String]
ns2' <- forall (m :: * -> *).
ErrorContextM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"private_namespace:" Namespace
ns2
    forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs1
    forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs2
    [String]
os' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig [ObjectFile]
os
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"version_hash: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show VersionHash
h,
        String
"root: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
p,
        String
"path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
d
      ] forall a. [a] -> [a] -> [a]
++ [String]
ns1' forall a. [a] -> [a] -> [a]
++ [String]
ns2' forall a. [a] -> [a] -> [a]
++ [
        String
"extra_paths: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ee) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"public_deps: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
is) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"private_deps: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
is2) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"public_categories: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [CategoryName]
cs1) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"private_categories: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [CategoryName]
cs2) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"public_subdirs: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ds1) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"private_subdirs: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ds2) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"public_files: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ps) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"private_files: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
xs) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"test_files: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ts) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"hxx_files: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
hxx) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"cxx_files: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
cxx) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"binaries: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
bs) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"libraries: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ls) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"link_flags: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
lf) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"object_files: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
os' forall a. [a] -> [a] -> [a]
++ [
        String
"]"
      ]

instance ConfigFormat ObjectFile where
  readConfig :: TextParser ObjectFile
readConfig = TextParser ObjectFile
category forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ObjectFile
other where
    category :: TextParser ObjectFile
category = do
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"category_object")
      TextParser ()
structOpen
      ObjectFile
o <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ CategoryIdentifier
-> [CategoryIdentifier] -> [String] -> ObjectFile
CategoryObjectFile
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"category:" forall a. ConfigFormat a => TextParser a
readConfig
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"requires:" (forall a. TextParser a -> TextParser [a]
parseList forall a. ConfigFormat a => TextParser a
readConfig)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"files:"    (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      TextParser ()
structClose
      forall (m :: * -> *) a. Monad m => a -> m a
return ObjectFile
o
    other :: TextParser ObjectFile
other = do
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"other_object")
      TextParser ()
structOpen
      ObjectFile
f <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ String -> ObjectFile
OtherObjectFile
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"file:" TextParser String
parseQuoted
      TextParser ()
structClose
      forall (m :: * -> *) a. Monad m => a -> m a
return ObjectFile
f
  writeConfig :: forall (m :: * -> *). CollectErrorsM m => ObjectFile -> m [String]
writeConfig (CategoryObjectFile CategoryIdentifier
c [CategoryIdentifier]
rs [String]
fs) = do
    [String]
category <- forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig CategoryIdentifier
c
    [String]
requires <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig [CategoryIdentifier]
rs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"category_object {"
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (String
"category: " String -> [String] -> [String]
`prependFirst` [String]
category) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"requires: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) [String]
requires forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"files: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
fs) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String
"}"
      ]
  writeConfig (OtherObjectFile String
f) = do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"other_object {",
        String -> String
indent (String
"file: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
f),
        String
"}"
      ]

instance ConfigFormat CategoryIdentifier where
  readConfig :: TextParser CategoryIdentifier
readConfig = TextParser CategoryIdentifier
category forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser CategoryIdentifier
unresolved where
    category :: TextParser CategoryIdentifier
category = do
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"category")
      TextParser ()
structOpen
      CategoryIdentifier
i <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ String -> CategoryName -> Namespace -> CategoryIdentifier
CategoryIdentifier
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"path:"      TextParser String
parseQuoted
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:"      forall a. ParseFromSource a => TextParser a
sourceParser
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"namespace:" Namespace
NoNamespace TextParser Namespace
parseNamespace
      TextParser ()
structClose
      forall (m :: * -> *) a. Monad m => a -> m a
return CategoryIdentifier
i
    unresolved :: TextParser CategoryIdentifier
unresolved = do
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"unresolved")
      TextParser ()
structOpen
      CategoryIdentifier
c <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ CategoryName -> CategoryIdentifier
UnresolvedCategory
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:" forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
structClose
      forall (m :: * -> *) a. Monad m => a -> m a
return CategoryIdentifier
c
  writeConfig :: forall (m :: * -> *).
CollectErrorsM m =>
CategoryIdentifier -> m [String]
writeConfig (CategoryIdentifier String
p CategoryName
c Namespace
ns) = do
    forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName CategoryName
c
    [String]
namespace <- forall (m :: * -> *).
ErrorContextM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"namespace:" Namespace
ns
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"category {",
        String -> String
indent forall a b. (a -> b) -> a -> b
$ String
"name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
c
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
namespace forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent forall a b. (a -> b) -> a -> b
$ String
"path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
p,
        String
"}"
      ]
  writeConfig (UnresolvedCategory CategoryName
c) = do
    forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName CategoryName
c
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String
"unresolved { " forall a. [a] -> [a] -> [a]
++ String
"name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
c forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
"}"]

instance ConfigFormat ModuleConfig where
  readConfig :: TextParser ModuleConfig
readConfig = forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ String
-> String
-> [String]
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig
ModuleConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"root:"            String
"" TextParser String
parseQuoted
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"path:"               TextParser String
parseQuoted
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extra_paths:"     [] (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"expression_map:"  [] (forall a. TextParser a -> TextParser [a]
parseList TextParser (MacroName, Expression SourceContext)
parseExprMacro)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"public_deps:"     [] (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"private_deps:"    [] (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extra_files:"     [] (forall a. TextParser a -> TextParser [a]
parseList forall a. ConfigFormat a => TextParser a
readConfig)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extension_specs:" [] (forall a. TextParser a -> TextParser [a]
parseList forall a. ConfigFormat a => TextParser a
readConfig)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"include_paths:"   [] (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"mode:"               forall a. ConfigFormat a => TextParser a
readConfig
  writeConfig :: forall (m :: * -> *).
CollectErrorsM m =>
ModuleConfig -> m [String]
writeConfig (ModuleConfig String
p String
d [String]
ee [(MacroName, Expression SourceContext)]
em [String]
is [String]
is2 [ExtraSource]
es [(CategoryName, CategorySpec SourceContext)]
cs [String]
ep CompileMode
m) = do
    [String]
es' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig [ExtraSource]
es
    [String]
m' <- forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig CompileMode
m
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(MacroName, Expression SourceContext)]
em) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Only empty expression maps are allowed when writing"
    [String]
cs' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig [(CategoryName, CategorySpec SourceContext)]
cs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"root: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
p,
        String
"path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
d,
        String
"extra_paths: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ee) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"expression_map: [",
        -- NOTE: expression_map isn't output because that would require making
        -- all Expression serializable.
        String
"]",
        String
"public_deps: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
is) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"private_deps: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
is2) forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"extra_files: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
es' forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"extension_specs: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
cs' forall a. [a] -> [a] -> [a]
++ [
        String
"]",
        String
"include_paths: ["
      ] forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ep) forall a. [a] -> [a] -> [a]
++ [
        String
"]"
      ] forall a. [a] -> [a] -> [a]
++ String
"mode: " String -> [String] -> [String]
`prependFirst` [String]
m'

instance ConfigFormat ExtraSource where
  readConfig :: TextParser ExtraSource
readConfig = TextParser ExtraSource
category forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ExtraSource
other where
    category :: TextParser ExtraSource
category = do
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"category_source")
      TextParser ()
structOpen
      ExtraSource
s <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ String -> [CategoryName] -> [CategoryName] -> ExtraSource
CategorySource
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"source:"        TextParser String
parseQuoted
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"categories:" [] (forall a. TextParser a -> TextParser [a]
parseList forall a. ParseFromSource a => TextParser a
sourceParser)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"requires:"   [] (forall a. TextParser a -> TextParser [a]
parseList forall a. ParseFromSource a => TextParser a
sourceParser)
      TextParser ()
structClose
      forall (m :: * -> *) a. Monad m => a -> m a
return ExtraSource
s
    other :: TextParser ExtraSource
other = do
      String
f <- TextParser String
parseQuoted
      forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ExtraSource
OtherSource String
f)
  writeConfig :: forall (m :: * -> *). CollectErrorsM m => ExtraSource -> m [String]
writeConfig (CategorySource String
f [CategoryName]
cs [CategoryName]
ds) = do
    forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs
    forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
ds
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"category_source {",
        String -> String
indent (String
"source: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
f),
        String -> String
indent String
"categories: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show) [CategoryName]
cs forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"requires: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show) [CategoryName]
ds forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String
"}"
      ]
  writeConfig (OtherSource String
f) = forall (m :: * -> *) a. Monad m => a -> m a
return [forall a. Show a => a -> String
show String
f]

instance ConfigFormat (CategoryName,CategorySpec SourceContext) where
  readConfig :: TextParser (CategoryName, CategorySpec SourceContext)
readConfig = do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"category")
    TextParser ()
structOpen
    (CategoryName, CategorySpec SourceContext)
s <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ (\CategoryName
n [ValueRefine SourceContext]
rs [ValueDefine SourceContext]
ds -> (CategoryName
n,forall c.
[c] -> [ValueRefine c] -> [ValueDefine c] -> CategorySpec c
CategorySpec [SourceContext
c] [ValueRefine SourceContext]
rs [ValueDefine SourceContext]
ds))
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:"       forall a. ParseFromSource a => TextParser a
sourceParser
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"refines:" [] (forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity (ValueRefine SourceContext)
parseRefine)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"defines:" [] (forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity (ValueDefine SourceContext)
parseDefine)
    TextParser ()
structClose
    forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryName, CategorySpec SourceContext)
s where
      parseRefine :: ParsecT CompilerMessage String Identity (ValueRefine SourceContext)
parseRefine = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        TypeInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine [SourceContext
c] TypeInstance
t
      parseDefine :: ParsecT CompilerMessage String Identity (ValueDefine SourceContext)
parseDefine = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        DefinesInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> DefinesInstance -> ValueDefine c
ValueDefine [SourceContext
c] DefinesInstance
t
  writeConfig :: forall (m :: * -> *).
CollectErrorsM m =>
(CategoryName, CategorySpec SourceContext) -> m [String]
writeConfig (CategoryName
n,CategorySpec [SourceContext]
_ [ValueRefine SourceContext]
rs [ValueDefine SourceContext]
ds) = do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"category {",
        String -> String
indent (String
"name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n),
        String -> String
indent String
"refines: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ValueRefine c -> TypeInstance
vrType)) [ValueRefine SourceContext]
rs forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"defines: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ValueDefine c -> DefinesInstance
vdType)) [ValueDefine SourceContext]
ds forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String
"}"
      ]

instance ConfigFormat CompileMode where
  readConfig :: TextParser CompileMode
readConfig = forall a. String -> TextParser a -> TextParser a
labeled String
"compile mode" forall a b. (a -> b) -> a -> b
$ TextParser CompileMode
binary forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser CompileMode
incremental where
    binary :: TextParser CompileMode
binary = do
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"binary")
      TextParser ()
structOpen
      CompileMode
b <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ CategoryName
-> FunctionName -> LinkerMode -> String -> [String] -> CompileMode
CompileBinary
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"category:"               forall a. ParseFromSource a => TextParser a
sourceParser
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"function:"               forall a. ParseFromSource a => TextParser a
sourceParser
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"link_mode:"  LinkerMode
LinkDynamic TextParser LinkerMode
parseLinkerMode
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"output:"     String
""          TextParser String
parseQuoted
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"link_flags:" []          (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      TextParser ()
structClose
      forall (m :: * -> *) a. Monad m => a -> m a
return CompileMode
b
    incremental :: TextParser CompileMode
incremental = do
      forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"incremental")
      TextParser ()
structOpen
      CompileMode
lf <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ [String] -> CompileMode
CompileIncremental
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"link_flags:" [] (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      TextParser ()
structClose
      forall (m :: * -> *) a. Monad m => a -> m a
return CompileMode
lf
  writeConfig :: forall (m :: * -> *). CollectErrorsM m => CompileMode -> m [String]
writeConfig (CompileBinary CategoryName
c FunctionName
f LinkerMode
lm String
o [String]
lf) = do
    forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName CategoryName
c
    forall (m :: * -> *). ErrorContextM m => FunctionName -> m ()
validateFunctionName FunctionName
f
    String
lm' <- forall (m :: * -> *). ErrorContextM m => LinkerMode -> m String
showLinkerMode LinkerMode
lm
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"binary {",
        String -> String
indent (String
"category: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
c),
        String -> String
indent (String
"function: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FunctionName
f),
        String -> String
indent (String
"link_mode: " forall a. [a] -> [a] -> [a]
++ String
lm'),
        String -> String
indent (String
"output: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
o),
        String -> String
indent (String
"link_flags: [")
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
lf) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String
"}"
      ]
  writeConfig (CompileIncremental [String]
lf) = do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"incremental {",
        String -> String
indent (String
"link_flags: [")
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
lf) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String
"}"
      ]
  writeConfig CompileMode
_ = forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Invalid compile mode"

parseLinkerMode :: TextParser LinkerMode
parseLinkerMode :: TextParser LinkerMode
parseLinkerMode = forall a. String -> TextParser a -> TextParser a
labeled String
"linker mode" forall a b. (a -> b) -> a -> b
$ TextParser LinkerMode
static forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser LinkerMode
dynamic where
  static :: TextParser LinkerMode
static  = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"static")  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return LinkerMode
LinkStatic
  dynamic :: TextParser LinkerMode
dynamic = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"dynamic") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return LinkerMode
LinkDynamic

showLinkerMode :: ErrorContextM m => LinkerMode -> m String
showLinkerMode :: forall (m :: * -> *). ErrorContextM m => LinkerMode -> m String
showLinkerMode LinkerMode
LinkStatic  = forall (m :: * -> *) a. Monad m => a -> m a
return String
"static"
showLinkerMode LinkerMode
LinkDynamic = forall (m :: * -> *) a. Monad m => a -> m a
return String
"dynamic"

parseExprMacro :: TextParser (MacroName,Expression SourceContext)
parseExprMacro :: TextParser (MacroName, Expression SourceContext)
parseExprMacro = do
  forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"expression_macro")
  TextParser ()
structOpen
  (MacroName, Expression SourceContext)
e <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ (,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:"       forall a. ParseFromSource a => TextParser a
sourceParser
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"expression:" forall a. ParseFromSource a => TextParser a
sourceParser
  TextParser ()
structClose
  forall (m :: * -> *) a. Monad m => a -> m a
return (MacroName, Expression SourceContext)
e