doc: fix reference to Symantic.Typed

[haskell/symantic-parser.git] / src / Symantic / Parser / Grammar / Write.hs

diff --git a/src/Symantic/Parser/Grammar/Write.hs b/src/Symantic/Parser/Grammar/Write.hs
index fff1ed7d794947762e219b5b62704fd020f2e638..bf1021a22effcca0bc458fa9e7a22b3736c23c43 100644 (file)
--- a/src/Symantic/Parser/Grammar/Write.hs
+++ b/src/Symantic/Parser/Grammar/Write.hs
@@ -8,16 +8,16 @@ import Data.Maybe (Maybe(..), fromMaybe, catMaybes)
 import Data.Monoid (Monoid(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
-import GHC.TypeLits (symbolVal)
+import Text.Show (Show(..))
 import qualified Data.Functor as Functor
 import qualified Data.HashMap.Strict as HM
 import qualified Data.List as List
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TLB
 
-import Symantic.Univariant.Letable
+import Symantic.Typed.ObserveSharing
+import Symantic.Typed.Fixity
 import Symantic.Parser.Grammar.Combinators
-import Symantic.Parser.Grammar.Fixity
 
 -- * Type 'WriteGrammar'
 newtype WriteGrammar (showName::Bool) a = WriteGrammar { unWriteGrammar ::
@@ -57,6 +57,31 @@ pairWriteGrammarInh inh op s =
   else s
   where (o,c) = writeGrammarInh_pair inh
 
+instance CombAlternable (WriteGrammar sN) where
+  alt exn x y = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
+    unWriteGrammar x inh
+     { writeGrammarInh_op = (op, SideL)
+     , writeGrammarInh_pair = pairParen
+     } <>
+    Just (" |^"<>fromString (show exn)<>" ") <>
+    unWriteGrammar y inh
+     { writeGrammarInh_op = (op, SideR)
+     , writeGrammarInh_pair = pairParen
+     }
+    where op = infixB SideL 3
+  throw exn = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
+      Just ("throw "<>fromString (show exn))
+    where
+    op = infixN 9
+  failure _sf = "failure"
+  empty = "empty"
+  try x = WriteGrammar $ \inh ->
+    pairWriteGrammarInh inh op $
+      Just "try " <> unWriteGrammar x inh
+    where
+    op = infixN 9
 instance CombApplicable (WriteGrammar sN) where
   pure _ = WriteGrammar $ return Nothing
   -- pure _ = "pure"
@@ -75,25 +100,6 @@ instance CombApplicable (WriteGrammar sN) where
           Just $ xt <> ", " <> yt
     where
     op = infixN 1
-instance CombAlternable (WriteGrammar sN) where
-  empty = "empty"
-  try x = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
-      Just "try " <> unWriteGrammar x inh
-    where
-    op = infixN 9
-  x <|> y = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
-    unWriteGrammar x inh
-     { writeGrammarInh_op = (op, SideL)
-     , writeGrammarInh_pair = pairParen
-     } <>
-    Just " | " <>
-    unWriteGrammar y inh
-     { writeGrammarInh_op = (op, SideR)
-     , writeGrammarInh_pair = pairParen
-     }
-    where op = infixB SideL 3
 instance CombFoldable (WriteGrammar sN) where
   chainPre f x = WriteGrammar $ \inh ->
     pairWriteGrammarInh inh op $
@@ -161,7 +167,7 @@ instance CombMatchable (WriteGrammar sN) where
     where
     op = infixN 9
 instance CombSatisfiable tok (WriteGrammar sN) where
-  satisfy _es _f = "satisfy"
+  satisfyOrFail _fs _f = "satisfy"
 instance CombSelectable (WriteGrammar sN) where
   branch lr l r = WriteGrammar $ \inh ->
     pairWriteGrammarInh inh op $
@@ -171,9 +177,3 @@ instance CombSelectable (WriteGrammar sN) where
       unWriteGrammar r inh
     where
     op = infixN 9
-instance CombThrowable (WriteGrammar sN) where
-  throw lbl = WriteGrammar $ \inh ->
-    pairWriteGrammarInh inh op $
-      Just ("throw "<>fromString (symbolVal lbl))
-    where
-    op = infixN 9