-- | Utilities for the `ReadP` parser.
module MCSP.Text.ReadP (
    -- * Construction and application
    readP,
    maybeP,
    readEitherP,
    readMaybeP,

    -- * Additional operations
    next,
    most,

    -- ** Whitespace adapters
    skipInLine,
    trimmed,
    trim,
    eol,
    word,
    words,

    -- * Re-export
    module Text.ParserCombinators.ReadP,
) where

import Control.Applicative (Applicative (..))
import Control.Monad (unless, void)
import Data.Bool (Bool (..), not, otherwise, (&&))
import Data.Char (Char, isSpace)
import Data.Either (Either (..))
import Data.Either.Extra (eitherToMaybe)
import Data.Eq (Eq (..))
import Data.Function (($), (.))
import Data.List.Extra (length, take, (++))
import Data.Maybe (Maybe (..), maybe)
import Data.Ord (Ord (..))
import Data.String (String)
import GHC.Num ((-))
import Safe (headMay, lastMay)
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec (minPrec, readPrec_to_P)
import Text.Read (Read (..))
import Text.Show (Show (..))

-- | `ReadP` parser using the `Read` instance.
--
-- >>> import Data.Int
--
-- >>> readP_to_S (readP @Int) "12"
-- [(12,"")]
--
-- >>> readP_to_S (readP @Int) "33XY"
-- [(33,"XY")]
--
-- >>> readP_to_S (readP @Int) "ZX"
-- []
readP :: Read a => ReadP a
readP :: forall a. Read a => ReadP a
readP = ReadPrec a -> Int -> ReadP a
forall a. ReadPrec a -> Int -> ReadP a
readPrec_to_P ReadPrec a
forall a. Read a => ReadPrec a
readPrec Int
minPrec

-- | Parse a string using the given `ReadP` parser instance.
--
-- Succeeds if there is exactly one valid result. A `Left` value indicates a parse error.
--
-- >>> import Data.Int
--
-- >>> readEitherP (readP @Int) "123"
-- Right 123
--
-- >>> readEitherP (readP @Int) "hello"
-- Left "no parse on \"hello\""
readEitherP :: ReadP a -> String -> Either String a
readEitherP :: forall a. ReadP a -> String -> Either String a
readEitherP ReadP a
read String
text = case [a
value | (a
value, String
"") <- ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
readP_to_S ReadP a
read String
text] of
    [Item [a]
exact] -> a -> Either String a
forall a b. b -> Either a b
Right a
Item [a]
exact
    [] -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"no parse on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (String -> String
prefix String
text)
    [a]
_ -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"ambiguous parse on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (String -> String
prefix String
text)
  where
    maxLength :: Int
maxLength = Int
15
    prefix :: String -> String
prefix String
s
        | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLength = String
s
        | Bool
otherwise = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
maxLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."

-- | Parse a string using the given `ReadP` parser instance.
--
-- Succeeds if there is exactly one valid result. A `Nothing` value indicates a parse error.
--
-- >>> import Data.Int
--
-- >>> readMaybeP (readP @Int) "123"
-- Just 123
--
-- >>> readMaybeP (readP @Int) "hello"
-- Nothing
readMaybeP :: ReadP a -> String -> Maybe a
readMaybeP :: forall a. ReadP a -> String -> Maybe a
readMaybeP ReadP a
read String
text = Either String a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String a -> Maybe a) -> Either String a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ReadP a -> String -> Either String a
forall a. ReadP a -> String -> Either String a
readEitherP ReadP a
read String
text

-- | Lift a `Maybe` to the `ReadP` monad.
--
-- `Nothing` causes a parse error.
--
-- >>> readP_to_S (maybeP $ Just 12) ""
-- [(12,"")]
--
-- >>> readP_to_S (maybeP $ Nothing) ""
-- []
maybeP :: Maybe a -> ReadP a
maybeP :: forall a. Maybe a -> ReadP a
maybeP = ReadP a -> (a -> ReadP a) -> Maybe a -> ReadP a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadP a
forall a. ReadP a
pfail a -> ReadP a
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Succeeds iff the next character matches the given predicate, without consuming it.
--
-- >>> readP_to_S (next (== 'x')) "x"
-- [((),"x")]
--
-- >>> readP_to_S (next (== 'x')) "y"
-- []
--
-- >>> readP_to_S (next (== 'x')) ""
-- []
next :: (Char -> Bool) -> ReadP ()
next :: (Char -> Bool) -> ReadP ()
next Char -> Bool
matches = do
    String
str <- ReadP String
look
    Char
ch <- Maybe Char -> ReadP Char
forall a. Maybe a -> ReadP a
maybeP (Maybe Char -> ReadP Char) -> Maybe Char -> ReadP Char
forall a b. (a -> b) -> a -> b
$ String -> Maybe Char
forall a. [a] -> Maybe a
headMay String
str
    Bool -> ReadP () -> ReadP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char -> Bool
matches Char
ch) ReadP ()
forall a. ReadP a
pfail

-- | Parses zero or more occurrences of the given parser.
--
-- Like `many`, but succeds only once, with as many matches as possible.
--
-- >>> readP_to_S (most word) " abc def ghi "
-- [(["abc","def","ghi"],"")]
--
-- >>> readP_to_S (many word) " abc def ghi "
-- [([]," abc def ghi "),(["abc"],"def ghi "),(["abc","def"],"ghi "),(["abc","def","ghi"],"")]
most :: ReadP a -> ReadP [a]
most :: forall a. ReadP a -> ReadP [a]
most ReadP a
readItem = (a -> [a] -> [a]) -> ReadP a -> ReadP [a] -> ReadP [a]
forall a b c. (a -> b -> c) -> ReadP a -> ReadP b -> ReadP c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) ReadP a
readItem (ReadP a -> ReadP [a]
forall a. ReadP a -> ReadP [a]
most ReadP a
readItem) ReadP [a] -> ReadP [a] -> ReadP [a]
forall a. ReadP a -> ReadP a -> ReadP a
<++ [a] -> ReadP [a]
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Skip whitespace, but not the end of line.
--
-- >>> readP_to_S skipInLine "   "
-- [((),"")]
--
-- >>> readP_to_S (skipInLine *> satisfy (/= '\n')) "  A"
-- [('A',"")]
--
-- >>> readP_to_S skipInLine "  \n"
-- [((),"\n")]
skipInLine :: ReadP ()
skipInLine :: ReadP ()
skipInLine = ReadP String -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Char -> Bool) -> ReadP String
munch Char -> Bool
isInLineSpace)
  where
    isInLineSpace :: Char -> Bool
isInLineSpace Char
ch = Char -> Bool
isSpace Char
ch Bool -> Bool -> Bool
&& Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'

-- | Updates the parser so it guarantees that no whitespace precedes or succedes the matched text.
--
-- >>> import Data.Int
--
-- >>> readP_to_S (readP @Int) " 12 "
-- [(12," ")]
--
-- >>> readP_to_S (trimmed $ readP @Int) " 12 "
-- []
trimmed :: ReadP a -> ReadP a
trimmed :: forall a. ReadP a -> ReadP a
trimmed ReadP a
read = do
    (String
text, a
value) <- ReadP a -> ReadP (String, a)
forall a. ReadP a -> ReadP (String, a)
gather ReadP a
read
    case (String -> Maybe Char
forall a. [a] -> Maybe a
headMay String
text, String -> Maybe Char
forall a. [a] -> Maybe a
lastMay String
text) of
        (Just Char
head, Maybe Char
_) | Char -> Bool
isSpace Char
head -> ReadP a
forall a. ReadP a
pfail
        (Maybe Char
_, Just Char
last) | Char -> Bool
isSpace Char
last -> ReadP a
forall a. ReadP a
pfail
        (Maybe Char, Maybe Char)
_ -> a -> ReadP a
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value

-- | Updates the parser so it used only in a trimmed part of the text, removing outer whitespace.
--
-- >>> import Data.Int
--
-- >>> readP_to_S (readP @Int) " 12 "
-- [(12," ")]
--
-- >>> readP_to_S (trim $ readP @Int) " 12 "
-- [(12,"")]
trim :: ReadP a -> ReadP a
trim :: forall a. ReadP a -> ReadP a
trim ReadP a
read = ReadP ()
skipInLine ReadP () -> ReadP a -> ReadP a
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a
trimmed ReadP a
read ReadP a -> ReadP () -> ReadP a
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
skipInLine

-- | Matches the end-of-line.
--
-- End-of-line can be `eof` or @'\n'@.
--
-- >>> readP_to_S eol ""
-- [((),"")]
--
-- >>> readP_to_S eol "a"
-- []
--
-- >>> readP_to_S eol "\na"
-- [((),"\na")]
eol :: ReadP ()
eol :: ReadP ()
eol = ReadP ()
eof ReadP () -> ReadP () -> ReadP ()
forall a. ReadP a -> ReadP a -> ReadP a
<++ (Char -> Bool) -> ReadP ()
next (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- | Matches a single word.
--
-- >>> readP_to_S word "  abc "
-- [("abc","")]
--
-- >>> readP_to_S word "  abc def "
-- [("abc","def ")]
--
-- >>> readP_to_S word "  "
-- []
word :: ReadP String
word :: ReadP String
word = ReadP String -> ReadP String
forall a. ReadP a -> ReadP a
trim (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP String
munch1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)

-- | Matches a list of words separated by whitespaces.
--
-- >>> readP_to_S words "12 3 4"
-- [([],"12 3 4"),(["12"],"3 4"),(["12","3"],"4"),(["12","3","4"],"")]

-- >>> readP_to_S words "  xy k abcd "
-- [([],"xy k abcd "),(["xy"],"k abcd "),(["xy","k"],"abcd "),(["xy","k","abcd"],"")]
--
-- >>> readP_to_S words ""
-- [([],"")]
words :: ReadP [String]
words :: ReadP [String]
words = ReadP [String] -> ReadP [String]
forall a. ReadP a -> ReadP a
trim (ReadP [String] -> ReadP [String])
-> ReadP [String] -> ReadP [String]
forall a b. (a -> b) -> a -> b
$ ReadP String -> ReadP () -> ReadP [String]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy ((Char -> Bool) -> ReadP String
munch1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) ReadP ()
skipInLine