{- -----------------------------------------------------------------------------
Copyright 2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

module Module.ParseMetadata (
  ConfigFormat,
  autoReadConfig,
  autoWriteConfig,
) where

import Control.Monad (when)
import Text.Parsec
import Text.Parsec.String

import Base.CompileError
import Cli.CompileOptions
import Cli.Programs (VersionHash(..))
import Module.CompileMetadata
import Parser.Common
import Parser.Procedure ()
import Parser.Pragma (parseMacroName)
import Parser.TypeCategory ()
import Parser.TypeInstance ()
import Text.Regex.TDFA -- Not safe!
import Types.Procedure (Expression)
import Types.TypeCategory (FunctionName(..),Namespace(..))
import Types.TypeInstance (CategoryName(..))


class ConfigFormat a where
  readConfig :: Parser a
  writeConfig :: CompileErrorM m => a -> m [String]

autoReadConfig :: (ConfigFormat a, CompileErrorM m) => String -> String -> m a
autoReadConfig :: String -> String -> m a
autoReadConfig String
f String
s  = Either ParseError a -> m a
forall (m :: * -> *) a a.
(CompileErrorM m, Show a) =>
Either a a -> m a
unwrap Either ParseError a
parsed where
  parsed :: Either ParseError a
parsed = Parsec String () a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT String () Identity ()
-> ParsecT String () Identity ()
-> Parsec String () a
-> Parsec String () a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String () Identity ()
optionalSpace ParsecT String () Identity ()
endOfDoc Parsec String () a
forall a. ConfigFormat a => Parser a
readConfig) String
f String
s
  unwrap :: Either a a -> m a
unwrap (Left a
e)  = String -> m a
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (a -> String
forall a. Show a => a -> String
show a
e)
  unwrap (Right a
t) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t

autoWriteConfig ::  (ConfigFormat a, CompileErrorM m) => a -> m String
autoWriteConfig :: a -> m String
autoWriteConfig = ([String] -> String) -> m [String] -> m String
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, CompileErrorM m) =>
a -> m [String]
writeConfig

structOpen :: Parser ()
structOpen :: ParsecT String () Identity ()
structOpen = ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"{")

structClose :: Parser ()
structClose :: ParsecT String () Identity ()
structClose = ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT 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 :: CompileErrorM m => CategoryName -> m ()
validateCategoryName :: 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 (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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
"\""

parseCategoryName :: Parser CategoryName
parseCategoryName :: Parser CategoryName
parseCategoryName = Parser CategoryName
forall a. ParseFromSource a => Parser a
sourceParser :: Parser CategoryName

validateFunctionName :: CompileErrorM m => FunctionName -> m ()
validateFunctionName :: 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 (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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
"\""

parseFunctionName :: Parser FunctionName
parseFunctionName :: Parser FunctionName
parseFunctionName = Parser FunctionName
forall a. ParseFromSource a => Parser a
sourceParser :: Parser FunctionName

validateHash :: CompileErrorM m => VersionHash -> m ()
validateHash :: 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 (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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 :: Parser VersionHash
parseHash :: Parser VersionHash
parseHash = String -> Parser VersionHash -> Parser VersionHash
forall a. String -> Parser a -> Parser a
labeled String
"version hash" (Parser VersionHash -> Parser VersionHash)
-> Parser VersionHash -> Parser VersionHash
forall a b. (a -> b) -> a -> b
$ Parser VersionHash -> Parser VersionHash
forall a. Parser a -> Parser a
sepAfter ((String -> VersionHash)
-> ParsecT String () Identity String -> Parser VersionHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> VersionHash
VersionHash (ParsecT String () Identity String -> Parser VersionHash)
-> ParsecT String () Identity String -> Parser VersionHash
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit)

maybeShowNamespace :: CompileErrorM m => String -> Namespace -> m [String]
maybeShowNamespace :: 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 (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM (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 (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 (m :: * -> *) a. Monad m => a -> m a
return []

parseNamespace :: Parser Namespace
parseNamespace :: Parser Namespace
parseNamespace = String -> Parser Namespace -> Parser Namespace
forall a. String -> Parser a -> Parser a
labeled String
"namespace" (Parser Namespace -> Parser Namespace)
-> Parser Namespace -> Parser Namespace
forall a b. (a -> b) -> a -> b
$ do
  Char
b <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower
  String
e <- ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. Parser a -> Parser a
sepAfter (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')
  Namespace -> Parser Namespace
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> Parser Namespace) -> Namespace -> Parser Namespace
forall a b. (a -> b) -> a -> b
$ String -> Namespace
StaticNamespace (Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:String
e)

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

parseList :: Parser a -> Parser [a]
parseList :: Parser a -> Parser [a]
parseList Parser a
p = String -> Parser [a] -> Parser [a]
forall a. String -> Parser a -> Parser a
labeled String
"list" (Parser [a] -> Parser [a]) -> Parser [a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ do
  ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"[")
  [a]
xs <- Parser a -> ParsecT String () Identity () -> Parser [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (Parser a -> Parser a
forall a. Parser a -> Parser a
sepAfter Parser a
p) (String -> ParsecT String () Identity ()
string_ String
"]")
  ParsecT String () Identity ()
optionalSpace
  [a] -> Parser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs

parseOptional :: String -> a -> Parser a -> Parser a
parseOptional :: String -> a -> Parser a -> Parser a
parseOptional String
l a
def Parser a
p = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
parseRequired String
l Parser a
p Parser a -> Parser a -> Parser a
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
def

parseRequired :: String -> Parser a -> Parser a
parseRequired :: String -> Parser a -> Parser a
parseRequired String
l Parser a
p = do
    ParsecT String () Identity () -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity () -> ParsecT String () Identity ())
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
l)
    Parser a
p

instance ConfigFormat CompileMetadata where
  readConfig :: Parser CompileMetadata
readConfig = do
    VersionHash
h   <- String -> Parser VersionHash -> Parser VersionHash
forall a. String -> Parser a -> Parser a
parseRequired String
"version_hash:"       Parser VersionHash
parseHash
    String
p   <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> Parser a -> Parser a
parseRequired String
"path:"               ParsecT String () Identity String
parseQuoted
    Namespace
ns1 <- String -> Namespace -> Parser Namespace -> Parser Namespace
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"public_namespace:"   Namespace
NoNamespace Parser Namespace
parseNamespace
    Namespace
ns2 <- String -> Namespace -> Parser Namespace -> Parser Namespace
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"private_namespace:"  Namespace
NoNamespace Parser Namespace
parseNamespace
    [String]
is  <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"public_deps:"        (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
is2 <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"private_deps:"       (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [CategoryName]
cs1 <- String -> Parser [CategoryName] -> Parser [CategoryName]
forall a. String -> Parser a -> Parser a
parseRequired String
"public_categories:"  (Parser CategoryName -> Parser [CategoryName]
forall a. Parser a -> Parser [a]
parseList Parser CategoryName
parseCategoryName)
    [CategoryName]
cs2 <- String -> Parser [CategoryName] -> Parser [CategoryName]
forall a. String -> Parser a -> Parser a
parseRequired String
"private_categories:" (Parser CategoryName -> Parser [CategoryName]
forall a. Parser a -> Parser [a]
parseList Parser CategoryName
parseCategoryName)
    [String]
ds1 <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"public_subdirs:"     (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
ds2 <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"private_subdirs:"    (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
ps  <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"public_files:"       (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
xs  <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"private_files:"      (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
ts  <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"test_files:"         (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
hxx <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"hxx_files:"          (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
cxx <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"cxx_files:"          (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
bs  <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"binaries:"           (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [String]
lf  <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"link_flags:"         (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
    [ObjectFile]
os  <- String -> Parser [ObjectFile] -> Parser [ObjectFile]
forall a. String -> Parser a -> Parser a
parseRequired String
"object_files:"       (Parser ObjectFile -> Parser [ObjectFile]
forall a. Parser a -> Parser [a]
parseList Parser ObjectFile
forall a. ConfigFormat a => Parser a
readConfig)
    CompileMetadata -> Parser CompileMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return (VersionHash
-> String
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata
CompileMetadata VersionHash
h String
p 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]
lf [ObjectFile]
os)
  writeConfig :: CompileMetadata -> m [String]
writeConfig (CompileMetadata VersionHash
h String
p 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]
lf [ObjectFile]
os) = do
    VersionHash -> m ()
forall (m :: * -> *). CompileErrorM m => VersionHash -> m ()
validateHash VersionHash
h
    [String]
ns1' <- String -> Namespace -> m [String]
forall (m :: * -> *).
CompileErrorM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"public_namespace:"  Namespace
ns1
    [String]
ns2' <- String -> Namespace -> m [String]
forall (m :: * -> *).
CompileErrorM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"private_namespace:" Namespace
ns2
    (CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ CategoryName -> m ()
forall (m :: * -> *). CompileErrorM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs1
    (CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ CategoryName -> m ()
forall (m :: * -> *). CompileErrorM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs2
    [String]
os' <- ([[String]] -> [String]) -> m [[String]] -> m [String]
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.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM ObjectFile -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
a -> m [String]
writeConfig [ObjectFile]
os
    [String] -> m [String]
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
"path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
p
      ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ns1' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ns2' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
        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
"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 :: Parser ObjectFile
readConfig = Parser ObjectFile
category Parser ObjectFile -> Parser ObjectFile -> Parser ObjectFile
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ObjectFile
other where
    category :: Parser ObjectFile
category = do
      ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"category_object")
      ParsecT String () Identity ()
structOpen
      CategoryIdentifier
c <-  String -> Parser CategoryIdentifier -> Parser CategoryIdentifier
forall a. String -> Parser a -> Parser a
parseRequired String
"category:" Parser CategoryIdentifier
forall a. ConfigFormat a => Parser a
readConfig
      [CategoryIdentifier]
rs <- String
-> Parser [CategoryIdentifier] -> Parser [CategoryIdentifier]
forall a. String -> Parser a -> Parser a
parseRequired String
"requires:" (Parser CategoryIdentifier -> Parser [CategoryIdentifier]
forall a. Parser a -> Parser [a]
parseList Parser CategoryIdentifier
forall a. ConfigFormat a => Parser a
readConfig)
      [String]
fs <- String -> Parser [String] -> Parser [String]
forall a. String -> Parser a -> Parser a
parseRequired String
"files:"    (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
      ParsecT String () Identity ()
structClose
      ObjectFile -> Parser ObjectFile
forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryIdentifier
-> [CategoryIdentifier] -> [String] -> ObjectFile
CategoryObjectFile CategoryIdentifier
c [CategoryIdentifier]
rs [String]
fs)
    other :: Parser ObjectFile
other = do
      ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"other_object")
      ParsecT String () Identity ()
structOpen
      String
f <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> Parser a -> Parser a
parseRequired String
"file:" ParsecT String () Identity String
parseQuoted
      ParsecT String () Identity ()
structClose
      ObjectFile -> Parser ObjectFile
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ObjectFile
OtherObjectFile String
f)
  writeConfig :: ObjectFile -> m [String]
writeConfig (CategoryObjectFile CategoryIdentifier
c [CategoryIdentifier]
rs [String]
fs) = do
    [String]
category <- CategoryIdentifier -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
a -> m [String]
writeConfig CategoryIdentifier
c
    [String]
requires <- ([[String]] -> [String]) -> m [[String]] -> m [String]
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.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM CategoryIdentifier -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
a -> m [String]
writeConfig [CategoryIdentifier]
rs
    [String] -> m [String]
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 (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 :: Parser CategoryIdentifier
readConfig = Parser CategoryIdentifier
category Parser CategoryIdentifier
-> Parser CategoryIdentifier -> Parser CategoryIdentifier
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser CategoryIdentifier
unresolved where
    category :: Parser CategoryIdentifier
category = do
      ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"category")
      ParsecT String () Identity ()
structOpen
      CategoryName
c <-  String -> Parser CategoryName -> Parser CategoryName
forall a. String -> Parser a -> Parser a
parseRequired String
"name:"      Parser CategoryName
parseCategoryName
      Namespace
ns <- String -> Namespace -> Parser Namespace -> Parser Namespace
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"namespace:" Namespace
NoNamespace Parser Namespace
parseNamespace
      String
p <-  String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> Parser a -> Parser a
parseRequired String
"path:"      ParsecT String () Identity String
parseQuoted
      ParsecT String () Identity ()
structClose
      CategoryIdentifier -> Parser CategoryIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CategoryName -> Namespace -> CategoryIdentifier
CategoryIdentifier String
p CategoryName
c Namespace
ns)
    unresolved :: Parser CategoryIdentifier
unresolved = do
      ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"unresolved")
      ParsecT String () Identity ()
structOpen
      CategoryName
c <- String -> Parser CategoryName -> Parser CategoryName
forall a. String -> Parser a -> Parser a
parseRequired String
"name:" Parser CategoryName
parseCategoryName
      ParsecT String () Identity ()
structClose
      CategoryIdentifier -> Parser CategoryIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryName -> CategoryIdentifier
UnresolvedCategory CategoryName
c)
  writeConfig :: CategoryIdentifier -> m [String]
writeConfig (CategoryIdentifier String
p CategoryName
c Namespace
ns) = do
    CategoryName -> m ()
forall (m :: * -> *). CompileErrorM m => CategoryName -> m ()
validateCategoryName CategoryName
c
    [String]
namespace <- String -> Namespace -> m [String]
forall (m :: * -> *).
CompileErrorM m =>
String -> Namespace -> m [String]
maybeShowNamespace String
"namespace:" Namespace
ns
    [String] -> m [String]
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 :: * -> *). CompileErrorM m => CategoryName -> m ()
validateCategoryName CategoryName
c
    [String] -> m [String]
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 :: Parser ModuleConfig
readConfig = do
      String
p   <- String
-> String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"root:"           String
"" ParsecT String () Identity String
parseQuoted
      String
d   <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> Parser a -> Parser a
parseRequired String
"path:"              ParsecT String () Identity String
parseQuoted
      [(String, Expression SourcePos)]
em  <- String
-> [(String, Expression SourcePos)]
-> Parser [(String, Expression SourcePos)]
-> Parser [(String, Expression SourcePos)]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"expression_map:" [] (Parser (String, Expression SourcePos)
-> Parser [(String, Expression SourcePos)]
forall a. Parser a -> Parser [a]
parseList Parser (String, Expression SourcePos)
parseExprMacro)
      [String]
is  <- String -> [String] -> Parser [String] -> Parser [String]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"public_deps:"    [] (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
      [String]
is2 <- String -> [String] -> Parser [String] -> Parser [String]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"private_deps:"   [] (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
      [ExtraSource]
es  <- String
-> [ExtraSource] -> Parser [ExtraSource] -> Parser [ExtraSource]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"extra_files:"    [] (Parser ExtraSource -> Parser [ExtraSource]
forall a. Parser a -> Parser [a]
parseList Parser ExtraSource
forall a. ConfigFormat a => Parser a
readConfig)
      [String]
ep  <- String -> [String] -> Parser [String] -> Parser [String]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"include_paths:"  [] (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
      CompileMode
m   <- String -> Parser CompileMode -> Parser CompileMode
forall a. String -> Parser a -> Parser a
parseRequired String
"mode:"              Parser CompileMode
forall a. ConfigFormat a => Parser a
readConfig
      ModuleConfig -> Parser ModuleConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> String
-> [(String, Expression SourcePos)]
-> [String]
-> [String]
-> [ExtraSource]
-> [String]
-> CompileMode
-> ModuleConfig
ModuleConfig String
p String
d [(String, Expression SourcePos)]
em [String]
is [String]
is2 [ExtraSource]
es [String]
ep CompileMode
m)
  writeConfig :: ModuleConfig -> m [String]
writeConfig (ModuleConfig String
p String
d [(String, Expression SourcePos)]
em [String]
is [String]
is2 [ExtraSource]
es [String]
ep CompileMode
m) = do
    [String]
es' <- ([[String]] -> [String]) -> m [[String]] -> m [String]
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.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM ExtraSource -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
a -> m [String]
writeConfig [ExtraSource]
es
    [String]
m' <- CompileMode -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
a -> 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
$ [(String, Expression SourcePos)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Expression SourcePos)]
em) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM String
"Only empty expression maps are allowed when writing"
    [String] -> m [String]
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
"expression_map: [",
        -- NOTE: expression_map isn't output because that would require making
        -- all Expression serializable.
        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
"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 :: Parser ExtraSource
readConfig = Parser ExtraSource
category Parser ExtraSource -> Parser ExtraSource -> Parser ExtraSource
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ExtraSource
other where
    category :: Parser ExtraSource
category = do
      ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"category_source")
      ParsecT String () Identity ()
structOpen
      String
f <-  String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> Parser a -> Parser a
parseRequired String
"source:"        ParsecT String () Identity String
parseQuoted
      [CategoryName]
cs <- String
-> [CategoryName] -> Parser [CategoryName] -> Parser [CategoryName]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"categories:" [] (Parser CategoryName -> Parser [CategoryName]
forall a. Parser a -> Parser [a]
parseList Parser CategoryName
parseCategoryName)
      [CategoryName]
ds <- String
-> [CategoryName] -> Parser [CategoryName] -> Parser [CategoryName]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"requires:"   [] (Parser CategoryName -> Parser [CategoryName]
forall a. Parser a -> Parser [a]
parseList Parser CategoryName
parseCategoryName)
      ParsecT String () Identity ()
structClose
      ExtraSource -> Parser ExtraSource
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [CategoryName] -> [CategoryName] -> ExtraSource
CategorySource String
f [CategoryName]
cs [CategoryName]
ds)
    other :: Parser ExtraSource
other = do
      String
f <- ParsecT String () Identity String
parseQuoted
      ExtraSource -> Parser ExtraSource
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ExtraSource
OtherSource String
f)
  writeConfig :: ExtraSource -> m [String]
writeConfig (CategorySource String
f [CategoryName]
cs [CategoryName]
ds) = do
    (CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ CategoryName -> m ()
forall (m :: * -> *). CompileErrorM m => CategoryName -> m ()
validateCategoryName [CategoryName]
cs
    (CategoryName -> m ()) -> [CategoryName] -> m ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ CategoryName -> m ()
forall (m :: * -> *). CompileErrorM m => CategoryName -> m ()
validateCategoryName [CategoryName]
ds
    [String] -> m [String]
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 (m :: * -> *) a. Monad m => a -> m a
return [String -> String
forall a. Show a => a -> String
show String
f]

instance ConfigFormat CompileMode where
  readConfig :: Parser CompileMode
readConfig = String -> Parser CompileMode -> Parser CompileMode
forall a. String -> Parser a -> Parser a
labeled String
"compile mode" (Parser CompileMode -> Parser CompileMode)
-> Parser CompileMode -> Parser CompileMode
forall a b. (a -> b) -> a -> b
$ Parser CompileMode
binary Parser CompileMode -> Parser CompileMode -> Parser CompileMode
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser CompileMode
incremental where
    binary :: Parser CompileMode
binary = do
      ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"binary")
      ParsecT String () Identity ()
structOpen
      CategoryName
c <-  String -> Parser CategoryName -> Parser CategoryName
forall a. String -> Parser a -> Parser a
parseRequired String
"category:"      Parser CategoryName
parseCategoryName
      FunctionName
f <-  String -> Parser FunctionName -> Parser FunctionName
forall a. String -> Parser a -> Parser a
parseRequired String
"function:"      Parser FunctionName
parseFunctionName
      String
o <-  String
-> String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"output:"     String
"" ParsecT String () Identity String
parseQuoted
      [String]
lf <- String -> [String] -> Parser [String] -> Parser [String]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"link_flags:" [] (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
      ParsecT String () Identity ()
structClose
      CompileMode -> Parser CompileMode
forall (m :: * -> *) a. Monad m => a -> m a
return (CategoryName -> FunctionName -> String -> [String] -> CompileMode
CompileBinary CategoryName
c FunctionName
f String
o [String]
lf)
    incremental :: Parser CompileMode
incremental = do
      ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"incremental")
      ParsecT String () Identity ()
structOpen
      [String]
lf <- String -> [String] -> Parser [String] -> Parser [String]
forall a. String -> a -> Parser a -> Parser a
parseOptional String
"link_flags:" [] (ParsecT String () Identity String -> Parser [String]
forall a. Parser a -> Parser [a]
parseList ParsecT String () Identity String
parseQuoted)
      ParsecT String () Identity ()
structClose
      CompileMode -> Parser CompileMode
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> CompileMode
CompileIncremental [String]
lf)
  writeConfig :: CompileMode -> m [String]
writeConfig (CompileBinary CategoryName
c FunctionName
f String
o [String]
lf) = do
    CategoryName -> m ()
forall (m :: * -> *). CompileErrorM m => CategoryName -> m ()
validateCategoryName CategoryName
c
    FunctionName -> m ()
forall (m :: * -> *). CompileErrorM m => FunctionName -> m ()
validateFunctionName FunctionName
f
    [String] -> m [String]
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
"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 (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
CompileUnspecified = CompileMode -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CompileErrorM m) =>
a -> m [String]
writeConfig ([String] -> CompileMode
CompileIncremental [])
  writeConfig CompileMode
_ = String -> m [String]
forall (m :: * -> *) a. CompileErrorM m => String -> m a
compileErrorM String
"Invalid compile mode"

parseExprMacro :: Parser (String,Expression SourcePos)
parseExprMacro :: Parser (String, Expression SourcePos)
parseExprMacro = do
  ParsecT String () Identity () -> ParsecT String () Identity ()
forall a. Parser a -> Parser a
sepAfter (String -> ParsecT String () Identity ()
string_ String
"expression_macro")
  ParsecT String () Identity ()
structOpen
  String
n <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a. String -> Parser a -> Parser a
parseRequired String
"name:"       ParsecT String () Identity String
parseMacroName
  Expression SourcePos
e <- String
-> Parser (Expression SourcePos) -> Parser (Expression SourcePos)
forall a. String -> Parser a -> Parser a
parseRequired String
"expression:" Parser (Expression SourcePos)
forall a. ParseFromSource a => Parser a
sourceParser
  ParsecT String () Identity ()
structClose
  (String, Expression SourcePos)
-> Parser (String, Expression SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n,Expression SourcePos
e)