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