diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-18 08:20:33 +0000 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-18 08:20:33 +0000 |
| commit | 67025bbbed585e1245cc3f895c6f6fdf5fe35d6d (patch) | |
| tree | a6373e2cb572fb01c69fe615d48f3be44699ccfe /bbcode/src | |
| parent | bc956b6977019fb55cac94bf5bc4ab0ae4fe7e2c (diff) | |
| download | thermoprint-67025bbbed585e1245cc3f895c6f6fdf5fe35d6d.tar thermoprint-67025bbbed585e1245cc3f895c6f6fdf5fe35d6d.tar.gz thermoprint-67025bbbed585e1245cc3f895c6f6fdf5fe35d6d.tar.bz2 thermoprint-67025bbbed585e1245cc3f895c6f6fdf5fe35d6d.tar.xz thermoprint-67025bbbed585e1245cc3f895c6f6fdf5fe35d6d.zip | |
Fixed handling of juxtaposition at toplevel
Diffstat (limited to 'bbcode/src')
| -rw-r--r-- | bbcode/src/Text/BBCode.hs | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/bbcode/src/Text/BBCode.hs b/bbcode/src/Text/BBCode.hs index 8f04f19..ac56974 100644 --- a/bbcode/src/Text/BBCode.hs +++ b/bbcode/src/Text/BBCode.hs | |||
| @@ -50,14 +50,16 @@ type DomForest = [[DomTree]] | |||
| 50 | dom :: Forest BBLabel -> DomForest | 50 | dom :: Forest BBLabel -> DomForest |
| 51 | -- ^ Parse semantically constrained rose tree to syntactically constrained version | 51 | -- ^ Parse semantically constrained rose tree to syntactically constrained version |
| 52 | -- | 52 | -- |
| 53 | -- Silently drops children of semantically terminal nodes ('BBPlain') and paragraphs anywhere but at top level | 53 | -- Silently drops children of semantically terminal nodes ('BBPlain') |
| 54 | dom = map fromPar | 54 | -- |
| 55 | -- We already ensured that paragraphs occur nowhere but at toplevel | ||
| 56 | dom = map (\(Node BBPar ts) -> map dom' ts) . ensureTopLevelPar | ||
| 55 | where | 57 | where |
| 56 | fromPar (Node BBPar ts) = concatMap dom' ts | 58 | ensureTopLevelPar xs@((Node BBPar _):_) = xs |
| 57 | fromPar x = dom' x | 59 | ensureTopLevelPar xs = pure $ Node BBPar xs |
| 58 | dom' (Node (BBPlain t) _) = pure $ Content t | 60 | |
| 59 | dom' (Node (BBTag t attrs) ts) = pure . Element (CI.mk t) (Map.mapKeys CI.mk attrs) $ concatMap dom' ts | 61 | dom' (Node (BBPlain t) _) = Content t |
| 60 | dom' (Node BBPar _) = [] | 62 | dom' (Node (BBTag t attrs) ts) = Element (CI.mk t) (Map.mapKeys CI.mk attrs) $ map dom' ts |
| 61 | 63 | ||
| 62 | -- | Errors encountered during parsing | 64 | -- | Errors encountered during parsing |
| 63 | data BBCodeError = LexerError String -- ^ Error while parsing input to stream of tokens | 65 | data BBCodeError = LexerError String -- ^ Error while parsing input to stream of tokens |