wikipedia4epub 0.0.1 → 0.0.2
raw patch · 4 files changed
+210/−1 lines, 4 files
Files
- src/Network/Wikipedia.hs +78/−0
- src/Web/Firefox.hs +48/−0
- src/Wikipedia4epub/Commands.hs +78/−0
- wikipedia4epub.cabal +6/−1
+ src/Network/Wikipedia.hs view
@@ -0,0 +1,78 @@+module Network.Wikipedia ( isArticleURL+ , WikiArticle(..)+ , articleURL2Title+ , getArticleLinks+ , sanitizeArticle+ --, fetchPrintArticle+ --, fetchRawArticle+ , fetchArticle)+where+import Network.URL+import Network.URI+import Text.Regex.Posix+import Text.Regex.Base+import Network.HTTP+import Text.HTML.TagSoup+import Data.List (nub)+import Data.Maybe (catMaybes, mapMaybe, fromJust)++data WikiArticle = WikiArticleHTML { waTitle :: String, waContent :: String } + | WikiArticleSRC { waTitle :: String, waContent :: String } deriving (Show, Ord, Eq)++isArticleURL :: URL -> Bool+isArticleURL (URL (Absolute (Host (HTTP False) xs Nothing)) ph []) = (xs =~ ".*en[.]wikipedia.org$") && (ph =~ "wiki/[^:/]+$" )+isArticleURL _ = False++articleURL2Title :: URL -> String+articleURL2Title x | isArticleURL x = filter (/= '%') $ urlEncode $ tail $ dropWhile (/='/') (url_path x)+ | otherwise = ""++getArticleLinks :: WikiArticle -> [URL]+getArticleLinks xs = let inTags = parseTags (waContent xs)+ aTags = filter (isTagOpenName "a") inTags+ hrefs = map (fromAttrib "href") aTags + in mapMaybe importURL $ nub $ filter (=~ "^/wiki/[^:/]+$") hrefs+ +-- http://en.wikipedia.org/w/index.php?title=Computer&printable=yes+articleURL2PrintURL :: URL -> URL+articleURL2PrintURL xs | isArticleURL xs = URL (url_type xs) "w/index.php" [("title",articleURL2Title xs),("printable","yes")]+ | otherwise = xs++-- http://en.wikipedia.org/wiki/index.php?title=Psychology&action=raw+articleURL2RawURL :: URL -> URL+articleURL2RawURL xs | isArticleURL xs = URL (url_type xs) "w/index.php" [("title",articleURL2Title xs),("action","raw")]+ | otherwise = xs++sanitizeArticle :: WikiArticle -> WikiArticle+sanitizeArticle xs = let inTags = parseTags (waContent xs)+ outTags = processTags $ filterTags "img" $ filterTags "div" $ filterTags "link" $ filterTags "script" inTags+ in WikiArticleHTML (waTitle xs) (renderTags outTags)++processTags xs = map removeEmptyAttr xs+ where+ removeEmptyAttr t@(TagOpen s xs) | null s = t+ | head s == '!' = t+ | otherwise = TagOpen s (filter (not . null . snd) xs) + removeEmptyAttr t = t++filterTags tn [] = []+filterTags tn (x:xs) | isTagOpenName tn x = filterTags tn $ dropWhile (not . isTagCloseName tn) xs+ | isTagCloseName tn x = filterTags tn xs+ | otherwise = x:filterTags tn xs+{-+fetchPrintArticle :: URL -> IO WikiArticle+fetchPrintArticle xs = do+ contents <- getResponseBody =<< simpleHTTP (getRequest (exportURL (articleURL2PrintURL xs)))+ return (WikiArticleHTML (articleURL2Title xs) contents)++fetchRawArticle :: URL -> IO WikiArticle+fetchRawArticle xs = do+ contents <- getResponseBody =<< simpleHTTP (getRequest (exportURL (articleURL2RawURL xs)))+ return (WikiArticleSRC (articleURL2Title xs) contents)+-}++fetchArticle :: URL -> IO WikiArticle+fetchArticle xs = do+ rsp <- Network.HTTP.simpleHTTP (getRequest (exportURL xs))+ contents <- (getResponseBody rsp)+ return (WikiArticleHTML (articleURL2Title xs) contents)
+ src/Web/Firefox.hs view
@@ -0,0 +1,48 @@+module Web.Firefox (listPlacesFiles, listHistoryURLs, listAllHistoryURLs) +where+import Database.HDBC (disconnect, fromSql, quickQuery')+import Database.HDBC.Sqlite3 (connectSqlite3, setBusyTimeout)+import Network.URL (importURL, URL)+import Data.List (isSuffixOf)+import Control.Monad (forM)+import Data.Maybe (catMaybes, mapMaybe)+import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory)+import System.FilePath ((</>))++firefoxDirs = [ ".mozilla" ]+placesFile = "places.sqlite"+timeoutFox = 5++listPlacesFiles :: IO [FilePath]+listPlacesFiles = do+ homeDir <- getHomeDirectory+ xs <- mapM (getRecursiveContents . (homeDir </>)) firefoxDirs+ return $ filter (placesFile `isSuffixOf`) (concat xs)++listAllHistoryURLs :: IO [URL]+listAllHistoryURLs = do+ putStrLn $ "Please close your Firefox if you see this message longer than "++show timeoutFox++" seconds..."+ places <- listPlacesFiles + xs <- mapM listHistoryURLs places+ return $ concat xs++listHistoryURLs :: FilePath -> IO [URL]+listHistoryURLs name = do+ putStrLn $ "Going to connect on Firefox SQLite DB: " ++ name+ conn <- connectSqlite3 name+ setBusyTimeout conn (1000*timeoutFox)+ xs <- quickQuery' conn "select url from moz_places order by last_visit_date desc" []+ let ys = map (fromSql . head) xs :: [String]+ return $ mapMaybe importURL ys++getRecursiveContents :: FilePath -> IO [FilePath]+getRecursiveContents topdir = do+ names <- getDirectoryContents topdir+ let properNames = filter (`notElem` [".", ".."]) names+ paths <- forM properNames $ \name -> do+ let path = topdir </> name+ isDirectory <- doesDirectoryExist path+ if isDirectory+ then getRecursiveContents path+ else return [path]+ return (concat paths)
+ src/Wikipedia4epub/Commands.hs view
@@ -0,0 +1,78 @@+module Wikipedia4epub.Commands where+import Network.Wikipedia+import Web.Firefox+import System.FilePath+import System.Directory+import Network.URL+import Control.Monad (liftM)+import Data.List (nub, foldl')+import Data.Char (isLetter)+import System.IO+import Codec.EBook+import qualified Data.ByteString.Lazy as B++wiki4e_fetchArticle :: FilePath -> URL -> IO ()+wiki4e_fetchArticle oud x = do+ e <- doesFileExist filename+ if not e then do+ putStrLn $ "Fetching : " ++ exportURL x+ (WikiArticleHTML t c) <- fetchArticle x+ withBinaryFile filename WriteMode (flip hPutStr c)+ else putStrLn $ "File already exists. Skipping download: " ++ filename+ where+ filename = oud </> title+ title = articleURL2Title x++wiki4e_fetchArticles :: FilePath -> [URL] -> IO ()+wiki4e_fetchArticles oud xs = mapM_ (wiki4e_fetchArticle oud) xs++wiki4e_fetchArticleTree :: String -> Int -> IO ()+wiki4e_fetchArticleTree xs l = undefined++wiki4e_sanitizeArticle :: FilePath -> FilePath -> IO ()+wiki4e_sanitizeArticle inf ouf = withFile inf ReadMode (\hi -> do+ hSetEncoding hi utf8+ withFile ouf WriteMode (\ho -> do + hSetEncoding ho utf8+ c <- hGetContents hi+ let a = sanitizeArticle $ WikiArticleHTML "" c+ hPutStr ho $ waContent a+ )+ )++wiki4e_sanitizeArticles :: FilePath -> FilePath -> IO ()+wiki4e_sanitizeArticles ind oud = wiki4e_listFiles ind >>= + mapM_ (\x -> wiki4e_sanitizeArticle (ind </> x) (oud </> x))++wiki4e_listFiles :: FilePath -> IO [FilePath]+wiki4e_listFiles = liftM (filter (\(c:_) -> c /= '.')) . getDirectoryContents++wiki4e_createEpub :: String -> FilePath -> IO ()+wiki4e_createEpub bookName srcDir = do+ xs <- wiki4e_listFiles srcDir+ let book = emptyBook { + bookID = "http://localhost/"++bookName,+ bookAuthor = "wiki4e-firefox-epub",+ bookTitle = bookName+ }+ let fileNames = map (srcDir </>) xs+ items <- mapM (loadArticleFile "wiki") fileNames+ let bookFull = foldl' addItem2Book book items+ let epubFName = bookName++".epub"+ outdata <- book2Bin' bookFull+ B.writeFile epubFName outdata+ putStrLn $ epubFName ++ " constructed."++loadArticleFile :: FilePath -> FilePath -> IO BookItem+loadArticleFile bookDir fname = do+ cs <- B.readFile fname+ return (BookItem aid bfile cs opsMediatype (Just (ChapterMetadata name))) + where+ aid = filter isLetter name + bfile = bookDir </> name+ name = takeFileName $ normalise fname++wiki4e_listFirefoxURLs :: IO [URL]+wiki4e_listFirefoxURLs = do+ xs <- listAllHistoryURLs+ return $ nub $ filter isArticleURL xs
wikipedia4epub.cabal view
@@ -1,5 +1,5 @@ Name: wikipedia4epub-Version: 0.0.1+Version: 0.0.2 License: BSD3 License-File: LICENSE Homepage: http://rampa.sk/static/wikipedia4epub.html@@ -44,6 +44,11 @@ Hs-Source-Dirs: src Extensions: CPP, PatternGuards Ghc-Options: -Wall -fno-warn-orphans++ Exposed-modules:+ Wikipedia4epub.Commands+ Network.Wikipedia+ Web.Firefox Executable wiki4e-firefox-epub Hs-Source-Dirs: src