Parsec.hs

module Hydrogen.Util.Parsec (
    module Text.Parsec.Combinator
  , module Text.Parsec.Prim
  , module Text.Parsec.Pos
  , Parser
  , ParseError
  , SomethingBad
  , Tokens
  , runTokenParser
  , mkError
  , sourceToken
  , manyBetween
  , (>+>)
  , (<+<)
  ) where

import Hydrogen.Prelude

import Text.Parsec.Combinator
import Text.Parsec.Error
import Text.Parsec.Pos
import Text.Parsec.Prim

type SomethingBad = (SourcePos, [String])
type Parser source result = source -> Either SomethingBad result
type Tokens t = [(SourcePos, t)]

mkError :: ParseError -> Either SomethingBad b
mkError e = Left (errorPos e, map messageString (errorMessages e))

runTokenParser :: (Stream a Identity t) => ParsecT a () Identity b -> Parser a b
runTokenParser p = either mkError Right . runIdentity . runParserT p () ""

sourceToken :: (Show t, Stream (Tokens t) m (SourcePos, t))
    => (t -> Maybe a)
    -> ParsecT [(SourcePos, t)] u m a
sourceToken f = tokenPrim (show . snd) nextPos (f . snd)
  where
    nextPos p _ = \case
        ((p', _) : _) -> p'
        _ -> p

manyBetween :: (Monad m, Stream s m t)
    => ParsecT s u m open -> ParsecT s u m close -> ParsecT s u m p -> ParsecT s u m [p]
manyBetween o c p = o *> manyTill p c

(>+>) :: Parser a b -> Parser b c -> Parser a c
p1 >+> p2 = join <$> fmap p2 <$> p1

(<+<) :: Parser b c -> Parser a b -> Parser a c
(<+<) = flip (>+>)