{- -----------------------------------------------------------------------------
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 Config.ParseConfig (
) where

import Control.Applicative.Permutations

import Config.CompilerConfig
import Module.ParseMetadata
import Parser.Common


instance ConfigFormat Backend where
  readConfig :: TextParser Backend
readConfig = do
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"unix_backend")
    TextParser ()
structOpen
    Backend
o <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String] -> [String] -> String -> Backend
UnixBackend
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"cxx_binary:"    TextParser String
parseQuoted
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"compile_flags:" (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"library_flags:" (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"binary_flags:"  (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"ar_binary:"     TextParser String
parseQuoted
    TextParser ()
structClose
    forall (m :: * -> *) a. Monad m => a -> m a
return Backend
o
  writeConfig :: forall (m :: * -> *). CollectErrorsM m => Backend -> m [String]
writeConfig (UnixBackend String
cb [String]
cf [String]
lf [String]
bf String
ar) = do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"unix_backend {",
        String -> String
indent forall a b. (a -> b) -> a -> b
$ String
"cxx_binary: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
cb,
        String -> String
indent String
"compile_flags: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
cf) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"library_flags: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
lf) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"binary_flags: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
bf) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent forall a b. (a -> b) -> a -> b
$ String
"ar_binary: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
ar,
        String
"}"
      ]

instance ConfigFormat Resolver where
  readConfig :: TextParser Resolver
readConfig = do
    forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"simple_resolver")
    TextParser ()
structOpen
    Resolver
o <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> Resolver
SimpleResolver
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"system_allowed:" (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"extra_paths:"    (forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    TextParser ()
structClose
    forall (m :: * -> *) a. Monad m => a -> m a
return Resolver
o
  writeConfig :: forall (m :: * -> *). CollectErrorsM m => Resolver -> m [String]
writeConfig (SimpleResolver [String]
ss [String]
es) = do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [
        String
"simple_resolver {",
        String -> String
indent String
"system_allowed: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
ss) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"extra_paths: ["
      ] forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
indents forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
indents) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [String]
es) forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String
"}"
      ]

instance ConfigFormat LocalConfig where
  readConfig :: TextParser LocalConfig
readConfig = forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$ Resolver -> Backend -> LocalConfig
LocalConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"resolver:" forall a. ConfigFormat a => TextParser a
readConfig
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"backend:"  forall a. ConfigFormat a => TextParser a
readConfig
  writeConfig :: forall (m :: * -> *). CollectErrorsM m => LocalConfig -> m [String]
writeConfig (LocalConfig Resolver
r Backend
b) = do
    [String]
r' <- forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig Resolver
r
    [String]
b' <- forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
writeConfig Backend
b
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String
"resolver: " String -> [String] -> [String]
`prependFirst` [String]
r') forall a. [a] -> [a] -> [a]
++ (String
"backend: " String -> [String] -> [String]
`prependFirst` [String]
b')