{- -----------------------------------------------------------------------------
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
    TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"unix_backend")
    TextParser ()
structOpen
    Backend
o <- Permutation TextParser Backend -> TextParser Backend
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser Backend -> TextParser Backend)
-> Permutation TextParser Backend -> TextParser Backend
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String] -> [String] -> String -> Backend
UnixBackend
      (String -> [String] -> [String] -> [String] -> String -> Backend)
-> Permutation TextParser String
-> Permutation
     TextParser ([String] -> [String] -> [String] -> String -> Backend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> TextParser String -> Permutation TextParser String
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"cxx_binary:"    TextParser String
parseQuoted
      Permutation
  TextParser ([String] -> [String] -> [String] -> String -> Backend)
-> Permutation TextParser [String]
-> Permutation
     TextParser ([String] -> [String] -> String -> Backend)
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
"compile_flags:" (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation TextParser ([String] -> [String] -> String -> Backend)
-> Permutation TextParser [String]
-> Permutation TextParser ([String] -> String -> Backend)
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
"library_flags:" (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation TextParser ([String] -> String -> Backend)
-> Permutation TextParser [String]
-> Permutation TextParser (String -> Backend)
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
"binary_flags:"  (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation TextParser (String -> Backend)
-> Permutation TextParser String -> Permutation TextParser Backend
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
"ar_binary:"     TextParser String
parseQuoted
    TextParser ()
structClose
    Backend -> TextParser Backend
forall (m :: * -> *) a. Monad m => a -> m a
return Backend
o
  writeConfig :: Backend -> m [String]
writeConfig (UnixBackend String
cb [String]
cf [String]
lf [String]
bf String
ar) = 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
"unix_backend {",
        String -> String
indent (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"cxx_binary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
cb,
        String -> String
indent String
"compile_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]
cf) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"library_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 -> String
indent String
"binary_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]
bf) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"ar_binary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
ar,
        String
"}"
      ]

instance ConfigFormat Resolver where
  readConfig :: TextParser Resolver
readConfig = do
    TextParser () -> TextParser ()
forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"simple_resolver")
    TextParser ()
structOpen
    Resolver
o <- Permutation TextParser Resolver -> TextParser Resolver
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation TextParser Resolver -> TextParser Resolver)
-> Permutation TextParser Resolver -> TextParser Resolver
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> Resolver
SimpleResolver
      ([String] -> [String] -> Resolver)
-> Permutation TextParser [String]
-> Permutation TextParser ([String] -> Resolver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> TextParser [String] -> Permutation TextParser [String]
forall a. String -> TextParser a -> Permutation TextParser a
parseRequired String
"system_allowed:" (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation TextParser ([String] -> Resolver)
-> Permutation TextParser [String]
-> Permutation TextParser Resolver
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
"extra_paths:"    (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    TextParser ()
structClose
    Resolver -> TextParser Resolver
forall (m :: * -> *) a. Monad m => a -> m a
return Resolver
o
  writeConfig :: Resolver -> m [String]
writeConfig (SimpleResolver [String]
ss [String]
es) = 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
"simple_resolver {",
        String -> String
indent String
"system_allowed: ["
      ] [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]
ss) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String -> String
indent String
"extra_paths: ["
      ] [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]
es) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [
        String -> String
indent String
"]",
        String
"}"
      ]

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