[HtmlParser moved to haskell-ugly
David Fox **20071205142053] {
hunk ./HtmlParser.hs 1
-module HtmlParser
- ( parse
- ) where
-
-import qualified Text.XML.HaXml.Types as H
---import Text.XML.HaXml.Pretty
-import qualified Text.XML.HaXml.Html.Parse as H
-import qualified Text.XHtml.Transitional as X
-import System.IO.Unsafe
-import Control.Exception
-
-parse :: String -> X.Html
-parse text = unsafePerformIO (parseM text)
-
-parseM :: String -> IO X.Html
-parseM text =
- do
- -- The $! is required to force the parse error to occur before
- -- we test for it. That's why they call it "unsafe IO" I guess.
- result <- try (return $! (H.htmlParse "text" (addHtml text)))
- case result of
- Right doc -> return . X.toHtml . stripHtml $ doc
- Left _ -> return . X.stringToHtml $ text
- where addHtml x = "" ++ x ++ ""
- stripHtml (H.Document a b (H.Elem "html" _ [H.CElem content]) c) = H.Document a b content c
- stripHtml x = x
-
-instance X.HTML H.Document where
- toHtml (H.Document _ _ element _) =
- elementToHtml element
- where
- elementToHtml :: H.Element -> X.Html
- elementToHtml (H.Elem name [] []) = X.itag name
- elementToHtml (H.Elem name attrs []) = X.itag name X.! map attrsToHtml (attrs :: [(H.Name, H.AttValue)])
- elementToHtml (H.Elem name [] content) = X.tag name (X.concatHtml (map contentToHtml content))
- elementToHtml (H.Elem name attrs content) = X.tag name (X.concatHtml (map contentToHtml content)) X.! map attrsToHtml attrs
- attrsToHtml :: (H.Name, H.AttValue) -> X.HtmlAttr
- attrsToHtml (name, H.AttValue attValue) = X.strAttr name (concat (map attValueToString attValue))
- attValueToString (Left string) = string
- attValueToString (Right (H.RefEntity er)) = "&" ++ er ++ ";"
- attValueToString (Right (H.RefChar ch)) = "&#" ++ show ch ++ ";"
- contentToHtml :: H.Content -> X.Html
- contentToHtml (H.CElem element) = elementToHtml element
- contentToHtml (H.CString _bool chardata) = X.primHtml chardata
- contentToHtml (H.CRef (H.RefEntity er)) = X.primHtmlChar er
- contentToHtml (H.CRef (H.RefChar ch)) = X.primHtml ("#" ++ show ch)
- contentToHtml (H.CMisc (H.Comment _comment)) = X.noHtml
- contentToHtml (H.CMisc (H.PI (_pitarget, _string))) = X.noHtml
rmfile ./HtmlParser.hs
hunk ./HomePage.hs 23
-import qualified HtmlParser as H
+import qualified Ugly.HtmlParser as H
hunk ./Makefile 1
-homepage: Makefile Main.hs HomePage.hs Example.hs HtmlParser.hs
+homepage: Makefile Main.hs HomePage.hs Example.hs
}