Language/Symantic/RNC/Sym.hs

   1 {-# LANGUAGE TypeFamilyDependencies #-}
   2 module Language.Symantic.RNC.Sym
   3  ( module Language.Symantic.RNC.Sym
   4  , Functor(..), (<$>)
   5  , Applicative(..)
   6  , Alternative(..)
   7  ) where
   8
   9 import Control.Applicative (Applicative(..), Alternative(..))
  10 import Control.Monad (Monad(..))
  11 import Data.Eq (Eq)
  12 import Data.Function ((.), id)
  13 import Data.Functor (Functor(..), (<$>))
  14 import Data.Maybe (Maybe(..))
  15 import Data.Sequence (Seq)
  16 import Data.String (String)
  17 import Text.Show (Show(..))
  18 import qualified Data.Sequence as Seq
  19 import qualified Data.Text.Lazy as TL
  20
  21 import qualified Language.Symantic.XML as XML
  22
  23 -- * Class 'Sym_RNC'
  24 class
  25  ( Applicative repr
  26  , Alternative repr
  27  , Sym_Rule repr
  28  , Sym_Permutation repr
  29  ) => Sym_RNC repr where
  30         namespace   :: Maybe XML.NCName -> XML.Namespace -> repr ()
  31         element     :: XML.QName -> repr a -> repr a
  32         attribute   :: XML.QName -> repr a -> repr a
  33         any         :: repr ()
  34         anyElem     :: XML.Namespace -> (XML.NCName -> repr a) -> repr a
  35         escapedText :: repr XML.EscapedText
  36         text        :: repr TL.Text
  37         text = XML.unescapeText <$> escapedText
  38         fail        :: repr a
  39         try         :: repr a -> repr a
  40         option      :: a -> repr a -> repr a
  41         optional    :: repr a -> repr (Maybe a)
  42         choice      :: [repr a] -> repr a
  43         intermany   :: [repr a] -> repr [a]
  44         intermany = many . choice . (try <$>)
  45         manySeq :: repr a -> repr (Seq a)
  46         manySeq r = Seq.fromList <$> many r
  47         someSeq :: repr a -> repr (Seq a)
  48         someSeq r = Seq.fromList <$> some r
  49
  50 -- * Class 'Sym_Rule'
  51 class Sym_Rule repr where
  52         rule :: Show a => String -> repr a -> repr a
  53         rule _n = id
  54         arg :: String -> repr ()
  55
  56 -- ** Type 'RuleMode'
  57 data RuleMode
  58  =   RuleMode_Body -- ^ Request to generate the body of the rule.
  59  |   RuleMode_Ref  -- ^ Request to generate a reference to the rule.
  60  |   RuleMode_Def  -- ^ Request to generate a definition of the rule.
  61  deriving (Eq, Show)
  62
  63 -- * Class 'Sym_Permutation'
  64 class (Alternative repr, Applicative (Permutation repr)) => Sym_Permutation repr where
  65         runPermutation :: Permutation repr a -> repr a
  66         toPermutation :: repr a -> Permutation repr a
  67         toPermutationWithDefault :: a -> repr a -> Permutation repr a
  68
  69         (<$$>) :: (a -> b) -> repr a -> Permutation repr b
  70         (<$?>) :: (a -> b) -> (a, repr a) -> Permutation repr b
  71         (<$*>) :: ([a] -> b) -> repr a -> Permutation repr b
  72         (<$:>) :: (Seq a -> b) -> repr a -> Permutation repr b
  73         infixl 2 <$$>, <$?>, <$*>, <$:>
  74         {-# INLINE (<$$>) #-}
  75         {-# INLINE (<$?>) #-}
  76         {-# INLINE (<$*>) #-}
  77         {-# INLINE (<$:>) #-}
  78
  79         (<||>) :: Permutation repr (a -> b) -> repr a -> Permutation repr b
  80         (<|?>) :: Permutation repr (a -> b) -> (a, repr a) -> Permutation repr b
  81         (<|*>) :: Permutation repr ([a] -> b) -> repr a -> Permutation repr b
  82         (<|:>) :: Permutation repr (Seq a -> b) -> repr a -> Permutation repr b
  83         infixl 1 <||>, <|?>, <|*>, <|:>
  84         {-# INLINE (<||>) #-}
  85         {-# INLINE (<|?>) #-}
  86         {-# INLINE (<|*>) #-}
  87         {-# INLINE (<|:>) #-}
  88
  89         f <$$> x = f <$> toPermutation x
  90         f <$?> (d,x) = f <$> toPermutationWithDefault d x
  91         f <$*> x = f <$> toPermutationWithDefault [] (many x)
  92         f <$:> x = f . Seq.fromList <$> toPermutationWithDefault [] (many x)
  93
  94         f <||> x = f <*> toPermutation x
  95         f <|?> (d,x) = f <*> toPermutationWithDefault d x
  96         f <|*> x = f <*> toPermutationWithDefault [] (many x)
  97         f <|:> x = f <*> toPermutationWithDefault Seq.empty (Seq.fromList <$> many x)
  98
  99 -- ** Type family 'Permutation'
 100 -- | Type of permutations, depending on the representation.
 101 type family Permutation (repr:: * -> *) = (r :: * -> *) | r -> repr