Language/RNC/Sym.hs

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