html-truncate (empty) → 0.3.0.0
raw patch · 4 files changed
+125/−0 lines, 4 filesdep +basedep +tagsoupsetup-changed
Dependencies added: base, tagsoup
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Text/HTML/Truncate.hs +71/−0
- html-truncate.cabal +22/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Marcel Ruegenberg++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Marcel Ruegenberg nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/HTML/Truncate.hs view
@@ -0,0 +1,71 @@+module Text.HTML.Truncate(truncateHtml,truncateHtml',truncateStringLike) where++import qualified Text.HTML.TagSoup as TS+import qualified Text.StringLike as SL+import Data.Char(isSpace)+import Data.List(dropWhileEnd)++{- +Roughly, the algorithm works like this:+1. Parse the HTML to a list of tags+2. Walk through those tags. If a tag with actual text content is encountered,+ truncate it. + If the text was not long enough to result in actually anything being truncated, keep going and truncate less the in the next tag that is encountered.+ Otherwise, just close all open tags and remove all remaining text in them.+3. Remove trailing empty tags+-}++-- | Truncate HTML, and ensure that tags are closed; Remove trailing empty tags+truncateHtml :: SL.StringLike str => Int -> str -> str+truncateHtml n txt = snd $ truncateHtml' n txt++truncateHtml' :: SL.StringLike str => Int -> str -> (Int,str)+truncateHtml' n txt = fmap (TS.renderTags . removeTrailingEmptyTags) $ go n 0 (TS.parseTags txt)+ where+ removeTrailingEmptyTags = removeTrailingEmptyTags' [] . reverse+ removeTrailingEmptyTags' accm (t@(TS.TagClose _) : ts) = removeTrailingEmptyTags' (t : accm) ts+ removeTrailingEmptyTags' accm (t@(TS.TagOpen _ _) : ts) = removeTrailingEmptyTags' (delCloseTag accm) ts+ removeTrailingEmptyTags' accm (t@(TS.TagText _) : ts) = reverse (t : ts) ++ accm+ removeTrailingEmptyTags' accm (t : ts) = removeTrailingEmptyTags' (t : accm) ts+ removeTrailingEmptyTags' accm [] = accm+ + delCloseTag (t@(TS.TagClose _) : ts) = ts+ delCloseTag (t : ts) = t : delCloseTag ts+ delCloseTag [] = []+ + go :: (SL.StringLike str) + => Int -- ^The number of remaining characters to truncate+ -> Int -- ^The number of open tags+ -> [TS.Tag str] -- ^The remaining tags to walk through+ -> (Int,[TS.Tag str])+ go c openTags _ | c <= 0 && openTags <= 0 = (0,[]) -- we're done. Nothing to truncate, nothing to close+ go i _ [] = (i,[])+ + go 0 openTags (t@(TS.TagOpen _ _) : ts) = go 0 (openTags + 1) ts+ go c openTags (t@(TS.TagOpen _ _) : ts) = fmap (t :) (go c (openTags + 1) ts)+ + go 0 openTags (t@(TS.TagClose _) : ts) = go 0 (openTags - 1) ts+ go c openTags (t@(TS.TagClose _) : ts) = fmap (t :) (go c (openTags - 1) ts)+ + go 0 openTags ((TS.TagText str) : ts) = go 0 openTags ts+ go c openTags (t@(TS.TagText str) : ts) = case truncateStringLike c str of+ (c', str') -> fmap ((TS.TagText str') :) (go (max 0 c') openTags ts)+ + go c openTags (t : ts) = fmap (t :) (go c openTags ts)+ +-- | Truncate to full words. If actual truncation occured, remove the last (usually cut-off) word, then remove trailing whitespace.+-- | Returns the truncated string and the number of characters that remain to be truncated+truncateStringLike :: SL.StringLike str => Int -> str -> (Int, str)+truncateStringLike c t = case truncateStringLike' c t of+ (0, t') -> (0, dropWhileEndSL isSpace $ dropWhileEndSL (not . isSpace) $ t')+ other -> other+ +truncateStringLike' :: SL.StringLike str => Int -> str -> (Int, str)+truncateStringLike' 0 t = (0, SL.empty)+truncateStringLike' c t = case SL.uncons t of+ Nothing -> (c, t)+ Just (char, rest) -> fmap (SL.cons char) (truncateStringLike (c - 1) rest)+ +-- note: could be optimized for double applications of this.+dropWhileEndSL :: SL.StringLike a => (Char -> Bool) -> a -> a+dropWhileEndSL p = SL.fromString . (dropWhileEnd p) . SL.toString
+ html-truncate.cabal view
@@ -0,0 +1,22 @@+-- Initial html-truncate.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: html-truncate+version: 0.3.0.0+synopsis: A HTML truncator+description: This package provides a simple function to truncate HTML in text form. It preserves tags open and close tags, prevents cut-off words and removes trailing empty tags.+homepage: https://github.com/mruegenberg/html-truncate+license: BSD3+license-file: LICENSE+author: Marcel Ruegenberg+-- maintainer: +-- copyright: +category: Text+build-type: Simple+cabal-version: >=1.8++library+ exposed-modules: Text.HTML.Truncate+ -- other-modules: + build-depends: base >= 4 && < 5+ , tagsoup >= 0.10