Parsec.hs

{-  Copyright 2010 Dominique Devriese

    This file is part of the grammar-combinators library.

    The grammar-combinators library is free software: you can
    redistribute it and/or modify it under the terms of the GNU
    Lesser General Public License as published by the Free
    Software Foundation, either version 3 of the License, or (at
    your option) any later version.

    Foobar is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General
    Public License along with Foobar. If not, see
    <http://www.gnu.org/licenses/>.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Compatibility component for the Parsec library.
module Text.GrammarCombinators.Parser.Parsec (
  parseParsec,
  parseParsecR,
  parseParsecBiased,
  WrapGenParser, unWGP
  ) where

import Text.GrammarCombinators.Base
import Text.GrammarCombinators.Transform.UnfoldRecursion
import Text.GrammarCombinators.Transform.IntroduceBias

import Text.Parsec
import Text.Parsec.Pos
import qualified Text.Parsec as Parsec
--import Text.ParserCombinators.Parsec.Prim

newtype WrapGenParser t v = WGP { unWGP :: Parsec [ConcreteToken t] () v }

instance (Token t) => ProductionRule (WrapGenParser t) where
  a >>> b = WGP $ do f <- unWGP a; x <- unWGP b; return $ f x
  a ||| b = WGP $ try (unWGP a) <|> unWGP b
  endOfInput = WGP eof
  die = WGP parserZero

instance BiasedProductionRule (WrapGenParser t) where
  a >||| b = WGP $ unWGP a <|> unWGP b

instance (Token t) => EpsProductionRule (WrapGenParser t) where
  epsilon v = WGP $ return v

instance (Token t) => LiftableProductionRule (WrapGenParser t) where
  epsilonL v _ = epsilon v

nextPos :: SourcePos -> t -> t1 -> SourcePos
nextPos p _ _  = newPos (sourceName p) (sourceLine p) (sourceColumn p+1)

instance (Token t) => TokenProductionRule (WrapGenParser t) t where
  token tt = WGP $ tokenPrim show nextPos testToken
    where
      testToken t        = if classify t == tt then Just t else Nothing
  anyToken = WGP $ tokenPrim show nextPos Just

-- | Parse a given string according to a given grammar, starting from a given start
--   non-terminal, using the Parsec parser library. Currently uses backtracking for
--   every branch.
parseParsec :: forall phi t r ix.
               (Token t) =>
               ProcessingBiasedContextFreeGrammar phi t r ->
               phi ix -> SourceName -> [ConcreteToken t] -> Either ParseError (r ix)
parseParsec gram idx = 
  let irule :: WrapGenParser t (r ix)
      irule = unfoldRecursionB gram idx
      parser = unWGP irule
  in Parsec.parse parser

parseParsecR :: forall phi t r ix.
               (Token t) =>
               ProcessingBiasedRegularGrammar phi t r ->
               phi ix -> SourceName -> [ConcreteToken t] -> Either ParseError (r ix)
parseParsecR gram idx = 
  let irule :: WrapGenParser t (r ix)
      irule = gram idx
      parser = unWGP irule
  in Parsec.parse parser

parseParsecBiased :: forall phi t r ix.
                      (Token t, EqFam phi) =>
                      ProcessingContextFreeGrammar phi t r ->
                      phi ix -> SourceName -> 
                      [ConcreteToken t] -> Either ParseError (r ix)
parseParsecBiased gram idx = 
  let gramB :: ProcessingBiasedContextFreeGrammar phi t r 
      gramB = introduceBias gram
      irule :: WrapGenParser t (r ix)
      irule = unfoldRecursionB gramB idx
      parser = unWGP irule
  in Parsec.parse parser