{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Permutation
-- Copyright : (C) 2013 Bitbase, LLC
-- License : BSD3
-- Maintainer : Samuel Hoffstaetter (samuel@hoffstaetter.com)
-- Stability : provisional
-- Portability : portable
--
-- Text.Parsec.Permutation is a permutation parser for parsec intended as
-- a generalized replacement for Text.Parsec.Perm in parsec.
--
-- Example usage:
--
-- > import Text.Parsec.Permutation
-- >
-- > fooParser :: ParsecT s u m a -> ParsecT s u m [a]
-- > fooParser = runPermParser $
-- > (,,) <$> oncePerm (char 'A')
-- > <*> manyPerm (char 'B')
-- > <*> optionMaybePerm (char 'C' >> char 'D')
--
-- This parser will return ('A', \"BBB\", Just 'D') when parsing for example
-- the strings \"BCDABB\", \"CDBBAB\", &etc.
--
----------------------------------------------------------------------------
module Text.Parsec.Permutation
(PermParser, runPermParser, oncePerm, manyPerm, many1Perm,
optionPerm, optionMaybePerm)
where
import Control.Applicative ((<*>), (<$>), Applicative, pure)
import Text.Parsec ((<|>), ParsecT, Stream, parserZero, optionMaybe, unexpected)
data PermParser s u m a =
PermParser {
permValue :: Maybe a -- potential intermediate value parsed so far
, permParser :: ParsecT s u m (PermParser s u m a)
}
instance Functor (PermParser s u m) where
fmap f (PermParser value parser) =
PermParser (f <$> value) (fmap f <$> parser)
instance Stream s m t => Applicative (PermParser s u m) where
parser1 <*> parser2 =
PermParser (permValue parser1 <*> permValue parser2)
(attemptParser1 <|> attemptParser2)
where attemptParser1 = do parser1 <- permParser parser1
return $ parser1 <*> parser2
attemptParser2 = do parser2 <- permParser parser2
return $ parser1 <*> parser2
pure value = PermParser (Just value) parserZero
-- | Turns a permutation parser into a regular parsec parser.
runPermParser :: Stream s m t => PermParser s u m a -> ParsecT s u m a
runPermParser (PermParser value parser) =
do result <- optionMaybe parser
case result of
Nothing -> maybe (fail "Could not parse all permutations") return value
Just permParser -> runPermParser permParser
-- | Attempt parsing a value once. Fails if parsing the value succeeds multiple
-- times.
oncePerm :: (Stream s m t) => ParsecT s u m a -> PermParser s u m a
oncePerm parser =
PermParser Nothing $
do value <- parser
return $ PermParser (Just value) $
parser >> unexpected "duplicate occurrence.\
\ Expected only one occurrence."
-- | Attempt parsing a value at most once. Fails when parsing the value
-- succeeds multiple times. The first argument is the default value to be
-- used when parsing never succeeds.
optionPerm :: (Stream s m t)
=> a -> ParsecT s u m a -> PermParser s u m a
optionPerm defaultValue parser =
PermParser (Just defaultValue) $
do value <- parser
return $ PermParser (Just value) $
parser >> unexpected "duplicate optional occurrence.\
\ Expected at most one occurrence."
-- | Similar to "optionPerm", but uses Nothing as the default value.
optionMaybePerm :: (Stream s m t)
=> ParsecT s u m a -> PermParser s u m (Maybe a)
optionMaybePerm parser = optionPerm Nothing (Just <$> parser)
-- | Parses a given value as many times as possible in the permutation. As with
-- Parsec.Prim.many in parsec, you need to make sure that the provided parser
-- consumes input when succeeding to prevent infinite recursion.
manyPerm :: ParsecT s u m a -> PermParser s u m [a]
manyPerm parser = manyPermAccum (Just []) parser
-- | Same as "manyPerm", but fails when the parsing doesn't succeed at least
-- once.
many1Perm :: ParsecT s u m a -> PermParser s u m [a]
many1Perm parser = manyPermAccum Nothing parser
-- helper function for manyPerm / many1Perm
manyPermAccum :: Maybe [a] -> ParsecT s u m a -> PermParser s u m [a]
manyPermAccum accumValue parser =
PermParser (reverse <$> accumValue) $
do value <- parser
let combinedValue = maybe [value] (value:) accumValue
return $ manyPermAccum (Just combinedValue) parser