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 Data.Eq (Eq)
  11 import Data.Function ((.), id)
  12 import Data.Functor (Functor(..), (<$>))
  13 import Data.Maybe (Maybe(..))
  14 import Data.Sequence (Seq)
  15 import Data.String (String)
  16 import Text.Show (Show(..))
  17 import qualified Data.Sequence as Seq
  18
  19 import qualified Language.Symantic.XML as XML
  20
  21 infixl 2 <$$>, <$?>, <$*>, <$:>
  22 infixl 1 <||>, <|?>, <|*>{-, <|:>-}
  23
  24 -- * Class 'Sym_RNC'
  25 class
  26  ( Applicative repr
  27  , Alternative repr
  28  , Sym_Rule repr
  29  , Sym_Interleaved repr
  30  ) => Sym_RNC repr where
  31         namespace :: Maybe XML.NCName -> XML.Namespace -> repr ()
  32         element   :: XML.QName -> repr a -> repr a
  33         attribute :: XML.QName -> repr a -> repr a
  34         any       :: repr ()
  35         anyElem   :: XML.Namespace -> (XML.NCName -> repr a) -> repr a
  36         text      :: repr XML.Text
  37         fail      :: repr a
  38         try       :: repr a -> repr a
  39         option    :: a -> repr a -> repr a
  40         optional  :: repr a -> repr (Maybe a)
  41         choice    :: [repr a] -> repr a
  42         intermany :: [repr a] -> repr [a]
  43         intermany = many . choice . (try <$>)
  44         manySeq :: repr a -> repr (Seq a)
  45         manySeq r = Seq.fromList <$> many r
  46         someSeq :: repr a -> repr (Seq a)
  47         someSeq r = Seq.fromList <$> some r
  48
  49 -- * Class 'Sym_Rule'
  50 class Sym_Rule repr where
  51         rule :: Show a => String -> repr a -> repr a
  52         rule _n = id
  53         arg :: String -> repr ()
  54
  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_Interleaved'
  64 class Sym_Interleaved repr where
  65         interleaved :: Perm repr a -> repr a
  66         (<$$>) :: (a -> b) -> repr a -> Perm repr b
  67
  68         (<$?>) :: (a -> b) -> (a, repr a) -> Perm repr b
  69         (<||>) :: Perm repr (a -> b) -> repr a -> Perm repr b
  70         (<|?>) :: Perm repr (a -> b) -> (a, repr a) -> Perm repr b
  71
  72         (<$*>) :: ([a] -> b) -> repr a -> Perm repr b
  73         (<|*>) :: Perm repr ([a] -> b) -> repr a -> Perm repr b
  74
  75         (<$:>) :: (Seq a -> b) -> repr a -> Perm repr b
  76         (<$:>) f = (f . Seq.fromList <$*>)
  77         {- NOTE: Megaparsec's PermParser has no Functor instance.
  78         (<|:>) :: Perm repr (Seq a -> b) -> repr a -> Perm repr b
  79         default (<|:>) :: Functor (Perm repr) => Perm repr (Seq a -> b) -> repr a -> Perm repr b
  80         (<|:>) f x = (. Seq.fromList) <$> f <|*> x
  81         -}
  82
  83 -- ** Type family 'Perm'
  84 -- | Type of permutations, depending on the representation.
  85 type family Perm (repr:: * -> *) = (r :: * -> *) | r -> repr
  86 -- type instance Perm (Dup x y) = Dup (Perm x) (Perm y)
  87 -- type instance Perm (Rule repr) = Rule (Perm repr) -- Compose [] (Rule (Perm repr))