函数式内功心法-02: parser复合技术之parsec凌波微步

解析器复合技术简史

谈起haskell parsec,对于函数式编程的人来说,可谓无人不知,无人不晓。
能轻轻松松20行搞定csv解析器, 90行搞定 json解析器,非常强大。

而自己本身也只有2000行左右的代码。

所谓江湖传闻,精通函数式的人,能以一己之力开创一门语言乃是基本功也!
所以,能弹指间灰飞烟灰,一般公司惹不起,最终的下场想想岳飞就知道了。。。

对于java世界来说,antlr听说得比较多,毕竟成了各大sql解析器的标准。不管是antlr类型,还是正则类型的解析器,都是比不上parsec好用的。
为啥?下面讲解一下基本的程序员进化思想

1. 库大于框架,不容置疑

框架是给个小窗给你用,小窗之外的东西一旦发生错误,那就是灾难性的,需要专家级的人物,才能救场,这就是所谓的抽象泄露!
而parsec定制了一套库,程序员从底层开始自由组合,拥有完全的自由权,对于调试以及定制化,简单是随心所欲,手到擒来。而antlr这家伙呢?用嵌入式代码解决?丑陋到了极点!!。对于正则呢,那完全是恶梦,一子走错,全盘皆输啊!
所以,parser combinator解析器复合技术值得你拥有!

2. 复合复合复合,二两拨千金

解析器复合技术(Parser Combinator)是什么呢?
对于解析器,最基本的单位是什么? TOKEN。
最基本的文本TOKEN是CHAR!
最基本的文本解析输入就是CHAR STREAM!

对于复杂的sql解析将会在queryparser源码里面详细介绍。

a. 对于CSV来说:

有了CHAR,我们可以复合成CELL,有了CELL我们可以复合成LINE,有了LINE我们可以复合出最终的csv结构体。

b. 对于JSON来说:

有了CHAR, 我们可以复合出BOOL, STRING, NUMBER基础类型,有了基础类型,我们可以复合出ARRAY, OBJECT,最终复合出了JSON结构体。

parsec还有进阶版本?

既然parsec这么强大,那么在haskell世界里面一定无敌喽?
有了parsec,自然有parsec++,那就是attoparsec。
haskell标准商业库aeson(json解析)以及cassava(csv解析)都是基于它的。
为啥呢?attoparsec牺牲了弱化了错误处理功能,直接采用原生的byte进行处理,提速了性能。

attoparsec有时间的话,我们来日再战!
附上商业库csv及json库的地址,以供参考。
cassava: https://github.com/haskell-hvr/cassava
aeson: https://github.com/bos/aeson

口水讲干了,开始干源码,兴奋一下!

  1. parsec内功心法
  2. parsec源码开战!
    a. 首先看parsec的定义及运行过程
    b. 接着来看parsecT是如何构造的
    c. parsec的复合传递及分支修改器,开始凌波微步
    d. 解析复合常用函数
    e. 基本的文本解析处理函数
  3. 20行搞定parsec csv解析
  4. 90行搞定parsec json解析

一. parsec内功心法

  1. 调用解析过程时,传入输入流以及终极状态分支函数(见解析过程)。
  2. 解析过程开始, 进行内容匹配, 产生以下各种状态后调用终极状态分支函数返回结果:
    a. 消耗内容后匹配成功cok(consumed+ok)
    b. 消耗内容后匹配失败cerr(consumed+err)
    c. 未消耗内容下匹配成功eok(empty+ok)
    d. 未消耗内容下匹配失败eerr(empty+err)

当然发生状态的情况有很多种,具体后文详细分析.
简而言之,单次解析的过程就是根据解析后产生的状态,选择相应的状态分支函数进行传递后完成了单次操作。

  1. 单个解析很简单,解析完了接着传递,那么传递有哪些形式呢?
    a. 连续消耗复合, 分次解析(cok1->cok2)
    b. 可选消耗复合, 一个不行换一个(eerr1->cok2)
    c. 检测消耗复合, 部分成功后即回进行全部解析(cok1->eok1->cok2)
    所以整个解析过程就是解析产生状态之后,选择下一个传递分支(cok, cerr, eok,eerr),通过不同的传递形式选择不同的跳转完成复合。这里分支可以终结,可以交错,产生了凌波微步的即视感。最终运行解析器时, 接入外部输入流以及各终极分支状态函数输出结果。

  2. 解析不就是这么回事么?一点都不神秘
    a. 解析技术其实不难,解析只是人类友好接口转换成机器友好接口,或者将其它系统接口格式进行接入。属于机器接口的前奏区而已。
    b. 但是解析技术极其有用。毕竟解析技术只是表面,接口设计才是核心。
    c. 比如SQL,大家觉得很自然,如何接入到你的程序入口呢?这里面涉及的东西就很有趣了。
    d. 除了接入,设计好自己的接口标准,能达到灵活扩展,也是非常考验架构能力的。可以说,在有限的格式里,展现出你的强大且简单,不是一朝一夕所能达到的。

二. parsec源码开战!

前面讲了,解析过程的核心在于状态传递及处理。
parsec包含两个模块, Text.Parsec以及Text.ParsercCombinators。
前者为具体实现,后者为外部接口, 这里忽略。
其中核心部分主要在Text.Parsec.Prim模块里面,我们也从这里开始!

1. 首先看parsec的定义及运行过程:

newtype ParsecT s u m a
    = ParsecT {unParser :: forall b .
                 State s u
              -> (a -> State s u -> ParseError -> m b) -- consumed ok
              -> (ParseError -> m b)                   -- consumed err
              -> (a -> State s u -> ParseError -> m b) -- empty ok
              -> (ParseError -> m b)                   -- empty err
              -> m b
             }
#if MIN_VERSION_base(4,7,0)
     deriving ( Typeable )
     -- GHC 7.6 doesn't like deriving instances of Typeabl1 for types with
     -- non-* type-arguments.
#endif

runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT p s = unParser p s cok cerr eok eerr
    where cok a s' err = return . Consumed . return $ Ok a s' err
          cerr err = return . Consumed . return $ Error err
          eok a s' err = return . Empty . return $ Ok a s' err
          eerr err = return . Empty . return $ Error err

data State s u = State {
      stateInput :: s,
      statePos   :: !SourcePos,
      stateUser  :: !u
    }
    deriving ( Typeable )

data SourcePos  = SourcePos SourceName !Line !Column
    deriving ( Eq, Ord, Data, Typeable)

type SourceName = String
type Line       = Int
type Column     = Int

data Consumed a  = Consumed a
                 | Empty !a
    deriving ( Typeable )

data Reply s u a = Ok a !(State s u) ParseError
                 | Error ParseError
    deriving ( Typeable )

getInput :: (Monad m) => ParsecT s u m s
getInput = do state <- getParserState
              return (stateInput state)

getPosition :: (Monad m) => ParsecT s u m SourcePos
getPosition = do state <- getParserState
                 return (statePos state)

getParserState :: (Monad m) => ParsecT s u m (State s u)
getParserState = updateParserState id

getState :: (Monad m) => ParsecT s u m u
getState = stateUser `liftM` getParserState

parsecT包括四个参数:
s表示stream输入, u表示自定义状态, a表示往下传递的解析值, m只是一层隔离。
parsecT等待一个状态State(stream以及自定义状态)以及四个状态函数分支[cok, cerr, elk, eerr]处理传递过程。

State状态包包含以下部分:

  1. 输入流stream
  2. 内置解析状态statePos(包含解析源,当前解析行列位置)
  3. 自定义状态
    对于各种状态, parsec提供了getInput, getPosition, getParserState, getState系列函数进行处理。

接着提供不同的状态函数分支生成最终结果,将最终结果a, 状态s, 以及错误信息err包装在Consumed|Empty以及Ok| Error的四种状态结构下, 最终选择的分支由parsecT具体逻辑确定.

2. 接着来看parsecT是如何构造的

runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT p s = unParser p s cok cerr eok eerr
    where cok a s' err = return . Consumed . return $ Ok a s' err
          cerr err = return . Consumed . return $ Error err
          eok a s' err = return . Empty . return $ Ok a s' err
          eerr err = return . Empty . return $ Error err

instance Monad (ParsecT s u m) where
    return = Applicative.pure

instance Applicative.Applicative (ParsecT s u m) where
    pure = parserReturn

parserReturn :: a -> ParsecT s u m a
parserReturn x
    = ParsecT $ \s _ _ eok _ ->
      eok x s (unknownError s)

runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))

mkPT :: Monad m => (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT k = ParsecT $ \s cok cerr eok eerr -> do
           cons <- k s
           case cons of
             Consumed mrep -> do
                       rep <- mrep
                       case rep of
                         Ok x s' err -> cok x s' err
                         Error err -> cerr err
             Empty mrep -> do
                       rep <- mrep
                       case rep of
                         Ok x s' err -> eok x s' err
                         Error err -> eerr err

tokenPrim :: (Stream s m t)
          => (t -> String)                      -- ^ Token pretty-printing function.
          -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.
          -> (t -> Maybe a)                     -- ^ Matching function for the token to parse.
          -> ParsecT s u m a
{-# INLINE tokenPrim #-}
tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test

tokenPrimEx :: (Stream s m t)
            => (t -> String)
            -> (SourcePos -> t -> s -> SourcePos)
            -> Maybe (SourcePos -> t -> s -> u -> u)
            -> (t -> Maybe a)
            -> ParsecT s u m a
{-# INLINE tokenPrimEx #-}
tokenPrimEx showToken nextpos Nothing test
  = ParsecT $ \(State input pos user) cok _cerr _eok eerr -> do
      r <- uncons input
      case r of
        Nothing -> eerr $ unexpectError "" pos
        Just (c,cs)
         -> case test c of
              Just x -> let newpos = nextpos pos c cs
                            newstate = State cs newpos user
                        in seq newpos $ seq newstate $
                           cok x newstate (newErrorUnknown newpos)
              Nothing -> eerr $ unexpectError (showToken c) pos
tokenPrimEx showToken nextpos (Just nextState) test
  = ParsecT $ \(State input pos user) cok _cerr _eok eerr -> do
      r <- uncons input
      case r of
        Nothing -> eerr $ unexpectError "" pos
        Just (c,cs)
         -> case test c of
              Just x -> let newpos = nextpos pos c cs
                            newUser = nextState pos c cs user
                            newstate = State cs newpos newUser
                        in seq newpos $ seq newstate $
                           cok x newstate $ newErrorUnknown newpos
              Nothing -> eerr $ unexpectError (showToken c) pos

unexpectError :: String -> SourcePos -> ParseError
unexpectError msg pos = newErrorMessage (SysUnExpect msg) pos

newErrorMessage :: Message -> SourcePos -> ParseError
newErrorMessage msg pos
    = ParseError pos [msg]

data Message = SysUnExpect !String -- @ library generated unexpect
             | UnExpect    !String -- @ unexpected something
             | Expect      !String -- @ expecting something
             | Message     !String -- @ raw message
    deriving ( Typeable )

分为三种情况: 前两种接口为基本接口

a. 内置Monad接口: 直接传递参数值常量。

通过Monad接口return方法直接传递参数值,状态传递函数置为eok(未消耗内容下成功匹配)。

b. 逆向run接口:底层接口, 不建议使用

将parsecT的run接口逻辑进行逆向,倒推出状态传递函数

c. 基本状态变更接口: 大佬在此。。。

tokenPrim接受三个函数. 第一个showToken为打印函数,将stream里面的token转为字符串用于错误消息显示。第二个nextpos更新状态位置。第三个test检测是否匹配成功。
基本逻辑为: 用uncons方法从stream取出一条token

  • 如果stream已经结束,选择eerr分支(未消耗内容下匹配失败),错误消息为SysUnExpect ""
  • 如果stream取出token后匹配失败, 选择eerr分支(未消耗内容下匹配失败),错误消息为SysUnExpect (showToken token)
  • 如果stream取出token后匹配成功, 调用nextpos更新State自管理的位置字段,接着选择cok分支(消耗内容后匹配成功)传递新状态(新的stream, 新的pos位置及原始的user自定义状态), 其它分支状态不改变。

这里我们可以看到第一个接口有了eok, 第三个接口有了cok,errr
似乎少了点什么,对,就是cerr(消耗内容后匹配失败)。
失败匹配之后按理来说不应该消耗内容。但是如果我们有一个解析器cok之后,下一个解析器err呢, 组合后结果会是什么样子?有代码有真相,谜底在下一小节揭晓!

3.parsec的复合传递及分支修改器,开始凌波微步

传递的过程使用的cps机制,不太熟悉的用户可以参见上一章callcc原理。
parsecT有两个基本的传递接口,一个是Monad接口>>=方法, 一个是MonadPlus接口的mplus方法。
前者为参数绑定传递,后者为alternative多路选择传递。

instance Monad (ParsecT s u m) where
    p >>= f = parserBind p f
    (>>) = (Applicative.*>)

instance Applicative.Applicative (ParsecT s u m) where
    p1 *> p2 = p1 `parserBind` const p2

parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b
{-# INLINE parserBind #-}
parserBind m k
  = ParsecT $ \s cok cerr eok eerr ->
    let
        -- consumed-okay case for m
        mcok x s err =
            let
                 -- if (k x) consumes, those go straigt up
                 pcok = cok
                 pcerr = cerr

                 -- if (k x) doesn't consume input, but is okay,
                 -- we still return in the consumed continuation
                 peok x s err' = cok x s (mergeError err err')

                 -- if (k x) doesn't consume input, but errors,
                 -- we return the error in the 'consumed-error'
                 -- continuation
                 peerr err' = cerr (mergeError err err')
            in  unParser (k x) s pcok pcerr peok peerr

        -- empty-ok case for m
        meok x s err =
            let
                -- in these cases, (k x) can return as empty
                pcok = cok
                peok x s err' = eok x s (mergeError err err')
                pcerr = cerr
                peerr err' = eerr (mergeError err err')
            in  unParser (k x) s pcok pcerr peok peerr
        -- consumed-error case for m
        mcerr = cerr

        -- empty-error case for m
        meerr = eerr

    in unParser m s mcok mcerr meok meerr

instance MonadPlus (ParsecT s u m) where
    mzero = parserZero
    mplus p1 p2 = parserPlus p1 p2

parserPlus :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
{-# INLINE parserPlus #-}
parserPlus m n
    = ParsecT $ \s cok cerr eok eerr ->
      let
          meerr err =
              let
                  neok y s' err' = eok y s' (mergeError err err')
                  neerr err' = eerr $ mergeError err err'
              in unParser n s cok cerr neok neerr
      in unParser m s cok cerr eok meerr

instance Applicative.Alternative (ParsecT s u m) where
    empty = mzero
    (<|>) = mplus

(<|>) :: (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)
p1 <|> p2 = mplus p1 p2

第一种传递>==我们叫它连续消耗传递。

在parserBind逻辑里面我们可以看到,它只在mcok及meok情况下传递,也就是匹配成功后往下传递,失败了就跳到终级函数分支喽。额外的一些错误状态收集我们这里不过多关心,可以自行消化。
这里也解开了上一小节留下来的疑惑,当进行复合合时mcok + peok = cok, mcok + peerr = cerr。
也就是说,如果cok之后,发生了eerr,则复合出来cerr这种情况了。
>>=有一种快捷方式>>函数,忽略传递参数,还有一种等价形式*>。

第二种传递mplus,或者等价函数<|> 我们叫它可选消耗复合。

在parserPlus逻辑里面我们可以看到, 当前面的解析器状态为meerr时,即消耗内容后匹配失败,我们才传递下去,否则直接走终极分支传递。

单次的状态传递有cok, eok, eerr。
经过>>=及<|>复合后有如下变更:
cok>>=cok=cok,
cok>>=eok=cok,
cok>>=eerr=cerr,
eok>>=eok=eok,
eok>>=cok=cok
eok>>=eerr= eerr,
eerr <|> cok = cok,

对于可选消耗复合,它必须接入eerr才行,如果我们cok+eerr=cerr消耗了状态,我们可不可以撤消状态后接入呢?我们可以用分支修改器。

我们前面介绍过tokenPrim,可以看到,状态的修改都是发生在cok分支上的state上面。当我们消耗错误的时候,我们使用try分支修改器。将cerr的分支直接跳转到eerr即可,因为eerr的状态并非改变。

try :: ParsecT s u m a -> ParsecT s u m a
try p =
    ParsecT $ \s cok _ eok eerr ->
    unParser p s cok eerr eok eerr

前面讲到复合后改变状态的有cok ,cerr。
对于cerr我们可以通过try分支修改器跳转到eerr。
对于cok,我们有另一种修改器, lookAhead。

lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a
lookAhead p =
    ParsecT $ \s _ cerr eok eerr -> do
        let eok' a _ _ = eok a s (newErrorUnknown (statePos s))
        unParser p s eok' cerr eok' eerr

这里面逻辑比较简单,就是cok分支跳转到了eok上面去,使用了不带状态变更的eok,完成了状态回位。

前面分析过,在第二种可选传递情况下,需要try修改器。

那么在哪种传递情况下需要lookAhead修改器撤消成功匹配状态呢?

这就是我们提到的第三种: 检测消耗复合。

我们先检测部分匹配,得出部分匹配结论后,再进行细一步处理。所有,我们是需要撤消成功匹配状态的。

4. 解析复合的常用函数

前面讲解了三种基本的解析复合形式。parsec为了方便使用,提供一些常用的复合逻辑。
Text.Parsec.Prim提供了核心的many及skipMany
Text.Parsec.Combinator提供了choice, count, between, option, optionMaybe, optional, skipMany1, many1, sepBy, sepBy1, endBy, endBy1, sepEndBy, sepEndBy1, chainl, chainl1, chainr, chainr1, eof, notFollowedBy, manyTill, anyToken.

这里的函数我们简单过一遍。

a. 先看many以及skipMany

many :: ParsecT s u m a -> ParsecT s u m [a]
many p
  = do xs <- manyAccum (:) p
       return (reverse xs)

-- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping
-- its result.
--
-- >  spaces  = skipMany space

skipMany :: ParsecT s u m a -> ParsecT s u m ()
skipMany p
  = do _ <- manyAccum (\_ _ -> []) p
       return ()

manyAccum :: (a -> [a] -> [a])
          -> ParsecT s u m a
          -> ParsecT s u m [a]
manyAccum acc p =
    ParsecT $ \s cok cerr eok _eerr ->
    let walk xs x s' _err =
            unParser p s'
              (seq xs $ walk $ acc x xs)  -- consumed-ok
              cerr                        -- consumed-err
              manyErr                     -- empty-ok
              (\e -> cok (acc x xs) s' e) -- empty-err
    in unParser p s (walk []) cerr manyErr (\e -> eok [] s e)

manyErr :: a
manyErr = error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."

可以看到many就是递归去匹配解析器,对于cok分支继续往下走,第一个匹配失败后eerr跳转到cok结束递归。最后将匹配上的结果连接起来作为结果返回。
skipMany逻辑一样,就是匹配了之后将结果丢弃。

b. 接下来看Combinator模块基本复合

对应的many及skipMany有many1以及skipMany1

many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]
many1 p             = do{ x <- p; xs <- many p; return (x:xs) }
skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
skipMany1 p         = do{ _ <- p; skipMany p }

这个逻辑很简单,就是把第一次拿出来,走>>=传递,只有第一次成功了才能成功向下走。所以,至少有一次成功匹配。

choice ps           = foldr (<|>) mzero ps

count :: (Stream s m t) => Int -> ParsecT s u m a -> ParsecT s u m [a]
count n p           | n <= 0    = return []
                    | otherwise = sequence (replicate n p)

between :: (Stream s m t) => ParsecT s u m open -> ParsecT s u m close
            -> ParsecT s u m a -> ParsecT s u m a
between open close p
                    = do{ _ <- open; x <- p; _ <- close; return x }

choice比较简单,就是将数组里面的parser依次进行<|>调用
count也比较简单,就是进行特定次数复合后解析进行结果合并,全部成功后得到数组值,否则为[]。
between也不难,就是丢掉between前后的结果,返回中间解析的结果

c. 接着就是option家族

option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a
option x p          = p <|> return x

optionMaybe :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe p       = option Nothing (liftM Just p)

optional :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
optional p          = do{ _ <- p; return ()} <|> return ()

option家族的话就是<|>的一种扩展,成功后消耗内容, 如果失败进行各种特殊处理
option失败则使用x的parsec常量接口作为解析值.
optionMaybe则是如果失败,则返回Nothing值与成功值构造成Maybe对象
optional则是解析失败及成功后丢弃结果。用于内容匹配消耗。

d. 接着看sepBy & endBy & chain家族

sepBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 p sep        = do{ x <- p
                        ; xs <- many (sep >> p)
                        ; return (x:xs)
                        }

sepBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy p sep         = sepBy1 p sep <|> return []

endBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
endBy1 p sep        = many1 (do{ x <- p; _ <- sep; return x })

endBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
endBy p sep         = many (do{ x <- p; _ <- sep; return x })

sepEndBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy1 p sep     = do{ x <- p
                        ; do{ _ <- sep
                            ; xs <- sepEndBy p sep
                            ; return (x:xs)
                            }
                          <|> return [x]
                        }
sepEndBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy p sep      = sepEndBy1 p sep <|> return []

chainl :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
chainl p op x       = chainl1 p op <|> return x

chainl1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 p op        = do{ x <- p; rest x }
                    where
                      rest x    = do{ f <- op
                                    ; y <- p
                                    ; rest (f x y)
                                    }
                                <|> return x

chainr :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
chainr p op x       = chainr1 p op <|> return x

chainr1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainr1 p op        = scan
                    where
                      scan      = do{ x <- p; rest x }

                      rest x    = do{ f <- op
                                    ; y <- scan
                                    ; return (f x y)
                                    }
                                <|> return x

sepBy1就是自我匹配>>=重复的[分隔匹配>>自我匹配]。
sepBy则是允许匹配不上的情况出现。

endBy跟endBy1仅仅是自我匹配+尾部匹配的多次重复,endBy1要求必须匹配一次

sepEndBy1跟sepEndBy比较特别,同时支持sepBy跟endBy功能。
sepEndBy1实现逻辑为,先自我匹配,后面分为两种情况。
第一种情况,分隔符匹配成功。即p+sep成功
接着递归匹配sepEndB =p+sep,实现了endBy功能.
第二种情况,递归过程中出现分隔符匹配失败。
即[p+sep]+p->[sep失败走<|>回归p位], 实现了sepBy功能。

chain家族与sepBy类似,加入了计算功能解,主要用于左递归以及右递归形式的表达式计算

e. 最后几个

anyToken :: (Stream s m t, Show t) => ParsecT s u m t
anyToken            = tokenPrim show (\pos _tok _toks -> pos) Just

notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()
notFollowedBy p     = try (do{ c <- try p; unexpected (show c) }
                           <|> return ()
                          )

eof :: (Stream s m t, Show t) => ParsecT s u m ()
eof                 = notFollowedBy anyToken  "end of input"

manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill p end      = scan
                    where
                      scan  = do{ _ <- end; return [] }
                            <|>
                              do{ x <- p; xs <- scan; return (x:xs) }

anyToken比较简单,如果stream依然有token输入, 进入test函数后返回结果为Just,始终匹配成功,nexpos函数为(\pos _tok _toks -> pos) ,即匹配成功了也不改变位置状态。

notFollowedBy即是尝试进行匹配,如果匹配成功,返回unexpected错误.

eof则是如果依然有token存在, anyToken就会成功,notFollowedBy则会匹配成功,则返回unexpected错误。

manyTill为递归匹配, 可用于匹配注释
a. 如果到达end,则返回空。
b. 否则进行p解析后,再次递归。
最终的效果是一直运行p ,直到end出现,将p的结果使用列表保存.

至此, 大功告成!

5. 基本的文本解析处理函数

好了,底层基础已经介绍完毕,我们接着介绍基本的文本解析函数.
这个源码在Text.Parsec.Char模块里面

satisfy :: (Stream s m Char) => (Char -> Bool) -> ParsecT s u m Char
satisfy f           = tokenPrim (\c -> show [c])
                                (\pos c _cs -> updatePosChar pos c)
                                (\c -> if f c then Just c else Nothing)

updatePosChar   :: SourcePos -> Char -> SourcePos
updatePosChar (SourcePos name line column) c
    = case c of
        '\n' -> SourcePos name (line+1) 1
        '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))
        _    -> SourcePos name line (column + 1)

oneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char
oneOf cs            = satisfy (\c -> elem c cs)

noneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char
noneOf cs           = satisfy (\c -> not (elem c cs))

space :: (Stream s m Char) => ParsecT s u m Char
space               = satisfy isSpace        "space"

spaces :: (Stream s m Char) => ParsecT s u m ()
spaces              = skipMany space         "white space"

newline :: (Stream s m Char) => ParsecT s u m Char
newline             = char '\n'              "lf new-line"

crlf :: (Stream s m Char) => ParsecT s u m Char
crlf                = char '\r' *> char '\n'  "crlf new-line"

endOfLine :: (Stream s m Char) => ParsecT s u m Char
endOfLine           = newline <|> crlf        "new-line"

tab :: (Stream s m Char) => ParsecT s u m Char
tab                 = char '\t'              "tab"

upper :: (Stream s m Char) => ParsecT s u m Char
upper               = satisfy isUpper        "uppercase letter"

lower :: (Stream s m Char) => ParsecT s u m Char
lower               = satisfy isLower        "lowercase letter"

alphaNum :: (Stream s m Char => ParsecT s u m Char)
alphaNum            = satisfy isAlphaNum     "letter or digit"

letter :: (Stream s m Char) => ParsecT s u m Char
letter              = satisfy isAlpha        "letter"

digit :: (Stream s m Char) => ParsecT s u m Char
digit               = satisfy isDigit        "digit"

hexDigit :: (Stream s m Char) => ParsecT s u m Char
hexDigit            = satisfy isHexDigit     "hexadecimal digit"

octDigit :: (Stream s m Char) => ParsecT s u m Char
octDigit            = satisfy isOctDigit     "octal digit"

char :: (Stream s m Char) => Char -> ParsecT s u m Char
char c              = satisfy (==c)   show [c]

anyChar :: (Stream s m Char) => ParsecT s u m Char
anyChar             = satisfy (const True)

string :: (Stream s m Char) => String -> ParsecT s u m String
string s            = tokens show updatePosString s

看到这里,内容就太简单了。
核心就在于satisfy函数,这个函数接受一个Char->Bool对Char Token进行检测,最终移交到前面的tokenPrim去生成parsecT的基本接口。

tokenPrim包含三个函数,错误打印showTok,nextPosTok, testTok
现在有了testTok检测,showTok直接转成string打印即可,nextPosTok 稍复杂一点,也挺简单。除了特殊计算\n, \t这种位置,其它则是列位置向后移动一位。

有了satisfy, 我们可以判断char类型。就有了 space, spaces, newline, crlf, endOfLine, tab, upper, lower, alphaNum, letter, digit, hexDigit, octDigit, anyChar,一干就是一大篇,真是开心呀。

还剩哪几个? char, oneOf , noneOf , string。
前面是检测类型,剩下的就是检测内容了.
char就是检测提供的字符参数是否与char token相等.
oneOf,则是检测提供的数组参数是否包含当前char token。
noneOf, 则是检测提供的数组参数是否不包含当前char token。
string则是调用tokens函数检测一组token,同时使用updatePosString进行updatePosChar的foldl递用。

轻轻松松!

三. 20行搞定parsec csv解析

源码参考:
https://resources.oreilly.com/examples/9780596514983/blob/master/examples/ch16/csv9.hs

import Text.ParserCombinators.Parsec

csvFile = endBy line eol
line = sepBy cell (char ',')
cell = quotedCell <|> many (noneOf ",\n\r")

quotedCell = 
    do char '"'
       content <- many quotedChar
       char '"'  "quote at end of cell"
       return content

quotedChar =
        noneOf "\""
    <|> try (string "\"\"" >> return '"')

eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
     "end of line"

a. 首先定义cell,有两种类型, quotedCell以及regular cell

regular cell比较简单,不包含换行符及分隔符。
quotedCell则是通过前后"号进行保护,可以在里面有各种特殊符号.
为什么可以这样呢?如果一个字段以"开头,那么单个"作为结束符,当里面再次出现"时,我们进行2部重复,所以内容永远不会出现单次"。
所以quotedCell定义就比较简单了,包括了前后"引号,中间则是quotedChar的复合,如果为双倍引号,则按单次提取即可,其它正常返回。

b. 有了cell, 我们用分隔符sepBy调用就有了line。

c. 有了line,我们用结尾符endBy调用就有了csvFile

当然这里结尾符情况有多种,对于多TOKEN CHAR的解析为了避免部分状态变更,我们使用了try分支修改器撤消状态。

有点太简单了,对不对头?

四. 90行搞定parsec json解析

前面的CSV结构过于简单,我们来个json的玩起来!
json涉及字符转结构的逻辑,所以是相当的实用!
文档源码出自于:
https://resources.oreilly.com/examples/9780596514983/blob/master/examples/ch16/JSONParsec.hs

import Numeric (readFloat, readHex, readSigned)

newtype JAry a = JAry {
      fromJAry :: [a]
    } deriving (Eq, Ord, Show)

newtype JObj a = JObj {
      fromJObj :: [(String, a)]
    } deriving (Eq, Ord, Show)

data JValue = JString String
            | JNumber Double
            | JBool Bool
            | JNull
            | JObject (JObj JValue)   -- was [(String, JValue)]
            | JArray (JAry JValue)    -- was [JValue]
              deriving (Eq, Ord, Show)

p_bool :: CharParser () Bool
p_bool = True <$ string "true"
     <|> False <$ string "false"

p_string :: CharParser () String
p_string = between (char '\"') (char '\"') (many jchar)
    where jchar = char '\\' *> (p_escape <|> p_unicode)
              <|> satisfy (`notElem` "\"\\")

p_escape = choice (zipWith decode "bnfrt\\\"/" "\b\n\f\r\t\\\"/")
    where decode c r = r <$ char c

p_unicode :: CharParser () Char
p_unicode = char 'u' *> (decode <$> count 4 hexDigit)
    where decode x = toEnum code
              where ((code,_):_) = readHex x

p_number :: CharParser () Double
p_number = do s <- getInput
              case readSigned readFloat s of
                [(n, s')] -> n <$ setInput s'
                _         -> empty

p_value :: CharParser () JValue
p_value = value <* spaces
  where value = JString <$> p_string
            <|> JNumber <$> p_number
            <|> JObject <$> p_object
            <|> JArray <$> p_array
            <|> JBool <$> p_bool
            <|> JNull <$ string "null"
             "JSON value"

p_series :: Char -> CharParser () a -> Char -> CharParser () [a]
p_series left parser right =
    between (char left <* spaces) (char right) $
            (parser <* spaces) `sepBy` (char ',' <* spaces)

p_array :: CharParser () (JAry JValue)
p_array = JAry <$> p_series '[' p_value ']'

p_object :: CharParser () (JObj JValue)
p_object = JObj <$> p_series '{' p_field '}'
    where p_field = (,) <$> (p_string <* char ':' <* spaces) <*> p_value


p_text :: CharParser () JValue
p_text = spaces *> text
      "JSON text"
    where text = JObject <$> p_object
             <|> JArray <$> p_array

a. 基本的数据类型为bool,string, number.

bool比较简单,如果是"true"或者"false,则转为True或False返回.
<$>函数是functor里面的,就是对functor接品里的内容调用函数。
<$函数则是<$>的快捷形式,丢弃参数,直接返回值。

string也不难,就是以引号开始及结束,中间可以有正常的不为引号或者逃逸字符,或者以\开始的引号或逃逸字符

number稍低层一点,由于parsec没有提供数值解析功能,自己调用了底层的方法接受状态输入流进行解析。 最终原生的readSigned方法解析后获得了两部分内容: 解析的数值以及剩余的输入流。接着更新输入流状态后,将数值结果返回。

b. 复合类型array以及object

这两种类型为递归结构,就比较有趣了。
这里首先介绍JValue这种结构, 它包含了JNull, JBool , JString, JNumber以及JArray, JObj

array及object 可以包含jvalue, jvalue则又可以为array即object,则完成了递归结构构造。

我们先看辅助函数p_series,它调用between后,通过逗号分隔填充中间内容。当然还有一些去除空格的处理,我们这里不太关心。

p_array函数调用它构造JArray的JAry参数,则是以[开始,]结束,中间包含以逗号分隔的多个JValue, 最终得到[JValue]

p_object函数调用它构造JObject的JAry参数,则是以{开始, }结束,中间包括string + ':' + JValue, 将:前后两部分转换为tuple,最终得到[(String, JValue)]

c. 最后的json解析器p_text

p_text去除空格后,进行JObject以及JArray解析构造,最终实现了JSON解析功能

==== 好了,今天就给大家介绍到这里了====

你可能感兴趣的:(函数式内功心法-02: parser复合技术之parsec凌波微步)