{-# 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 = TextParser a -> String -> String -> m a
forall (m :: * -> *) a.
ErrorContextM m =>
TextParser a -> String -> String -> m a
runTextParser (ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
-> TextParser a
-> TextParser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ParsecT CompilerMessage String Identity ()
optionalSpace ParsecT CompilerMessage String Identity ()
endOfDoc TextParser a
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 = ([String] -> String) -> m [String] -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unlines (m [String] -> m String) -> (a -> m [String]) -> a -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *). CollectErrorsM m => a -> m [String]
writeConfig
structOpen :: TextParser ()
structOpen :: ParsecT CompilerMessage String Identity ()
structOpen = ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"{")
structClose :: TextParser ()
structClose :: ParsecT CompilerMessage String Identity ()
structClose = ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"}")
indents :: [String] -> [String]
indents :: [String] -> [String]
indents = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
indent
indent :: String -> String
indent :: String -> String
indent = (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
prependFirst :: String -> [String] -> [String]
prependFirst :: String -> [String] -> [String]
prependFirst String
s0 (String
s:[String]
ss) = (String
s0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)String -> [String] -> [String]
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 =
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
$ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
c String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[A-Z][A-Za-z0-9]*$") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid category name: \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
validateFunctionName :: ErrorContextM m => FunctionName -> m ()
validateFunctionName :: forall (m :: * -> *). ErrorContextM m => FunctionName -> m ()
validateFunctionName FunctionName
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
$ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
f String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[a-z][A-Za-z0-9]*$") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid function name: \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
validateHash :: ErrorContextM m => VersionHash -> m ()
validateHash :: forall (m :: * -> *). ErrorContextM m => VersionHash -> m ()
validateHash VersionHash
h =
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
$ VersionHash -> String
forall a. Show a => a -> String
show VersionHash
h String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[A-Za-z0-9]+$") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Version hash must be a hex string: \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ VersionHash -> String
forall a. Show a => a -> String
show VersionHash
h String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
parseHash :: TextParser VersionHash
parseHash :: TextParser VersionHash
parseHash = String -> TextParser VersionHash -> TextParser VersionHash
forall a. String -> TextParser a -> TextParser a
labeled String
"version hash" (TextParser VersionHash -> TextParser VersionHash)
-> TextParser VersionHash -> TextParser VersionHash
forall a b. (a -> b) -> a -> b
$ TextParser VersionHash -> TextParser VersionHash
forall a. TextParser a -> TextParser a
sepAfter ((String -> VersionHash)
-> ParsecT CompilerMessage String Identity String
-> TextParser VersionHash
forall a b.
(a -> b)
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> VersionHash
VersionHash (ParsecT CompilerMessage String Identity String
-> TextParser VersionHash)
-> ParsecT CompilerMessage String Identity String
-> TextParser VersionHash
forall a b. (a -> b) -> a -> b
$ ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CompilerMessage String Identity Char
ParsecT CompilerMessage String Identity (Token String)
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
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
$ String
ns String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[A-Za-z][A-Za-z0-9_]*$") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid category namespace: \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ns String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ns]
maybeShowNamespace String
_ Namespace
_ = [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
parseNamespace :: TextParser Namespace
parseNamespace :: TextParser Namespace
parseNamespace = String -> TextParser Namespace -> TextParser Namespace
forall a. String -> TextParser a -> TextParser a
labeled String
"namespace" (TextParser Namespace -> TextParser Namespace)
-> TextParser Namespace -> TextParser Namespace
forall a b. (a -> b) -> a -> b
$ do
Char
b <- ParsecT CompilerMessage String Identity Char
ParsecT CompilerMessage String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
String
e <- ParsecT CompilerMessage String Identity String
-> ParsecT CompilerMessage String Identity String
forall a. TextParser a -> TextParser a
sepAfter (ParsecT CompilerMessage String Identity String
-> ParsecT CompilerMessage String Identity String)
-> ParsecT CompilerMessage String Identity String
-> ParsecT CompilerMessage String Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CompilerMessage String Identity Char
ParsecT CompilerMessage String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity Char
forall a.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token String
-> ParsecT CompilerMessage String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'_')
Namespace -> TextParser Namespace
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> TextParser Namespace)
-> Namespace -> TextParser Namespace
forall a b. (a -> b) -> a -> b
$ String -> Namespace
StaticNamespace (Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:String
e)
parseQuoted :: TextParser String
parseQuoted :: ParsecT CompilerMessage String Identity String
parseQuoted = String
-> ParsecT CompilerMessage String Identity String
-> ParsecT CompilerMessage String Identity String
forall a. String -> TextParser a -> TextParser a
labeled String
"quoted string" (ParsecT CompilerMessage String Identity String
-> ParsecT CompilerMessage String Identity String)
-> ParsecT CompilerMessage String Identity String
-> ParsecT CompilerMessage String Identity String
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT CompilerMessage String Identity ()
string_ String
"\""
String
ss <- ParsecT CompilerMessage String Identity Char
-> ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CompilerMessage String Identity Char
stringChar (String -> ParsecT CompilerMessage String Identity ()
string_ String
"\"")
ParsecT CompilerMessage String Identity ()
optionalSpace
String -> ParsecT CompilerMessage String Identity String
forall a. a -> ParsecT CompilerMessage String Identity a
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 = String -> TextParser [a] -> TextParser [a]
forall a. String -> TextParser a -> TextParser a
labeled String
"list" (TextParser [a] -> TextParser [a])
-> TextParser [a] -> TextParser [a]
forall a b. (a -> b) -> a -> b
$ do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"[")
[a]
xs <- TextParser a
-> ParsecT CompilerMessage String Identity () -> TextParser [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (TextParser a -> TextParser a
forall a. TextParser a -> TextParser a
sepAfter TextParser a
p) (String -> ParsecT CompilerMessage String Identity ()
string_ String
"]")
ParsecT CompilerMessage String Identity ()
optionalSpace
[a] -> TextParser [a]
forall a. a -> ParsecT CompilerMessage String Identity a
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 = a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault a
def (TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a)
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
forall a b. (a -> b) -> a -> b
$ do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ())
-> ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
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 = TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a)
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
forall a b. (a -> b) -> a -> b
$ do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ())
-> ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
l)
TextParser a
p
instance ConfigFormat CompileMetadata where
readConfig :: TextParser CompileMetadata
readConfig = Permutation
(ParsecT CompilerMessage String Identity) CompileMetadata
-> TextParser CompileMetadata
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
(ParsecT CompilerMessage String Identity) CompileMetadata
-> TextParser CompileMetadata)
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMetadata
-> TextParser CompileMetadata
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
(VersionHash
-> String
-> String
-> [String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation
(ParsecT CompilerMessage String Identity) VersionHash
-> Permutation
(ParsecT CompilerMessage String Identity)
(String
-> String
-> [String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser VersionHash
-> Permutation
(ParsecT CompilerMessage String Identity) VersionHash
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"version_hash:" TextParser VersionHash
parseHash
Permutation
(ParsecT CompilerMessage String Identity)
(String
-> String
-> [String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
(ParsecT CompilerMessage String Identity)
(String
-> [String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"root:" ParsecT CompilerMessage String Identity String
parseQuoted
Permutation
(ParsecT CompilerMessage String Identity)
(String
-> [String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"path:" ParsecT CompilerMessage String Identity String
parseQuoted
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
(Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extra_paths:" [] (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
(Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) Namespace
-> Permutation
(ParsecT CompilerMessage String Identity)
(Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Namespace
-> TextParser Namespace
-> Permutation (ParsecT CompilerMessage String Identity) Namespace
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"public_namespace:" Namespace
NoNamespace TextParser Namespace
parseNamespace
Permutation
(ParsecT CompilerMessage String Identity)
(Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) Namespace
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Namespace
-> TextParser Namespace
-> Permutation (ParsecT CompilerMessage String Identity) Namespace
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"private_namespace:" Namespace
NoNamespace TextParser Namespace
parseNamespace
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_deps:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_deps:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_categories:" (TextParser CategoryName -> TextParser [CategoryName]
forall a. TextParser a -> TextParser [a]
parseList TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser)
Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_categories:" (TextParser CategoryName -> TextParser [CategoryName]
forall a. TextParser a -> TextParser [a]
parseList TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_subdirs:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_subdirs:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"public_files:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"private_files:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"test_files:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"hxx_files:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String] -> [String] -> [ObjectFile] -> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"cxx_files:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String] -> [String] -> [ObjectFile] -> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String] -> [String] -> [ObjectFile] -> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"binaries:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String] -> [String] -> [ObjectFile] -> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String] -> [ObjectFile] -> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"libraries:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String] -> [ObjectFile] -> CompileMetadata)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([ObjectFile] -> CompileMetadata)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"link_flags:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([ObjectFile] -> CompileMetadata)
-> Permutation
(ParsecT CompilerMessage String Identity) [ObjectFile]
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMetadata
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [ObjectFile]
-> Permutation
(ParsecT CompilerMessage String Identity) [ObjectFile]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"object_files:" (TextParser ObjectFile -> TextParser [ObjectFile]
forall a. TextParser a -> TextParser [a]
parseList TextParser ObjectFile
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
VersionHash -> m ()
forall (m :: * -> *). ErrorContextM m => VersionHash -> m ()
validateHash VersionHash
h
[String]
ns1' <- String -> Namespace -> m [String]
forall (m :: * -> *).
ErrorContextM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"public_namespace:" Namespace
ns1
[String]
ns2' <- String -> Namespace -> m [String]
forall (m :: * -> *).
ErrorContextM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"private_namespace:" Namespace
ns2
(CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ CategoryName -> m ()
forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs1
(CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ CategoryName -> m ()
forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs2
[String]
os' <- ([[String]] -> [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[String]] -> m [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> a -> b
$ (ObjectFile -> m [String]) -> [ObjectFile] -> m [[String]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ObjectFile -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *). CollectErrorsM m => ObjectFile -> m [String]
writeConfig [ObjectFile]
os
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"version_hash: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VersionHash -> String
forall a. Show a => a -> String
show VersionHash
h,
String
"root: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
p,
String
"path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
d
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ns1' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ns2' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"extra_paths: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ee) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"public_deps: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
is) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"private_deps: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
is2) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"public_categories: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> String
forall a. Show a => a -> String
show [CategoryName]
cs1) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"private_categories: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> String
forall a. Show a => a -> String
show [CategoryName]
cs2) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"public_subdirs: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ds1) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"private_subdirs: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ds2) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"public_files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ps) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"private_files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
xs) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"test_files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ts) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"hxx_files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
hxx) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"cxx_files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
cxx) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"binaries: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
bs) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"libraries: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ls) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"link_flags: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
lf) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"object_files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
os' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]"
]
instance ConfigFormat ObjectFile where
readConfig :: TextParser ObjectFile
readConfig = TextParser ObjectFile
category TextParser ObjectFile
-> TextParser ObjectFile -> TextParser ObjectFile
forall a.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ObjectFile
other where
category :: TextParser ObjectFile
category = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"category_object")
ParsecT CompilerMessage String Identity ()
structOpen
ObjectFile
o <- Permutation (ParsecT CompilerMessage String Identity) ObjectFile
-> TextParser ObjectFile
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) ObjectFile
-> TextParser ObjectFile)
-> Permutation (ParsecT CompilerMessage String Identity) ObjectFile
-> TextParser ObjectFile
forall a b. (a -> b) -> a -> b
$ CategoryIdentifier
-> [CategoryIdentifier] -> [String] -> ObjectFile
CategoryObjectFile
(CategoryIdentifier
-> [CategoryIdentifier] -> [String] -> ObjectFile)
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
-> Permutation
(ParsecT CompilerMessage String Identity)
([CategoryIdentifier] -> [String] -> ObjectFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser CategoryIdentifier
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"category:" TextParser CategoryIdentifier
forall a. ConfigFormat a => TextParser a
readConfig
Permutation
(ParsecT CompilerMessage String Identity)
([CategoryIdentifier] -> [String] -> ObjectFile)
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryIdentifier]
-> Permutation
(ParsecT CompilerMessage String Identity) ([String] -> ObjectFile)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [CategoryIdentifier]
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryIdentifier]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"requires:" (TextParser CategoryIdentifier -> TextParser [CategoryIdentifier]
forall a. TextParser a -> TextParser [a]
parseList TextParser CategoryIdentifier
forall a. ConfigFormat a => TextParser a
readConfig)
Permutation
(ParsecT CompilerMessage String Identity) ([String] -> ObjectFile)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation (ParsecT CompilerMessage String Identity) ObjectFile
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"files:" (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
ParsecT CompilerMessage String Identity ()
structClose
ObjectFile -> TextParser ObjectFile
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ObjectFile
o
other :: TextParser ObjectFile
other = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"other_object")
ParsecT CompilerMessage String Identity ()
structOpen
ObjectFile
f <- Permutation (ParsecT CompilerMessage String Identity) ObjectFile
-> TextParser ObjectFile
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) ObjectFile
-> TextParser ObjectFile)
-> Permutation (ParsecT CompilerMessage String Identity) ObjectFile
-> TextParser ObjectFile
forall a b. (a -> b) -> a -> b
$ String -> ObjectFile
OtherObjectFile
(String -> ObjectFile)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation (ParsecT CompilerMessage String Identity) ObjectFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"file:" ParsecT CompilerMessage String Identity String
parseQuoted
ParsecT CompilerMessage String Identity ()
structClose
ObjectFile -> TextParser ObjectFile
forall a. a -> ParsecT CompilerMessage String Identity a
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 <- CategoryIdentifier -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *).
CollectErrorsM m =>
CategoryIdentifier -> m [String]
writeConfig CategoryIdentifier
c
[String]
requires <- ([[String]] -> [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[String]] -> m [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> a -> b
$ (CategoryIdentifier -> m [String])
-> [CategoryIdentifier] -> m [[String]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM CategoryIdentifier -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *).
CollectErrorsM m =>
CategoryIdentifier -> m [String]
writeConfig [CategoryIdentifier]
rs
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"category_object {"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents (String
"category: " String -> [String] -> [String]
`prependFirst` [String]
category) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"requires: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) [String]
requires [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String -> String
indent String
"files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
fs) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String
"}"
]
writeConfig (OtherObjectFile String
f) = do
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"other_object {",
String -> String
indent (String
"file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
f),
String
"}"
]
instance ConfigFormat CategoryIdentifier where
readConfig :: TextParser CategoryIdentifier
readConfig = TextParser CategoryIdentifier
category TextParser CategoryIdentifier
-> TextParser CategoryIdentifier -> TextParser CategoryIdentifier
forall a.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser CategoryIdentifier
unresolved where
category :: TextParser CategoryIdentifier
category = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"category")
ParsecT CompilerMessage String Identity ()
structOpen
CategoryIdentifier
i <- Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
-> TextParser CategoryIdentifier
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
-> TextParser CategoryIdentifier)
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
-> TextParser CategoryIdentifier
forall a b. (a -> b) -> a -> b
$ String -> CategoryName -> Namespace -> CategoryIdentifier
CategoryIdentifier
(String -> CategoryName -> Namespace -> CategoryIdentifier)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
(ParsecT CompilerMessage String Identity)
(CategoryName -> Namespace -> CategoryIdentifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"path:" ParsecT CompilerMessage String Identity String
parseQuoted
Permutation
(ParsecT CompilerMessage String Identity)
(CategoryName -> Namespace -> CategoryIdentifier)
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity)
(Namespace -> CategoryIdentifier)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:" TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser
Permutation
(ParsecT CompilerMessage String Identity)
(Namespace -> CategoryIdentifier)
-> Permutation (ParsecT CompilerMessage String Identity) Namespace
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Namespace
-> TextParser Namespace
-> Permutation (ParsecT CompilerMessage String Identity) Namespace
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"namespace:" Namespace
NoNamespace TextParser Namespace
parseNamespace
ParsecT CompilerMessage String Identity ()
structClose
CategoryIdentifier -> TextParser CategoryIdentifier
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CategoryIdentifier
i
unresolved :: TextParser CategoryIdentifier
unresolved = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"unresolved")
ParsecT CompilerMessage String Identity ()
structOpen
CategoryIdentifier
c <- Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
-> TextParser CategoryIdentifier
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
-> TextParser CategoryIdentifier)
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
-> TextParser CategoryIdentifier
forall a b. (a -> b) -> a -> b
$ CategoryName -> CategoryIdentifier
UnresolvedCategory
(CategoryName -> CategoryIdentifier)
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:" TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser
ParsecT CompilerMessage String Identity ()
structClose
CategoryIdentifier -> TextParser CategoryIdentifier
forall a. a -> ParsecT CompilerMessage String Identity a
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
CategoryName -> m ()
forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName CategoryName
c
[String]
namespace <- String -> Namespace -> m [String]
forall (m :: * -> *).
ErrorContextM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"namespace:" Namespace
ns
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"category {",
String -> String
indent (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
c
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
namespace [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
p,
String
"}"
]
writeConfig (UnresolvedCategory CategoryName
c) = do
CategoryName -> m ()
forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName CategoryName
c
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [String
"unresolved { " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"]
instance ConfigFormat ModuleConfig where
readConfig :: TextParser ModuleConfig
readConfig = Permutation (ParsecT CompilerMessage String Identity) ModuleConfig
-> TextParser ModuleConfig
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) ModuleConfig
-> TextParser ModuleConfig)
-> Permutation
(ParsecT CompilerMessage String Identity) ModuleConfig
-> TextParser ModuleConfig
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [String]
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig
ModuleConfig
(String
-> String
-> [String]
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
(ParsecT CompilerMessage String Identity)
(String
-> [String]
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"root:" String
"" ParsecT CompilerMessage String Identity String
parseQuoted
Permutation
(ParsecT CompilerMessage String Identity)
(String
-> [String]
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"path:" ParsecT CompilerMessage String Identity String
parseQuoted
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extra_paths:" [] (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
-> Permutation
(ParsecT CompilerMessage String Identity)
[(MacroName, Expression SourceContext)]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [(MacroName, Expression SourceContext)]
-> TextParser [(MacroName, Expression SourceContext)]
-> Permutation
(ParsecT CompilerMessage String Identity)
[(MacroName, Expression SourceContext)]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"expression_map:" [] (TextParser (MacroName, Expression SourceContext)
-> TextParser [(MacroName, Expression SourceContext)]
forall a. TextParser a -> TextParser [a]
parseList TextParser (MacroName, Expression SourceContext)
parseExprMacro)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"public_deps:" [] (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([String]
-> [ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
([ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"private_deps:" [] (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
([ExtraSource]
-> [(CategoryName, CategorySpec SourceContext)]
-> [String]
-> CompileMode
-> ModuleConfig)
-> Permutation
(ParsecT CompilerMessage String Identity) [ExtraSource]
-> Permutation
(ParsecT CompilerMessage String Identity)
([(CategoryName, CategorySpec SourceContext)]
-> [String] -> CompileMode -> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [ExtraSource]
-> TextParser [ExtraSource]
-> Permutation
(ParsecT CompilerMessage String Identity) [ExtraSource]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extra_files:" [] (TextParser ExtraSource -> TextParser [ExtraSource]
forall a. TextParser a -> TextParser [a]
parseList TextParser ExtraSource
forall a. ConfigFormat a => TextParser a
readConfig)
Permutation
(ParsecT CompilerMessage String Identity)
([(CategoryName, CategorySpec SourceContext)]
-> [String] -> CompileMode -> ModuleConfig)
-> Permutation
(ParsecT CompilerMessage String Identity)
[(CategoryName, CategorySpec SourceContext)]
-> Permutation
(ParsecT CompilerMessage String Identity)
([String] -> CompileMode -> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [(CategoryName, CategorySpec SourceContext)]
-> TextParser [(CategoryName, CategorySpec SourceContext)]
-> Permutation
(ParsecT CompilerMessage String Identity)
[(CategoryName, CategorySpec SourceContext)]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"extension_specs:" [] (TextParser (CategoryName, CategorySpec SourceContext)
-> TextParser [(CategoryName, CategorySpec SourceContext)]
forall a. TextParser a -> TextParser [a]
parseList TextParser (CategoryName, CategorySpec SourceContext)
forall a. ConfigFormat a => TextParser a
readConfig)
Permutation
(ParsecT CompilerMessage String Identity)
([String] -> CompileMode -> ModuleConfig)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity)
(CompileMode -> ModuleConfig)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"include_paths:" [] (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
Permutation
(ParsecT CompilerMessage String Identity)
(CompileMode -> ModuleConfig)
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMode
-> Permutation
(ParsecT CompilerMessage String Identity) ModuleConfig
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser CompileMode
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMode
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"mode:" TextParser CompileMode
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' <- ([[String]] -> [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[String]] -> m [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> a -> b
$ (ExtraSource -> m [String]) -> [ExtraSource] -> m [[String]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ExtraSource -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *). CollectErrorsM m => ExtraSource -> m [String]
writeConfig [ExtraSource]
es
[String]
m' <- CompileMode -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *). CollectErrorsM m => CompileMode -> m [String]
writeConfig CompileMode
m
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
$ [(MacroName, Expression SourceContext)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(MacroName, Expression SourceContext)]
em) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Only empty expression maps are allowed when writing"
[String]
cs' <- ([[String]] -> [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[String]] -> m [String]) -> m [[String]] -> m [String]
forall a b. (a -> b) -> a -> b
$ ((CategoryName, CategorySpec SourceContext) -> m [String])
-> [(CategoryName, CategorySpec SourceContext)] -> m [[String]]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (CategoryName, CategorySpec SourceContext) -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *).
CollectErrorsM m =>
(CategoryName, CategorySpec SourceContext) -> m [String]
writeConfig [(CategoryName, CategorySpec SourceContext)]
cs
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"root: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
p,
String
"path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
d,
String
"extra_paths: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ee) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"expression_map: [",
String
"]",
String
"public_deps: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
is) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"private_deps: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
is2) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"extra_files: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
es' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"extension_specs: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents [String]
cs' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]",
String
"include_paths: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
indents ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
ep) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String
"]"
] [String] -> [String] -> [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 TextParser ExtraSource
-> TextParser ExtraSource -> TextParser ExtraSource
forall a.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ExtraSource
other where
category :: TextParser ExtraSource
category = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"category_source")
ParsecT CompilerMessage String Identity ()
structOpen
ExtraSource
s <- Permutation (ParsecT CompilerMessage String Identity) ExtraSource
-> TextParser ExtraSource
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) ExtraSource
-> TextParser ExtraSource)
-> Permutation
(ParsecT CompilerMessage String Identity) ExtraSource
-> TextParser ExtraSource
forall a b. (a -> b) -> a -> b
$ String -> [CategoryName] -> [CategoryName] -> ExtraSource
CategorySource
(String -> [CategoryName] -> [CategoryName] -> ExtraSource)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName] -> [CategoryName] -> ExtraSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"source:" ParsecT CompilerMessage String Identity String
parseQuoted
Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName] -> [CategoryName] -> ExtraSource)
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName] -> ExtraSource)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [CategoryName]
-> TextParser [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"categories:" [] (TextParser CategoryName -> TextParser [CategoryName]
forall a. TextParser a -> TextParser [a]
parseList TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser)
Permutation
(ParsecT CompilerMessage String Identity)
([CategoryName] -> ExtraSource)
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity) ExtraSource
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [CategoryName]
-> TextParser [CategoryName]
-> Permutation
(ParsecT CompilerMessage String Identity) [CategoryName]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"requires:" [] (TextParser CategoryName -> TextParser [CategoryName]
forall a. TextParser a -> TextParser [a]
parseList TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser)
ParsecT CompilerMessage String Identity ()
structClose
ExtraSource -> TextParser ExtraSource
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ExtraSource
s
other :: TextParser ExtraSource
other = do
String
f <- ParsecT CompilerMessage String Identity String
parseQuoted
ExtraSource -> TextParser ExtraSource
forall a. a -> ParsecT CompilerMessage String Identity a
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
(CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ CategoryName -> m ()
forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs
(CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ CategoryName -> m ()
forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName [CategoryName]
ds
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"category_source {",
String -> String
indent (String
"source: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
f),
String -> String
indent String
"categories: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([CategoryName] -> [String]) -> [CategoryName] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents ([String] -> [String])
-> ([CategoryName] -> [String]) -> [CategoryName] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> String
forall a. Show a => a -> String
show) [CategoryName]
cs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String -> String
indent String
"requires: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([CategoryName] -> [String]) -> [CategoryName] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents ([String] -> [String])
-> ([CategoryName] -> [String]) -> [CategoryName] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CategoryName -> String) -> [CategoryName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CategoryName -> String
forall a. Show a => a -> String
show) [CategoryName]
ds [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String
"}"
]
writeConfig (OtherSource String
f) = [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [String -> String
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
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"category")
ParsecT CompilerMessage String Identity ()
structOpen
(CategoryName, CategorySpec SourceContext)
s <- Permutation
(ParsecT CompilerMessage String Identity)
(CategoryName, CategorySpec SourceContext)
-> TextParser (CategoryName, CategorySpec SourceContext)
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
(ParsecT CompilerMessage String Identity)
(CategoryName, CategorySpec SourceContext)
-> TextParser (CategoryName, CategorySpec SourceContext))
-> Permutation
(ParsecT CompilerMessage String Identity)
(CategoryName, CategorySpec SourceContext)
-> TextParser (CategoryName, CategorySpec SourceContext)
forall a b. (a -> b) -> a -> b
$ (\CategoryName
n [ValueRefine SourceContext]
rs [ValueDefine SourceContext]
ds -> (CategoryName
n,[SourceContext]
-> [ValueRefine SourceContext]
-> [ValueDefine SourceContext]
-> CategorySpec SourceContext
forall c.
[c] -> [ValueRefine c] -> [ValueDefine c] -> CategorySpec c
CategorySpec [SourceContext
c] [ValueRefine SourceContext]
rs [ValueDefine SourceContext]
ds))
(CategoryName
-> [ValueRefine SourceContext]
-> [ValueDefine SourceContext]
-> (CategoryName, CategorySpec SourceContext))
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity)
([ValueRefine SourceContext]
-> [ValueDefine SourceContext]
-> (CategoryName, CategorySpec SourceContext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:" TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser
Permutation
(ParsecT CompilerMessage String Identity)
([ValueRefine SourceContext]
-> [ValueDefine SourceContext]
-> (CategoryName, CategorySpec SourceContext))
-> Permutation
(ParsecT CompilerMessage String Identity)
[ValueRefine SourceContext]
-> Permutation
(ParsecT CompilerMessage String Identity)
([ValueDefine SourceContext]
-> (CategoryName, CategorySpec SourceContext))
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [ValueRefine SourceContext]
-> TextParser [ValueRefine SourceContext]
-> Permutation
(ParsecT CompilerMessage String Identity)
[ValueRefine SourceContext]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"refines:" [] (TextParser (ValueRefine SourceContext)
-> TextParser [ValueRefine SourceContext]
forall a. TextParser a -> TextParser [a]
parseList TextParser (ValueRefine SourceContext)
parseRefine)
Permutation
(ParsecT CompilerMessage String Identity)
([ValueDefine SourceContext]
-> (CategoryName, CategorySpec SourceContext))
-> Permutation
(ParsecT CompilerMessage String Identity)
[ValueDefine SourceContext]
-> Permutation
(ParsecT CompilerMessage String Identity)
(CategoryName, CategorySpec SourceContext)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [ValueDefine SourceContext]
-> TextParser [ValueDefine SourceContext]
-> Permutation
(ParsecT CompilerMessage String Identity)
[ValueDefine SourceContext]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"defines:" [] (TextParser (ValueDefine SourceContext)
-> TextParser [ValueDefine SourceContext]
forall a. TextParser a -> TextParser [a]
parseList TextParser (ValueDefine SourceContext)
parseDefine)
ParsecT CompilerMessage String Identity ()
structClose
(CategoryName, CategorySpec SourceContext)
-> TextParser (CategoryName, CategorySpec SourceContext)
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryName, CategorySpec SourceContext)
s where
parseRefine :: TextParser (ValueRefine SourceContext)
parseRefine = do
SourceContext
c <- TextParser SourceContext
getSourceContext
TypeInstance
t <- TextParser TypeInstance
forall a. ParseFromSource a => TextParser a
sourceParser
ValueRefine SourceContext -> TextParser (ValueRefine SourceContext)
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValueRefine SourceContext
-> TextParser (ValueRefine SourceContext))
-> ValueRefine SourceContext
-> TextParser (ValueRefine SourceContext)
forall a b. (a -> b) -> a -> b
$ [SourceContext] -> TypeInstance -> ValueRefine SourceContext
forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine [SourceContext
c] TypeInstance
t
parseDefine :: TextParser (ValueDefine SourceContext)
parseDefine = do
SourceContext
c <- TextParser SourceContext
getSourceContext
DefinesInstance
t <- TextParser DefinesInstance
forall a. ParseFromSource a => TextParser a
sourceParser
ValueDefine SourceContext -> TextParser (ValueDefine SourceContext)
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValueDefine SourceContext
-> TextParser (ValueDefine SourceContext))
-> ValueDefine SourceContext
-> TextParser (ValueDefine SourceContext)
forall a b. (a -> b) -> a -> b
$ [SourceContext] -> DefinesInstance -> ValueDefine SourceContext
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
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"category {",
String -> String
indent (String
"name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n),
String -> String
indent String
"refines: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([ValueRefine SourceContext] -> [String])
-> [ValueRefine SourceContext]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents ([String] -> [String])
-> ([ValueRefine SourceContext] -> [String])
-> [ValueRefine SourceContext]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueRefine SourceContext -> String)
-> [ValueRefine SourceContext] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (TypeInstance -> String
forall a. Show a => a -> String
show (TypeInstance -> String)
-> (ValueRefine SourceContext -> TypeInstance)
-> ValueRefine SourceContext
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueRefine SourceContext -> TypeInstance
forall c. ValueRefine c -> TypeInstance
vrType)) [ValueRefine SourceContext]
rs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String -> String
indent String
"defines: ["
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([ValueDefine SourceContext] -> [String])
-> [ValueDefine SourceContext]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents ([String] -> [String])
-> ([ValueDefine SourceContext] -> [String])
-> [ValueDefine SourceContext]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueDefine SourceContext -> String)
-> [ValueDefine SourceContext] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (DefinesInstance -> String
forall a. Show a => a -> String
show (DefinesInstance -> String)
-> (ValueDefine SourceContext -> DefinesInstance)
-> ValueDefine SourceContext
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueDefine SourceContext -> DefinesInstance
forall c. ValueDefine c -> DefinesInstance
vdType)) [ValueDefine SourceContext]
ds [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String
"}"
]
instance ConfigFormat CompileMode where
readConfig :: TextParser CompileMode
readConfig = String -> TextParser CompileMode -> TextParser CompileMode
forall a. String -> TextParser a -> TextParser a
labeled String
"compile mode" (TextParser CompileMode -> TextParser CompileMode)
-> TextParser CompileMode -> TextParser CompileMode
forall a b. (a -> b) -> a -> b
$ TextParser CompileMode
binary TextParser CompileMode
-> TextParser CompileMode -> TextParser CompileMode
forall a.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser CompileMode
incremental where
binary :: TextParser CompileMode
binary = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"binary")
ParsecT CompilerMessage String Identity ()
structOpen
CompileMode
b <- Permutation (ParsecT CompilerMessage String Identity) CompileMode
-> TextParser CompileMode
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) CompileMode
-> TextParser CompileMode)
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMode
-> TextParser CompileMode
forall a b. (a -> b) -> a -> b
$ CategoryName
-> FunctionName -> LinkerMode -> String -> [String] -> CompileMode
CompileBinary
(CategoryName
-> FunctionName -> LinkerMode -> String -> [String] -> CompileMode)
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity)
(FunctionName -> LinkerMode -> String -> [String] -> CompileMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser CategoryName
-> Permutation
(ParsecT CompilerMessage String Identity) CategoryName
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"category:" TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser
Permutation
(ParsecT CompilerMessage String Identity)
(FunctionName -> LinkerMode -> String -> [String] -> CompileMode)
-> Permutation
(ParsecT CompilerMessage String Identity) FunctionName
-> Permutation
(ParsecT CompilerMessage String Identity)
(LinkerMode -> String -> [String] -> CompileMode)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser FunctionName
-> Permutation
(ParsecT CompilerMessage String Identity) FunctionName
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"function:" TextParser FunctionName
forall a. ParseFromSource a => TextParser a
sourceParser
Permutation
(ParsecT CompilerMessage String Identity)
(LinkerMode -> String -> [String] -> CompileMode)
-> Permutation (ParsecT CompilerMessage String Identity) LinkerMode
-> Permutation
(ParsecT CompilerMessage String Identity)
(String -> [String] -> CompileMode)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> LinkerMode
-> TextParser LinkerMode
-> Permutation (ParsecT CompilerMessage String Identity) LinkerMode
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"link_mode:" LinkerMode
LinkDynamic TextParser LinkerMode
parseLinkerMode
Permutation
(ParsecT CompilerMessage String Identity)
(String -> [String] -> CompileMode)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
(ParsecT CompilerMessage String Identity) ([String] -> CompileMode)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> String
-> ParsecT CompilerMessage String Identity String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"output:" String
"" ParsecT CompilerMessage String Identity String
parseQuoted
Permutation
(ParsecT CompilerMessage String Identity) ([String] -> CompileMode)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMode
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"link_flags:" [] (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
ParsecT CompilerMessage String Identity ()
structClose
CompileMode -> TextParser CompileMode
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CompileMode
b
incremental :: TextParser CompileMode
incremental = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"incremental")
ParsecT CompilerMessage String Identity ()
structOpen
CompileMode
lf <- Permutation (ParsecT CompilerMessage String Identity) CompileMode
-> TextParser CompileMode
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) CompileMode
-> TextParser CompileMode)
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMode
-> TextParser CompileMode
forall a b. (a -> b) -> a -> b
$ [String] -> CompileMode
CompileIncremental
([String] -> CompileMode)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
(ParsecT CompilerMessage String Identity) CompileMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [String]
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> a
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseOptional String
"link_flags:" [] (ParsecT CompilerMessage String Identity String
-> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList ParsecT CompilerMessage String Identity String
parseQuoted)
ParsecT CompilerMessage String Identity ()
structClose
CompileMode -> TextParser CompileMode
forall a. a -> ParsecT CompilerMessage String Identity a
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
CategoryName -> m ()
forall (m :: * -> *). ErrorContextM m => CategoryName -> m ()
validateCategoryName CategoryName
c
FunctionName -> m ()
forall (m :: * -> *). ErrorContextM m => FunctionName -> m ()
validateFunctionName FunctionName
f
String
lm' <- LinkerMode -> m String
forall (m :: * -> *). ErrorContextM m => LinkerMode -> m String
showLinkerMode LinkerMode
lm
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"binary {",
String -> String
indent (String
"category: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
c),
String -> String
indent (String
"function: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionName -> String
forall a. Show a => a -> String
show FunctionName
f),
String -> String
indent (String
"link_mode: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lm'),
String -> String
indent (String
"output: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
o),
String -> String
indent (String
"link_flags: [")
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
lf) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String
"}"
]
writeConfig (CompileIncremental [String]
lf) = do
[String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
String
"incremental {",
String -> String
indent (String
"link_flags: [")
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [String]
lf) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
String -> String
indent String
"]",
String
"}"
]
writeConfig CompileMode
_ = String -> m [String]
forall a. String -> m a
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Invalid compile mode"
parseLinkerMode :: TextParser LinkerMode
parseLinkerMode :: TextParser LinkerMode
parseLinkerMode = String -> TextParser LinkerMode -> TextParser LinkerMode
forall a. String -> TextParser a -> TextParser a
labeled String
"linker mode" (TextParser LinkerMode -> TextParser LinkerMode)
-> TextParser LinkerMode -> TextParser LinkerMode
forall a b. (a -> b) -> a -> b
$ TextParser LinkerMode
static TextParser LinkerMode
-> TextParser LinkerMode -> TextParser LinkerMode
forall a.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser LinkerMode
dynamic where
static :: TextParser LinkerMode
static = ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"static") ParsecT CompilerMessage String Identity ()
-> TextParser LinkerMode -> TextParser LinkerMode
forall a b.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity b
-> ParsecT CompilerMessage String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LinkerMode -> TextParser LinkerMode
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return LinkerMode
LinkStatic
dynamic :: TextParser LinkerMode
dynamic = ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"dynamic") ParsecT CompilerMessage String Identity ()
-> TextParser LinkerMode -> TextParser LinkerMode
forall a b.
ParsecT CompilerMessage String Identity a
-> ParsecT CompilerMessage String Identity b
-> ParsecT CompilerMessage String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LinkerMode -> TextParser LinkerMode
forall a. a -> ParsecT CompilerMessage String Identity a
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 = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"static"
showLinkerMode LinkerMode
LinkDynamic = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"dynamic"
parseExprMacro :: TextParser (MacroName,Expression SourceContext)
parseExprMacro :: TextParser (MacroName, Expression SourceContext)
parseExprMacro = do
ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
forall a. TextParser a -> TextParser a
sepAfter (String -> ParsecT CompilerMessage String Identity ()
string_ String
"expression_macro")
ParsecT CompilerMessage String Identity ()
structOpen
(MacroName, Expression SourceContext)
e <- Permutation
(ParsecT CompilerMessage String Identity)
(MacroName, Expression SourceContext)
-> TextParser (MacroName, Expression SourceContext)
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
(ParsecT CompilerMessage String Identity)
(MacroName, Expression SourceContext)
-> TextParser (MacroName, Expression SourceContext))
-> Permutation
(ParsecT CompilerMessage String Identity)
(MacroName, Expression SourceContext)
-> TextParser (MacroName, Expression SourceContext)
forall a b. (a -> b) -> a -> b
$ (,)
(MacroName
-> Expression SourceContext
-> (MacroName, Expression SourceContext))
-> Permutation (ParsecT CompilerMessage String Identity) MacroName
-> Permutation
(ParsecT CompilerMessage String Identity)
(Expression SourceContext -> (MacroName, Expression SourceContext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser MacroName
-> Permutation (ParsecT CompilerMessage String Identity) MacroName
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"name:" TextParser MacroName
forall a. ParseFromSource a => TextParser a
sourceParser
Permutation
(ParsecT CompilerMessage String Identity)
(Expression SourceContext -> (MacroName, Expression SourceContext))
-> Permutation
(ParsecT CompilerMessage String Identity)
(Expression SourceContext)
-> Permutation
(ParsecT CompilerMessage String Identity)
(MacroName, Expression SourceContext)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser (Expression SourceContext)
-> Permutation
(ParsecT CompilerMessage String Identity)
(Expression SourceContext)
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"expression:" TextParser (Expression SourceContext)
forall a. ParseFromSource a => TextParser a
sourceParser
ParsecT CompilerMessage String Identity ()
structClose
(MacroName, Expression SourceContext)
-> TextParser (MacroName, Expression SourceContext)
forall a. a -> ParsecT CompilerMessage String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MacroName, Expression SourceContext)
e