Symantic/RNC/Sym.hs

   1 {-# LANGUAGE TypeFamilyDependencies #-}
   2 module Symantic.RNC.Sym
   3  ( module 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 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 [] (some x)
  91         f <$:> x = f . Seq.fromList <$> toPermutationWithDefault [] (some x)
  92
  93         f <||> x = f <*> toPermutation x
  94         f <|?> (d,x) = f <*> toPermutationWithDefault d x
  95         f <|*> x = f <*> toPermutationWithDefault [] (some x)
  96         f <|:> x = f <*> toPermutationWithDefault Seq.empty (Seq.fromList <$> some x)
  97
  98 -- ** Type family 'Permutation'
  99 -- | Type of permutations, depending on the representation.
 100 type family Permutation (repr:: * -> *) = (r :: * -> *) | r -> repr