module Text.Parsec.Permutation
(PermParser, runPermParser, runPermParserTill, oncePerm, manyPerm, many1Perm,
optionPerm, optionMaybePerm)
where
import Control.Monad (void)
import Control.Applicative
((<*>), (<$>), Applicative, pure)
import Text.Parsec
((<|>), ParsecT, Stream, parserZero, optionMaybe, unexpected, lookAhead)
data PermParser s u m a =
PermParser {
permValue :: Maybe a
, 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
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 -> fromJustOrFail value
Just permParser -> runPermParser permParser
runPermParserTill :: Stream s m t
=> ParsecT s u m end -> PermParser s u m a -> ParsecT s u m a
runPermParserTill untilParser (PermParser value parser) =
do void $ lookAhead untilParser
fromJustOrFail value
<|>
do result <- optionMaybe parser
case result of
Nothing -> unexpected "end of permutation parser"
Just permParser -> runPermParserTill untilParser permParser
fromJustOrFail :: Maybe a -> ParsecT s u m a
fromJustOrFail value =
maybe (fail "Could not parse all permutations") return value
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."
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."
optionMaybePerm :: (Stream s m t)
=> ParsecT s u m a -> PermParser s u m (Maybe a)
optionMaybePerm parser = optionPerm Nothing (Just <$> parser)
manyPerm :: ParsecT s u m a -> PermParser s u m [a]
manyPerm parser = manyPermAccum (Just []) parser
many1Perm :: ParsecT s u m a -> PermParser s u m [a]
many1Perm parser = manyPermAccum Nothing parser
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