Language/RNC/Sym.hs

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