hydrogen-util-0.5: src/Hydrogen/Util/Parsec.hs

module Hydrogen.Util.Parsec (
    module Text.Parsec.Combinator
  , module Text.Parsec.Prim
  , module Text.Parsec.Pos
  , Parser
  , SomethingBad
  , Tokens
  , mkError
  , sourceToken
  , (>+>)
  , (<+<)
  ) 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))

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

(>+>) :: 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 (>+>)