改行をBRタグに置き換える
Posted feedbacks - Haskell
テストケースがあるといいですねぇ。 Tag Soup ライブラリをつかってます #2757にすこし手を入れたものです
see: Tag Soup
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | module Main (main) where
import Data.Char
import Data.List
import Data.Maybe
import Text.HTML.TagSoup
-- Parsing
-- Text.HTML.TagSoup.parseTags :: String -> [Tag Char]
-- Translating
translate :: [Tag Char] -> [Tag Char]
translate = concatMap trans
trans :: Tag Char -> [Tag Char]
trans tag = case tag of
TagOpen t attrs | ignore t -> [escapeTagOpen t attrs]
| otherwise -> [TagOpen t (filterAttr t attrs)]
TagClose t | ignore t -> [escapeTagClose t]
TagText s -> concat $ intersperse [TagOpen "br" [], TagClose "br"]
$ map ((:[]) . TagText) $ lines s
_ -> [tag]
ignore :: String -> Bool
ignore = flip notElem (map fst filterTable) . map toLower
escapeTagOpen t attrs
= TagText $ "<"++t++escape (' ':unwords (map showAttr attrs))++">"
escapeTagClose t
= TagText $ "</"++t++">"
filterAttr :: String -> [Attribute Char] -> [Attribute Char]
filterAttr t = filter ((maybe (const True) id (lookup t filterTable)) . fst)
filterTable :: [(String,String->Bool)]
filterTable = [("a",flip elem ["href","name"])
,("strong",const False)
,("br",const False)]
-- Showing
showTags :: [Tag Char] -> String
showTags [] = ""
showTags (TagOpen s [] : TagClose e : ts) | isEmptyTag s && s == e
= angle (s ++"/")++showTags ts
showTags (TagOpen s attrs : TagClose e : ts) | isEmptyTag s && s == e
= angle (s ++ ' ':unwords (map showAttr attrs)++"/")++showTags ts
showTags (TagOpen s [] : ts) | isEmptyTag s
= angle (s ++"/")++showTags ts
showTags (TagOpen s attrs : ts) | isEmptyTag s
= angle (s ++ ' ':unwords (map showAttr attrs)++"/")++showTags ts
showTags (t:ts)
= showTag t ++ showTags ts
showTag tag = case tag of
TagOpen t attrs -> angle $ t ++ ' ':unwords (map showAttr attrs)
TagClose t -> angle $ t ++ "/"
TagText s -> s
TagComment c -> angle $ "!--" ++ c ++ "--"
TagSpecial s t -> angle $ "!" ++ s ++ ' ':t
TagWarning s -> ""
angle :: String -> String
angle s = "<"++s++">"
isEmptyTag :: String -> Bool
isEmptyTag = flip elem ["br","hr"] -- not full fledged
showAttr :: Attribute Char -> String
showAttr (a,v) = a ++ "=" ++ q v
where q v = if elem sq v then dq:v++[dq]
else sq:v++[sq]
sq = '\''
dq = '\"'
escape :: String -> String
escape = concatMap esc
where esc '<' = "<"
esc '>' = ">"
esc '&' = "&"
esc c = [c]
--
main :: IO ()
main = do { putStrLn . showTags . translate . parseTags $ testdata1
; putStrLn . showTags . translate . parseTags $ testdata2
; putStrLn . showTags . translate . parseTags $ testdata3
; putStrLn . showTags . translate . parseTags $ testdata4
}
testdata1 = "<script foo=\"<script>alert('bar')</script>\">alert('foo')</script>"
testdata2 = "<script foo=\"<a href='link'>link</a>\">alert('foo')</script>"
testdata3 = "<a href='www.g>oogle.com'>link</a>"
testdata4 = "<a\n href='www.google.com'>link<!-- comment --></a> This<br> is an\n example."
{-
*Main> :main
<script foo="<script>alert('bar')</script>">alert('foo')</script>
<script foo="<a href='link'>link</a>">alert('foo')</script>
<a href='www.g>oogle.com'>link<a/>
<a href='www.google.com'>link<!-- comment --><a/> This <br/> is an<br/> example.
-}
|
にしお
#3413()
Rating-2/2=-1.00
また、ユーザの入力注の<br>は<br/>に変換してください。
このお題はperezvonさんの提案を元にした三部作の二問目です。ご協力ありがとうございました。
[ reply ]