impl: make `HideName` support newer constructors

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

diff --git a/src/Symantic/Parser.hs b/src/Symantic/Parser.hs
index 14a72d0d5dafd570aa15f2da7a8429e002ecf593..d3e5fb6752118e57ba564e406b2b9abfb138e738 100644 (file)
--- a/src/Symantic/Parser.hs
+++ b/src/Symantic/Parser.hs
@@ -1,28 +1,28 @@
-{-# LANGUAGE TemplateHaskell #-}
 module Symantic.Parser
   ( module Symantic.Parser.Grammar
   , module Symantic.Parser.Machine
   , module Symantic.Parser
   ) where
 
-import Data.Either (Either(..))
-import Data.Ord (Ord)
+import Control.Monad.ST (ST, RealWorld)
+import Data.Function (($))
 import Language.Haskell.TH (CodeQ)
-import Text.Show (Show)
-import Type.Reflection (Typeable)
 import qualified Language.Haskell.TH.Syntax as TH
 
 import Symantic.Parser.Grammar
 import Symantic.Parser.Machine
 
+-- * Type 'Parser'
+type Parser inp a = Machine Gen inp a
+
+-- ** Type 'Parsed'
+type Parsed inp a = ST RealWorld (Result inp a)
+
 runParser :: forall inp a.
-  Ord (InputToken inp) =>
-  Show (InputToken inp) =>
-  TH.Lift (InputToken inp) =>
-  Typeable (InputToken inp) =>
-  -- InputToken inp ~ Char =>
-  Input inp =>
-  Readable (InputToken inp) Gen =>
+  Inputable inp =>
+  Machinable (InputToken inp) Gen =>
   Parser inp a ->
-  CodeQ (inp -> Either (ParsingError inp) a)
-runParser p = [|| \input -> $$(generate [||input||] (machine p)) ||]
+  CodeQ (inp -> Parsed inp a)
+runParser p = TH.Code $ do
+  mach <- TH.runIO $ machine p
+  TH.examineCode $ generateCode mach