{-# LANGUAGE ConstraintKinds #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Parsing.Test where

import Control.Applicative (Applicative(..))
import qualified Control.Applicative as Alt
import qualified Data.Char as Char
import Data.String (IsString(..))
import qualified Data.Text as Text
import Prelude hiding (any, (^), exp)
import qualified Text.Megaparsec as P

import Language.Symantic.Grammar

-- * Type 'ParsecT'
type ParsecC e s = (P.Token s ~ Char, P.Stream s, P.ErrorComponent e)
instance ParsecC e s => IsString (P.ParsecT e s m [Char]) where
	fromString = P.string
instance ParsecC e s => Gram_Rule (P.ParsecT e s m) where
	rule = P.label . Text.unpack
instance ParsecC e s => Gram_Terminal (P.ParsecT e s m) where
	any          = P.anyChar
	eoi          = P.eof
	char         = P.char
	string       = P.string
	unicat cat   = P.satisfy $ (`elem` cats) . Char.generalCategory
		where cats = unicode_categories cat
	range (l, h) = P.satisfy $ \c -> l <= c && c <= h
	Terminal f `but` Terminal p = Terminal $ P.notFollowedBy (P.try p) *> f
instance ParsecC e s => Alter (P.ParsecT e s m) where
	empty  = Alt.empty
	(<+>)  = (Alt.<|>)
	choice = P.choice
instance ParsecC e s => Try (P.ParsecT e s m) where
	try = P.try
instance ParsecC e s => Gram_RegR (P.ParsecT e s m) where
	Terminal f .*> Reg x = Reg $ f <*> x
instance ParsecC e s => Gram_RegL (P.ParsecT e s m) where
	Reg f <*. Terminal x = Reg $ f <*> x
instance ParsecC e s => App (P.ParsecT e s m) where
	between = P.between
instance ParsecC e s => Alt (P.ParsecT e s m) where
	option   = P.option
	optional = P.optional
	many     = P.many
	some     = P.some
	skipMany = P.skipMany
instance ParsecC e s => Gram_CF (P.ParsecT e s m) where
	CF f <& Reg p        = CF $ P.lookAhead f <*> p
	Reg f &> CF p        = CF $ P.lookAhead f <*> p
	minus (CF f) (Reg p) = CF $ P.notFollowedBy (P.try p) *> f
instance ParsecC e s => Gram_Meta P.SourcePos (P.ParsecT e s m) where
	metaG p = do
		pos <- P.getPosition
		($ pos) <$> p
instance ParsecC e s => Gram_Lexer (P.ParsecT e s m)
instance ParsecC e s => Gram_Op (P.ParsecT e s m)