解析器复合技术简史
谈起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
口水讲干了，开始干源码，兴奋一下！
- parsec内功心法
- parsec源码开战！
a. 首先看parsec的定义及运行过程
b. 接着来看parsecT是如何构造的
c. parsec的复合传递及分支修改器，开始凌波微步
d. 解析复合常用函数
e. 基本的文本解析处理函数 - 20行搞定parsec csv解析
- 90行搞定parsec json解析
一. parsec内功心法
- 调用解析过程时，传入输入流以及终极状态分支函数(见解析过程)。
- 解析过程开始, 进行内容匹配, 产生以下各种状态后调用终极状态分支函数返回结果:
a. 消耗内容后匹配成功cok(consumed+ok)
b. 消耗内容后匹配失败cerr(consumed+err)
c. 未消耗内容下匹配成功eok(empty+ok)
d. 未消耗内容下匹配失败eerr(empty+err)
当然发生状态的情况有很多种，具体后文详细分析.
简而言之，单次解析的过程就是根据解析后产生的状态，选择相应的状态分支函数进行传递后完成了单次操作。
-
单个解析很简单，解析完了接着传递，那么传递有哪些形式呢？
a. 连续消耗复合, 分次解析(cok1->cok2)
b. 可选消耗复合, 一个不行换一个(eerr1->cok2)
c. 检测消耗复合, 部分成功后即回进行全部解析(cok1->eok1->cok2)
所以整个解析过程就是解析产生状态之后，选择下一个传递分支(cok, cerr, eok,eerr)，通过不同的传递形式选择不同的跳转完成复合。这里分支可以终结，可以交错，产生了凌波微步的即视感。最终运行解析器时, 接入外部输入流以及各终极分支状态函数输出结果。 -
解析不就是这么回事么？一点都不神秘
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状态包包含以下部分:
- 输入流stream
- 内置解析状态statePos(包含解析源，当前解析行列位置)
- 自定义状态
对于各种状态, 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解析
源码参考<Real World Haskell>:
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涉及字符转结构的逻辑，所以是相当的实用！
文档源码出自于<real world haskell>:
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解析功能
网友评论