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