-- |
-- Module      :  Data.Text.Parser
-- License     :  CC0-1.0
--
-- Maintainer  :  mordae@anilinux.org
-- Stability   :  unstable
-- Portability :  non-portable (ghc)
--
-- This module provides a parser for Unicode 'Text'.
--

module Data.Text.Parser
  ( Parser(..)
  , parseOnly

    -- * Characters
  , char
  , notChar
  , anyChar
  , satisfy
  , space
  , isSpace
  , skipSpace
  , peekChar

    -- * Strings
  , string
  , stringCI
  , Data.Text.Parser.take
  , scan
  , runScanner
  , inRange
  , notInRange
  , Data.Text.Parser.takeWhile
  , takeWhile1
  , takeTill
  , takeTill1

    -- * Numbers
  , signed
  , decimal
  , hexadecimal
  , octal
  , fractional

    -- * Combinators
  , provided
  , choice
  , Snack.Combinators.count
  , optional
  , eitherP
  , option
  , many
  , many1
  , manyTill
  , sepBy
  , sepBy1
  , wrap
  , match

    -- * End Of Input
  , takeText
  , endOfInput
  , atEnd

    -- * Miscelaneous
    -- |
    -- These are all generic methods, but since I sometimes forget about them,
    -- it is nice to have them listed here for reference what writing parsers.
  , Control.Applicative.empty
  , pure
  , guard
  , when
  , unless
  , void
  )
where
  import Prelude hiding (null, length, splitAt, take)

  import Control.Applicative
  import Control.Monad

  import Data.Char
  import Data.Maybe

  import Data.Text as T
  import Data.Text.Unsafe as T
  import Data.Text.Encoding as T

  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Parser.Char8 as BSP

  import Snack.Combinators


  newtype Parser a =
    Parser
      { forall a. Parser a -> Text -> Maybe (a, Text)
runParser :: Text -> Maybe (a, Text)
      }

  instance Functor Parser where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
fn Parser{Text -> Maybe (a, Text)
runParser :: Text -> Maybe (a, Text)
runParser :: forall a. Parser a -> Text -> Maybe (a, Text)
runParser} = (Text -> Maybe (b, Text)) -> Parser b
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
      case Text -> Maybe (a, Text)
runParser Text
inp of
        Just (a
res, Text
rest) -> (b, Text) -> Maybe (b, Text)
forall a. a -> Maybe a
Just (a -> b
fn a
res, Text
rest)
        Maybe (a, Text)
Nothing -> Maybe (b, Text)
forall a. Maybe a
Nothing

  instance Applicative Parser where
    {-# INLINE pure #-}
    pure :: forall a. a -> Parser a
pure a
x = (Text -> Maybe (a, Text)) -> Parser a
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp -> (a, Text) -> Maybe (a, Text)
forall a. a -> Maybe a
Just (a
x, Text
inp)

    {-# INLINE (<*>) #-}
    (Parser Text -> Maybe (a -> b, Text)
runFn) <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> (Parser Text -> Maybe (a, Text)
runArg) = (Text -> Maybe (b, Text)) -> Parser b
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
      case Text -> Maybe (a -> b, Text)
runFn Text
inp of
        Maybe (a -> b, Text)
Nothing -> Maybe (b, Text)
forall a. Maybe a
Nothing
        Just (a -> b
fn, Text
rest) ->
          case Text -> Maybe (a, Text)
runArg Text
rest of
            Maybe (a, Text)
Nothing -> Maybe (b, Text)
forall a. Maybe a
Nothing
            Just (a
x, Text
rest') -> (b, Text) -> Maybe (b, Text)
forall a. a -> Maybe a
Just (a -> b
fn a
x, Text
rest')

  instance Alternative Parser where
    {-# INLINE empty #-}
    empty :: forall a. Parser a
empty = (Text -> Maybe (a, Text)) -> Parser a
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
_ -> Maybe (a, Text)
forall a. Maybe a
Nothing

    {-# INLINE (<|>) #-}
    (Parser Text -> Maybe (a, Text)
runLeft) <|> :: forall a. Parser a -> Parser a -> Parser a
<|> (Parser Text -> Maybe (a, Text)
runRight) = (Text -> Maybe (a, Text)) -> Parser a
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
      case Text -> Maybe (a, Text)
runLeft Text
inp of
        Just (a, Text)
r  -> (a, Text) -> Maybe (a, Text)
forall a. a -> Maybe a
Just (a, Text)
r
        Maybe (a, Text)
Nothing -> Text -> Maybe (a, Text)
runRight Text
inp

  instance Monad Parser where
    {-# INLINE (>>=) #-}
    (Parser Text -> Maybe (a, Text)
runLeft) >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
right = (Text -> Maybe (b, Text)) -> Parser b
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
      case Text -> Maybe (a, Text)
runLeft Text
inp of
        Maybe (a, Text)
Nothing -> Maybe (b, Text)
forall a. Maybe a
Nothing
        Just (a
x, Text
more) -> Parser b -> Text -> Maybe (b, Text)
forall a. Parser a -> Text -> Maybe (a, Text)
runParser (a -> Parser b
right a
x) Text
more

  instance MonadPlus Parser

  instance MonadFail Parser where
    {-# INLINE CONLIKE fail #-}
    fail :: forall a. String -> Parser a
fail String
_ = Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero


  {-# INLINE CONLIKE parseOnly #-}
  parseOnly :: Parser a -> Text -> Maybe a
  parseOnly :: forall a. Parser a -> Text -> Maybe a
parseOnly Parser a
par = \Text
inp -> (a, Text) -> a
forall a b. (a, b) -> a
fst ((a, Text) -> a) -> Maybe (a, Text) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Text -> Maybe (a, Text)
forall a. Parser a -> Text -> Maybe (a, Text)
runParser Parser a
par Text
inp


  {-# INLINE CONLIKE satisfy #-}
  satisfy :: (Char -> Bool) -> Parser Char
  satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isOk = (Text -> Maybe (Char, Text)) -> Parser Char
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    if Text -> Bool
null Text
inp
       then Maybe (Char, Text)
forall a. Maybe a
Nothing
       else let c :: Char
c = Text -> Char
unsafeHead Text
inp
             in if Char -> Bool
isOk Char
c
                   then (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just (Char
c, Text -> Text
unsafeTail Text
inp)
                   else Maybe (Char, Text)
forall a. Maybe a
Nothing


  {-# INLINE CONLIKE string #-}
  string :: Text -> Parser Text
  string :: Text -> Parser Text
string Text
str = (Text -> Maybe (Text, Text)) -> Parser Text
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    let (Text
pfx, Text
sfx) = Int -> Text -> (Text, Text)
splitAt (Text -> Int
length Text
str) Text
inp
     in case Text
pfx Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
str of
          Bool
True -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
pfx, Text
sfx)
          Bool
False -> Maybe (Text, Text)
forall a. Maybe a
Nothing


  {-# INLINE CONLIKE take #-}
  take :: Int -> Parser Text
  take :: Int -> Parser Text
take Int
n = (Text -> Maybe (Text, Text)) -> Parser Text
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Text -> Int
length Text
inp
       then Maybe (Text, Text)
forall a. Maybe a
Nothing
       else (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Int -> Text -> (Text, Text)
splitAt Int
n Text
inp)


  {-# INLINE CONLIKE scan #-}
  scan :: s -> (s -> Char -> Maybe s) -> Parser Text
  scan :: forall s. s -> (s -> Char -> Maybe s) -> Parser Text
scan s
state s -> Char -> Maybe s
scanner = (Text, s) -> Text
forall a b. (a, b) -> a
fst ((Text, s) -> Text) -> Parser (Text, s) -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> (s -> Char -> Maybe s) -> Parser (Text, s)
forall s. s -> (s -> Char -> Maybe s) -> Parser (Text, s)
runScanner s
state s -> Char -> Maybe s
scanner


  -- |
  -- Like 'scan', but also returns the final scanner state.
  --
  {-# INLINE CONLIKE runScanner #-}
  runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
  runScanner :: forall s. s -> (s -> Char -> Maybe s) -> Parser (Text, s)
runScanner s
state s -> Char -> Maybe s
scanner = (Text -> Maybe ((Text, s), Text)) -> Parser (Text, s)
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp -> Text -> s -> Int -> Maybe ((Text, s), Text)
loop Text
inp s
state Int
0
    where
      loop :: Text -> s -> Int -> Maybe ((Text, s), Text)
loop Text
inp !s
st !Int
n =
        case Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
lengthWord8 Text
inp of
          Bool
True -> ((Text, s), Text) -> Maybe ((Text, s), Text)
forall a. a -> Maybe a
Just ((Text
inp, s
st), Text
forall a. Monoid a => a
mempty)
          Bool
False ->
            case Text -> Int -> Iter
iter Text
inp Int
n of
              Iter Char
c Int
n' ->
                case s -> Char -> Maybe s
scanner s
st Char
c of
                  Maybe s
Nothing -> ((Text, s), Text) -> Maybe ((Text, s), Text)
forall a. a -> Maybe a
Just ((Int -> Text -> Text
takeWord8 Int
n Text
inp, s
st), Int -> Text -> Text
dropWord8 Int
n Text
inp)
                  Just s
st' -> Text -> s -> Int -> Maybe ((Text, s), Text)
loop Text
inp s
st' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n')


  {-# INLINE CONLIKE takeWhile #-}
  takeWhile :: (Char -> Bool) -> Parser Text
  takeWhile :: (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
test = (Char -> Bool) -> Parser Text
takeTill (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
test)


  {-# INLINE CONLIKE takeWhile1 #-}
  takeWhile1 :: (Char -> Bool) -> Parser Text
  takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
test = (Text -> Bool) -> Parser Text -> Parser Text
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
(a -> Bool) -> m a -> m a
provided (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
null) (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
                    (Char -> Bool) -> Parser Text
Data.Text.Parser.takeWhile Char -> Bool
test


  {-# INLINE CONLIKE takeTill #-}
  takeTill :: (Char -> Bool) -> Parser Text
  takeTill :: (Char -> Bool) -> Parser Text
takeTill Char -> Bool
test = (Text -> Maybe (Text, Text)) -> Parser Text
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    let n :: Int
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Text -> Int
length Text
inp) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Int
findIndex Char -> Bool
test Text
inp
     in (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Int -> Text -> (Text, Text)
splitAt Int
n Text
inp)


  {-# INLINE CONLIKE takeTill1 #-}
  takeTill1 :: (Char -> Bool) -> Parser Text
  takeTill1 :: (Char -> Bool) -> Parser Text
takeTill1 Char -> Bool
test = (Text -> Bool) -> Parser Text -> Parser Text
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
(a -> Bool) -> m a -> m a
provided (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
null) (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$
                    (Char -> Bool) -> Parser Text
Data.Text.Parser.takeTill Char -> Bool
test


  {-# INLINE CONLIKE match #-}
  match :: Parser a -> Parser (Text, a)
  match :: forall a. Parser a -> Parser (Text, a)
match Parser a
par = (Text -> Maybe ((Text, a), Text)) -> Parser (Text, a)
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    case Parser a -> Text -> Maybe (a, Text)
forall a. Parser a -> Text -> Maybe (a, Text)
runParser Parser a
par Text
inp of
      Maybe (a, Text)
Nothing -> Maybe ((Text, a), Text)
forall a. Maybe a
Nothing
      Just (a
x, Text
more) ->
        let n :: Int
n = Text -> Int
length Text
more
         in ((Text, a), Text) -> Maybe ((Text, a), Text)
forall a. a -> Maybe a
Just ((Int -> Text -> Text
T.take Int
n Text
inp, a
x), Text
more)


  {-# INLINE takeText #-}
  takeText :: Parser Text
  takeText :: Parser Text
takeText = (Text -> Maybe (Text, Text)) -> Parser Text
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
inp, Text
forall a. Monoid a => a
mempty)


  {-# INLINE endOfInput #-}
  endOfInput :: Parser ()
  endOfInput :: Parser ()
endOfInput = (Text -> Maybe ((), Text)) -> Parser ()
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \case
    Text
inp | Text -> Bool
null Text
inp  -> ((), Text) -> Maybe ((), Text)
forall a. a -> Maybe a
Just ((), Text
inp)
    Text
_otherwise      -> Maybe ((), Text)
forall a. Maybe a
Nothing


  {-# INLINE atEnd #-}
  atEnd :: Parser Bool
  atEnd :: Parser Bool
atEnd = (Text -> Maybe (Bool, Text)) -> Parser Bool
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp -> (Bool, Text) -> Maybe (Bool, Text)
forall a. a -> Maybe a
Just (Text -> Bool
null Text
inp, Text
inp)


  {-# INLINE CONLIKE char #-}
  char :: Char -> Parser Char
  char :: Char -> Parser Char
char Char
c = (Char -> Bool) -> Parser Char
satisfy (Char
c ==)


  {-# INLINE space #-}
  space :: Parser Char
  space :: Parser Char
space = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isSpace


  {-# INLINE skipSpace #-}
  skipSpace :: Parser ()
  skipSpace :: Parser ()
skipSpace = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text
Data.Text.Parser.takeWhile Char -> Bool
isSpace


  {-# INLINE CONLIKE notChar #-}
  notChar :: Char -> Parser Char
  notChar :: Char -> Parser Char
notChar Char
c = (Char -> Bool) -> Parser Char
satisfy (Char
c /=)


  {-# INLINE anyChar #-}
  anyChar :: Parser Char
  anyChar :: Parser Char
anyChar = (Text -> Maybe (Char, Text)) -> Parser Char
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    if Text -> Bool
null Text
inp
       then Maybe (Char, Text)
forall a. Maybe a
Nothing
       else (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just (Text -> Char
unsafeHead Text
inp, Text -> Text
unsafeTail Text
inp)


  {-# INLINE peekChar #-}
  peekChar :: Parser Char
  peekChar :: Parser Char
peekChar = (Text -> Maybe (Char, Text)) -> Parser Char
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    if Text -> Bool
null Text
inp
       then Maybe (Char, Text)
forall a. Maybe a
Nothing
       else (Char, Text) -> Maybe (Char, Text)
forall a. a -> Maybe a
Just (Text -> Char
unsafeHead Text
inp, Text
inp)


  {-# INLINE CONLIKE stringCI #-}
  stringCI :: Text -> Parser Text
  stringCI :: Text -> Parser Text
stringCI Text
str = (Text -> Maybe (Text, Text)) -> Parser Text
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    let (Text
pfx, Text
sfx) = Int -> Text -> (Text, Text)
splitAt (Text -> Int
length Text
str) Text
inp
     in case Text -> Text
toCaseFold Text
pfx Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
toCaseFold Text
str of
          Bool
True -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
pfx, Text
sfx)
          Bool
False -> Maybe (Text, Text)
forall a. Maybe a
Nothing


  {-# INLINE signed #-}
  signed :: (Num a) => Parser a -> Parser a
  signed :: forall a. Num a => Parser a -> Parser a
signed Parser a
runNumber = (Char -> Parser Char
char Char
'-' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate Parser a
runNumber)
                 Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'+' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
runNumber)
                 Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser a
runNumber)


  {-# INLINE CONLIKE unsafeWithUtf8 #-}
  unsafeWithUtf8 :: BSP.Parser a -> Parser a
  unsafeWithUtf8 :: forall a. Parser a -> Parser a
unsafeWithUtf8 Parser a
bspar = (Text -> Maybe (a, Text)) -> Parser a
forall a. (Text -> Maybe (a, Text)) -> Parser a
Parser \Text
inp ->
    let bstr :: ByteString
bstr = Text -> ByteString
encodeUtf8 Text
inp
     in case Parser a -> ByteString -> Maybe (a, ByteString)
forall a. Parser a -> ByteString -> Maybe (a, ByteString)
BSP.runParser Parser a
bspar ByteString
bstr of
          Maybe (a, ByteString)
Nothing -> Maybe (a, Text)
forall a. Maybe a
Nothing
          Just (a
x, ByteString
more) ->
            let n :: Int
n = Text -> Int
lengthWord8 Text
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
more
             in (a, Text) -> Maybe (a, Text)
forall a. a -> Maybe a
Just (a
x, Int -> Text -> Text
dropWord8 Int
n Text
inp)


  {-# INLINE decimal #-}
  decimal :: (Integral a) => Parser a
  decimal :: forall a. Integral a => Parser a
decimal = Parser a -> Parser a
forall a. Parser a -> Parser a
unsafeWithUtf8 Parser a
forall a. Integral a => Parser a
BSP.decimal


  {-# INLINE hexadecimal #-}
  hexadecimal :: (Integral a) => Parser a
  hexadecimal :: forall a. Integral a => Parser a
hexadecimal = Parser a -> Parser a
forall a. Parser a -> Parser a
unsafeWithUtf8 Parser a
forall a. Integral a => Parser a
BSP.hexadecimal


  {-# INLINE octal #-}
  octal :: (Integral a) => Parser a
  octal :: forall a. Integral a => Parser a
octal = Parser a -> Parser a
forall a. Parser a -> Parser a
unsafeWithUtf8 Parser a
forall a. Integral a => Parser a
BSP.octal


  {-# INLINE fractional #-}
  fractional :: (Fractional a) => Parser a
  fractional :: forall a. Fractional a => Parser a
fractional = Parser a -> Parser a
forall a. Parser a -> Parser a
unsafeWithUtf8 Parser a
forall a. Fractional a => Parser a
BSP.fractional


-- vim:set ft=haskell sw=2 ts=2 et: