From 006b05fc061c0ce2fa0ce8b8c7f9361b0d64bb43 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 26 Jun 2012 13:35:31 -0400 Subject: [PATCH] Combine a few tests. --- src/LWN/Page.hs | 88 ++++++++++++++++++++++--------------------------- 1 file changed, 39 insertions(+), 49 deletions(-) diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs index 2499715..a4a56c2 100644 --- a/src/LWN/Page.hs +++ b/src/LWN/Page.hs @@ -117,38 +117,43 @@ parse xml = do else appr --- --- ArticlePage Stuff --- -ap_parse :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Page) -ap_parse xml = do - arts <- ap_parse_articles xml - case arts of - Just [x] -> return $ Just $ ArticlePage x - _ -> return Nothing -ap_parse_headline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) -ap_parse_headline xml = do +parse_headline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) +parse_headline xml = do let element_filter = xml >>> css "div.PageHeadline h1" let element_text_filter = element_filter /> getText element_text <- runX element_text_filter - return $ case element_text of - [x] -> Just $ strip x - [] -> Nothing - _ -> error "Found more than one headline." + return $ + case element_text of + [x] -> Just $ strip x + [] -> Nothing + _ -> error "Found more than one headline." -ap_parse_byline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) -ap_parse_byline xml = do - let element_filter = xml >>> css "div.Byline" + +parse_byline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) +parse_byline xml = do + let element_filter = xml >>> css "div.FeatureByLine" let element_text_filter = element_filter /> getText element_text <- runX element_text_filter - return $ case element_text of - [x] -> Just $ strip x - [] -> Nothing - _ -> error "Found more than one byline." + return $ + case element_text of + [x] -> Just $ strip x + [] -> Nothing + _ -> error "Found more than one article byline." +-- +-- ArticlePage Stuff +-- +ap_parse :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Page) +ap_parse xml = do + arts <- ap_parse_articles xml + case arts of + Just [x] -> return $ Just $ ArticlePage x + _ -> return Nothing + + ap_parse_body :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) ap_parse_body xml = do let element_filter = xml >>> css "div.ArticleText" @@ -162,8 +167,8 @@ ap_parse_body xml = do ap_parse_articles :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe [Article]) ap_parse_articles xml = do - parsed_headline <- ap_parse_headline xml - parsed_byline <- ap_parse_byline xml + parsed_headline <- parse_headline xml + parsed_byline <- parse_byline xml parsed_body <- ap_parse_body xml let title' = Title (fromJust parsed_headline) let byline' = Byline parsed_byline @@ -179,7 +184,7 @@ ap_parse_articles xml = do fp_parse :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Page) fp_parse xml = do - hl <- fp_parse_headline xml + hl <- parse_headline xml parsed_articles <- fp_parse_articles xml case parsed_articles of them@(_:_) -> return $ Just $ FullPage (fromJust hl) them @@ -187,28 +192,6 @@ fp_parse xml = do - -fp_parse_headline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) -fp_parse_headline xml = do - let element_filter = xml >>> css "div.PageHeadline h1" - let element_text_filter = element_filter /> getText - element_text <- runX element_text_filter - return $ case element_text of - [x] -> Just $ strip x - [] -> Nothing - _ -> error "Found more than one headline." - -fp_parse_article_byline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) -fp_parse_article_byline xml = do - let element_filter = xml >>> css "div.FeatureByLine" - let element_text_filter = element_filter /> getText - element_text <- runX element_text_filter - return $ case element_text of - [x] -> Just $ strip x - [] -> Nothing - _ -> error "Found more than one article byline." - - fp_parse_article_title :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) fp_parse_article_title xml = do let element_filter = xml >>> css "h2.SummaryHL" @@ -266,7 +249,7 @@ fp_parse_article_body xml = do fp_parse_article :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Article) fp_parse_article xml = do parsed_article_title <- fp_parse_article_title xml - parsed_article_byline <- fp_parse_article_byline xml + parsed_article_byline <- parse_byline xml parsed_article_body <- fp_parse_article_body xml let title' = Title $ fromJust parsed_article_title let byline' = Byline parsed_article_byline @@ -280,7 +263,7 @@ parse_html_article html = do -- | In the full page, all of the article titles and bodies are --- wrapped in a div.ArticleText. +-- wrapped in one big div.ArticleText. parse_bodies :: IOSArrow XmlTree (NTree XNode) -> IOSArrow XmlTree (NTree XNode) parse_bodies xml = xml >>> css "div.ArticleText" @@ -301,6 +284,8 @@ fp_parse_articles xml = do return just_articles +-- | This makes it easy to select otherwise-random chunks of html +-- using 'css'. wrap_in_body_div :: String -> String wrap_in_body_div s = "
" ++ s ++ "
" @@ -347,6 +332,11 @@ xhtml_to_epub epmd = + +-- +-- Tests +-- + test_preprocess_links :: Assertion test_preprocess_links = do actual_xml' <- runX $ (preprocess input_xml) >>> css "body" -- 2.44.2