wikipedia4epub 0.0.10 → 0.0.12
raw patch · 8 files changed
+29/−188 lines, 8 filesdep −Cabaldep −HDBCdep −HDBC-sqlite3
Dependencies removed: Cabal, HDBC, HDBC-sqlite3, ghc
Files
- src/Network/Wikipedia.hs +14/−16
- src/Web/Firefox.hs +0/−59
- src/Wiki4e/Commands/Articles.hs +1/−1
- src/Wiki4e/Commands/Common.hs +6/−5
- src/wiki4e-mkepub-cache.hs +0/−46
- src/wiki4e-mkepub-firefox.hs +0/−44
- src/wiki4e-mkepub-subtree.hs +4/−1
- wikipedia4epub.cabal +4/−16
src/Network/Wikipedia.hs view
@@ -17,10 +17,8 @@ import System.FilePath import Data.List (nub) import Data.Maybe (mapMaybe, fromJust)-import Data.Either import Data.Char import qualified Data.ByteString.Lazy.Char8 as BC-import qualified Data.ByteString.Lazy as ByteString import qualified Codec.Compression.GZip as GZip data WikiArticle = WikiArticleHTML { waTitle :: String, waContent :: String } @@ -33,17 +31,16 @@ | otherwise = '_' isArticleURL :: URL -> Bool-isArticleURL (URL (Absolute (Host (HTTP False) xs Nothing)) ph []) = (xs =~ ".*en[.]wikipedia.org$") && (ph =~ "wiki/[^/]+$" )+isArticleURL (URL (Absolute (Host (HTTP False) xs Nothing)) ph []) = (xs =~ ".*[.]wikipedia.org") && (ph =~ "wiki/.*") isArticleURL _ = False articleURL2Title :: URL -> String-articleURL2Title x | isArticleURL x = sanitizeFileName (takeFileName (url_path x))- | otherwise = ""+articleURL2Title x = sanitizeFileName (takeFileName (url_path x)) articleRelURL2Title :: String -> String articleRelURL2Title ('#':xs) = '#':xs-articleRelURL2Title x = case importURL ("http://en.wikipedia.org"++x) of - Nothing -> ""+articleRelURL2Title x = case importURL ("http://en.wikipedia.org/"++x) of + Nothing -> error $ "Invalid article relative path: "++x Just u -> articleURL2Title u isArticleImgURL :: String -> Bool@@ -61,10 +58,11 @@ hrefs = map (fromAttrib "href") aTags in mapMaybe importURL $ nub $ filter (=~ "^/wiki/[^:/]+$") hrefs -getArticleLinksAbs :: WikiArticle -> [URL]-getArticleLinksAbs xs = let ys = getArticleLinks xs- toAbsURL (URL _ path params) = (URL (Absolute (Host (HTTP False) "en.wikipedia.org" Nothing)) path params)- in map toAbsURL ys+getArticleLinksAbs :: String -> WikiArticle -> [URL]+getArticleLinksAbs domain xs = map toAbsURL ys+ where+ ys = getArticleLinks xs+ toAbsURL (URL _ path params) = (URL (Absolute (Host (HTTP False) domain Nothing)) path params) -- http://en.wikipedia.org/w/index.php?title=Computer&printable=yes {-@@ -86,14 +84,14 @@ processTags alnk xs = procHrefTags alnk $ procImgTags $ map processAttrs xs where- processAttrs t@(TagOpen "div" _) = TagText ""- processAttrs t@(TagClose "div") = TagText ""+ processAttrs (TagOpen "div" _) = TagText ""+ processAttrs (TagClose "div") = TagText "" processAttrs t@(TagOpen s ys) | null s = t | head s == '!' = t | otherwise = TagOpen s (removeStyleAttr $ removeEmptyAttr ys) processAttrs t = t- removeEmptyAttr xs = filter (not . null . snd) xs - removeStyleAttr xs = filter (\x -> (fst x) `notElem` ["style", "class"]) xs+ removeEmptyAttr = filter (not . null . snd)+ removeStyleAttr = filter (\x -> (fst x) `notElem` ["style", "class"]) filterAllTags tgs xs = filter (not . isTagComment) $ foldr (filterTags) xs tgs @@ -101,7 +99,7 @@ isTagComment (TagComment _) = True isTagComment _ = False -filterTags tn [] = []+filterTags _ [] = [] 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
− src/Web/Firefox.hs
@@ -1,59 +0,0 @@-module Web.Firefox (listPlacesFiles, listHistoryURLs, listAllHistoryURLs) -where-import Database.HDBC (fromSql, quickQuery')-import Database.HDBC.Sqlite3 (connectSqlite3, setBusyTimeout)-import Network.URL (importURL, URL)-import Data.List (isSuffixOf)-import Control.Monad (forM)-import Data.Maybe (mapMaybe)-import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, getTemporaryDirectory, copyFile, removeFile)-import System.FilePath ((</>))--firefoxDirs :: [String]-firefoxDirs = [ ".mozilla", ".mozilla-firefox", ".firefox" ]--placesFile :: String-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- tmpDir <- getTemporaryDirectory- let tmpName = tmpDir </> "wiki4e_places.sqlite"- copyFile name tmpName- conn <- connectSqlite3 tmpName- 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]- removeFile tmpName- return $ mapMaybe importURL ys--getRecursiveContents :: FilePath -> IO [FilePath]-getRecursiveContents topdir = do- e <- doesDirectoryExist topdir- if e then do- names <- getDirectoryContents topdir- let properNames = filter (`notElem` [".", ".."]) names- paths <- forM properNames $ \name -> do- let path = topdir </> name- e2 <- doesDirectoryExist path- if e2- then getRecursiveContents path- else return [path]- return (concat paths)- else return []
src/Wiki4e/Commands/Articles.hs view
@@ -70,7 +70,7 @@ wiki4e_fetchArticles config us let fs = map (outd </>) $ map (articleURL2Title) us as <- mapM (wiki4e_readArticle) fs- let xs = nub $ concat $ map getArticleLinksAbs as+ let xs = nub $ concat $ map (getArticleLinksAbs (w4confDomain config)) as ys <- wiki4e_crawlArticlesLinks config xs l return (nub $ us++xs++ys) where
src/Wiki4e/Commands/Common.hs view
@@ -13,14 +13,15 @@ -- | Basic configuration of the commands data Wiki4eConfig = Wiki4eConfig { w4confDirFetch :: FilePath, w4confDirImg :: FilePath,- w4confDirSanitized :: FilePath }+ w4confDirSanitized :: FilePath, + w4confDomain :: String } -- Support Functions getWiki4eDir :: IO FilePath getWiki4eDir = getAppUserDataDirectory "wiki4e" -wiki4e_initConfig :: IO Wiki4eConfig-wiki4e_initConfig = do+wiki4e_initConfig :: String -> IO Wiki4eConfig+wiki4e_initConfig domain = do tmpDir <- getWiki4eDir let tmpDirFetch = tmpDir </> "wiki4e_fetch" let tmpDirSanitize = tmpDir </> "wiki4e_sanitize"@@ -28,11 +29,11 @@ createDirectoryIfMissing True tmpDirFetch createDirectoryIfMissing True tmpDirSanitize createDirectoryIfMissing True tmpDirImgs- return (Wiki4eConfig tmpDirFetch tmpDirImgs tmpDirSanitize)+ return (Wiki4eConfig tmpDirFetch tmpDirImgs tmpDirSanitize domain) readFileUTF8 :: FilePath -> IO String readFileUTF8 x = do- h <- openBinaryFile x ReadMode+ h <- openFile x ReadMode hSetEncoding h utf8 c <- hGetContents h forceList c `seq` hClose h
− src/wiki4e-mkepub-cache.hs
@@ -1,46 +0,0 @@-import Text.HTML.TagSoup-import System.Environment-import System.Directory-import System.FilePath-import Data.Maybe (catMaybes)-import Control.Monad (liftM)-import System.IO -import Network.URL-import Wiki4e.Commands-import Network.Wikipedia (isArticleURL)--defaultEbookName = "Wikipedia_Articles_From_Cache"--main = do- name <- getProgName- args <- getArgs- case args of - [] -> cache2epub defaultEbookName- ['-':_] -> usageHelp name- ['/':_] -> usageHelp name- [xs] -> cache2epub xs- _ -> usageHelp name--usageHelp name = putStrLn $ "Usage: " ++ name ++ " [<Title Name of new e-book>]"--cache2epub bookName = do- hSetBinaryMode stdout True- config <- wiki4e_initConfig- arts <- wiki4e_listCacheURLs config- putStrLn "# STAGE 1/5 - Verify Articles..."- wiki4e_fetchArticles config arts- putStrLn "# STAGE 2/5 - Sanitize Articles..."- wiki4e_sanitizeArticles config arts- putStrLn "# STAGE 3/5 - Inspect Articles for Images..."- imgs <- wiki4e_listArticlesImages config arts- putStrLn "# STAGE 4/5 - Download Images..."- wiki4e_fetchImages config imgs- putStrLn "# STAGE 5/5 - Constructing EPUB..."- wiki4e_createEpub config bookName arts imgs- putStrLn "Done."---- | It is expected that all articles are from english wikipedia-wiki4e_listCacheURLs :: Wiki4eConfig -> IO [URL]-wiki4e_listCacheURLs config = do- files <- liftM (filter (\(c:_) -> c /= '.')) $ getDirectoryContents (w4confDirFetch config)- return $ catMaybes $ map (importURL) (map (\x -> "http://en.wikipedia.org/wiki/"++x) files)
− src/wiki4e-mkepub-firefox.hs
@@ -1,44 +0,0 @@-import Text.HTML.TagSoup-import System.Environment-import System.Directory-import System.FilePath-import Data.List (nub)-import System.IO -import Network.URL-import Wiki4e.Commands-import Network.Wikipedia (isArticleURL)-import Web.Firefox--defaultEbookName = "Wikipedia_Articles_From_Firefox"--main = do- name <- getProgName- args <- getArgs- case args of - [] -> firefox2epub defaultEbookName- ['-':_] -> usageHelp name- ['/':_] -> usageHelp name- [xs] -> firefox2epub xs- _ -> usageHelp name--usageHelp name = putStrLn $ "Usage: " ++ name ++ " [<Title Name of new e-book>]"--firefox2epub bookName = do- hSetBinaryMode stdout True- arts <- wiki4e_listFirefoxURLs- config <- wiki4e_initConfig- putStrLn "# STAGE 1/4 - Download Articles..."- wiki4e_fetchArticles config arts- putStrLn "# STAGE 2/4 - Sanitize Articles..."- wiki4e_sanitizeArticles config arts- putStrLn "# STAGE 3/4 - Download Images..."- imgs <- wiki4e_listArticlesImages config arts- wiki4e_fetchImages config imgs- putStrLn "# STAGE 4/4 - Constructing EPUB..."- wiki4e_createEpub config bookName arts imgs- putStrLn "Done."--wiki4e_listFirefoxURLs :: IO [URL]-wiki4e_listFirefoxURLs = do- xs <- listAllHistoryURLs- return $ nub $ filter isArticleURL xs
src/wiki4e-mkepub-subtree.hs view
@@ -25,7 +25,10 @@ subtree2epub cs l = do hSetBinaryMode stdout True let u = fromJust $ importURL cs- config <- wiki4e_initConfig+ let domain = case url_type u of+ Absolute hst -> host $ hst+ _ -> error "Invalid URL: "++(show u)+ config <- wiki4e_initConfig domain putStrLn $ "# INFO - download depth is hardcoded value = " ++ (show defaultDepth) putStrLn $ "# STAGE 1/4 - Fetch starting article: " ++ (exportURL u) arts <- wiki4e_crawlArticlesLinks config [u] l
wikipedia4epub.cabal view
@@ -1,5 +1,5 @@ Name: wikipedia4epub-Version: 0.0.10+Version: 0.0.12 License: BSD3 License-File: LICENSE Homepage: http://rampa.sk/static/wikipedia4epub.html@@ -20,11 +20,10 @@ Source-Repository head type: darcs- location: http://patch-tag.com/r/dixiecko/wikipedia4epub+ location: http://darcsden.com/dixie/wikipedia4epub Library- Build-Depends: ghc >= 6.12.1,- base < 5,+ Build-Depends: base < 5, filepath, bytestring, haskell98,@@ -34,14 +33,11 @@ regex-posix, network, regex-base,- HDBC-sqlite3,- HDBC >= 2.1.1, tagsoup >= 0.8, HTTP, zip-archive, zlib,- xml,- Cabal >= 1.5 && < 1.9+ xml Hs-Source-Dirs: src Extensions: CPP, PatternGuards Ghc-Options: -Wall -fno-warn-orphans@@ -54,16 +50,8 @@ Wiki4e.Commands.Fetching Wiki4e.Commands.EPUB Network.Wikipedia- Web.Firefox -Executable wiki4e-mkepub-firefox- Hs-Source-Dirs: src- Main-Is: wiki4e-mkepub-firefox.hs- Executable wiki4e-mkepub-subtree Hs-Source-Dirs: src Main-Is: wiki4e-mkepub-subtree.hs -Executable wiki4e-mkepub-cache- Hs-Source-Dirs: src- Main-Is: wiki4e-mkepub-cache.hs