如何在没有GeneralizedNewTypederiving扩展的monadic解析器中实现Monad,MonadError和MonadState?

时间:2018-02-03 13:54:57

标签: haskell

我在haskell中发现了一个使用monadic错误处理和状态的Parser示例。 它是这样写的。

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Monad.Except
import Control.Monad.State

newtype Parser a
  = Parser { runParser :: ExceptT String (State String) a }
    deriving ( Functor
             , Applicative
             , Monad
             , MonadError String
             , MonadState String
             )

我了解它的作用以及如何使用它。但是,我想知道的是如何 它是在没有GeneralizedNewtypeDeriving扩展名的情况下实施的。

那么,如何让Parser成为FunctorApplicativeMonad的实例, 如果没有MonadError,则MonadStateGeneralizedNewtypeDeriving 扩展

2 个答案:

答案 0 :(得分:3)

GeneralizedNewtypeDeriving使用ExceptT String (State String)样板包装基础类型的实例(在您的情况下为newtype)。例如,Functor一个等于:

-- p :: ExceptT String (State String) a
instance Functor Parser where
    fmap f (Parser p) = Parser (fmap f p)
    -- Or, equivalently:
    -- fmap f = Parser . fmap f . runParser

对于底层实例的作用,您可以通过遵循文档中实例的“源”链接来检查其来源。例如,Functor for ExceptT是:

instance (Functor m) => Functor (ExceptT e m) where
    fmap f = ExceptT . fmap (fmap f) . runExceptT

(嵌套的fmap是因为ExceptT e m a的基础类型是m (Either e a),因此有两个Functor层可以通过:{{1} }和m。)

答案 1 :(得分:0)

我花了差不多一整天的时间来弄清楚如何实现这一点。但是,在我之后 弄清楚,这个概念实际上非常简单。重点是挖掘 通过monad堆栈来应用要实现的功能然后 将结果再次埋入monad堆栈中。这些工作可以用这些完成 功能:

unwrap :: Parser a -> String -> (Either String a, String)
unwrap p s = runState (runExceptT (runParser p)) s

wrap :: (String -> (Either String a, String)) -> Parser a
wrap f = Parser (ExceptT (state (\s -> (f s))))

因此,要使Parser成为FunctorApplicativeMonad的实例, MonadErrorMonadState我可以在里面定义一个lambda或一个函数 where绑定,然后用wrap包装。

以下是实施实例:

instance Functor Parser where
  fmap f p = wrap fn
    where fn s = let (ea, s') = unwrap p s
                  in case ea of
                       Right a -> (Right (f a), s')
                       Left  e -> (Left e, s)

instance Applicative Parser where
  pure x    = wrap fn
    where fn s = (Right x, s)

  p1 <*> p2 = wrap fn
    where fn s = let (ef, s')  = unwrap p1 s
                     (ea, s'') = unwrap p2 s'
                  in run ef ea s'' s

          run (Right f) (Right a) s' s = (Right (f a), s')
          run (Left  e) _         s' s = (Left e, s)
          run _         (Left e)  s' s = (Left e, s)

instance Monad Parser where
  return  = pure

  p >>= f = wrap fn
    where fn s = let (ea, s') = unwrap p s
                  in case ea of
                       Right a -> unwrap (f a) s'
                       Left  e -> (Left e, s)

instance MonadError String Parser where
  throwError err = wrap fn
    where fn s = (Left err, s)

  catchError p h = wrap fn
    where fn s = let (ea, s') = unwrap p s
                  in case ea of
                       Right a -> (Right a, s')
                       Left  e -> unwrap (h e) s

instance MonadState String Parser where
  get   = wrap fn
    where fn s = (Right s, s)

  put s = wrap fn
    where fn s = (Right (), s)

有了这个,解析器现在可以像这样使用:

item :: Parser Char
item = do
  s <- get
  case s of
    []     -> throwError "unexpected end of input"
    (c:cs) -> do put cs
                 return c

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = item >>= \c -> if p c then return c else throwError $ "unexpected: " ++ show c

char :: Char -> Parser Char
char c = satisfy (c ==)

main :: IO ()
main = do
  print $ unwrap item "c"
  print $ unwrap (char 'c') "c"
  print $ unwrap (satisfy isDigit) "c"