module GLL.Combinators.Options where

import Data.Function (on)

-- | CombinatorOptions datatype
--      * left_biased_choice: see function leftBiased
--      * pivot_select: provide a filtering function on `pivots'
data PCOptions = PCOptions  { PCOptions -> Bool
left_biased_choice    :: Bool
                            , PCOptions -> Maybe (Int -> Int -> Ordering)
pivot_select          :: Maybe (Int -> Int -> Ordering)
                            , PCOptions -> Bool
pivot_select_nt       :: Bool
                            , PCOptions -> Bool
throw_errors          :: Bool
                            , PCOptions -> Bool
do_memo               :: Bool
                            , PCOptions -> Int
max_errors            :: Int
                            , PCOptions -> Bool
nt_select_test        :: Bool
                            , PCOptions -> Bool
alt_select_test       :: Bool
                            , PCOptions -> Bool
seq_select_test       :: Bool
                            }

-- | A list of 'CombinatorOption's for evaluating combinator expressions.
type CombinatorOptions    = [CombinatorOption]

-- | A single option.
type CombinatorOption     = PCOptions -> PCOptions

runOptions :: CombinatorOptions -> PCOptions
runOptions :: CombinatorOptions -> PCOptions
runOptions = PCOptions -> CombinatorOptions -> PCOptions
runOptionsOn PCOptions
defaultOptions

runOptionsOn :: PCOptions -> CombinatorOptions -> PCOptions 
runOptionsOn :: PCOptions -> CombinatorOptions -> PCOptions
runOptionsOn = (CombinatorOption -> CombinatorOption)
-> PCOptions -> CombinatorOptions -> PCOptions
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CombinatorOption -> CombinatorOption
forall a b. (a -> b) -> a -> b
($)

-- | The default options: no disambiguation.
defaultOptions :: PCOptions
defaultOptions :: PCOptions
defaultOptions = Bool
-> Maybe (Int -> Int -> Ordering)
-> Bool
-> Bool
-> Bool
-> Int
-> Bool
-> Bool
-> Bool
-> PCOptions
PCOptions Bool
False Maybe (Int -> Int -> Ordering)
forall a. Maybe a
Nothing Bool
False Bool
False Bool
False Int
3 Bool
True Bool
True Bool
True

-- | Enables a 'longest-match' at production level.
maximumPivot :: CombinatorOption
maximumPivot :: CombinatorOption
maximumPivot PCOptions
opts = PCOptions
opts {pivot_select = Just compare}

-- | Enables a 'shortest-match' at production level.
minimumPivot :: CombinatorOption
minimumPivot :: CombinatorOption
minimumPivot PCOptions
opts = PCOptions
opts {pivot_select = Just (flip compare)}

-- | Discards a pivot select option (internal use only)
anyPivot :: CombinatorOption
anyPivot :: CombinatorOption
anyPivot PCOptions
opts = PCOptions
opts {pivot_select = Nothing}

-- | Enables 'longest-match' at non-terminal level. 
maximumPivotAtNt :: CombinatorOption
maximumPivotAtNt :: CombinatorOption
maximumPivotAtNt PCOptions
opts = PCOptions
opts {pivot_select_nt = True, pivot_select = Just compare}

-- | 
-- Set the maximum number of errors shown in case of an unsuccessful parse.
maximumErrors :: Int -> CombinatorOption
maximumErrors :: Int -> CombinatorOption
maximumErrors Int
n PCOptions
opts = PCOptions
opts { max_errors = n }

-- | 
-- If there are no parse results, the default behaviour is to return an empty list.
-- If this option is used, a runtime error will be reported, with debugging information.
throwErrors :: CombinatorOption
throwErrors :: CombinatorOption
throwErrors PCOptions
opts = PCOptions
opts{throw_errors = True}


-- | 
-- Turns all occurrences of '<||>' into a 'left biased' variant:
--  only return results of the second alternate if the first alternate
-- does not have any results.
leftBiased :: CombinatorOption
leftBiased :: CombinatorOption
leftBiased PCOptions
opts = PCOptions
opts { left_biased_choice = True }

-- | 
-- Whether to use unsafe memoisation to speed up the enumeration of parse results.
useMemoisation :: CombinatorOption
useMemoisation :: CombinatorOption
useMemoisation PCOptions
opts = PCOptions
opts { do_memo = True }

-- | Filter a list such that the only remaining elements are equal to
-- the maximum element, given an ordering operator.
maximumsWith :: (a -> a -> Ordering) -> [a] -> [a]
maximumsWith :: forall a. (a -> a -> Ordering) -> [a] -> [a]
maximumsWith a -> a -> Ordering
compare [a]
xs = 
    case [a]
xs of
    []      -> []
    [a
x]     -> [a
x]
    a
x:[a]
xs    -> [a] -> a -> [a] -> [a]
maxx [a]
xs a
x []
 where  maxx :: [a] -> a -> [a] -> [a]
maxx []     a
x [a]
acc = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
        maxx (a
y:[a]
ys) a
x [a]
acc = case a
y a -> a -> Ordering
`compare` a
x of
                            Ordering
LT -> [a] -> a -> [a] -> [a]
maxx [a]
ys a
x [a]
acc
                            Ordering
GT -> [a] -> a -> [a] -> [a]
maxx [a]
ys a
y []
                            Ordering
EQ -> [a] -> a -> [a] -> [a]
maxx [a]
ys a
y (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)

-- assumes every sub-list contains only maximums already
maintainWith :: (Eq k) => (k -> k -> Ordering) -> [[(k,a)]] -> [[(k,a)]]
maintainWith :: forall k a.
Eq k =>
(k -> k -> Ordering) -> [[(k, a)]] -> [[(k, a)]]
maintainWith k -> k -> Ordering
compare = 
    [[(k, a)]] -> [[(k, a)]]
forall {b}. [[(k, b)]] -> [[(k, b)]]
maintain ([[(k, a)]] -> [[(k, a)]])
-> ([[(k, a)]] -> [[(k, a)]]) -> [[(k, a)]] -> [[(k, a)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ([(k, a)] -> Bool) -> [[(k, a)]] -> [[(k, a)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([(k, a)] -> Bool) -> [(k, a)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
 where  maintain :: [[(k, b)]] -> [[(k, b)]]
maintain [[(k, b)]]
xss = 
            let (k
max,b
_):[(k, b)]
_ = ((k, b) -> (k, b) -> Ordering) -> [(k, b)] -> [(k, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
maximumsWith (k -> k -> Ordering
compare (k -> k -> Ordering)
-> ((k, b) -> k) -> (k, b) -> (k, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, b) -> k
forall a b. (a, b) -> a
fst) ([(k, b)] -> [(k, b)]) -> [(k, b)] -> [(k, b)]
forall a b. (a -> b) -> a -> b
$ ([(k, b)] -> (k, b)) -> [[(k, b)]] -> [(k, b)]
forall a b. (a -> b) -> [a] -> [b]
map [(k, b)] -> (k, b)
forall a. HasCallStack => [a] -> a
head [[(k, b)]]
xss
             in (([(k, b)] -> Bool) -> [[(k, b)]] -> [[(k, b)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
max) (k -> Bool) -> ([(k, b)] -> k) -> [(k, b)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, b) -> k
forall a b. (a, b) -> a
fst ((k, b) -> k) -> ([(k, b)] -> (k, b)) -> [(k, b)] -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, b)] -> (k, b)
forall a. HasCallStack => [a] -> a
head) [[(k, b)]]
xss)

-- | 
-- Enables select tests at all levels: nonterminal, alternative and slot.
doSelectTest :: CombinatorOption
doSelectTest :: CombinatorOption
doSelectTest PCOptions
opts = PCOptions
opts { nt_select_test = True, alt_select_test = True
                         , seq_select_test = True }

-- | 
-- Disables select tests at all levels: nonterminal, alternative and slot.
noSelectTest :: CombinatorOption
noSelectTest :: CombinatorOption
noSelectTest PCOptions
opts = PCOptions
opts { nt_select_test = False, alt_select_test = False
                         , seq_select_test = False }

-- | 
-- Enables select tests at the level of alternatives
doAltSelectTest :: CombinatorOption
doAltSelectTest :: CombinatorOption
doAltSelectTest PCOptions
opts = PCOptions
opts { alt_select_test = True }

-- | 
-- Disables select tests at the level of alternatives
noAltSelectTest :: CombinatorOption
noAltSelectTest :: CombinatorOption
noAltSelectTest PCOptions
opts = PCOptions
opts { alt_select_test = False }

-- | 
-- Enables select tests at the level of nonterminals
doNtSelectTest :: CombinatorOption
doNtSelectTest :: CombinatorOption
doNtSelectTest PCOptions
opts = PCOptions
opts { nt_select_test = True }

-- | 
-- Disables select tests at the level of nonterminals
noNtSelectTest :: CombinatorOption
noNtSelectTest :: CombinatorOption
noNtSelectTest PCOptions
opts = PCOptions
opts { nt_select_test = False }

-- | 
-- Enables select tests at the level of grammar slots
doSlotSelectTest :: CombinatorOption
doSlotSelectTest :: CombinatorOption
doSlotSelectTest PCOptions
opts = PCOptions
opts { seq_select_test = True }

-- | 
-- Disables select tests at the level of grammar slots
noSlotSelectTest :: CombinatorOption
noSlotSelectTest :: CombinatorOption
noSlotSelectTest PCOptions
opts = PCOptions
opts { seq_select_test = False }