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

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

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

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

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

module Module.ParseMetadata (
  ConfigFormat,
  autoReadConfig,
  autoWriteConfig,
) 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 (FunctionName(..),Namespace(..))
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 :: 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 :: 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, 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 :: 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. 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 :: 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. 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 :: 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. 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 (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
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar)

maybeShowNamespace :: ErrorContextM 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. 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 (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 :: 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
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
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return String
ss

parseList :: TextParser a -> TextParser [a]
parseList :: 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 (m :: * -> *) a. Monad m => a -> m a
return [a]
xs

parseOptional :: String -> a -> TextParser a -> Permutation (TextParser) a
parseOptional :: String -> a -> TextParser a -> Permutation TextParser a
parseOptional String
l a
def TextParser a
p = a -> TextParser a -> Permutation TextParser a
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault a
def (TextParser a -> Permutation TextParser a)
-> TextParser a -> Permutation TextParser a
forall a b. (a -> b) -> a -> b
$ do
    ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
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 :: String -> TextParser a -> Permutation TextParser a
parseRequired String
l TextParser a
p = TextParser a -> Permutation TextParser a
forall (m :: * -> *) a. Alternative m => m a -> Permutation m a
toPermutation (TextParser a -> Permutation TextParser a)
-> TextParser a -> Permutation TextParser a
forall a b. (a -> b) -> a -> b
$ do
    ParsecT CompilerMessage String Identity ()
-> ParsecT CompilerMessage String Identity ()
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 TextParser CompileMetadata
-> TextParser CompileMetadata
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser CompileMetadata
 -> TextParser CompileMetadata)
-> Permutation TextParser CompileMetadata
-> TextParser CompileMetadata
forall a b. (a -> b) -> a -> b
$ VersionHash
-> String
-> Namespace
-> Namespace
-> [String]
-> [String]
-> [CategoryName]
-> [CategoryName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [ObjectFile]
-> CompileMetadata
CompileMetadata
    (VersionHash
 -> String
 -> Namespace
 -> Namespace
 -> [String]
 -> [String]
 -> [CategoryName]
 -> [CategoryName]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [String]
 -> [ObjectFile]
 -> CompileMetadata)
-> Permutation TextParser VersionHash
-> Permutation
     TextParser
     (String
      -> Namespace
      -> Namespace
      -> [String]
      -> [String]
      -> [CategoryName]
      -> [CategoryName]
      -> [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 TextParser VersionHash
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"version_hash:"       TextParser VersionHash
parseHash
    Permutation
  TextParser
  (String
   -> Namespace
   -> Namespace
   -> [String]
   -> [String]
   -> [CategoryName]
   -> [CategoryName]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser String
-> Permutation
     TextParser
     (Namespace
      -> Namespace
      -> [String]
      -> [String]
      -> [CategoryName]
      -> [CategoryName]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> ParsecT CompilerMessage String Identity String
-> Permutation TextParser String
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"path:"               ParsecT CompilerMessage String Identity String
parseQuoted
    Permutation
  TextParser
  (Namespace
   -> Namespace
   -> [String]
   -> [String]
   -> [CategoryName]
   -> [CategoryName]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser Namespace
-> Permutation
     TextParser
     (Namespace
      -> [String]
      -> [String]
      -> [CategoryName]
      -> [CategoryName]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Namespace
-> TextParser Namespace
-> Permutation TextParser Namespace
forall a. String -> a -> TextParser a -> Permutation TextParser a
parseOptional String
"public_namespace:"   Namespace
NoNamespace TextParser Namespace
parseNamespace
    Permutation
  TextParser
  (Namespace
   -> [String]
   -> [String]
   -> [CategoryName]
   -> [CategoryName]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser Namespace
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [CategoryName]
      -> [CategoryName]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Namespace
-> TextParser Namespace
-> Permutation TextParser Namespace
forall a. String -> a -> TextParser a -> Permutation TextParser a
parseOptional String
"private_namespace:"  Namespace
NoNamespace TextParser Namespace
parseNamespace
    Permutation
  TextParser
  ([String]
   -> [String]
   -> [CategoryName]
   -> [CategoryName]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [CategoryName]
      -> [CategoryName]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [CategoryName]
   -> [CategoryName]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([CategoryName]
      -> [CategoryName]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([CategoryName]
   -> [CategoryName]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [CategoryName]
-> Permutation
     TextParser
     ([CategoryName]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [CategoryName]
-> Permutation TextParser [CategoryName]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([CategoryName]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [CategoryName]
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [CategoryName]
-> Permutation TextParser [CategoryName]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [String]
      -> [String]
      -> [ObjectFile]
      -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String]
   -> [String]
   -> [String]
   -> [ObjectFile]
   -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [String] -> [String] -> [ObjectFile] -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String] -> [String] -> [ObjectFile] -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String] -> [String] -> [ObjectFile] -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String] -> [String] -> [ObjectFile] -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation
     TextParser ([String] -> [ObjectFile] -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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
  TextParser ([String] -> [ObjectFile] -> CompileMetadata)
-> Permutation TextParser [String]
-> Permutation TextParser ([ObjectFile] -> CompileMetadata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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 TextParser ([ObjectFile] -> CompileMetadata)
-> Permutation TextParser [ObjectFile]
-> Permutation TextParser CompileMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [ObjectFile] -> Permutation TextParser [ObjectFile]
forall a. String -> TextParser a -> Permutation TextParser 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 :: 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 :: * -> *). 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 (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]
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 :: TextParser ObjectFile
readConfig = TextParser ObjectFile
category TextParser ObjectFile
-> TextParser ObjectFile -> TextParser ObjectFile
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 TextParser ObjectFile -> TextParser ObjectFile
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser ObjectFile -> TextParser ObjectFile)
-> Permutation TextParser ObjectFile -> TextParser ObjectFile
forall a b. (a -> b) -> a -> b
$ CategoryIdentifier
-> [CategoryIdentifier] -> [String] -> ObjectFile
CategoryObjectFile
        (CategoryIdentifier
 -> [CategoryIdentifier] -> [String] -> ObjectFile)
-> Permutation TextParser CategoryIdentifier
-> Permutation
     TextParser ([CategoryIdentifier] -> [String] -> ObjectFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser CategoryIdentifier
-> Permutation TextParser CategoryIdentifier
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"category:" TextParser CategoryIdentifier
forall a. ConfigFormat a => TextParser a
readConfig
        Permutation
  TextParser ([CategoryIdentifier] -> [String] -> ObjectFile)
-> Permutation TextParser [CategoryIdentifier]
-> Permutation TextParser ([String] -> ObjectFile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [CategoryIdentifier]
-> Permutation TextParser [CategoryIdentifier]
forall a. String -> TextParser a -> Permutation TextParser 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 TextParser ([String] -> ObjectFile)
-> Permutation TextParser [String]
-> Permutation TextParser ObjectFile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser 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 (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 TextParser ObjectFile -> TextParser ObjectFile
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser ObjectFile -> TextParser ObjectFile)
-> Permutation TextParser ObjectFile -> TextParser ObjectFile
forall a b. (a -> b) -> a -> b
$ String -> ObjectFile
OtherObjectFile
        (String -> ObjectFile)
-> Permutation TextParser String
-> Permutation TextParser ObjectFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT CompilerMessage String Identity String
-> Permutation TextParser String
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"file:" ParsecT CompilerMessage String Identity String
parseQuoted
      ParsecT CompilerMessage String Identity ()
structClose
      ObjectFile -> TextParser ObjectFile
forall (m :: * -> *) a. Monad m => a -> m a
return ObjectFile
f
  writeConfig :: 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]
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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM CategoryIdentifier -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM 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 :: TextParser CategoryIdentifier
readConfig = TextParser CategoryIdentifier
category TextParser CategoryIdentifier
-> TextParser CategoryIdentifier -> TextParser CategoryIdentifier
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 TextParser CategoryIdentifier
-> TextParser CategoryIdentifier
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser CategoryIdentifier
 -> TextParser CategoryIdentifier)
-> Permutation TextParser CategoryIdentifier
-> TextParser CategoryIdentifier
forall a b. (a -> b) -> a -> b
$ String -> CategoryName -> Namespace -> CategoryIdentifier
CategoryIdentifier
        (String -> CategoryName -> Namespace -> CategoryIdentifier)
-> Permutation TextParser String
-> Permutation
     TextParser (CategoryName -> Namespace -> CategoryIdentifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT CompilerMessage String Identity String
-> Permutation TextParser String
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"path:"      ParsecT CompilerMessage String Identity String
parseQuoted
        Permutation
  TextParser (CategoryName -> Namespace -> CategoryIdentifier)
-> Permutation TextParser CategoryName
-> Permutation TextParser (Namespace -> CategoryIdentifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser CategoryName -> Permutation TextParser CategoryName
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"name:"      TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser
        Permutation TextParser (Namespace -> CategoryIdentifier)
-> Permutation TextParser Namespace
-> Permutation TextParser CategoryIdentifier
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Namespace
-> TextParser Namespace
-> Permutation TextParser Namespace
forall a. String -> a -> TextParser a -> Permutation TextParser a
parseOptional String
"namespace:" Namespace
NoNamespace TextParser Namespace
parseNamespace
      ParsecT CompilerMessage String Identity ()
structClose
      CategoryIdentifier -> TextParser CategoryIdentifier
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 TextParser CategoryIdentifier
-> TextParser CategoryIdentifier
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser CategoryIdentifier
 -> TextParser CategoryIdentifier)
-> Permutation TextParser CategoryIdentifier
-> TextParser CategoryIdentifier
forall a b. (a -> b) -> a -> b
$ CategoryName -> CategoryIdentifier
UnresolvedCategory
        (CategoryName -> CategoryIdentifier)
-> Permutation TextParser CategoryName
-> Permutation TextParser CategoryIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser CategoryName -> Permutation TextParser CategoryName
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"name:" TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser
      ParsecT CompilerMessage String Identity ()
structClose
      CategoryIdentifier -> TextParser CategoryIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return CategoryIdentifier
c
  writeConfig :: 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 (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 (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 TextParser ModuleConfig -> TextParser ModuleConfig
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser ModuleConfig -> TextParser ModuleConfig)
-> Permutation TextParser ModuleConfig -> TextParser ModuleConfig
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [(MacroName, Expression SourceContext)]
-> [String]
-> [String]
-> [ExtraSource]
-> [String]
-> CompileMode
-> ModuleConfig
ModuleConfig
    (String
 -> String
 -> [(MacroName, Expression SourceContext)]
 -> [String]
 -> [String]
 -> [ExtraSource]
 -> [String]
 -> CompileMode
 -> ModuleConfig)
-> Permutation TextParser String
-> Permutation
     TextParser
     (String
      -> [(MacroName, Expression SourceContext)]
      -> [String]
      -> [String]
      -> [ExtraSource]
      -> [String]
      -> CompileMode
      -> ModuleConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> String
-> ParsecT CompilerMessage String Identity String
-> Permutation TextParser String
forall a. String -> a -> TextParser a -> Permutation TextParser a
parseOptional String
"root:"           String
"" ParsecT CompilerMessage String Identity String
parseQuoted
    Permutation
  TextParser
  (String
   -> [(MacroName, Expression SourceContext)]
   -> [String]
   -> [String]
   -> [ExtraSource]
   -> [String]
   -> CompileMode
   -> ModuleConfig)
-> Permutation TextParser String
-> Permutation
     TextParser
     ([(MacroName, Expression SourceContext)]
      -> [String]
      -> [String]
      -> [ExtraSource]
      -> [String]
      -> CompileMode
      -> ModuleConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> ParsecT CompilerMessage String Identity String
-> Permutation TextParser String
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"path:"              ParsecT CompilerMessage String Identity String
parseQuoted
    Permutation
  TextParser
  ([(MacroName, Expression SourceContext)]
   -> [String]
   -> [String]
   -> [ExtraSource]
   -> [String]
   -> CompileMode
   -> ModuleConfig)
-> Permutation TextParser [(MacroName, Expression SourceContext)]
-> Permutation
     TextParser
     ([String]
      -> [String]
      -> [ExtraSource]
      -> [String]
      -> CompileMode
      -> ModuleConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [(MacroName, Expression SourceContext)]
-> TextParser [(MacroName, Expression SourceContext)]
-> Permutation TextParser [(MacroName, Expression SourceContext)]
forall a. String -> a -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [String]
   -> [ExtraSource]
   -> [String]
   -> CompileMode
   -> ModuleConfig)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([String]
      -> [ExtraSource] -> [String] -> CompileMode -> ModuleConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation TextParser [String]
forall a. String -> a -> TextParser a -> Permutation TextParser 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
  TextParser
  ([String]
   -> [ExtraSource] -> [String] -> CompileMode -> ModuleConfig)
-> Permutation TextParser [String]
-> Permutation
     TextParser
     ([ExtraSource] -> [String] -> CompileMode -> ModuleConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation TextParser [String]
forall a. String -> a -> TextParser a -> Permutation TextParser 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
  TextParser
  ([ExtraSource] -> [String] -> CompileMode -> ModuleConfig)
-> Permutation TextParser [ExtraSource]
-> Permutation TextParser ([String] -> CompileMode -> ModuleConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [ExtraSource]
-> TextParser [ExtraSource]
-> Permutation TextParser [ExtraSource]
forall a. String -> a -> TextParser a -> Permutation TextParser 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 TextParser ([String] -> CompileMode -> ModuleConfig)
-> Permutation TextParser [String]
-> Permutation TextParser (CompileMode -> ModuleConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation TextParser [String]
forall a. String -> a -> TextParser a -> Permutation TextParser 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 TextParser (CompileMode -> ModuleConfig)
-> Permutation TextParser CompileMode
-> Permutation TextParser ModuleConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser CompileMode -> Permutation TextParser CompileMode
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"mode:"              TextParser CompileMode
forall a. ConfigFormat a => TextParser a
readConfig
  writeConfig :: ModuleConfig -> m [String]
writeConfig (ModuleConfig String
p String
d [(MacroName, Expression SourceContext)]
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.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM ExtraSource -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig [ExtraSource]
es
    [String]
m' <- CompileMode -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM 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
$ [(MacroName, Expression SourceContext)] -> 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 (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM 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 :: TextParser ExtraSource
readConfig = TextParser ExtraSource
category TextParser ExtraSource
-> TextParser ExtraSource -> TextParser ExtraSource
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 TextParser ExtraSource -> TextParser ExtraSource
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser ExtraSource -> TextParser ExtraSource)
-> Permutation TextParser ExtraSource -> TextParser ExtraSource
forall a b. (a -> b) -> a -> b
$ String -> [CategoryName] -> [CategoryName] -> ExtraSource
CategorySource
        (String -> [CategoryName] -> [CategoryName] -> ExtraSource)
-> Permutation TextParser String
-> Permutation
     TextParser ([CategoryName] -> [CategoryName] -> ExtraSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT CompilerMessage String Identity String
-> Permutation TextParser String
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"source:"        ParsecT CompilerMessage String Identity String
parseQuoted
        Permutation
  TextParser ([CategoryName] -> [CategoryName] -> ExtraSource)
-> Permutation TextParser [CategoryName]
-> Permutation TextParser ([CategoryName] -> ExtraSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [CategoryName]
-> TextParser [CategoryName]
-> Permutation TextParser [CategoryName]
forall a. String -> a -> TextParser a -> Permutation TextParser 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 TextParser ([CategoryName] -> ExtraSource)
-> Permutation TextParser [CategoryName]
-> Permutation TextParser ExtraSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [CategoryName]
-> TextParser [CategoryName]
-> Permutation TextParser [CategoryName]
forall a. String -> a -> TextParser a -> Permutation TextParser 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 (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 (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.
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 (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 :: 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 (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 TextParser CompileMode -> TextParser CompileMode
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser CompileMode -> TextParser CompileMode)
-> Permutation TextParser CompileMode -> TextParser CompileMode
forall a b. (a -> b) -> a -> b
$ CategoryName -> FunctionName -> String -> [String] -> CompileMode
CompileBinary
        (CategoryName -> FunctionName -> String -> [String] -> CompileMode)
-> Permutation TextParser CategoryName
-> Permutation
     TextParser (FunctionName -> String -> [String] -> CompileMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser CategoryName -> Permutation TextParser CategoryName
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"category:"      TextParser CategoryName
forall a. ParseFromSource a => TextParser a
sourceParser
        Permutation
  TextParser (FunctionName -> String -> [String] -> CompileMode)
-> Permutation TextParser FunctionName
-> Permutation TextParser (String -> [String] -> CompileMode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser FunctionName -> Permutation TextParser FunctionName
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"function:"      TextParser FunctionName
forall a. ParseFromSource a => TextParser a
sourceParser
        Permutation TextParser (String -> [String] -> CompileMode)
-> Permutation TextParser String
-> Permutation TextParser ([String] -> CompileMode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> String
-> ParsecT CompilerMessage String Identity String
-> Permutation TextParser String
forall a. String -> a -> TextParser a -> Permutation TextParser a
parseOptional String
"output:"     String
"" ParsecT CompilerMessage String Identity String
parseQuoted
        Permutation TextParser ([String] -> CompileMode)
-> Permutation TextParser [String]
-> Permutation TextParser CompileMode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [String]
-> TextParser [String]
-> Permutation TextParser [String]
forall a. String -> a -> TextParser a -> Permutation TextParser 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 (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 TextParser CompileMode -> TextParser CompileMode
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser CompileMode -> TextParser CompileMode)
-> Permutation TextParser CompileMode -> TextParser CompileMode
forall a b. (a -> b) -> a -> b
$ [String] -> CompileMode
CompileIncremental
        ([String] -> CompileMode)
-> Permutation TextParser [String]
-> Permutation TextParser CompileMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [String]
-> TextParser [String]
-> Permutation TextParser [String]
forall a. String -> a -> TextParser a -> Permutation TextParser 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 (m :: * -> *) a. Monad m => a -> m a
return CompileMode
lf
  writeConfig :: CompileMode -> m [String]
writeConfig (CompileBinary CategoryName
c FunctionName
f 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] -> 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, CollectErrorsM m) =>
a -> m [String]
writeConfig ([String] -> CompileMode
CompileIncremental [])
  writeConfig CompileMode
_ = String -> m [String]
forall (m :: * -> *) a. ErrorContextM m => String -> m a
compilerErrorM String
"Invalid compile mode"

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 TextParser (MacroName, Expression SourceContext)
-> TextParser (MacroName, Expression SourceContext)
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser (MacroName, Expression SourceContext)
 -> TextParser (MacroName, Expression SourceContext))
-> Permutation TextParser (MacroName, Expression SourceContext)
-> TextParser (MacroName, Expression SourceContext)
forall a b. (a -> b) -> a -> b
$ (,)
    (MacroName
 -> Expression SourceContext
 -> (MacroName, Expression SourceContext))
-> Permutation TextParser MacroName
-> Permutation
     TextParser
     (Expression SourceContext -> (MacroName, Expression SourceContext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> TextParser MacroName -> Permutation TextParser MacroName
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"name:"       TextParser MacroName
forall a. ParseFromSource a => TextParser a
sourceParser
    Permutation
  TextParser
  (Expression SourceContext -> (MacroName, Expression SourceContext))
-> Permutation TextParser (Expression SourceContext)
-> Permutation TextParser (MacroName, Expression SourceContext)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser (Expression SourceContext)
-> Permutation TextParser (Expression SourceContext)
forall a. String -> TextParser a -> Permutation TextParser 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 (m :: * -> *) a. Monad m => a -> m a
return (MacroName, Expression SourceContext)
e