+-- | Stolen from writeEPUB.
+default_stylesheet :: IO String
+default_stylesheet =
+ -- This comes with Pandoc, I guess.
+ readDataFile (writerUserDataDir defaultWriterOptions) "epub.css"
+
+
+construct_stylesheet :: IO String
+construct_stylesheet = do
+ defaults <- default_stylesheet
+ -- Allow word-wrapping in <pre> elements.
+ let my_additions = "\n" ++ "pre { white-space: pre-wrap; }" ++ "\n"
+ return $ defaults ++ my_additions
+
+page_from_url :: Cfg -> URL -> IO (Maybe Page)
+page_from_url cfg url = do
+ contents <- get_article_contents cfg url
+ case (xml_from_contents contents) of
+ Just html -> parse cfg html
+ Nothing -> return Nothing
+
+
+
+insert_full_stories :: (ArrowXml a) => StoryMap -> a XmlTree XmlTree
+insert_full_stories story_map =
+ processTopDown (article_xml `when` full_story_paragraph)
+ where
+ lookup_func :: (ArrowXml a) => URL -> a XmlTree XmlTree
+ lookup_func href =
+ case Map.lookup href story_map of
+ -- Drop the paragraph if we don't have the contents.
+ Nothing -> none
+ Just v -> to_xml v
+
+ article_xml :: (ArrowXml a) => a XmlTree XmlTree
+ article_xml =
+ lookup_func
+ $< -- From HXT's Control.Arrow.ArrowList
+ (this /> full_story_link >>> getAttrValue "href")
+
+replace_remote_img_srcs :: (ArrowXml a) => ImageMap -> a XmlTree XmlTree
+replace_remote_img_srcs image_map =
+ processTopDown (make_srcs_local `when` is_image)
+ where
+ -- old_src -> new_src
+ change_src_func :: String -> String
+ change_src_func old_src =
+ case Map.lookup old_src image_map of
+ -- Leave it alone if we don't have the file locally
+ Nothing -> old_src
+ Just v -> v
+
+ change_src :: (ArrowXml a) => a XmlTree XmlTree
+ change_src =
+ changeAttrValue change_src_func
+
+ make_srcs_local :: (ArrowXml a) => a XmlTree XmlTree
+ make_srcs_local =
+ processAttrl $ (change_src `when` (hasName "src"))
+
+
+