{-|
Description:    Small helpers for constructing parsers.

Copyright:      (c) 2020-2021 Sam May
License:        MPL-2.0
Maintainer:     ag.eitilt@gmail.com

Stability:      experimental
Portability:    portable
-}
module Web.Willow.Common.Parser.Util
    ( range
    , choice
    , findNext
    ) where


import qualified Control.Applicative as A

import Control.Applicative ( (<|>) )

import Web.Willow.Common.Parser


-- | Test whether a given value falls within the range defined by the two
-- bounds, inclusive.
-- 
-- >>> range 1 2 3
-- False
-- 
-- >>> range 1 3 2
-- True
-- 
-- >>> range 1 2 2
-- True
range
    :: Ord a
    => a
        -- ^ Low bound
    -> a
        -- ^ High bound
    -> a
        -- ^ Value to test
    -> Bool
range :: a -> a -> a -> Bool
range a
low a
high a
test = a
test a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
low Bool -> Bool -> Bool
&& a
test a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
high

-- | Reduce a list of 'A.Alternative's, such that the first successful instance
-- will be run.  If the list is empty, the resulting value will always fail.
choice :: A.Alternative m => [m a] -> m a
choice :: [m a] -> m a
choice = (m a -> m a -> m a) -> m a -> [m a] -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) m a
forall (f :: * -> *) a. Alternative f => f a
A.empty

-- | Scan through the stream, until the given parser succeeds (discarding any
-- tokens between the initial location and where the first success is found).
-- Fails if the parser does not succeed at any point in the remainder of the
-- stream.
findNext :: MonadParser parser stream token => parser out -> parser out
findNext :: parser out -> parser out
findNext parser out
target = [parser out] -> parser out
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice
    [ parser out
target
    , parser token
forall (m :: * -> *) stream token.
MonadParser m stream token =>
m token
next parser token -> parser out -> parser out
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> parser out -> parser out
forall (parser :: * -> *) stream token out.
MonadParser parser stream token =>
parser out -> parser out
findNext parser out
target
    ]