packages feed

tagsoup 0.8 → 0.9

raw patch · 12 files changed

+52/−69 lines, 12 files

Files

Main.hs view
@@ -6,7 +6,6 @@ import TagSoup.Test import TagSoup.Benchmark import Data.Char(toLower)-import Text.HTML.TagSoup -- just to make it easier to use in GHCi   helpMsg :: IO ()
TagSoup/Benchmark.hs view
@@ -7,9 +7,6 @@ import Control.Monad import Data.List import Data.Maybe-import Data.Char-import System.CPUTime-import System.IO import System.IO.Unsafe(unsafeInterleaveIO) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS
TagSoup/Sample.hs view
@@ -6,8 +6,6 @@  import Data.Char import Data.List-import Data.Maybe-import System.IO   openItem :: String -> IO String
TagSoup/Test.hs view
@@ -6,7 +6,6 @@ import Text.HTML.TagSoup.Entity import Text.HTML.TagSoup.Match -import Control.Exception import Control.Monad import Data.List import Test.QuickCheck@@ -42,6 +41,7 @@  test :: IO () test = runTest $ do+    warnTests     parseTests     optionsTests     renderTests@@ -117,6 +117,12 @@     parseTags "hello &haskell; world" === [TagText "hello &haskell; world"]     parseTags "hello \n\t world" === [TagText "hello \n\t world"]     parseTags "<a href=http://www.google.com>" === [TagOpen "a" [("href","http://www.google.com")]]+    parseTags "<foo bar=\"bar&#54;baz\">" === [TagOpen "foo" [("bar","bar6baz")]]+    parseTags "<foo bar=\"bar&amp;baz\">" === [TagOpen "foo" [("bar","bar&baz")]]+    parseTags "hey &how are you" === [TagText "hey &how are you"]+    parseTags "hey &how; are you" === [TagText "hey &how; are you"]+    parseTags "hey &amp are you" === [TagText "hey & are you"]+    parseTags "hey &amp; are you" === [TagText "hey & are you"]      -- real cases reported by users     parseTags "<a href=\"series.php?view=single&ID=72710\">" === [TagOpen "a" [("href","series.php?view=single&ID=72710")]]@@ -174,6 +180,7 @@     rp "<?xml foo?>" === "<?xml foo ?>"     rp "<?xml foo?>" === "<?xml foo ?>"     rp "<!-- neil -->" === "<!-- neil -->"+    escapeHTML "this is a &\" <test>" === "this is a &amp;&quot; &lt;test&gt;"     check $ \(HTML x) -> let y = rp x in rp y == (y :: String)      @@ -205,15 +212,6 @@  warnTests :: Test () warnTests = do-    return ()-{--    -- TODO: Check that when there is a warning, it shows up at the right place-    warns "neil &foo bar" = missing ;-    let parse = parseTagsOptions parseOptions{-    let noWarn x = -    -    -    -        {optTagPosition :: Bool -- ^ Should 'TagPosition' values be given before some items (default=False,fast=False)-        ,optTagWarning :: Bool  -- ^ Should 'TagWarning' values be given (default=False,fast=False)--}+    let p = parseTagsOptions parseOptions{optTagPosition=True,optTagWarning=True}+        wt x = [(msg,c) | TagWarning msg:TagPosition _ c:_ <- tails $ p x]+    wt "neil &foo bar" === [("Unknown entity: foo",10)]
Text/HTML/TagSoup/Implementation.hs view
@@ -2,7 +2,6 @@  module Text.HTML.TagSoup.Implementation where -import Data.List import Text.HTML.TagSoup.Type import Text.HTML.TagSoup.Options import Text.StringLike as Str@@ -16,19 +15,18 @@  data Out     = Char Char-    | Tag          -- <-    | TagShut      -- </+    | Tag             -- <+    | TagShut         -- </     | AttName     | AttVal-    | TagEnd       -- >-    | TagEndClose  -- />-    | Comment      -- <!---    | CommentEnd   -- -->-    | Entity       -- &-    | EntityNum    -- &#-    | EntityHex    -- &#x-    | EntityEnd    -- ;-    | EntityEndAtt -- missing the ; and in an attribute+    | TagEnd          -- >+    | TagEndClose     -- />+    | Comment         -- <!--+    | CommentEnd      -- -->+    | EntityName      -- &+    | EntityNum       -- &#+    | EntityHex       -- &#x+    | EntityEnd Bool  -- Attributed followed by ; for True, missing ; for False     | Warn String     | Pos Position       deriving (Show,Eq)@@ -98,9 +96,9 @@                   (z,b) = atts y         go x | isComment x = pos x $ TagComment a : go (skip isCommentEnd y)             where (y,a) = charsStr $ next x-        go x | isEntity x = poss x ((if optTagWarning then id else filter (not . isTagWarning)) $ optEntityData a) ++ go (skip isEntityEnd y) +        go x | isEntityName x = poss x ((if optTagWarning then id else filter (not . isTagWarning)) $ optEntityData (a, getEntityEnd y)) ++ go (skip isEntityEnd y)              where (y,a) = charsStr $ next x-        go x | isEntityChr x = pos x $ TagText (fromChar $ entityChr x a) : go (skip isEntityEnd y)+        go x | isEntityNumHex x = pos x $ TagText (fromChar $ entityChr x a) : go (skip isEntityEnd y)             where (y,a) = chars $ next x         go x | Just a <- fromWarn x = if optTagWarning then pos x $ TagWarning (fromString a) : go (next x) else go (next x)         go x | isEof x = []@@ -122,14 +120,14 @@         charss :: Bool -> ((Position,[Tag str]),[Out]) -> ( ((Position,[Tag str]),[Out]) , String)         charss t x | Just a <- fromChr x = (y, a:b)             where (y,b) = charss t (next x)-        charss t x | t, isEntity x = second (toString n ++) $ charss t $ addWarns m z+        charss t x | t, isEntityName x = second (toString n ++) $ charss t $ addWarns m z             where (y,a) = charsStr $ next x-                  b = not $ isEntityEndAtt y-                  z = if b then skip isEntityEnd y else next y+                  b = getEntityEnd y+                  z = skip isEntityEnd y                   (n,m) = optEntityAttrib (a,b)-        charss t x | t, isEntityChr x = second (entityChr x a:) $ charss t z+        charss t x | t, isEntityNumHex x = second (entityChr x a:) $ charss t z             where (y,a) = chars $ next x-                  (z,b) = charss t $ if isEntityEnd y then next y else skip isEntityEndAtt y+                  z = skip isEntityEnd y         charss t ((_,w),Pos p:xs) = charss t ((p,w),xs)         charss t x | Just a <- fromWarn x = charss t $ (if optTagWarning then addWarns [TagWarning $ fromString a] else id) $ next x         charss t x = (x, [])@@ -157,16 +155,17 @@ isTagEndClose (_,TagEndClose{}:_) = True; isTagEndClose _ = False isComment (_,Comment{}:_) = True; isComment _ = False isCommentEnd (_,CommentEnd{}:_) = True; isCommentEnd _ = False-isEntity (_,Entity{}:_) = True; isEntity _ = False-isEntityChr (_,EntityNum{}:_) = True; isEntityChr (_,EntityHex{}:_) = True; isEntityChr _ = False+isEntityName (_,EntityName{}:_) = True; isEntityName _ = False+isEntityNumHex (_,EntityNum{}:_) = True; isEntityNumHex (_,EntityHex{}:_) = True; isEntityNumHex _ = False isEntityNum (_,EntityNum{}:_) = True; isEntityNum _ = False isEntityHex (_,EntityHex{}:_) = True; isEntityHex _ = False isEntityEnd (_,EntityEnd{}:_) = True; isEntityEnd _ = False-isEntityEndAtt (_,EntityEndAtt{}:_) = True; isEntityEndAtt _ = False isWarn (_,Warn{}:_) = True; isWarn _ = False  fromChr (_,Char x:_) = Just x ; fromChr _ = Nothing fromWarn (_,Warn x:_) = Just x ; fromWarn _ = Nothing++getEntityEnd (_,EntityEnd b:_) = b   -- Merge all adjacent TagText bits
Text/HTML/TagSoup/Options.hs view
@@ -12,7 +12,7 @@ data ParseOptions str = ParseOptions     {optTagPosition :: Bool -- ^ Should 'TagPosition' values be given before some items (default=False,fast=False)     ,optTagWarning :: Bool  -- ^ Should 'TagWarning' values be given (default=False,fast=False)-    ,optEntityData :: str -> [Tag str] -- ^ How to lookup an entity+    ,optEntityData :: (str,Bool) -> [Tag str] -- ^ How to lookup an entity (Bool = has ending @';'@)     ,optEntityAttrib :: (str,Bool) -> (str,[Tag str]) -- ^ How to lookup an entity in an attribute (Bool = has ending @';'@?)     ,optTagTextMerge :: Bool -- ^ Require no adjacent 'TagText' values (default=True,fast=False)     }@@ -23,13 +23,10 @@ parseOptions :: StringLike str => ParseOptions str parseOptions = ParseOptions False False entityData entityAttrib True     where-        entityData x = case lookupEntity y of-            Just y -> [TagText $ fromChar y]-            Nothing -> [TagText $ fromString $ "&" ++ y ++ ";"-                       ,TagWarning $ fromString $ "Unknown entity: " ++ y]-            where y = toString x+        entityData x = TagText a : b+            where (a,b) = entityAttrib x -        entityAttrib (x,b) = case lookupEntity y of+        entityAttrib ~(x,b) = case lookupEntity y of             Just y -> (fromChar y, [])             Nothing -> (fromString $ "&" ++ y ++ [';'|b], [TagWarning $ fromString $ "Unknown entity: " ++ y])             where y = toString x@@ -44,7 +41,7 @@ fmapParseOptions :: (StringLike from, StringLike to) => ParseOptions from -> ParseOptions to fmapParseOptions (ParseOptions a b c d e) = ParseOptions a b c2 d2 e     where-        c2 x = map (fmap castString) $ c $ castString x-        d2 (x,y) = (castString r, map (fmap castString) s)+        c2 ~(x,y) = map (fmap castString) $ c (castString x, y)+        d2 ~(x,y) = (castString r, map (fmap castString) s)             where (r,s) = d (castString x, y)
Text/HTML/TagSoup/Parser.hs view
@@ -6,7 +6,6 @@  import Text.HTML.TagSoup.Type import Text.HTML.TagSoup.Options-import Text.StringLike import qualified Text.HTML.TagSoup.Generated as Gen
Text/HTML/TagSoup/Render.hs view
@@ -5,7 +5,7 @@  module Text.HTML.TagSoup.Render     (-    renderTags, renderTagsOptions,+    renderTags, renderTagsOptions, escapeHTML,     RenderOptions(..), renderOptions     ) where @@ -26,17 +26,16 @@     }  --- | The default render options value, described in 'RenderOptions'.-renderOptions :: StringLike str => RenderOptions str-renderOptions = RenderOptions-        (\x -> fromString $ concatMap esc1 $ toString x)-        (\x -> toString x == "br")+-- | Replace the four characters @&\"\<\>@ with their HTML entities.+escapeHTML :: StringLike str => str -> str+escapeHTML = fromString . concatMap esc1 . toString     where esc = IntMap.fromList [(b, "&"++a++";") | (a,b) <- htmlEntities]           esc1 x = IntMap.findWithDefault [x] (ord x) esc  -fmapRenderOptions :: (StringLike a, StringLike b) => RenderOptions a -> RenderOptions b-fmapRenderOptions (RenderOptions x y) = RenderOptions (castString . x . castString) (y . castString)+-- | The default render options value, described in 'RenderOptions'.+renderOptions :: StringLike str => RenderOptions str+renderOptions = RenderOptions escapeHTML (\x -> toString x == "br")   -- | Show a list of tags, as they might have been parsed, using the default settings given in
Text/HTML/TagSoup/Specification.hs view
@@ -288,18 +288,18 @@  charRefNum3 resume hex S{..} = pos $ case hd of     _ | hexChar hex hd -> hd & charRefNum3 resume hex tl-    ';' -> EntityEnd & resume tl-    _ -> errWant ";" & EntityEnd & resume s+    ';' -> EntityEnd True & resume tl+    _ -> EntityEnd False & errWant ";" & resume s  charRefAlpha resume att S{..} = pos $ case hd of-    _ | isAlpha hd -> Entity & hd & charRefAlpha2 resume att tl+    _ | isAlpha hd -> EntityName & hd & charRefAlpha2 resume att tl     _ -> errSeen "&" & '&' & resume s  charRefAlpha2 resume att S{..} = pos $ case hd of     _ | alphaChar hd -> hd & charRefAlpha2 resume att tl-    ';' -> EntityEnd & resume tl-    _ | att -> EntityEndAtt & resume s-    _ -> errWant ";" & EntityEnd & resume s+    ';' -> EntityEnd True & resume tl+    _ | att -> EntityEnd False & resume s+    _ -> EntityEnd False & errWant ";" & resume s   alphaChar x = isAlphaNum x || x `elem` ":-_"
Text/HTML/TagSoup/Type.hs view
@@ -19,7 +19,6 @@     ) where  -import Data.Char import Data.List import Data.Maybe import Text.StringLike
Text/StringLike.hs view
@@ -6,8 +6,6 @@ --   TagSoup to work with String (list of Char), ByteString.Char8 and ByteString.Lazy.Char8. module Text.StringLike where -import Data.List-import Data.Maybe import Data.Typeable  import qualified Data.ByteString.Char8 as BS
tagsoup.cabal view
@@ -1,6 +1,6 @@ cabal-version:  >= 1.6 name:           tagsoup-version:        0.8+version:        0.9 copyright:      Neil Mitchell 2006-2010 author:         Neil Mitchell <ndmitchell@gmail.com> maintainer:     Neil Mitchell <ndmitchell@gmail.com>