Hdoc/RNC/Sym.hs

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