{-# LANGUAGE Safe #-}
{- arch-tag: Parsec utilities
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : Text.ParserCombinators.Parsec.Utils
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Written by John Goerzen, jgoerzen\@complete.org

-}

module Text.ParserCombinators.Parsec.Utils(-- * Generalized Utilities
                       -- | These functions are generalized versions of
                       -- ones you might see in the Char parser.
                       GeneralizedToken, GeneralizedTokenParser,
                       togtok, tokeng, satisfyg, oneOfg, noneOfg,
                       specificg, allg,
                       -- * Other Utilities
                       notMatching
                      ) where

import safe Text.ParserCombinators.Parsec
    ( (<?>),
      (<|>),
      getPosition,
      many,
      token,
      unexpected,
      try,
      SourcePos,
      GenParser )

type GeneralizedToken a = (SourcePos, a)
type GeneralizedTokenParser a st b = GenParser (GeneralizedToken a) st b

{- | Generate (return) a 'GeneralizedToken'. -}
togtok :: a -> GenParser b st (GeneralizedToken a)
togtok :: a -> GenParser b st (GeneralizedToken a)
togtok a
tok = do
              SourcePos
x <- ParsecT [b] st Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
              GeneralizedToken a -> GenParser b st (GeneralizedToken a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
x, a
tok)

{- | Retrieve the next token from a 'GeneralizedToken' stream.
   The given function should return the value to use, or Nothing
   to cause an error. -}
tokeng :: (Show a) => (a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng :: (a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng a -> Maybe b
test =
    ((SourcePos, a) -> String)
-> ((SourcePos, a) -> SourcePos)
-> ((SourcePos, a) -> Maybe b)
-> GeneralizedTokenParser a st b
forall s t a u.
Stream s Identity t =>
(t -> String) -> (t -> SourcePos) -> (t -> Maybe a) -> Parsec s u a
token (a -> String
forall a. Show a => a -> String
show (a -> String) -> ((SourcePos, a) -> a) -> (SourcePos, a) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, a) -> a
forall a b. (a, b) -> b
snd) ((SourcePos, a) -> SourcePos
forall a b. (a, b) -> a
fst) (a -> Maybe b
test (a -> Maybe b)
-> ((SourcePos, a) -> a) -> (SourcePos, a) -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourcePos, a) -> a
forall a b. (a, b) -> b
snd)

{- | A shortcut to 'tokeng'; the test here is just a function that returns
a Bool.  If the result is true; return that value -- otherwise, an error.
-}
satisfyg :: (Show a) => (a -> Bool) -> GeneralizedTokenParser a st a
satisfyg :: (a -> Bool) -> GeneralizedTokenParser a st a
satisfyg a -> Bool
test = (a -> Maybe a) -> GeneralizedTokenParser a st a
forall a b st.
Show a =>
(a -> Maybe b) -> GeneralizedTokenParser a st b
tokeng (\a
t -> if a -> Bool
test a
t then a -> Maybe a
forall a. a -> Maybe a
Just a
t else Maybe a
forall a. Maybe a
Nothing)

{- | Matches one item in a list and returns it. -}
oneOfg :: (Eq a, Show a) => [a] -> GeneralizedTokenParser a st a
oneOfg :: [a] -> GeneralizedTokenParser a st a
oneOfg [a]
i = (a -> Bool) -> GeneralizedTokenParser a st a
forall a st. Show a => (a -> Bool) -> GeneralizedTokenParser a st a
satisfyg (\a
x -> a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x [a]
i)

{- | Matches all items and returns them -}
allg :: (Show a) => GeneralizedTokenParser a st [a]
allg :: GeneralizedTokenParser a st [a]
allg = ParsecT [GeneralizedToken a] st Identity a
-> GeneralizedTokenParser a st [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [GeneralizedToken a] st Identity a
 -> GeneralizedTokenParser a st [a])
-> ParsecT [GeneralizedToken a] st Identity a
-> GeneralizedTokenParser a st [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> ParsecT [GeneralizedToken a] st Identity a
forall a st. Show a => (a -> Bool) -> GeneralizedTokenParser a st a
satisfyg (\a
_ -> Bool
True)

{- | Matches one item not in a list and returns it. -}
noneOfg :: (Eq a, Show a) => [a] -> GeneralizedTokenParser a st a
noneOfg :: [a] -> GeneralizedTokenParser a st a
noneOfg [a]
l = (a -> Bool) -> GeneralizedTokenParser a st a
forall a st. Show a => (a -> Bool) -> GeneralizedTokenParser a st a
satisfyg (\a
x -> Bool -> Bool
not (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x [a]
l))

{- | Matches one specific token and returns it. -}
specificg :: (Eq a, Show a) => a -> GeneralizedTokenParser a st a
specificg :: a -> GeneralizedTokenParser a st a
specificg a
i = (a -> Bool) -> GeneralizedTokenParser a st a
forall a st. Show a => (a -> Bool) -> GeneralizedTokenParser a st a
satisfyg (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i) GeneralizedTokenParser a st a
-> String -> GeneralizedTokenParser a st a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> a -> String
forall a. Show a => a -> String
show a
i

{- Matches a list of tokens and returns it. -}
{-
listg :: (Eq a, Show a) => [GeneralizedToken a] -> GeneralizedTokenParser a st [GeneralizedToken a]
listg l = tokens (show . map fst) nextpos l
          where
          tokpos = fst
          nextpos
          nextposs _ _ (tok:toks) = tokpos tok
          nextposs _ tok [] = tokpos tok
          nextpos pos x = nextposs pos [x]
-}

{- | Running @notMatching p msg@ will try to apply parser p.
If it fails, returns ().  If it succeds, cause a failure and raise
the given error message.  It will not consume input in either case. -}
notMatching :: GenParser a b c -> String -> GenParser a b ()
notMatching :: GenParser a b c -> String -> GenParser a b ()
notMatching GenParser a b c
p String
errormsg =
    let maybeRead :: ParsecT [a] b Identity (Maybe c)
maybeRead = ParsecT [a] b Identity (Maybe c)
-> ParsecT [a] b Identity (Maybe c)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do
                         c
x <- GenParser a b c
p
                         Maybe c -> ParsecT [a] b Identity (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Maybe c
forall a. a -> Maybe a
Just c
x)
                        )
                    ParsecT [a] b Identity (Maybe c)
-> ParsecT [a] b Identity (Maybe c)
-> ParsecT [a] b Identity (Maybe c)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe c -> ParsecT [a] b Identity (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing
        workerFunc :: GenParser a b ()
workerFunc =  do
                      Maybe c
x <- ParsecT [a] b Identity (Maybe c)
maybeRead
                      case Maybe c
x of
                             Maybe c
Nothing -> () -> GenParser a b ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                             Just c
_  -> String -> GenParser a b ()
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
errormsg
        in
        GenParser a b () -> GenParser a b ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser a b ()
workerFunc