{-# LANGUAGE OverloadedStrings, TupleSections, FlexibleContexts #-}

module Funcons.RunOptions where

import Funcons.Types
import Funcons.GLLParser (Parser(..), pFunconsSeq, pFuncons, fct_lexerSettings)
import Funcons.Parser (fct_parse)

import GLL.Combinators hiding (chooses)

import qualified Data.Map as M
import Control.Monad (when)
import Control.Compose (OO(..))
import Data.Text (pack)
import Data.List (isSuffixOf, isPrefixOf)
import Data.List.Split (splitOn)

import System.Directory (doesFileExist)

type GeneralOptions = M.Map Name String
type BuiltinFunconsOptions = M.Map Name Funcons
type TestOptions = M.Map Name [Funcons]
type InputValues = M.Map Name [Values]

data RunOptions = RunOptions {
            RunOptions -> Maybe Funcons
mfuncon_term        :: Maybe Funcons
        ,   RunOptions -> GeneralOptions
general_opts        :: GeneralOptions
        ,   RunOptions -> BuiltinFunconsOptions
builtin_funcons     :: BuiltinFunconsOptions
        ,   RunOptions -> TestOptions
expected_outcomes   :: TestOptions
        ,   RunOptions -> InputValues
given_inputs        :: InputValues
        }

defaultRunOptions :: RunOptions
defaultRunOptions :: RunOptions
defaultRunOptions = Maybe Funcons
-> GeneralOptions
-> BuiltinFunconsOptions
-> TestOptions
-> InputValues
-> RunOptions
RunOptions Maybe Funcons
forall a. Maybe a
Nothing GeneralOptions
forall k a. Map k a
M.empty BuiltinFunconsOptions
forall k a. Map k a
M.empty TestOptions
forall k a. Map k a
M.empty InputValues
forall k a. Map k a
M.empty

optionsOverride :: RunOptions -> RunOptions -> RunOptions
optionsOverride RunOptions
opts RunOptions
opts' = Maybe Funcons
-> GeneralOptions
-> BuiltinFunconsOptions
-> TestOptions
-> InputValues
-> RunOptions
RunOptions
    (Maybe Funcons
-> (Funcons -> Maybe Funcons) -> Maybe Funcons -> Maybe Funcons
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RunOptions -> Maybe Funcons
mfuncon_term RunOptions
opts) Funcons -> Maybe Funcons
forall a. a -> Maybe a
Just (RunOptions -> Maybe Funcons
mfuncon_term RunOptions
opts'))
    (RunOptions -> GeneralOptions
general_opts RunOptions
opts GeneralOptions -> GeneralOptions -> GeneralOptions
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` RunOptions -> GeneralOptions
general_opts RunOptions
opts')
    (RunOptions -> BuiltinFunconsOptions
builtin_funcons RunOptions
opts BuiltinFunconsOptions
-> BuiltinFunconsOptions -> BuiltinFunconsOptions
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` RunOptions -> BuiltinFunconsOptions
builtin_funcons RunOptions
opts')
    (RunOptions -> TestOptions
expected_outcomes RunOptions
opts TestOptions -> TestOptions -> TestOptions
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` RunOptions -> TestOptions
expected_outcomes RunOptions
opts')
    (RunOptions -> InputValues
given_inputs RunOptions
opts InputValues -> InputValues -> InputValues
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` RunOptions -> InputValues
given_inputs RunOptions
opts')

funcon_term :: RunOptions -> Funcons
funcon_term :: RunOptions -> Funcons
funcon_term = Funcons -> (Funcons -> Funcons) -> Maybe Funcons -> Funcons
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Funcons
forall a. a
err Funcons -> Funcons
forall a. a -> a
id (Maybe Funcons -> Funcons)
-> (RunOptions -> Maybe Funcons) -> RunOptions -> Funcons
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> Maybe Funcons
mfuncon_term
    where err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Please give a .fct file as an argument or use the --funcon-term flag"

bool_opt_default :: Bool -> Name -> M.Map Name String -> Bool
bool_opt_default :: Bool -> Name -> GeneralOptions -> Bool
bool_opt_default Bool
def Name
nm GeneralOptions
m = case Name -> GeneralOptions -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
nm GeneralOptions
m of
    Maybe [Char]
Nothing         -> Bool
def
    Just [Char]
"false"    -> Bool
False
    Maybe [Char]
_               -> Bool
True


bool_opt :: Name -> M.Map Name String -> Bool
bool_opt :: Name -> GeneralOptions -> Bool
bool_opt Name
nm GeneralOptions
m = Bool -> Name -> GeneralOptions -> Bool
bool_opt_default Bool
False Name
nm GeneralOptions
m

do_refocus :: RunOptions -> Bool
do_refocus :: RunOptions -> Bool
do_refocus RunOptions
opts = Bool -> Name -> GeneralOptions -> Bool
bool_opt_default Bool
True Name
"refocus" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)

max_restarts :: RunOptions -> Maybe Int
max_restarts :: RunOptions -> Maybe Int
max_restarts = ([Char] -> Int) -> Maybe [Char] -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Int
forall a. Read a => [Char] -> a
read (Maybe [Char] -> Maybe Int)
-> (RunOptions -> Maybe [Char]) -> RunOptions -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"max-restarts" (GeneralOptions -> Maybe [Char])
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

do_abrupt_terminate :: RunOptions -> Bool
do_abrupt_terminate :: RunOptions -> Bool
do_abrupt_terminate = Bool -> Bool
not (Bool -> Bool) -> (RunOptions -> Bool) -> RunOptions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Bool
bool_opt Name
"no-abrupt-termination" (GeneralOptions -> Bool)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

pp_full_environments :: RunOptions -> Bool
pp_full_environments :: RunOptions -> Bool
pp_full_environments = Name -> GeneralOptions -> Bool
bool_opt Name
"full-environments" (GeneralOptions -> Bool)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

show_result :: RunOptions -> Bool
show_result :: RunOptions -> Bool
show_result RunOptions
opts = if Name -> GeneralOptions -> Bool
bool_opt Name
"hide-result" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)
    then Bool
False
    else Bool -> Bool
not (RunOptions -> Bool
interactive_mode RunOptions
opts)

show_counts :: RunOptions -> Bool
show_counts :: RunOptions -> Bool
show_counts RunOptions
opts = if Name -> GeneralOptions -> Bool
bool_opt Name
"display-steps" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)
    then Bool -> Bool
not (RunOptions -> Bool
interactive_mode RunOptions
opts)
    else Bool
False

show_mutable :: RunOptions -> [Name]
show_mutable :: RunOptions -> [Name]
show_mutable = [Name] -> ([Char] -> [Name]) -> Maybe [Char] -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (([Char] -> Name) -> [[Char]] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Name
pack ([[Char]] -> [Name]) -> ([Char] -> [[Char]]) -> [Char] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
",") (Maybe [Char] -> [Name])
-> (RunOptions -> Maybe [Char]) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"display-mutable-entity"  (GeneralOptions -> Maybe [Char])
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

hide_output :: RunOptions -> [Name]
hide_output :: RunOptions -> [Name]
hide_output = [Name] -> ([Char] -> [Name]) -> Maybe [Char] -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (([Char] -> Name) -> [[Char]] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Name
pack ([[Char]] -> [Name]) -> ([Char] -> [[Char]]) -> [Char] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
",") (Maybe [Char] -> [Name])
-> (RunOptions -> Maybe [Char]) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"hide-output-entity"  (GeneralOptions -> Maybe [Char])
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

hide_input :: RunOptions -> [Name]
hide_input :: RunOptions -> [Name]
hide_input = [Name] -> ([Char] -> [Name]) -> Maybe [Char] -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (([Char] -> Name) -> [[Char]] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Name
pack ([[Char]] -> [Name]) -> ([Char] -> [[Char]]) -> [Char] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
",") (Maybe [Char] -> [Name])
-> (RunOptions -> Maybe [Char]) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"hide-input-entity"  (GeneralOptions -> Maybe [Char])
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

hide_control :: RunOptions -> [Name]
hide_control :: RunOptions -> [Name]
hide_control = [Name] -> ([Char] -> [Name]) -> Maybe [Char] -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (([Char] -> Name) -> [[Char]] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Name
pack ([[Char]] -> [Name]) -> ([Char] -> [[Char]]) -> [Char] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
",") (Maybe [Char] -> [Name])
-> (RunOptions -> Maybe [Char]) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"hide-control-entity" (GeneralOptions -> Maybe [Char])
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

interactive_mode :: RunOptions -> Bool
interactive_mode :: RunOptions -> Bool
interactive_mode RunOptions
opts = 
  InputValues -> Bool
forall k a. Map k a -> Bool
M.null (RunOptions -> InputValues
inputValues RunOptions
opts) Bool -> Bool -> Bool
&& Name -> GeneralOptions -> Bool
bool_opt Name
"interactive-mode" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)

pp_string_outputs :: RunOptions -> Bool
pp_string_outputs :: RunOptions -> Bool
pp_string_outputs = Name -> GeneralOptions -> Bool
bool_opt Name
"format-string-outputs" (GeneralOptions -> Bool)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

string_inputs :: RunOptions -> Bool
string_inputs :: RunOptions -> Bool
string_inputs = Name -> GeneralOptions -> Bool
bool_opt Name
"string-inputs" (GeneralOptions -> Bool)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts

show_tests :: RunOptions -> Bool
show_tests :: RunOptions -> Bool
show_tests RunOptions
opts = if Name -> GeneralOptions -> Bool
bool_opt Name
"hide-tests" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)
        then Bool
False
        else TestOptions -> Int
forall k a. Map k a -> Int
M.size (RunOptions -> TestOptions
expected_outcomes RunOptions
opts) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

show_output_only :: RunOptions -> Bool
show_output_only :: RunOptions -> Bool
show_output_only RunOptions
opts = if Name -> GeneralOptions -> Bool
bool_opt Name
"show-output-only" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)
        then Bool
True
        else RunOptions -> Bool
interactive_mode RunOptions
opts

auto_config :: RunOptions -> Bool
auto_config :: RunOptions -> Bool
auto_config RunOptions
opts = Bool -> Name -> GeneralOptions -> Bool
bool_opt_default Bool
True Name
"auto-config" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)

csv_output :: RunOptions -> Bool
csv_output :: RunOptions -> Bool
csv_output RunOptions
opts = if Name -> GeneralOptions -> Bool
bool_opt Name
"csv" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)
                    then Bool
True
                    else RunOptions -> Bool
csv_output_with_keys RunOptions
opts

csv_output_with_keys :: RunOptions -> Bool
csv_output_with_keys :: RunOptions -> Bool
csv_output_with_keys RunOptions
opts = Name -> GeneralOptions -> Bool
bool_opt Name
"csv-keys" (RunOptions -> GeneralOptions
general_opts RunOptions
opts)

inputValues :: RunOptions -> InputValues
inputValues :: RunOptions -> InputValues
inputValues = RunOptions -> InputValues
given_inputs

booleanOptions :: [[Char]]
booleanOptions = 
  [[Char]
"refocus", [Char]
"full-environments", [Char]
"hide-result", [Char]
"display-steps"
  ,[Char]
"no-abrupt-termination", [Char]
"interactive-mode", [Char]
"string-inputs"
  ,[Char]
"format-string-outputs", [Char]
"hide-tests", [Char]
"show-output-only"
  ,[Char]
"auto-config", [Char]
"csv", [Char]
"csv-keys"]
booleanOptions_ :: [[Char]]
booleanOptions_ = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
booleanOptions

stringOptions :: [[Char]]
stringOptions = [[Char]
"display-mutable-entity", [Char]
"hide-output-entity"
    , [Char]
"hide-control-entity", [Char]
"hide-input-entity", [Char]
"max-restarts"]
stringOptions_ :: [[Char]]
stringOptions_ = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
stringOptions

allOptions :: [[Char]]
allOptions = [Char]
"funcon-term" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
booleanOptions [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
stringOptions
allOptions_ :: [[Char]]
allOptions_ = [Char]
"--funcon-term" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
booleanOptions_ [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
stringOptions_

run_options :: [String] -> IO (RunOptions, [String])
run_options :: [[Char]] -> IO (RunOptions, [[Char]])
run_options = (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
defaultRunOptions, [])
 where  fold :: (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts,[[Char]]
errors) ([Char]
arg:[[Char]]
args)
            | [Char]
arg [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
booleanOptions_ =
                let ([Char]
val, [[Char]]
rest)
                        | Bool -> Bool
not ([[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
args)
                        , Bool -> Bool
not ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
"--" ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
args)) = ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
args, [[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
args)
                        | Bool
otherwise = ([Char]
"true", [[Char]]
args)
                    opts' :: RunOptions
opts' = RunOptions
opts {general_opts :: GeneralOptions
general_opts = Name -> [Char] -> GeneralOptions -> GeneralOptions
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ([Char] -> Name
pack ([Char] -> [Char]
forall a. [a] -> [a]
tail ([Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
arg)))
                                    [Char]
val (RunOptions -> GeneralOptions
general_opts RunOptions
opts)}
                in (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts',[[Char]]
errors) [[Char]]
rest
            | [Char]
arg [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
stringOptions_ Bool -> Bool -> Bool
&& [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
                let opts' :: RunOptions
opts' = RunOptions
opts {general_opts :: GeneralOptions
general_opts = Name -> [Char] -> GeneralOptions -> GeneralOptions
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ([Char] -> Name
pack ([Char] -> [Char]
forall a. [a] -> [a]
tail ([Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
arg)))
                                    ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
args) (RunOptions -> GeneralOptions
general_opts RunOptions
opts)}
                in (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts', [[Char]]
errors) ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
args)
            | [Char]
arg [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"--funcon-term" Bool -> Bool -> Bool
&&  [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
                let opts' :: RunOptions
opts' = RunOptions
opts {mfuncon_term :: Maybe Funcons
mfuncon_term = Funcons -> Maybe Funcons
forall a. a -> Maybe a
Just ([Char] -> Funcons
fct_parse ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
args))}
                in (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts', [[Char]]
errors) ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
args)
            | [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
".fct" [Char]
arg = do
                [Char]
fct <- [Char] -> IO [Char]
readFile [Char]
arg
                let cfg_name :: [Char]
cfg_name = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
arg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) [Char]
arg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".config"
                Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
cfg_name
                RunOptions
opts' <- if Bool
exists Bool -> Bool -> Bool
&& RunOptions -> Bool
auto_config RunOptions
opts
                            then [Char] -> IO [Char]
readFile [Char]
cfg_name IO [Char] -> ([Char] -> IO RunOptions) -> IO RunOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                    RunOptions -> IO RunOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (RunOptions -> IO RunOptions)
-> ([Char] -> RunOptions) -> [Char] -> IO RunOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> RunOptions -> RunOptions)
-> RunOptions -> [Char] -> RunOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Char] -> [Char] -> RunOptions -> RunOptions
parseAndApplyConfig [Char]
cfg_name) RunOptions
opts
                            else RunOptions -> IO RunOptions
forall (m :: * -> *) a. Monad m => a -> m a
return RunOptions
opts
                let opts'' :: RunOptions
opts'' = RunOptions
opts' {mfuncon_term :: Maybe Funcons
mfuncon_term = Funcons -> Maybe Funcons
forall a. a -> Maybe a
Just ([Char] -> Funcons
fct_parse [Char]
fct)}
                (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts'', [[Char]]
errors) [[Char]]
args
            | [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
".config" [Char]
arg = (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts, [[Char]]
errors) ([Char]
"--config"[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
arg[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
args)
            | [Char]
arg [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"--config" Bool -> Bool -> Bool
&& [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
                let cfg_name :: [Char]
cfg_name = [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
args
                Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
cfg_name
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
exists) ([Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char]
"config file not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cfg_name))
                [Char]
str <- [Char] -> IO [Char]
readFile [Char]
cfg_name
                let opts' :: RunOptions
opts' = [Char] -> [Char] -> RunOptions -> RunOptions
parseAndApplyConfig [Char]
cfg_name [Char]
str RunOptions
opts
                (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts', [[Char]]
errors) ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
args)
            | Bool
otherwise = do
                Bool
exists <- [Char] -> IO Bool
doesFileExist ([Char]
arg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".fct")
                if Bool
exists then (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts, [[Char]]
errors) (([Char]
arg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
".fct")[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
args)
                          else (RunOptions, [[Char]]) -> [[Char]] -> IO (RunOptions, [[Char]])
fold (RunOptions
opts, [Char]
arg[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
errors) [[Char]]
args
        fold (RunOptions
opts, [[Char]]
errors) [] = (RunOptions, [[Char]]) -> IO (RunOptions, [[Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return (RunOptions
opts, [[Char]]
errors)

parseAndApplyConfig :: FilePath -> String -> RunOptions -> RunOptions
parseAndApplyConfig :: [Char] -> [Char] -> RunOptions -> RunOptions
parseAndApplyConfig [Char]
fp [Char]
str = RunOptions -> RunOptions -> RunOptions
optionsOverride ([Char] -> RunOptions
config_parser [Char]
str)

-- gll config parser
config_parser :: String -> RunOptions
config_parser :: [Char] -> RunOptions
config_parser [Char]
string = case CombinatorOptions
-> SymbExpr Token RunOptions -> [Token] -> [RunOptions]
forall t (s :: * -> * -> *) a.
(Show t, Parseable t, IsSymbExpr s) =>
CombinatorOptions -> s t a -> [t] -> [a]
GLL.Combinators.parseWithOptions [CombinatorOption
maximumPivot,CombinatorOption
throwErrors] SymbExpr Token RunOptions
pRunOptions
                             ([Char] -> [Token]
Funcons.RunOptions.lexer [Char]
string) of
  []      -> [Char] -> RunOptions
forall a. HasCallStack => [Char] -> a
error [Char]
"no parse (config)"
  (RunOptions
c:[RunOptions]
_)   -> RunOptions
c

lexer :: String -> [Token]
lexer :: [Char] -> [Token]
lexer = LexerSettings -> [Char] -> [Token]
forall t. SubsumesToken t => LexerSettings -> [Char] -> [t]
GLL.Combinators.lexer LexerSettings
cfg_lexerSettings

cfg_lexerSettings :: LexerSettings
cfg_lexerSettings = LexerSettings
fct_lexerSettings {
      keywords :: [[Char]]
keywords = (LexerSettings -> [[Char]]
keywords LexerSettings
fct_lexerSettings) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
cfg_keywords
  ,   keychars :: [Char]
keychars = (LexerSettings -> [Char]
keychars LexerSettings
fct_lexerSettings) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cfg_keychars
  }

cfg_keychars :: [Char]
cfg_keychars = [Char]
":;="
cfg_keywords :: [[Char]]
cfg_keywords = [[Char]]
allOptions [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"result-term", [Char]
"general", [Char]
"tests", [Char]
"funcons", [Char]
"inputs"]

pRunOptions :: Parser RunOptions
pRunOptions :: SymbExpr Token RunOptions
pRunOptions = [Char]
"SPECS"
  [Char] -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> (RunOptions -> RunOptions -> RunOptions)
-> RunOptions -> [RunOptions] -> RunOptions
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RunOptions -> RunOptions -> RunOptions
optionsOverride RunOptions
defaultRunOptions ([RunOptions] -> RunOptions)
-> SymbExpr Token [RunOptions] -> AltExpr Token RunOptions
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token RunOptions -> SymbExpr Token [RunOptions]
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t [a]
multiple SymbExpr Token RunOptions
pSpec

pSpec :: Parser RunOptions
pSpec :: SymbExpr Token RunOptions
pSpec = [Char]
"SPEC"
  [Char]
-> OO [] AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
"general" SymbExpr Token [Char]
-> SymbExpr Token RunOptions -> AltExpr Token RunOptions
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t b
**> SymbExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
braces SymbExpr Token RunOptions
pGeneral
  AltExpr Token RunOptions
-> OO [] AltExpr Token RunOptions -> OO [] AltExpr Token RunOptions
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
"tests" SymbExpr Token [Char]
-> SymbExpr Token RunOptions -> AltExpr Token RunOptions
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t b
**> SymbExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
braces SymbExpr Token RunOptions
pTestOutcomes
  AltExpr Token RunOptions
-> OO [] AltExpr Token RunOptions -> OO [] AltExpr Token RunOptions
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
"funcons" SymbExpr Token [Char]
-> SymbExpr Token RunOptions -> AltExpr Token RunOptions
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t b
**> SymbExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
braces SymbExpr Token RunOptions
pBuiltinFuncons
  AltExpr Token RunOptions
-> AltExpr Token RunOptions -> OO [] AltExpr Token RunOptions
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
"inputs" SymbExpr Token [Char]
-> SymbExpr Token RunOptions -> AltExpr Token RunOptions
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t b
**> SymbExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (s :: * -> * -> *) b.
(Show t, Ord t, IsSymbExpr s, SubsumesToken t) =>
s t b -> BNF t b
braces SymbExpr Token RunOptions
pInputValues

pGeneral :: Parser RunOptions
pGeneral :: SymbExpr Token RunOptions
pGeneral = [Char]
"GENERAL"
  [Char] -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> Maybe Funcons -> GeneralOptions -> RunOptions
toOpts (Maybe Funcons -> GeneralOptions -> RunOptions)
-> SymbExpr Token (Maybe Funcons)
-> AltExpr Token (GeneralOptions -> RunOptions)
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> --TODO uncomfortable usage of id
        AltExpr Token Funcons -> SymbExpr Token (Maybe Funcons)
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t (Maybe a)
optional (Funcons -> Funcons
forall a. a -> a
id (Funcons -> Funcons)
-> SymbExpr Token [Char] -> AltExpr Token (Funcons -> Funcons)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
"funcon-term" AltExpr Token (Funcons -> Funcons)
-> SymbExpr Token Char -> AltExpr Token (Funcons -> Funcons)
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
':' AltExpr Token (Funcons -> Funcons)
-> SymbExpr Token Funcons -> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token Funcons
pFuncons AltExpr Token Funcons
-> SymbExpr Token Char -> AltExpr Token Funcons
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
';')
          AltExpr Token (GeneralOptions -> RunOptions)
-> AltExpr Token GeneralOptions -> AltExpr Token RunOptions
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> ([(Name, [Char])] -> GeneralOptions
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, [Char])] -> GeneralOptions)
-> SymbExpr Token [(Name, [Char])] -> AltExpr Token GeneralOptions
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token (Name, [Char]) -> SymbExpr Token [(Name, [Char])]
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t [a]
multiple SymbExpr Token (Name, [Char])
pKeyValues)
 where toOpts :: Maybe Funcons -> GeneralOptions -> RunOptions
toOpts Maybe Funcons
mf GeneralOptions
gen = RunOptions
defaultRunOptions {mfuncon_term :: Maybe Funcons
mfuncon_term = Maybe Funcons
mf, general_opts :: GeneralOptions
general_opts = GeneralOptions
gen}
       pKeyValues :: SymbExpr Token (Name, [Char])
pKeyValues = [Char]
"GENERAL-KEYVALUES" [Char]
-> OO [] AltExpr Token (Name, [Char])
-> SymbExpr Token (Name, [Char])
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> SymbExpr Token (Name, [Char])
pBoolOpts SymbExpr Token (Name, [Char])
-> SymbExpr Token (Name, [Char])
-> OO [] AltExpr Token (Name, [Char])
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> SymbExpr Token (Name, [Char])
pStringOpts
        where   pBoolOpts :: SymbExpr Token (Name, [Char])
pBoolOpts = [Char]
"GENERAL-BOOLS" [Char]
-> [AltExpr Token (Name, [Char])] -> SymbExpr Token (Name, [Char])
forall t (f :: * -> *) (j :: * -> * -> *) a.
(Show t, Ord t, HasAlts (OO f j)) =>
[Char] -> f (j t a) -> SymbExpr t a
`chooses` (([Char] -> AltExpr Token (Name, [Char]))
-> [[Char]] -> [AltExpr Token (Name, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> AltExpr Token (Name, [Char])
pKeyValue [[Char]]
booleanOptions)
                 where pKeyValue :: [Char] -> AltExpr Token (Name, [Char])
pKeyValue [Char]
key = ([Char] -> Name
pack [Char]
key,) ([Char] -> (Name, [Char]))
-> (Maybe [Char] -> [Char]) -> Maybe [Char] -> (Name, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"true" [Char] -> [Char]
forall a. a -> a
id
                            (Maybe [Char] -> (Name, [Char]))
-> SymbExpr Token [Char]
-> AltExpr Token (Maybe [Char] -> (Name, [Char]))
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
key AltExpr Token (Maybe [Char] -> (Name, [Char]))
-> SymbExpr Token (Maybe [Char]) -> AltExpr Token (Name, [Char])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> AltExpr Token [Char] -> SymbExpr Token (Maybe [Char])
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t (Maybe a)
optional (Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
':' SymbExpr Token Char
-> SymbExpr Token [Char] -> AltExpr Token [Char]
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t b
**> SymbExpr Token [Char]
pBool)
                                  AltExpr Token (Name, [Char])
-> SymbExpr Token Char -> AltExpr Token (Name, [Char])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
';'

                pStringOpts :: SymbExpr Token (Name, [Char])
pStringOpts = [Char]
"GENERAL-STRINGS" [Char]
-> [AltExpr Token (Name, [Char])] -> SymbExpr Token (Name, [Char])
forall t (f :: * -> *) (j :: * -> * -> *) a.
(Show t, Ord t, HasAlts (OO f j)) =>
[Char] -> f (j t a) -> SymbExpr t a
`chooses` (([Char] -> AltExpr Token (Name, [Char]))
-> [[Char]] -> [AltExpr Token (Name, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> AltExpr Token (Name, [Char])
pKeyValue [[Char]]
stringOptions)
                 where pKeyValue :: [Char] -> AltExpr Token (Name, [Char])
pKeyValue [Char]
key = ([Char] -> Name
pack [Char]
key,) ([Char] -> (Name, [Char]))
-> SymbExpr Token [Char]
-> AltExpr Token ([Char] -> (Name, [Char]))
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
key AltExpr Token ([Char] -> (Name, [Char]))
-> SymbExpr Token Char -> AltExpr Token ([Char] -> (Name, [Char]))
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
':'
                                          AltExpr Token ([Char] -> (Name, [Char]))
-> SymbExpr Token [Char] -> AltExpr Token (Name, [Char])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token [Char]
pStringValue AltExpr Token (Name, [Char])
-> SymbExpr Token Char -> AltExpr Token (Name, [Char])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
';'

chooses :: [Char] -> f (j t a) -> SymbExpr t a
chooses [Char]
p f (j t a)
alts = [Char] -> OO f j t a -> SymbExpr t a
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
(<::=>) [Char]
p (f (j t a) -> OO f j t a
forall k k1 k2 (f :: k -> *) (j :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (j a b) -> OO f j a b
OO f (j t a)
alts)

pBool :: Parser String
pBool :: SymbExpr Token [Char]
pBool = [Char]
"BOOL-VALUE" [Char] -> SymbExpr Token [Char] -> SymbExpr Token [Char]
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> SymbExpr Token [Char]
forall t. SubsumesToken t => SymbExpr t [Char]
id_lit -- everything except `false` is considered `true`

pStringValue :: Parser String
pStringValue :: SymbExpr Token [Char]
pStringValue = [Char]
"STRING-VALUE" [Char] -> OO [] AltExpr Token [Char] -> SymbExpr Token [Char]
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> SymbExpr Token [Char]
forall t. SubsumesToken t => SymbExpr t [Char]
id_lit SymbExpr Token [Char]
-> SymbExpr Token [Char] -> OO [] AltExpr Token [Char]
forall t (i :: * -> * -> *) (b :: * -> * -> *) a.
(Show t, Ord t, IsAltExpr i, HasAlts b) =>
i t a -> b t a -> AltExprs t a
<||> SymbExpr Token [Char]
forall t. SubsumesToken t => SymbExpr t [Char]
string_lit

pFunconName :: Parser String
pFunconName :: SymbExpr Token [Char]
pFunconName = [Char]
"FUNCON-NAME" [Char] -> SymbExpr Token [Char] -> SymbExpr Token [Char]
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> SymbExpr Token [Char]
forall t. SubsumesToken t => SymbExpr t [Char]
id_lit

pTestOutcomes :: Parser RunOptions
pTestOutcomes :: SymbExpr Token RunOptions
pTestOutcomes = [Char]
"TEST-OUTCOMES"
  [Char] -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> TestOptions -> RunOptions
toOptions (TestOptions -> RunOptions)
-> AltExpr Token TestOptions -> AltExpr Token RunOptions
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> (TestOptions -> TestOptions -> TestOptions
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (TestOptions -> TestOptions -> TestOptions)
-> AltExpr Token TestOptions
-> AltExpr Token (TestOptions -> TestOptions)
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> AltExpr Token TestOptions
pResult AltExpr Token (TestOptions -> TestOptions)
-> SymbExpr Token TestOptions -> AltExpr Token TestOptions
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token TestOptions
pEntityValues)
    where pResult :: AltExpr Token TestOptions
pResult = Maybe [Funcons] -> TestOptions
forall k a. IsString k => Maybe a -> Map k a
mStoreResult (Maybe [Funcons] -> TestOptions)
-> SymbExpr Token (Maybe [Funcons]) -> AltExpr Token TestOptions
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$>
                      AltExpr Token [Funcons] -> SymbExpr Token (Maybe [Funcons])
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t (Maybe a)
optional ([Funcons] -> [Funcons]
forall a. a -> a
id ([Funcons] -> [Funcons])
-> SymbExpr Token [Char] -> AltExpr Token ([Funcons] -> [Funcons])
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ [Char] -> SymbExpr Token [Char]
forall t. SubsumesToken t => [Char] -> SymbExpr t [Char]
keyword [Char]
"result-term" AltExpr Token ([Funcons] -> [Funcons])
-> SymbExpr Token Char -> AltExpr Token ([Funcons] -> [Funcons])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
':'
                                             AltExpr Token ([Funcons] -> [Funcons])
-> SymbExpr Token [Funcons] -> AltExpr Token [Funcons]
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token [Funcons]
pFunconsSeq AltExpr Token [Funcons]
-> SymbExpr Token Char -> AltExpr Token [Funcons]
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
';')
            where mStoreResult :: Maybe a -> Map k a
mStoreResult Maybe a
Nothing = Map k a
forall k a. Map k a
M.empty
                  mStoreResult (Just a
f) = k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton k
"result-term" a
f
          pEntityValues :: SymbExpr Token TestOptions
pEntityValues = [Char]
"TEST-ENTITIES" [Char] -> AltExpr Token TestOptions -> SymbExpr Token TestOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> [(Name, [Funcons])] -> TestOptions
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, [Funcons])] -> TestOptions)
-> SymbExpr Token [(Name, [Funcons])] -> AltExpr Token TestOptions
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> AltExpr Token (Name, [Funcons])
-> SymbExpr Token [(Name, [Funcons])]
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t [a]
multiple
              ((,) (Name -> [Funcons] -> (Name, [Funcons]))
-> ([Char] -> Name) -> [Char] -> [Funcons] -> (Name, [Funcons])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
pack ([Char] -> [Funcons] -> (Name, [Funcons]))
-> SymbExpr Token [Char]
-> AltExpr Token ([Funcons] -> (Name, [Funcons]))
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token [Char]
pFunconName AltExpr Token ([Funcons] -> (Name, [Funcons]))
-> SymbExpr Token Char
-> AltExpr Token ([Funcons] -> (Name, [Funcons]))
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
':' AltExpr Token ([Funcons] -> (Name, [Funcons]))
-> SymbExpr Token [Funcons] -> AltExpr Token (Name, [Funcons])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token [Funcons]
pFunconsSeq AltExpr Token (Name, [Funcons])
-> SymbExpr Token Char -> AltExpr Token (Name, [Funcons])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
';')
          toOptions :: TestOptions -> RunOptions
toOptions TestOptions
map = RunOptions
defaultRunOptions { expected_outcomes :: TestOptions
expected_outcomes = TestOptions
map }

pBuiltinFuncons :: Parser RunOptions
pBuiltinFuncons :: SymbExpr Token RunOptions
pBuiltinFuncons = [Char]
"BUILTIN-FUNCONS"
  [Char] -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> [(Name, Funcons)] -> RunOptions
insertFuncons ([(Name, Funcons)] -> RunOptions)
-> SymbExpr Token [(Name, Funcons)] -> AltExpr Token RunOptions
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> AltExpr Token (Name, Funcons) -> SymbExpr Token [(Name, Funcons)]
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t [a]
multiple ((,) (Name -> Funcons -> (Name, Funcons))
-> ([Char] -> Name) -> [Char] -> Funcons -> (Name, Funcons)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Name
pack ([Char] -> Funcons -> (Name, Funcons))
-> SymbExpr Token [Char]
-> AltExpr Token (Funcons -> (Name, Funcons))
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token [Char]
pFunconName AltExpr Token (Funcons -> (Name, Funcons))
-> SymbExpr Token Char
-> AltExpr Token (Funcons -> (Name, Funcons))
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
'='
                            AltExpr Token (Funcons -> (Name, Funcons))
-> SymbExpr Token Funcons -> AltExpr Token (Name, Funcons)
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token Funcons
pFuncons AltExpr Token (Name, Funcons)
-> SymbExpr Token Char -> AltExpr Token (Name, Funcons)
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
';')
 where insertFuncons :: [(Name, Funcons)] -> RunOptions
insertFuncons [(Name, Funcons)]
list = RunOptions
defaultRunOptions {builtin_funcons :: BuiltinFunconsOptions
builtin_funcons = [(Name, Funcons)] -> BuiltinFunconsOptions
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, Funcons)]
list}

pInputValues :: Parser RunOptions
pInputValues :: SymbExpr Token RunOptions
pInputValues = [Char]
"INPUT-VALUES"
  [Char] -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
[Char] -> b t a -> SymbExpr t a
<:=> [(Name, [Values])] -> RunOptions
insertInputs ([(Name, [Values])] -> RunOptions)
-> SymbExpr Token [(Name, [Values])] -> AltExpr Token RunOptions
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> AltExpr Token (Name, [Values]) -> SymbExpr Token [(Name, [Values])]
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t [a]
multiple ([Char] -> [Funcons] -> (Name, [Values])
toPair ([Char] -> [Funcons] -> (Name, [Values]))
-> SymbExpr Token [Char]
-> AltExpr Token ([Funcons] -> (Name, [Values]))
forall t (s :: * -> * -> *) a b.
(Show t, Ord t, IsSymbExpr s) =>
(a -> b) -> s t a -> AltExpr t b
<$$> SymbExpr Token [Char]
pFunconName AltExpr Token ([Funcons] -> (Name, [Values]))
-> SymbExpr Token Char
-> AltExpr Token ([Funcons] -> (Name, [Values]))
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
':'
                                  AltExpr Token ([Funcons] -> (Name, [Values]))
-> SymbExpr Token [Funcons] -> AltExpr Token (Name, [Values])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t (a -> b) -> s t a -> AltExpr t b
<**> SymbExpr Token [Funcons]
pFunconsSeq AltExpr Token (Name, [Values])
-> SymbExpr Token Char -> AltExpr Token (Name, [Values])
forall t (i :: * -> * -> *) (s :: * -> * -> *) a b.
(Show t, Ord t, IsAltExpr i, IsSymbExpr s) =>
i t a -> s t b -> AltExpr t a
<** Char -> SymbExpr Token Char
forall t. SubsumesToken t => Char -> SymbExpr t Char
keychar Char
';')
  where insertInputs :: [(Name, [Values])] -> RunOptions
insertInputs [(Name, [Values])]
list = RunOptions
defaultRunOptions { given_inputs :: InputValues
given_inputs = [(Name, [Values])] -> InputValues
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, [Values])]
list }
        toPair :: [Char] -> [Funcons] -> (Name, [Values])
toPair [Char]
nm [Funcons]
fs = case [Maybe Values] -> Maybe [Values]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Funcons -> Maybe Values) -> [Funcons] -> [Maybe Values]
forall a b. (a -> b) -> [a] -> [b]
map Funcons -> Maybe Values
recursiveFunconValue [Funcons]
fs) of
                        Just [Values]
vs -> ([Char] -> Name
pack [Char]
nm, [Values]
vs)
                        Maybe [Values]
_       -> [Char] -> (Name, [Values])
forall a. HasCallStack => [Char] -> a
error ([Char]
"inputs for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not a sequence of values")