{-# 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 GLL.Types.TypeCompose (OO(..))
import Data.Text (pack, Text)
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
        }

-- | Several sources of nondeterminism exists, i.e. locations where a choice between a sequence of valid alternatives are made.
-- These options turn on pseudo-random selection of an alternative, based on a seed provide (configuration option `--seed <INT>`)
-- If random selection is not turned on for a particular location, the first alternative in the sequence is chosen
data SourceOfND  = 
        NDRuleSelection   -- | Several rules of a funcon may "overlap"
      | NDPatternMatching -- | ambiguity when multiple sequence variables occur in a pattern
      | NDInterleaving    -- | strict parameters in a funcon signature induce congruence rules that can be considered in different orders
      | NDValueOperations -- | value operations may produce several valid results
      deriving (Int -> SourceOfND
SourceOfND -> Int
SourceOfND -> [SourceOfND]
SourceOfND -> SourceOfND
SourceOfND -> SourceOfND -> [SourceOfND]
SourceOfND -> SourceOfND -> SourceOfND -> [SourceOfND]
(SourceOfND -> SourceOfND)
-> (SourceOfND -> SourceOfND)
-> (Int -> SourceOfND)
-> (SourceOfND -> Int)
-> (SourceOfND -> [SourceOfND])
-> (SourceOfND -> SourceOfND -> [SourceOfND])
-> (SourceOfND -> SourceOfND -> [SourceOfND])
-> (SourceOfND -> SourceOfND -> SourceOfND -> [SourceOfND])
-> Enum SourceOfND
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SourceOfND -> SourceOfND
succ :: SourceOfND -> SourceOfND
$cpred :: SourceOfND -> SourceOfND
pred :: SourceOfND -> SourceOfND
$ctoEnum :: Int -> SourceOfND
toEnum :: Int -> SourceOfND
$cfromEnum :: SourceOfND -> Int
fromEnum :: SourceOfND -> Int
$cenumFrom :: SourceOfND -> [SourceOfND]
enumFrom :: SourceOfND -> [SourceOfND]
$cenumFromThen :: SourceOfND -> SourceOfND -> [SourceOfND]
enumFromThen :: SourceOfND -> SourceOfND -> [SourceOfND]
$cenumFromTo :: SourceOfND -> SourceOfND -> [SourceOfND]
enumFromTo :: SourceOfND -> SourceOfND -> [SourceOfND]
$cenumFromThenTo :: SourceOfND -> SourceOfND -> SourceOfND -> [SourceOfND]
enumFromThenTo :: SourceOfND -> SourceOfND -> SourceOfND -> [SourceOfND]
Enum, Eq SourceOfND
Eq SourceOfND =>
(SourceOfND -> SourceOfND -> Ordering)
-> (SourceOfND -> SourceOfND -> Bool)
-> (SourceOfND -> SourceOfND -> Bool)
-> (SourceOfND -> SourceOfND -> Bool)
-> (SourceOfND -> SourceOfND -> Bool)
-> (SourceOfND -> SourceOfND -> SourceOfND)
-> (SourceOfND -> SourceOfND -> SourceOfND)
-> Ord SourceOfND
SourceOfND -> SourceOfND -> Bool
SourceOfND -> SourceOfND -> Ordering
SourceOfND -> SourceOfND -> SourceOfND
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SourceOfND -> SourceOfND -> Ordering
compare :: SourceOfND -> SourceOfND -> Ordering
$c< :: SourceOfND -> SourceOfND -> Bool
< :: SourceOfND -> SourceOfND -> Bool
$c<= :: SourceOfND -> SourceOfND -> Bool
<= :: SourceOfND -> SourceOfND -> Bool
$c> :: SourceOfND -> SourceOfND -> Bool
> :: SourceOfND -> SourceOfND -> Bool
$c>= :: SourceOfND -> SourceOfND -> Bool
>= :: SourceOfND -> SourceOfND -> Bool
$cmax :: SourceOfND -> SourceOfND -> SourceOfND
max :: SourceOfND -> SourceOfND -> SourceOfND
$cmin :: SourceOfND -> SourceOfND -> SourceOfND
min :: SourceOfND -> SourceOfND -> SourceOfND
Ord, SourceOfND -> SourceOfND -> Bool
(SourceOfND -> SourceOfND -> Bool)
-> (SourceOfND -> SourceOfND -> Bool) -> Eq SourceOfND
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceOfND -> SourceOfND -> Bool
== :: SourceOfND -> SourceOfND -> Bool
$c/= :: SourceOfND -> SourceOfND -> Bool
/= :: SourceOfND -> SourceOfND -> Bool
Eq)

defaultSources :: [a]
defaultSources = []

instance Show SourceOfND where
  show :: SourceOfND -> String
show SourceOfND
NDPatternMatching  = String
"pattern-matching"
  show SourceOfND
NDInterleaving     = String
"interleaving-of-args"
  show SourceOfND
NDValueOperations  = String
"value-operations"
  show SourceOfND
NDRuleSelection    = String
"rules"

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 = String -> a
forall a. HasCallStack => String -> a
error String
"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 String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
nm GeneralOptions
m of
    Maybe String
Nothing         -> Bool
def
    Just String
"false"    -> Bool
False
    Maybe String
_               -> 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)

turn_off_refocus :: RunOptions -> RunOptions
turn_off_refocus :: RunOptions -> RunOptions
turn_off_refocus RunOptions
opts = RunOptions
opts { general_opts = M.insert "refocus" "false" (general_opts opts) }

turn_on_refocus :: RunOptions -> RunOptions
turn_on_refocus :: RunOptions -> RunOptions
turn_on_refocus RunOptions
opts = RunOptions
opts { general_opts = M.insert "refocus" "true" (general_opts opts) }

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

random_seed :: RunOptions -> Int
random_seed :: RunOptions -> Int
random_seed = Int -> (String -> Int) -> Maybe String -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 String -> Int
forall a. Read a => String -> a
read (Maybe String -> Int)
-> (RunOptions -> Maybe String) -> RunOptions -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"seed" (GeneralOptions -> Maybe String)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe String
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

get_nd_sources :: RunOptions -> [SourceOfND]
get_nd_sources :: RunOptions -> [SourceOfND]
get_nd_sources = [SourceOfND]
-> (String -> [SourceOfND]) -> Maybe String -> [SourceOfND]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [SourceOfND]
forall a. [a]
defaultSources ([String] -> [SourceOfND]
readSources ([String] -> [SourceOfND])
-> (String -> [String]) -> String -> [SourceOfND]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
",") (Maybe String -> [SourceOfND])
-> (RunOptions -> Maybe String) -> RunOptions -> [SourceOfND]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
  Name -> GeneralOptions -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"non-deterministic" (GeneralOptions -> Maybe String)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunOptions -> GeneralOptions
general_opts
  where readSources :: [String] -> [SourceOfND]
readSources [String]
opts =  [ SourceOfND
source 
                            | String
o <- [String]
opts 
                            , SourceOfND
source <- [SourceOfND
NDRuleSelection ..]
                            , String
o String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== SourceOfND -> String
forall a. Show a => a -> String
show SourceOfND
source ]
                            

show_mutable :: RunOptions -> [Name]
show_mutable :: RunOptions -> [Name]
show_mutable = [Name] -> (String -> [Name]) -> Maybe String -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String -> Name) -> [String] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map String -> Name
pack ([String] -> [Name]) -> (String -> [String]) -> String -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
",") (Maybe String -> [Name])
-> (RunOptions -> Maybe String) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"display-mutable-entity"  (GeneralOptions -> Maybe String)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe String
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] -> (String -> [Name]) -> Maybe String -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String -> Name) -> [String] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map String -> Name
pack ([String] -> [Name]) -> (String -> [String]) -> String -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
",") (Maybe String -> [Name])
-> (RunOptions -> Maybe String) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"hide-output-entity"  (GeneralOptions -> Maybe String)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe String
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] -> (String -> [Name]) -> Maybe String -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String -> Name) -> [String] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map String -> Name
pack ([String] -> [Name]) -> (String -> [String]) -> String -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
",") (Maybe String -> [Name])
-> (RunOptions -> Maybe String) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"hide-input-entity"  (GeneralOptions -> Maybe String)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe String
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] -> (String -> [Name]) -> Maybe String -> [Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String -> Name) -> [String] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map String -> Name
pack ([String] -> [Name]) -> (String -> [String]) -> String -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
",") (Maybe String -> [Name])
-> (RunOptions -> Maybe String) -> RunOptions -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> GeneralOptions -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"hide-control-entity" (GeneralOptions -> Maybe String)
-> (RunOptions -> GeneralOptions) -> RunOptions -> Maybe String
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 :: [String]
booleanOptions :: [String]
booleanOptions = 
  [String
"refocus", String
"full-environments", String
"hide-result", String
"display-steps"
  ,String
"no-abrupt-termination", String
"interactive-mode", String
"string-inputs"
  ,String
"format-string-outputs", String
"hide-tests", String
"show-output-only"
  ,String
"auto-config", String
"csv", String
"csv-keys"]
booleanOptions_ :: [String]
booleanOptions_ :: [String]
booleanOptions_ = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
booleanOptions

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

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

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

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

-- gll config parser
config_parser :: String -> RunOptions
config_parser :: String -> RunOptions
config_parser String
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
                             (String -> [Token]
Funcons.RunOptions.lexer String
string) of
  []      -> String -> RunOptions
forall a. HasCallStack => String -> a
error String
"no parse (config)"
  (RunOptions
c:[RunOptions]
_)   -> RunOptions
c

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

cfg_lexerSettings :: LexerSettings
cfg_lexerSettings = LexerSettings
fct_lexerSettings {
      keywords = (keywords fct_lexerSettings) ++ cfg_keywords
  ,   keychars = (keychars fct_lexerSettings) ++ cfg_keychars
  }

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

pRunOptions :: Parser RunOptions
pRunOptions :: SymbExpr Token RunOptions
pRunOptions = String
"SPECS"
  String -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> (RunOptions -> RunOptions -> RunOptions)
-> RunOptions -> [RunOptions] -> RunOptions
forall a b. (a -> b -> b) -> b -> [a] -> b
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 = String
"SPEC"
  String
-> OO [] AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"general" SymbExpr Token String
-> 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
<||> String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"tests" SymbExpr Token String
-> 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
<||> String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"funcons" SymbExpr Token String
-> 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
<||> String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"inputs" SymbExpr Token String
-> 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 = String
"GENERAL"
  String -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> 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 String -> AltExpr Token (Funcons -> Funcons)
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"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, String)] -> GeneralOptions
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, String)] -> GeneralOptions)
-> SymbExpr Token [(Name, String)] -> 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, String) -> SymbExpr Token [(Name, String)]
forall t (s :: * -> * -> *) a.
(Show t, Ord t, IsSymbExpr s) =>
s t a -> SymbExpr t [a]
multiple SymbExpr Token (Name, String)
pKeyValues)
 where toOpts :: Maybe Funcons -> GeneralOptions -> RunOptions
toOpts Maybe Funcons
mf GeneralOptions
gen = RunOptions
defaultRunOptions {mfuncon_term = mf, general_opts = gen}
       pKeyValues :: SymbExpr Token (Name, String)
pKeyValues = String
"GENERAL-KEYVALUES" String
-> OO [] AltExpr Token (Name, String)
-> SymbExpr Token (Name, String)
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
<:=> SymbExpr Token (Name, String)
pBoolOpts SymbExpr Token (Name, String)
-> SymbExpr Token (Name, String)
-> OO [] AltExpr Token (Name, String)
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, String)
pStringOpts
        where   pBoolOpts :: SymbExpr Token (Name, String)
pBoolOpts = String
"GENERAL-BOOLS" String
-> [AltExpr Token (Name, String)] -> SymbExpr Token (Name, String)
forall {t} {f :: * -> *} {j :: * -> * -> *} {a}.
(Show t, Ord t, HasAlts (OO f j)) =>
String -> f (j t a) -> SymbExpr t a
`chooses` ((String -> AltExpr Token (Name, String))
-> [String] -> [AltExpr Token (Name, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> AltExpr Token (Name, String)
pKeyValue [String]
booleanOptions)
                 where pKeyValue :: String -> AltExpr Token (Name, String)
pKeyValue String
key = (String -> Name
pack String
key,) (String -> (Name, String))
-> (Maybe String -> String) -> Maybe String -> (Name, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"true" ShowS
forall a. a -> a
id
                            (Maybe String -> (Name, String))
-> SymbExpr Token String
-> AltExpr Token (Maybe String -> (Name, String))
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
key AltExpr Token (Maybe String -> (Name, String))
-> SymbExpr Token (Maybe String) -> AltExpr Token (Name, String)
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 String -> SymbExpr Token (Maybe String)
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 String -> AltExpr Token String
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 String
pBool)
                                  AltExpr Token (Name, String)
-> SymbExpr Token Char -> AltExpr Token (Name, String)
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, String)
pStringOpts = String
"GENERAL-STRINGS" String
-> [AltExpr Token (Name, String)] -> SymbExpr Token (Name, String)
forall {t} {f :: * -> *} {j :: * -> * -> *} {a}.
(Show t, Ord t, HasAlts (OO f j)) =>
String -> f (j t a) -> SymbExpr t a
`chooses` ((String -> AltExpr Token (Name, String))
-> [String] -> [AltExpr Token (Name, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> AltExpr Token (Name, String)
pKeyValue [String]
stringOptions)
                 where pKeyValue :: String -> AltExpr Token (Name, String)
pKeyValue String
key = (String -> Name
pack String
key,) (String -> (Name, String))
-> SymbExpr Token String
-> AltExpr Token (String -> (Name, String))
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
key AltExpr Token (String -> (Name, String))
-> SymbExpr Token Char -> AltExpr Token (String -> (Name, String))
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 (String -> (Name, String))
-> SymbExpr Token String -> AltExpr Token (Name, String)
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 String
pStringValue AltExpr Token (Name, String)
-> SymbExpr Token Char -> AltExpr Token (Name, String)
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 :: String -> f (j t a) -> SymbExpr t a
chooses String
p f (j t a)
alts = String -> OO f j t a -> SymbExpr t a
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> b t a -> SymbExpr t a
(<::=>) String
p (f (j t a) -> OO f j t a
forall (f :: * -> *) (j :: * -> * -> *) a b.
f (j a b) -> OO f j a b
OO f (j t a)
alts)

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

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

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

pTestOutcomes :: Parser RunOptions
pTestOutcomes :: SymbExpr Token RunOptions
pTestOutcomes = String
"TEST-OUTCOMES"
  String -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> 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 (M.Map Text [Funcons])
          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 String -> AltExpr Token ([Funcons] -> [Funcons])
forall t (s :: * -> * -> *) b a.
(Show t, Ord t, IsSymbExpr s) =>
b -> s t a -> AltExpr t b
<$$ String -> SymbExpr Token String
forall t. SubsumesToken t => String -> SymbExpr t String
keyword String
"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 = String
"TEST-ENTITIES" String -> AltExpr Token TestOptions -> SymbExpr Token TestOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> 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]))
-> (String -> Name) -> String -> [Funcons] -> (Name, [Funcons])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
pack (String -> [Funcons] -> (Name, [Funcons]))
-> SymbExpr Token String
-> 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 String
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 = map }

pBuiltinFuncons :: Parser RunOptions
pBuiltinFuncons :: SymbExpr Token RunOptions
pBuiltinFuncons = String
"BUILTIN-FUNCONS"
  String -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> 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))
-> (String -> Name) -> String -> Funcons -> (Name, Funcons)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
pack (String -> Funcons -> (Name, Funcons))
-> SymbExpr Token String
-> 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 String
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 = M.fromList list}

pInputValues :: Parser RunOptions
pInputValues :: SymbExpr Token RunOptions
pInputValues = String
"INPUT-VALUES"
  String -> AltExpr Token RunOptions -> SymbExpr Token RunOptions
forall t (b :: * -> * -> *) a.
(Show t, Ord t, HasAlts b) =>
String -> 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 (String -> [Funcons] -> (Name, [Values])
toPair (String -> [Funcons] -> (Name, [Values]))
-> SymbExpr Token String
-> 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 String
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 = M.fromList list }
        toPair :: String -> [Funcons] -> (Name, [Values])
toPair String
nm [Funcons]
fs = case [Maybe Values] -> Maybe [Values]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 -> (String -> Name
pack String
nm, [Values]
vs)
                        Maybe [Values]
_       -> String -> (Name, [Values])
forall a. HasCallStack => String -> a
error (String
"inputs for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not a sequence of values")