{-# LANGUAGE LambdaCase #-}

module Internal.Text.Read where

import Control.Monad
    ( replicateM_ )
import Text.Read
    ( ReadPrec, get, look, pfail )

import qualified Data.List as L

readCharMaybe :: (Char -> Maybe a) -> ReadPrec a
readCharMaybe :: forall a. (Char -> Maybe a) -> ReadPrec a
readCharMaybe Char -> Maybe a
f = ReadPrec String
look ReadPrec String -> (String -> ReadPrec a) -> ReadPrec a
forall a b. ReadPrec a -> (a -> ReadPrec b) -> ReadPrec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Char
a : String
_ | Just a
c <- Char -> Maybe a
f Char
a ->
        ReadPrec Char
get ReadPrec Char -> ReadPrec a -> ReadPrec a
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ReadPrec a
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
c
    String
_ ->
        ReadPrec a
forall a. ReadPrec a
pfail

skipChar :: Char -> ReadPrec ()
skipChar :: Char -> ReadPrec ()
skipChar Char
charToSkip = (Char -> Maybe ()) -> ReadPrec ()
forall a. (Char -> Maybe a) -> ReadPrec a
readCharMaybe
    (\Char
char -> if Char
char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
charToSkip then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing)

skipString :: String -> ReadPrec ()
skipString :: String -> ReadPrec ()
skipString String
stringToSkip = do
    String
remainder <- ReadPrec String
look
    if String
stringToSkip String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
remainder
    then Int -> ReadPrec Char -> ReadPrec ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
stringToSkip) ReadPrec Char
get
    else ReadPrec ()
forall a. ReadPrec a
pfail