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