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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 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 :: Maybe (Int -> Int -> Ordering)
pivot_select = forall a. a -> Maybe a
Just forall a. Ord a => a -> a -> Ordering
compare}

-- | Enables a 'shortest-match' at production level.
minimumPivot :: CombinatorOption
minimumPivot :: CombinatorOption
minimumPivot PCOptions
opts = PCOptions
opts {pivot_select :: Maybe (Int -> Int -> Ordering)
pivot_select = forall a. a -> Maybe a
Just (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare)}

-- | Discards a pivot select option (internal use only)
anyPivot :: CombinatorOption
anyPivot :: CombinatorOption
anyPivot PCOptions
opts = PCOptions
opts {pivot_select :: Maybe (Int -> Int -> Ordering)
pivot_select = forall a. Maybe a
Nothing}

-- | Enables 'longest-match' at non-terminal level. 
maximumPivotAtNt :: CombinatorOption
maximumPivotAtNt :: CombinatorOption
maximumPivotAtNt PCOptions
opts = PCOptions
opts {pivot_select_nt :: Bool
pivot_select_nt = Bool
True, pivot_select :: Maybe (Int -> Int -> Ordering)
pivot_select = forall a. a -> Maybe a
Just forall a. Ord a => a -> a -> Ordering
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 :: Int
max_errors = Int
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 :: Bool
throw_errors = Bool
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 :: Bool
left_biased_choice = Bool
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 :: Bool
do_memo = Bool
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 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
xforall 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 = 
    forall {b}. [[(k, b)]] -> [[(k, b)]]
maintain forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)]
_ = forall a. (a -> a -> Ordering) -> [a] -> [a]
maximumsWith (k -> k -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head [[(k, b)]]
xss
             in (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== k
max) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [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 :: Bool
nt_select_test = Bool
True, alt_select_test :: Bool
alt_select_test = Bool
True
                         , seq_select_test :: Bool
seq_select_test = Bool
True }

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

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

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

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

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

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

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