get rid of eitherToParser
This commit is contained in:
parent
48257099de
commit
b1531384ef
2 changed files with 10 additions and 13 deletions
|
@ -7,6 +7,7 @@ module Language.Yanais.Nfker7h.Parser.Lex (
|
|||
|
||||
-- import Debug.Trace
|
||||
|
||||
import Control.Monad.Error.Class (MonadError(..))
|
||||
import Control.Monad.State.Strict
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Language.Yanais.Parser
|
||||
|
@ -49,17 +50,18 @@ handleIdentsI :: Parser' Error (Maybe TokenKind)
|
|||
handleIdentsI = do
|
||||
pfx <- eats lexeIdentPrefixTree
|
||||
marker <- gets peOffset
|
||||
ident' <- takeIdent >>= (\ident -> eitherToParser $ case ident of
|
||||
Left exc -> Left $ DteUnicodeExc exc
|
||||
Right x -> Right x)
|
||||
case tmp pfx ident' marker of
|
||||
ident' <- takeIdent
|
||||
ident <- case ident' of
|
||||
Left exc -> throwError $ DteUnicodeExc exc
|
||||
Right x -> pure x
|
||||
case tmp pfx ident marker of
|
||||
Just x -> pure . Just $ x
|
||||
Nothing -> do
|
||||
gtc <- tryOne Just
|
||||
-- usually this is an error, but not at EOF
|
||||
eitherToParser $ case gtc of
|
||||
Just gtc_ -> Left $ UnexpectedChar marker gtc_
|
||||
Nothing -> Right Nothing
|
||||
case gtc of
|
||||
Just gtc_ -> throwError $ UnexpectedChar marker gtc_
|
||||
Nothing -> pure Nothing
|
||||
|
||||
where
|
||||
tmp (Just IpDot) (Just x) _ = Just $ TDotIdent x
|
||||
|
|
|
@ -13,7 +13,6 @@ module Language.Yanais.Parser (
|
|||
Span(..),
|
||||
HandleTree(..),
|
||||
emptyIdent,
|
||||
eitherToParser,
|
||||
|
||||
-- creating and running parsers
|
||||
makeParseEnv,
|
||||
|
@ -97,12 +96,8 @@ instance MonadState s (Parser s e) where
|
|||
state = Parser . state
|
||||
{-# INLINE state #-}
|
||||
|
||||
-- | injects an `Either` into the parser (used to conditionally throw errors)
|
||||
eitherToParser :: Either e a -> Parser s e a
|
||||
eitherToParser e = Parser . StateT $ \st -> fmap (\x -> (x, st)) e
|
||||
|
||||
instance MonadError e (Parser s e) where
|
||||
throwError e = Parser . StateT $ \st -> Left e
|
||||
throwError e = Parser . StateT . const $ Left e
|
||||
catchError (Parser (StateT m)) eh = Parser . StateT $ \st -> case m st of
|
||||
Left err -> let (Parser (StateT ehp)) = eh err in ehp st
|
||||
Right x -> Right x
|
||||
|
|
Loading…
Reference in a new issue