Question

我在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成为Functor，Applicative，Monad的实例，如果没有MonadError，则MonadState，GeneralizedNewtypeDeriving 扩展

Answer 1

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。）

Answer 2

我花了差不多一整天的时间来弄清楚如何实现这一点。但是，在我之后弄清楚，这个概念实际上非常简单。重点是挖掘通过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成为Functor，Applicative，Monad的实例， MonadError和MonadState我可以在里面定义一个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"

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

2 个答案: