{-# LANGUAGE TypeFamilyDependencies #-}
module Symantic.RNC.Sym
 ( module 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 Symantic.XML as XML

-- * Class 'Sym_RNC'
class
 ( Applicative repr
 , Alternative repr
 , Sym_Rule repr
 , Sym_Permutation 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_Permutation'
class (Alternative repr, Applicative (Permutation repr)) => Sym_Permutation repr where
        runPermutation :: Permutation repr a -> repr a
        toPermutation :: repr a -> Permutation repr a
        toPermutationWithDefault :: a -> repr a -> Permutation repr a

        (<$$>) :: (a -> b) -> repr a -> Permutation repr b
        (<$?>) :: (a -> b) -> (a, repr a) -> Permutation repr b
        (<$*>) :: ([a] -> b) -> repr a -> Permutation repr b
        (<$:>) :: (Seq a -> b) -> repr a -> Permutation repr b
        infixl 2 <$$>, <$?>, <$*>, <$:>
        {-# INLINE (<$$>) #-}
        {-# INLINE (<$?>) #-}
        {-# INLINE (<$*>) #-}
        {-# INLINE (<$:>) #-}

        (<||>) :: Permutation repr (a -> b) -> repr a -> Permutation repr b
        (<|?>) :: Permutation repr (a -> b) -> (a, repr a) -> Permutation repr b
        (<|*>) :: Permutation repr ([a] -> b) -> repr a -> Permutation repr b
        (<|:>) :: Permutation repr (Seq a -> b) -> repr a -> Permutation repr b
        infixl 1 <||>, <|?>, <|*>, <|:>
        {-# INLINE (<||>) #-}
        {-# INLINE (<|?>) #-}
        {-# INLINE (<|*>) #-}
        {-# INLINE (<|:>) #-}

        f <$$> x = f <$> toPermutation x
        f <$?> (d,x) = f <$> toPermutationWithDefault d x
        f <$*> x = f <$> toPermutationWithDefault [] (some x)
        f <$:> x = f . Seq.fromList <$> toPermutationWithDefault [] (some x)

        f <||> x = f <*> toPermutation x
        f <|?> (d,x) = f <*> toPermutationWithDefault d x
        f <|*> x = f <*> toPermutationWithDefault [] (some x)
        f <|:> x = f <*> toPermutationWithDefault Seq.empty (Seq.fromList <$> some x)

-- ** Type family 'Permutation'
-- | Type of permutations, depending on the representation.
type family Permutation (repr:: * -> *) = (r :: * -> *) | r -> repr