]> Git — Sourcephile - haskell/symantic-xml.git/blob - Language/Symantic/RNC/Sym.hs
XML: generalize Sourced type parameter where possible
[haskell/symantic-xml.git] / Language / Symantic / RNC / Sym.hs
1 {-# LANGUAGE TypeFamilyDependencies #-}
2 module Language.Symantic.RNC.Sym
3 ( module Language.Symantic.RNC.Sym
4 , Functor(..), (<$>)
5 , Applicative(..)
6 , Alternative(..)
7 ) where
8
9 import Control.Applicative (Applicative(..), Alternative(..))
10 import Data.Eq (Eq)
11 import Data.Function ((.), id)
12 import Data.Functor (Functor(..), (<$>))
13 import Data.Maybe (Maybe(..))
14 import Data.Sequence (Seq)
15 import Data.String (String)
16 import Text.Show (Show(..))
17 import qualified Data.Sequence as Seq
18 import qualified Data.Text.Lazy as TL
19
20 import qualified Language.Symantic.XML as XML
21
22 -- * Class 'Sym_RNC'
23 class
24 ( Applicative repr
25 , Alternative repr
26 , Sym_Rule repr
27 , Sym_Permutation repr
28 ) => Sym_RNC repr where
29 namespace :: Maybe XML.NCName -> XML.Namespace -> repr ()
30 element :: XML.QName -> repr a -> repr a
31 attribute :: XML.QName -> repr a -> repr a
32 any :: repr ()
33 anyElem :: XML.Namespace -> (XML.NCName -> repr a) -> repr a
34 escapedText :: repr XML.EscapedText
35 text :: repr TL.Text
36 text = XML.unescapeText <$> escapedText
37 fail :: repr a
38 try :: repr a -> repr a
39 option :: a -> repr a -> repr a
40 optional :: repr a -> repr (Maybe a)
41 choice :: [repr a] -> repr a
42 intermany :: [repr a] -> repr [a]
43 intermany = many . choice . (try <$>)
44 manySeq :: repr a -> repr (Seq a)
45 manySeq r = Seq.fromList <$> many r
46 someSeq :: repr a -> repr (Seq a)
47 someSeq r = Seq.fromList <$> some r
48
49 -- * Class 'Sym_Rule'
50 class Sym_Rule repr where
51 rule :: Show a => String -> repr a -> repr a
52 rule _n = id
53 arg :: String -> repr ()
54
55 -- ** Type 'RuleMode'
56 data RuleMode
57 = RuleMode_Body -- ^ Request to generate the body of the rule.
58 | RuleMode_Ref -- ^ Request to generate a reference to the rule.
59 | RuleMode_Def -- ^ Request to generate a definition of the rule.
60 deriving (Eq, Show)
61
62 -- * Class 'Sym_Permutation'
63 class (Alternative repr, Applicative (Permutation repr)) => Sym_Permutation repr where
64 runPermutation :: Permutation repr a -> repr a
65 toPermutation :: repr a -> Permutation repr a
66 toPermutationWithDefault :: a -> repr a -> Permutation repr a
67
68 (<$$>) :: (a -> b) -> repr a -> Permutation repr b
69 (<$?>) :: (a -> b) -> (a, repr a) -> Permutation repr b
70 (<$*>) :: ([a] -> b) -> repr a -> Permutation repr b
71 (<$:>) :: (Seq a -> b) -> repr a -> Permutation repr b
72 infixl 2 <$$>, <$?>, <$*>, <$:>
73 {-# INLINE (<$$>) #-}
74 {-# INLINE (<$?>) #-}
75 {-# INLINE (<$*>) #-}
76 {-# INLINE (<$:>) #-}
77
78 (<||>) :: Permutation repr (a -> b) -> repr a -> Permutation repr b
79 (<|?>) :: Permutation repr (a -> b) -> (a, repr a) -> Permutation repr b
80 (<|*>) :: Permutation repr ([a] -> b) -> repr a -> Permutation repr b
81 (<|:>) :: Permutation repr (Seq a -> b) -> repr a -> Permutation repr b
82 infixl 1 <||>, <|?>, <|*>, <|:>
83 {-# INLINE (<||>) #-}
84 {-# INLINE (<|?>) #-}
85 {-# INLINE (<|*>) #-}
86 {-# INLINE (<|:>) #-}
87
88 f <$$> x = f <$> toPermutation x
89 f <$?> (d,x) = f <$> toPermutationWithDefault d x
90 f <$*> x = f <$> toPermutationWithDefault [] (many x)
91 f <$:> x = f . Seq.fromList <$> toPermutationWithDefault [] (many x)
92
93 f <||> x = f <*> toPermutation x
94 f <|?> (d,x) = f <*> toPermutationWithDefault d x
95 f <|*> x = f <*> toPermutationWithDefault [] (many x)
96 f <|:> x = f <*> toPermutationWithDefault Seq.empty (Seq.fromList <$> many x)
97
98 -- ** Type family 'Permutation'
99 -- | Type of permutations, depending on the representation.
100 type family Permutation (repr:: * -> *) = (r :: * -> *) | r -> repr