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(..), maybe)
  15 import Data.Text (Text)
  16 import Text.Show (Show)
  17 import qualified Data.Text as Text
  18
  19 import Language.DTC.Document (Default(..), MayText(..))
  20 import Language.TCT.Write.XML (XmlName(..))
  21 import qualified Language.DTC.Document as DTC
  22
  23 foldlApp :: (DTC.Default a, Foldable t) => t (a -> a) -> a
  24 foldlApp = foldl' (flip ($)) def
  25 foldrApp :: (DTC.Default a, Foldable t) => t (a -> a) -> a
  26 foldrApp = foldr ($) def
  27
  28 -- * Type 'Rule'
  29 type Rule a = a -> a
  30
  31 -- ** Class 'Sym_Rule'
  32 class Sym_Rule repr where
  33         rule :: Show a => Text -> Rule (repr a)
  34         rule _n = id
  35
  36 -- * Type family 'Perm'
  37 type family Perm (repr:: * -> *) = (r :: * -> *) | r -> repr
  38
  39 -- * Class 'Sym_Interleaved'
  40 class Sym_Interleaved repr where
  41         interleaved :: Perm repr a -> repr a
  42         (<$$>) :: (a -> b) -> repr a -> Perm repr b
  43
  44         (<$?>) :: (a -> b) -> (a,repr a) -> Perm repr b
  45         (<||>) :: Perm repr (a -> b) -> repr a -> Perm repr b
  46         (<|?>) :: Perm repr (a -> b) -> (a,repr a) -> Perm repr b
  47
  48         (<$*>) :: ([a] -> b) -> repr a -> Perm repr b
  49         (<|*>) :: Perm repr ([a] -> b) -> repr a -> Perm repr b
  50
  51 infixl 3 <|>
  52 infixl 2 <$$>, <$?>, <$*>
  53 infixl 1 <||>, <|?>, <|*>
  54
  55 -- * Class 'Sym_RNC'
  56 class
  57  ( Applicative repr
  58  -- , Alternative repr
  59  , Sym_Rule repr
  60  , Sym_Interleaved repr
  61  ) => Sym_RNC repr where
  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 <$>)