{-# LANGUAGE TypeFamilyDependencies #-}
module Language.Symantic.RNC.Sym
 ( module Language.Symantic.RNC.Sym
 , Functor(..), (<$>)
 , Applicative(..)
 , Alternative(..)
 ) where

import Control.Applicative (Applicative(..), Alternative(..))
import Data.Eq (Eq)
import Data.Function ((.), id)
import Data.Functor (Functor(..), (<$>))
import Data.Maybe (Maybe(..))
import Data.Sequence (Seq)
import Data.String (String)
import Text.Show (Show(..))
import qualified Data.Sequence as Seq
import qualified Data.Text.Lazy as TL

import qualified Language.Symantic.XML as XML

infixl 2 <$$>, <$?>, <$*>, <$:>
infixl 1 <||>, <|?>, <|*>{-, <|:>-}

-- * Class 'Sym_RNC'
class
 ( Applicative repr
 , Alternative repr
 , Sym_Rule repr
 , Sym_Interleaved repr
 ) => Sym_RNC repr where
	namespace   :: Maybe XML.NCName -> XML.Namespace -> repr ()
	element     :: XML.QName -> repr a -> repr a
	attribute   :: XML.QName -> repr a -> repr a
	any         :: repr ()
	anyElem     :: XML.Namespace -> (XML.NCName -> repr a) -> repr a
	escapedText :: repr XML.EscapedText
	text        :: repr TL.Text
	text = XML.unescapeText <$> escapedText
	fail        :: repr a
	try         :: repr a -> repr a
	option      :: a -> repr a -> repr a
	optional    :: repr a -> repr (Maybe a)
	choice      :: [repr a] -> repr a
	intermany   :: [repr a] -> repr [a]
	intermany = many . choice . (try <$>)
	manySeq :: repr a -> repr (Seq a)
	manySeq r = Seq.fromList <$> many r
	someSeq :: repr a -> repr (Seq a)
	someSeq r = Seq.fromList <$> some r

-- * Class 'Sym_Rule'
class Sym_Rule repr where
	rule :: Show a => String -> repr a -> repr a
	rule _n = id
	arg :: String -> repr ()

-- ** Type 'RuleMode'
data RuleMode
 =   RuleMode_Body -- ^ Request to generate the body of the rule.
 |   RuleMode_Ref  -- ^ Request to generate a reference to the rule.
 |   RuleMode_Def  -- ^ Request to generate a definition of the rule.
 deriving (Eq, Show)

-- * Class 'Sym_Interleaved'
class Sym_Interleaved repr where
	interleaved :: Perm repr a -> repr a
	(<$$>) :: (a -> b) -> repr a -> Perm repr b
	
	(<$?>) :: (a -> b) -> (a, repr a) -> Perm repr b
	(<||>) :: Perm repr (a -> b) -> repr a -> Perm repr b
	(<|?>) :: Perm repr (a -> b) -> (a, repr a) -> Perm repr b
	
	(<$*>) :: ([a] -> b) -> repr a -> Perm repr b
	(<|*>) :: Perm repr ([a] -> b) -> repr a -> Perm repr b
	
	(<$:>) :: (Seq a -> b) -> repr a -> Perm repr b
	(<$:>) f = (f . Seq.fromList <$*>)
	{- NOTE: Megaparsec's PermParser has no Functor instance.
	(<|:>) :: Perm repr (Seq a -> b) -> repr a -> Perm repr b
	default (<|:>) :: Functor (Perm repr) => Perm repr (Seq a -> b) -> repr a -> Perm repr b
	(<|:>) f x = (. Seq.fromList) <$> f <|*> x
	-}

-- ** Type family 'Perm'
-- | Type of permutations, depending on the representation.
type family Perm (repr:: * -> *) = (r :: * -> *) | r -> repr
-- type instance Perm (Dup x y) = Dup (Perm x) (Perm y)
-- type instance Perm (Rule repr) = Rule (Perm repr) -- Compose [] (Rule (Perm repr))