{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.ParserCombinators.ReadPrec
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)
--
-- This library defines parser combinators for precedence parsing.

-----------------------------------------------------------------------------

module Text.ParserCombinators.ReadPrec
  (
  ReadPrec,

  -- * Precedences
  Prec,
  minPrec,

  -- * Precedence operations
  lift,
  prec,
  step,
  reset,

  -- * Other operations
  -- | All are based directly on their similarly-named 'ReadP' counterparts.
  get,
  look,
  (+++),
  (<++),
  pfail,
  choice,

  -- * Converters
  readPrec_to_P,
  readP_to_Prec,
  readPrec_to_S,
  readS_to_Prec,
  )
 where


import Text.ParserCombinators.ReadP
  ( ReadP
  , ReadS
  , readP_to_S
  , readS_to_P
  )

import qualified Text.ParserCombinators.ReadP as ReadP
  ( get
  , look
  , (+++), (<++)
  , pfail
  )

import GHC.Num( Num(..) )
import GHC.Base

import qualified Control.Monad.Fail as MonadFail

-- ---------------------------------------------------------------------------
-- The readPrec type

newtype ReadPrec a = P (Prec -> ReadP a)

-- Functor, Monad, MonadPlus

-- | @since 2.01
instance Functor ReadPrec where
  fmap :: (a -> b) -> ReadPrec a -> ReadPrec b
fmap h :: a -> b
h (P f :: Prec -> ReadP a
f) = (Prec -> ReadP b) -> ReadPrec b
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\n :: Prec
n -> (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h (Prec -> ReadP a
f Prec
n))

-- | @since 4.6.0.0
instance Applicative ReadPrec where
    pure :: a -> ReadPrec a
pure x :: a
x  = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\_ -> a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
    <*> :: ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
(<*>) = ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
    liftA2 :: (a -> b -> c) -> ReadPrec a -> ReadPrec b -> ReadPrec c
liftA2 = (a -> b -> c) -> ReadPrec a -> ReadPrec b -> ReadPrec c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 2.01
instance Monad ReadPrec where
  P f :: Prec -> ReadP a
f >>= :: ReadPrec a -> (a -> ReadPrec b) -> ReadPrec b
>>= k :: a -> ReadPrec b
k = (Prec -> ReadP b) -> ReadPrec b
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\n :: Prec
n -> do a
a <- Prec -> ReadP a
f Prec
n; let P f' :: Prec -> ReadP b
f' = a -> ReadPrec b
k a
a in Prec -> ReadP b
f' Prec
n)

-- | @since 4.9.0.0
instance MonadFail.MonadFail ReadPrec where
  fail :: String -> ReadPrec a
fail s :: String
s    = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\_ -> String -> ReadP a
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail String
s)

-- | @since 2.01
instance MonadPlus ReadPrec

-- | @since 4.6.0.0
instance Alternative ReadPrec where
  empty :: ReadPrec a
empty = ReadPrec a
forall a. ReadPrec a
pfail
  <|> :: ReadPrec a -> ReadPrec a -> ReadPrec a
(<|>) = ReadPrec a -> ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
(+++)

-- precedences
type Prec = Int

minPrec :: Prec
minPrec :: Prec
minPrec = 0

-- ---------------------------------------------------------------------------
-- Operations over ReadPrec

lift :: ReadP a -> ReadPrec a
-- ^ Lift a precedence-insensitive 'ReadP' to a 'ReadPrec'.
lift :: ReadP a -> ReadPrec a
lift m :: ReadP a
m = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\_ -> ReadP a
m)

step :: ReadPrec a -> ReadPrec a
-- ^ Increases the precedence context by one.
step :: ReadPrec a -> ReadPrec a
step (P f :: Prec -> ReadP a
f) = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\n :: Prec
n -> Prec -> ReadP a
f (Prec
nPrec -> Prec -> Prec
forall a. Num a => a -> a -> a
+1))

reset :: ReadPrec a -> ReadPrec a
-- ^ Resets the precedence context to zero.
reset :: ReadPrec a -> ReadPrec a
reset (P f :: Prec -> ReadP a
f) = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\_ -> Prec -> ReadP a
f Prec
minPrec)

prec :: Prec -> ReadPrec a -> ReadPrec a
-- ^ @(prec n p)@ checks whether the precedence context is
--   less than or equal to @n@, and
--
--   * if not, fails
--
--   * if so, parses @p@ in context @n@.
prec :: Prec -> ReadPrec a -> ReadPrec a
prec n :: Prec
n (P f :: Prec -> ReadP a
f) = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\c :: Prec
c -> if Prec
c Prec -> Prec -> Bool
forall a. Ord a => a -> a -> Bool
<= Prec
n then Prec -> ReadP a
f Prec
n else ReadP a
forall a. ReadP a
ReadP.pfail)

-- ---------------------------------------------------------------------------
-- Derived operations

get :: ReadPrec Char
-- ^ Consumes and returns the next character.
--   Fails if there is no input left.
get :: ReadPrec Char
get = ReadP Char -> ReadPrec Char
forall a. ReadP a -> ReadPrec a
lift ReadP Char
ReadP.get

look :: ReadPrec String
-- ^ Look-ahead: returns the part of the input that is left, without
--   consuming it.
look :: ReadPrec String
look = ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
lift ReadP String
ReadP.look

(+++) :: ReadPrec a -> ReadPrec a -> ReadPrec a
-- ^ Symmetric choice.
P f1 :: Prec -> ReadP a
f1 +++ :: ReadPrec a -> ReadPrec a -> ReadPrec a
+++ P f2 :: Prec -> ReadP a
f2 = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\n :: Prec
n -> Prec -> ReadP a
f1 Prec
n ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.+++ Prec -> ReadP a
f2 Prec
n)

(<++) :: ReadPrec a -> ReadPrec a -> ReadPrec a
-- ^ Local, exclusive, left-biased choice: If left parser
--   locally produces any result at all, then right parser is
--   not used.
P f1 :: Prec -> ReadP a
f1 <++ :: ReadPrec a -> ReadPrec a -> ReadPrec a
<++ P f2 :: Prec -> ReadP a
f2 = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\n :: Prec
n -> Prec -> ReadP a
f1 Prec
n ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
ReadP.<++ Prec -> ReadP a
f2 Prec
n)

pfail :: ReadPrec a
-- ^ Always fails.
pfail :: ReadPrec a
pfail = ReadP a -> ReadPrec a
forall a. ReadP a -> ReadPrec a
lift ReadP a
forall a. ReadP a
ReadP.pfail

choice :: [ReadPrec a] -> ReadPrec a
-- ^ Combines all parsers in the specified list.
choice :: [ReadPrec a] -> ReadPrec a
choice ps :: [ReadPrec a]
ps = (ReadPrec a -> ReadPrec a -> ReadPrec a)
-> ReadPrec a -> [ReadPrec a] -> ReadPrec a
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr ReadPrec a -> ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
(+++) ReadPrec a
forall a. ReadPrec a
pfail [ReadPrec a]
ps

-- ---------------------------------------------------------------------------
-- Converting between ReadPrec and Read

readPrec_to_P :: ReadPrec a -> (Int -> ReadP a)
readPrec_to_P :: ReadPrec a -> Prec -> ReadP a
readPrec_to_P (P f :: Prec -> ReadP a
f) = Prec -> ReadP a
f

readP_to_Prec :: (Int -> ReadP a) -> ReadPrec a
readP_to_Prec :: (Prec -> ReadP a) -> ReadPrec a
readP_to_Prec f :: Prec -> ReadP a
f = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P Prec -> ReadP a
f

readPrec_to_S :: ReadPrec a -> (Int -> ReadS a)
readPrec_to_S :: ReadPrec a -> Prec -> ReadS a
readPrec_to_S (P f :: Prec -> ReadP a
f) n :: Prec
n = ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S (Prec -> ReadP a
f Prec
n)

readS_to_Prec :: (Int -> ReadS a) -> ReadPrec a
readS_to_Prec :: (Prec -> ReadS a) -> ReadPrec a
readS_to_Prec f :: Prec -> ReadS a
f = (Prec -> ReadP a) -> ReadPrec a
forall a. (Prec -> ReadP a) -> ReadPrec a
P (\n :: Prec
n -> ReadS a -> ReadP a
forall a. ReadS a -> ReadP a
readS_to_P (Prec -> ReadS a
f Prec
n))