tagchup 0.4.0.1 → 0.4.0.2
raw patch · 4 files changed
+35/−23 lines, 4 filesdep ~containers
Dependency ranges changed: containers
Files
- src/Text/HTML/Tagchup/Parser/Combinator.hs +13/−2
- src/Text/HTML/Tagchup/Parser/Tag.hs +17/−17
- src/Text/HTML/Tagchup/Process.hs +0/−1
- tagchup.cabal +5/−3
src/Text/HTML/Tagchup/Parser/Combinator.hs view
@@ -1,9 +1,9 @@ module Text.HTML.Tagchup.Parser.Combinator ( Parser.T, Full, Emitting, Fallible, Plain,- char, dropSpaces, getPos,+ char, voidChar, dropSpaces, getPos, many, many1, manyS, many1S, manyNull, many1Null, many0toN, many1toN, many1Satisfy, manySatisfy, readUntil,- satisfy, string,+ satisfy, string, voidString, emit, modifyEmission, eval, run, write, gets, withDefault, allowFail, allowEmit,@@ -145,6 +145,17 @@ (Monoid output, Stream.C input) => String -> Parser.T input output Maybe String string = allowEmit . mapM char+++voidChar ::+ (Monoid output, Stream.C input) =>+ Char -> Parser.T input output Maybe ()+voidChar c = fmap (const ()) $ char c++voidString ::+ (Monoid output, Stream.C input) =>+ String -> Parser.T input output Maybe ()+voidString = allowEmit . mapM_ voidChar readUntil ::
src/Text/HTML/Tagchup/Parser/Tag.hs view
@@ -2,10 +2,10 @@ import Text.HTML.Tagchup.Parser.Combinator (allowFail, withDefault,- char, dropSpaces, getPos,+ voidChar, dropSpaces, getPos, many, many0toN, many1toN, many1Satisfy, readUntil,- satisfy, string,+ satisfy, voidString, emit, modifyEmission, ) import qualified Text.HTML.Tagchup.Parser.Combinator as Parser@@ -68,7 +68,7 @@ omitClose = liftM (\t -> (t, Nothing)) pos <- getPos mplus- (do char '<'+ (do voidChar '<' allowFail $ withDefault (msum $ omitClose (parseSpecialTag pos) :@@ -108,7 +108,7 @@ modifyEmission (restrictWarnings 10) $ many parseAttribute liftM ((,) tag) $ withDefault (do closePos <- getPos- string "/>"+ voidString "/>" allowFail $ liftM Just $ returnTag closePos (Tag.Close name)) (do junkPos <- getPos readUntilTerm@@ -123,7 +123,7 @@ (Stream.C source, Name.Tag name) => Position.T -> Parser source (PosTag.T name sink) parseCloseTag pos =- do char '/'+ do voidChar '/' name <- parseName allowFail $ do tag <- returnTag pos (Tag.Close name)@@ -141,13 +141,13 @@ (Stream.C source, Name.Tag name) => Position.T -> Parser source (PosTag.T name sink) parseSpecialTag pos =- do char '!'+ do voidChar '!' msum $- (do string "--"+ (do voidString "--" allowFail $ readUntilTerm (\ cmt -> returnTag pos (Tag.Comment cmt)) "Unterminated comment" "-->") :- (do string TagName.cdataString+ (do voidString TagName.cdataString allowFail $ readUntilTerm (\ cdata -> returnTag pos (Tag.cdata cdata)) "Unterminated cdata" "]]>") :@@ -164,7 +164,7 @@ Name.Attribute name, Name.Tag name) => Position.T -> Parser source (PosTag.T name sink) parseProcessingTag pos =- do char '?'+ do voidChar '?' name <- parseName allowFail $ do dropSpaces@@ -199,7 +199,7 @@ do dropSpaces value <- withDefault- (string "=" >> allowFail (dropSpaces >> parseValue))+ (voidString "=" >> allowFail (dropSpaces >> parseValue)) (return mempty) dropSpaces return $ Attr.Cons name value@@ -266,11 +266,11 @@ (Stream.C source, StringType sink) => String -> Char -> Parser source sink parseQuoted termMsg quote =- char quote >>+ voidChar quote >> (allowFail $ do str <- parseString (quote/=) withDefault- (char quote >> return ())+ (voidChar quote) (do termPos <- getPos emitWarning termPos termMsg) return str)@@ -379,7 +379,7 @@ withDefault (do ent <- mplus- (do char '#'+ (do voidChar '#' digits <- allowFail $ many0toN 10 (satisfy isAlphaNum) -- exclude ';', '"', '<' -- include 'x'@@ -391,7 +391,7 @@ (HTMLEntity.numberToChar digits)) (liftM ((:[]) . HTMLChar.EntityRef) $ many1toN 10 (satisfy isAlphaNum))- char ';'+ voidChar ';' return ent) (emitWarning pos "Non-terminated entity reference" >> return [HTMLChar.Unicode '&'])@@ -421,13 +421,13 @@ withDefault (do ent <- mplus- (char '#' >>+ (voidChar '#' >> liftM HTMLChar.CharRef (mplus- (char 'x' >> liftM readHex (many1toN 8 (satisfy isHexDigit)))+ (voidChar 'x' >> liftM readHex (many1toN 8 (satisfy isHexDigit))) (liftM read (many1toN 10 (satisfy isDigit))))) (liftM HTMLChar.EntityRef $ many1toN 10 (satisfy isAlphaNum))- char ';'+ voidChar ';' return [ent]) (emitWarning pos "Ill formed entity" >> return [HTMLChar.Unicode '&'])
src/Text/HTML/Tagchup/Process.hs view
@@ -24,7 +24,6 @@ import Control.Monad.Trans.State (State, put, get, evalState, ) import Data.Traversable (traverse, ) -import qualified Data.Char as Char import Data.List.HT (viewL, ) import Data.Maybe (fromMaybe, mapMaybe, ) import Control.Monad.HT ((<=<), )
tagchup.cabal view
@@ -1,5 +1,5 @@ Name: tagchup-Version: 0.4.0.1+Version: 0.4.0.2 License: GPL License-File: LICENSE Author: Henning Thielemann <tagchup@henning-thielemann.de>@@ -38,7 +38,7 @@ Source-Repository this Type: darcs Location: http://code.haskell.org/~thielema/tagchup/- Tag: 0.4.0.1+ Tag: 0.4.0.2 Flag buildExamples description: Build example executables@@ -55,7 +55,7 @@ transformers >=0.2 && <0.3, explicit-exception >=0.1 && <0.2, bytestring >=0.9.0.1 && <0.10,- containers >=0.1 && <0.4,+ containers >=0.1 && <0.5, data-accessor >=0.2 && <0.3, utility-ht >=0.0.1 && <0.1, base >=3 && <5@@ -80,6 +80,8 @@ Executable tagchuptest If !flag(buildTests) Buildable: False+ If impl(ghc >= 6.12)+ GHC-Options: -rtsopts GHC-Options: -Wall Hs-Source-Dirs: src, example Other-Modules: Text.HTML.Tagchup.Test