Language/RNC/Sym.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3 {-# LANGUAGE NoMonomorphismRestriction #-}
   4 {-# LANGUAGE TypeFamilyDependencies #-}
   5 module Language.RNC.Sym where
   6
   7 import Control.Applicative (Applicative(..), (<$>))
   8 import Data.Function ((.),id)
   9 import Data.Int (Int)
  10 import Data.Maybe (Maybe(..))
  11 import Data.Text (Text)
  12 import Text.Show (Show)
  13 import qualified Data.Text.Lazy as TL
  14
  15 import Language.XML
  16
  17 -- * Type 'Rule'
  18 type Rule a = a -> a
  19
  20 -- ** Class 'Sym_Rule'
  21 class Sym_Rule repr where
  22         rule :: Show a => Text -> Rule (repr a)
  23         rule _n = id
  24
  25 -- * Type family 'Perm'
  26 type family Perm (repr:: * -> *) = (r :: * -> *) | r -> repr
  27
  28 -- * Class 'Sym_Interleaved'
  29 class Sym_Interleaved repr where
  30         interleaved :: Perm repr a -> repr a
  31         (<$$>) :: (a -> b) -> repr a -> Perm repr b
  32
  33         (<$?>) :: (a -> b) -> (a,repr a) -> Perm repr b
  34         (<||>) :: Perm repr (a -> b) -> repr a -> Perm repr b
  35         (<|?>) :: Perm repr (a -> b) -> (a,repr a) -> Perm repr b
  36
  37         (<$*>) :: ([a] -> b) -> repr a -> Perm repr b
  38         (<|*>) :: Perm repr ([a] -> b) -> repr a -> Perm repr b
  39
  40 infixl 3 <|>
  41 infixl 2 <$$>, <$?>, <$*>
  42 infixl 1 <||>, <|?>, <|*>
  43
  44 -- * Class 'Sym_RNC'
  45 class
  46  ( Applicative repr
  47  -- , Alternative repr
  48  , Sym_Rule repr
  49  , Sym_Interleaved repr
  50  ) => Sym_RNC repr where
  51         element   :: XmlName -> repr a -> repr a
  52         attribute :: XmlName -> repr a -> repr a
  53         comment   :: repr TL.Text
  54         try       :: repr a -> repr a
  55         fail      :: repr a
  56         none      :: repr ()
  57         anyElem   :: Show a => (XmlName -> repr a) -> repr a
  58         any       :: repr ()
  59         text      :: repr TL.Text
  60         int       :: repr Int
  61         nat       :: repr Nat
  62         nat1      :: repr Nat1
  63         (<|>)     :: repr a -> repr a -> repr a
  64         many      :: repr a -> repr [a]
  65          -- TODO: maybe use Seq instead of []
  66         some      :: repr a -> repr [a]
  67         optional  :: repr a -> repr (Maybe a)
  68         option    :: a -> repr a -> repr a
  69         choice    :: [repr a] -> repr a
  70         intermany :: [repr a] -> repr [a]
  71         intermany = many . choice . (try <$>)