diff options
Diffstat (limited to 'bbcode/src')
| -rw-r--r-- | bbcode/src/Text/BBCode.hs | 2 | ||||
| -rw-r--r-- | bbcode/src/Text/BBCode/Lexer.hs | 17 |
2 files changed, 15 insertions, 4 deletions
diff --git a/bbcode/src/Text/BBCode.hs b/bbcode/src/Text/BBCode.hs index dfa1db7..a6de7b4 100644 --- a/bbcode/src/Text/BBCode.hs +++ b/bbcode/src/Text/BBCode.hs | |||
| @@ -42,7 +42,7 @@ rose = fmap Z.toForest . flip rose' (Z.fromForest []) | |||
| 42 | rose' (x:xs) = (>>= rose' xs) . rose'' x | 42 | rose' (x:xs) = (>>= rose' xs) . rose'' x |
| 43 | 43 | ||
| 44 | rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node t []) | 44 | rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node t []) |
| 45 | rose'' (BBOpen t) = return . Z.children . Z.insert (Node t []) | 45 | rose'' (BBOpen t _) = return . Z.children . Z.insert (Node t []) |
| 46 | rose'' (BBClose t) = close t -- for more pointless | 46 | rose'' (BBClose t) = close t -- for more pointless |
| 47 | 47 | ||
| 48 | close :: Text -> TreePos Empty Text -> Either TreeError (TreePos Empty Text) | 48 | close :: Text -> TreePos Empty Text -> Either TreeError (TreePos Empty Text) |
diff --git a/bbcode/src/Text/BBCode/Lexer.hs b/bbcode/src/Text/BBCode/Lexer.hs index a7294fe..ad26113 100644 --- a/bbcode/src/Text/BBCode/Lexer.hs +++ b/bbcode/src/Text/BBCode/Lexer.hs | |||
| @@ -14,20 +14,31 @@ import Data.Attoparsec.Text | |||
| 14 | import Data.Text (Text) | 14 | import Data.Text (Text) |
| 15 | import qualified Data.Text as T (singleton) | 15 | import qualified Data.Text as T (singleton) |
| 16 | 16 | ||
| 17 | import Data.Char (isSpace) | ||
| 18 | |||
| 17 | import Control.Applicative | 19 | import Control.Applicative |
| 18 | 20 | ||
| 21 | import Prelude hiding (takeWhile) | ||
| 22 | |||
| 19 | -- | Our lexicographical unit | 23 | -- | Our lexicographical unit |
| 20 | data BBToken = BBOpen Text -- ^ Tag open | 24 | data BBToken = BBOpen Text [(Text, Maybe Text)] -- ^ Tag open with attributes |
| 21 | | BBClose Text -- ^ Tag close | 25 | | BBClose Text -- ^ Tag close |
| 22 | | BBStr Text -- ^ Content of a tag | 26 | | BBStr Text -- ^ Content of a tag |
| 23 | deriving (Eq, Show) | 27 | deriving (Eq, Show) |
| 24 | 28 | ||
| 25 | token :: Parser BBToken | 29 | token :: Parser BBToken |
| 26 | -- ^ Tokenizer | 30 | -- ^ Tokenizer |
| 27 | token = BBClose <$> (string "[/" *> escapedText' [']'] <* string "]") | 31 | token = BBClose <$> ("[/" *> escapedText' [']'] <* "]") |
| 28 | <|> BBOpen <$> (string "[" *> escapedText' [']'] <* string "]") | 32 | <|> BBOpen <$> ("[" *> escapedText' [']', ' ']) <*> (option [] attrs <* "]") |
| 29 | <|> BBStr <$> escapedText ['['] | 33 | <|> BBStr <$> escapedText ['['] |
| 30 | 34 | ||
| 35 | attrs :: Parser [(Text, Maybe Text)] | ||
| 36 | attrs = (:) <$> (attrs' <* takeWhile isSpace) <*> (option [] $ attrs) | ||
| 37 | where | ||
| 38 | attrs' = (,) <$> escapedText ['=', ']', ' '] <*> optional ("=" *> attrArg) | ||
| 39 | attrArg = "\"" *> escapedText ['"'] <* "\"" | ||
| 40 | <|> escapedText [']', ' '] | ||
| 41 | |||
| 31 | escapedText :: [Char] -> Parser Text | 42 | escapedText :: [Char] -> Parser Text |
| 32 | -- ^ @escapedText cs@ consumes 'Text' up to (not including) the first occurence of a character from @cs@ that is not escaped using @\\@ | 43 | -- ^ @escapedText cs@ consumes 'Text' up to (not including) the first occurence of a character from @cs@ that is not escaped using @\\@ |
| 33 | -- | 44 | -- |
