{- -----------------------------------------------------------------------------
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 (ParsecT CompilerMessage String Identity) Backend
-> TextParser Backend
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) Backend
 -> TextParser Backend)
-> Permutation (ParsecT CompilerMessage String Identity) Backend
-> TextParser Backend
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String] -> [String] -> String -> Backend
UnixBackend
      (String -> [String] -> [String] -> [String] -> String -> Backend)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation
     (ParsecT CompilerMessage String Identity)
     ([String] -> [String] -> [String] -> String -> Backend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"cxx_binary:"    TextParser String
parseQuoted
      Permutation
  (ParsecT CompilerMessage String Identity)
  ([String] -> [String] -> [String] -> String -> Backend)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
     (ParsecT CompilerMessage String Identity)
     ([String] -> [String] -> String -> Backend)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"compile_flags:" (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation
  (ParsecT CompilerMessage String Identity)
  ([String] -> [String] -> String -> Backend)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
     (ParsecT CompilerMessage String Identity)
     ([String] -> String -> Backend)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"library_flags:" (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation
  (ParsecT CompilerMessage String Identity)
  ([String] -> String -> Backend)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
     (ParsecT CompilerMessage String Identity) (String -> Backend)
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"binary_flags:"  (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation
  (ParsecT CompilerMessage String Identity) (String -> Backend)
-> Permutation (ParsecT CompilerMessage String Identity) String
-> Permutation (ParsecT CompilerMessage String Identity) Backend
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser String
-> Permutation (ParsecT CompilerMessage String Identity) String
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"ar_binary:"     TextParser String
parseQuoted
    TextParser ()
structClose
    Backend -> TextParser Backend
forall a. a -> ParsecT CompilerMessage String Identity a
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
    [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
        String
"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 (ParsecT CompilerMessage String Identity) Resolver
-> TextParser Resolver
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) Resolver
 -> TextParser Resolver)
-> Permutation (ParsecT CompilerMessage String Identity) Resolver
-> TextParser Resolver
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> Resolver
SimpleResolver
      ([String] -> [String] -> Resolver)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation
     (ParsecT CompilerMessage String Identity) ([String] -> Resolver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"system_allowed:" (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
      Permutation
  (ParsecT CompilerMessage String Identity) ([String] -> Resolver)
-> Permutation (ParsecT CompilerMessage String Identity) [String]
-> Permutation (ParsecT CompilerMessage String Identity) Resolver
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser [String]
-> Permutation (ParsecT CompilerMessage String Identity) [String]
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"extra_paths:"    (TextParser String -> TextParser [String]
forall a. TextParser a -> TextParser [a]
parseList TextParser String
parseQuoted)
    TextParser ()
structClose
    Resolver -> TextParser Resolver
forall a. a -> ParsecT CompilerMessage String Identity a
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
    [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ [
        String
"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 (ParsecT CompilerMessage String Identity) LocalConfig
-> TextParser LocalConfig
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation (ParsecT CompilerMessage String Identity) LocalConfig
 -> TextParser LocalConfig)
-> Permutation
     (ParsecT CompilerMessage String Identity) LocalConfig
-> TextParser LocalConfig
forall a b. (a -> b) -> a -> b
$ Resolver -> Backend -> LocalConfig
LocalConfig
    (Resolver -> Backend -> LocalConfig)
-> Permutation (ParsecT CompilerMessage String Identity) Resolver
-> Permutation
     (ParsecT CompilerMessage String Identity) (Backend -> LocalConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> TextParser Resolver
-> Permutation (ParsecT CompilerMessage String Identity) Resolver
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"resolver:" TextParser Resolver
forall a. ConfigFormat a => TextParser a
readConfig
    Permutation
  (ParsecT CompilerMessage String Identity) (Backend -> LocalConfig)
-> Permutation (ParsecT CompilerMessage String Identity) Backend
-> Permutation
     (ParsecT CompilerMessage String Identity) LocalConfig
forall a b.
Permutation (ParsecT CompilerMessage String Identity) (a -> b)
-> Permutation (ParsecT CompilerMessage String Identity) a
-> Permutation (ParsecT CompilerMessage String Identity) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> TextParser Backend
-> Permutation (ParsecT CompilerMessage String Identity) Backend
forall a.
String
-> TextParser a
-> Permutation (ParsecT CompilerMessage String Identity) a
parseRequired String
"backend:"  TextParser 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' <- Resolver -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *). CollectErrorsM m => Resolver -> m [String]
writeConfig Resolver
r
    [String]
b' <- Backend -> m [String]
forall a (m :: * -> *).
(ConfigFormat a, CollectErrorsM m) =>
a -> m [String]
forall (m :: * -> *). CollectErrorsM m => Backend -> m [String]
writeConfig Backend
b
    [String] -> m [String]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ (String
"resolver: " String -> [String] -> [String]
`prependFirst` [String]
r') [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String
"backend: " String -> [String] -> [String]
`prependFirst` [String]
b')