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