Fix cabal-version warning.

[haskell/symantic.git] / symantic-grammar / Language / Symantic / Grammar / EBNF.hs

diff --git a/symantic-grammar/Language/Symantic/Grammar/EBNF.hs b/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
index f7c48534fedd837c444366a339b68853ab506988..2daa0206ee9b856864497c0f22444b8c36f1008b 100644 (file)
--- a/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/EBNF.hs
@@ -1,14 +1,15 @@
 module Language.Symantic.Grammar.EBNF where
 
 import Control.Applicative (Applicative(..))
-import Control.Monad
-import Data.Semigroup hiding (option)
+import Data.Eq (Eq)
+import Data.Function (($), (.), id)
+import Data.Functor (Functor(..))
+import Data.Semigroup (Semigroup(..))
 import Data.Text (Text)
-import Prelude hiding (any)
+import Text.Show (Show(..))
 import qualified Data.Text as Text
 
-import Language.Symantic.Grammar.Source
-import Language.Symantic.Grammar.Error
+import Language.Symantic.Grammar.Meta
 import Language.Symantic.Grammar.Fixity
 
 -- * Type 'EBNF'
@@ -31,11 +32,15 @@ import Language.Symantic.Grammar.Fixity
 -- Synthetized attributes are:
 --
 -- * 'Text' of the 'EBNF' rendition.
-data EBNF a = EBNF { unEBNF :: RuleMode -> (Infix, Side) -> Text }
-instance Gram_Meta meta EBNF where
-       withMeta (EBNF x) = EBNF x
+newtype EBNF a = EBNF { unEBNF :: RuleMode -> (Infix, Side) -> Text }
+instance Gram_Reader st EBNF where
+       askBefore (EBNF e) = EBNF e
+       askAfter  (EBNF e) = EBNF e
+instance Gram_State st EBNF where
+       stateBefore (EBNF e) = EBNF e
+       stateAfter  (EBNF e) = EBNF e
 instance Gram_Error err EBNF where
-       catch (EBNF g) = EBNF g
+       catch (EBNF e) = EBNF e
 
 -- | Get textual rendition of given 'EBNF'.
 runEBNF :: EBNF a -> Text
@@ -51,7 +56,7 @@ ebnf_const t = EBNF $ \_rm _op -> t
 
 -- | 'EBNF' which adds an argument to be applied.
 ebnf_arg :: EBNF a -> EBNF b -> EBNF ()
-ebnf_arg (EBNF a) (EBNF b) = EBNF $ \bo po -> parenInfix po op $
+ebnf_arg (EBNF a) (EBNF b) = EBNF $ \bo po -> pairIfNeeded pairParen po op $
        a bo (op, SideL) <> " " <> b bo (op, SideR)
        where op = infixL 11
 infixl 5 `ebnf_arg`
@@ -82,14 +87,15 @@ class Gram_Rule g where
 newtype RuleEBNF a = RuleEBNF { unRuleEBNF :: EBNF a }
  deriving (Functor, Applicative)
 deriving instance Gram_RuleEBNF RuleEBNF
+deriving instance Gram_Error err RuleEBNF
+deriving instance Gram_Reader st RuleEBNF
+deriving instance Gram_State st RuleEBNF
 instance Gram_Rule RuleEBNF where
        rule  n           = ruleEBNF (ebnf_const n)
        rule1 n g a       = ruleEBNF (ebnf_const n `ebnf_arg` unRuleEBNF a) (g a)
        rule2 n g a b     = ruleEBNF (ebnf_const n `ebnf_arg` unRuleEBNF a `ebnf_arg` unRuleEBNF b) (g a b)
        rule3 n g a b c   = ruleEBNF (ebnf_const n `ebnf_arg` unRuleEBNF a `ebnf_arg` unRuleEBNF b `ebnf_arg` unRuleEBNF c) (g a b c)
        rule4 n g a b c d = ruleEBNF (ebnf_const n `ebnf_arg` unRuleEBNF a `ebnf_arg` unRuleEBNF b `ebnf_arg` unRuleEBNF c `ebnf_arg` unRuleEBNF d) (g a b c d)
-instance Gram_Meta meta RuleEBNF where
-       withMeta (RuleEBNF x) = RuleEBNF $ withMeta x
 
 -- ** Class 'Gram_RuleEBNF'
 -- | Symantics for rendering 'EBNF' rules.
@@ -105,7 +111,7 @@ instance Functor EBNF where
        fmap _f (EBNF x) = EBNF x
 instance Applicative EBNF where
        pure _ = ebnf_const $ "\"\""
-       EBNF f <*> EBNF x = EBNF $ \bo po -> parenInfix po op $
+       EBNF f <*> EBNF x = EBNF $ \bo po -> pairIfNeeded pairParen po op $
                f bo (op, SideL) <> ", " <> x bo (op, SideR)
                where op = infixB SideL 10
 instance Gram_Rule EBNF where
@@ -142,4 +148,3 @@ instance Gram_RuleEBNF EBNF where
                                 , unEBNF body RuleMode_Ref (infixN0, SideR)
                                 , ";"
                                 ]
-deriving instance Gram_Error err RuleEBNF