diff --git a/src/Network/Wikipedia.hs b/src/Network/Wikipedia.hs --- a/src/Network/Wikipedia.hs +++ b/src/Network/Wikipedia.hs @@ -2,6 +2,7 @@ , WikiArticle(..) , articleURL2Title , getArticleLinks + , getArticleLinksAbs , getArticleImages , sanitizeArticle , sanitizeFileName @@ -10,19 +11,16 @@ , fetchArticle) where import Network.URL -import Network.URI import Text.Regex.Posix -import Text.Regex.Base import Network.HTTP import Text.HTML.TagSoup import System.FilePath import Data.List (nub) -import Data.Maybe (catMaybes, mapMaybe, fromJust) +import Data.Maybe (mapMaybe, fromJust) data WikiArticle = WikiArticleHTML { waTitle :: String, waContent :: String } | WikiArticleSRC { waTitle :: String, waContent :: String } deriving (Show, Ord, Eq) - sanitizeFileName :: FilePath -> FilePath sanitizeFileName cs = map (unPercent) $ urlEncode cs where @@ -36,6 +34,11 @@ articleURL2Title x | isArticleURL x = sanitizeFileName (takeFileName (url_path x)) | otherwise = "" +articleRelURL2Title :: String -> String +articleRelURL2Title x = case importURL ("http://en.wikipedia.org"++x) of + Nothing -> "" + Just u -> articleURL2Title u + isArticleImgURL :: String -> Bool isArticleImgURL cs = cs =~ "^http://upload.wikimedia.org/.*" @@ -50,8 +53,14 @@ aTags = filter (isTagOpenName "a") inTags 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 -- 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 @@ -60,23 +69,21 @@ 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 = procImgTags $ processTags $ filterAllTags tags4Filter inTags - tags4Filter = ["link", "script", "sup" ] - in WikiArticleHTML (waTitle xs) (renderTags outTags) +sanitizeArticle :: [String] -> WikiArticle -> WikiArticle +sanitizeArticle alnk xs = let inTags = parseTags (waContent xs) + outTags = processTags alnk $ filterAllTags tags4Filter inTags + tags4Filter = ["link", "script", "sup" ] + in WikiArticleHTML (waTitle xs) (renderTags outTags) -processTags xs = map processAttrs xs +processTags alnk xs = procHrefTags alnk $ procImgTags $ map processAttrs xs where - processAttrs t@(TagOpen "a" _) = TagText "" - processAttrs t@(TagClose "a") = TagText "" processAttrs t@(TagOpen "div" _) = TagText "" processAttrs t@(TagClose "div") = TagText "" - processAttrs t@(TagOpen s xs) | null s = t + processAttrs t@(TagOpen s ys) | null s = t | head s == '!' = t - | otherwise = TagOpen s (removeStyleAttr $ removeEmptyAttr xs) + | otherwise = TagOpen s (removeStyleAttr $ removeEmptyAttr ys) processAttrs t = t removeEmptyAttr xs = filter (not . null . snd) xs removeStyleAttr xs = filter (\x -> (fst x) `notElem` ["style", "id", "class"]) xs @@ -91,6 +98,18 @@ 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 + + +procHrefTags _ [] = [] +procHrefTags alnk (x:xs) | isTagOpenName "a" x = let relP = fromAttrib "href" x + title = articleRelURL2Title relP + imgOk = (TagOpen "a" [("href",title)]):(procHrefTags alnk xs) + isInBook = elem (title) alnk + imgNok = let pre = takeWhile (not . isTagCloseName "a") xs + post = tail $ dropWhile (not . isTagCloseName "a") xs + in pre ++ (procHrefTags alnk post) + in if isInBook then imgOk else imgNok + | otherwise = x:(procHrefTags alnk xs) procImgTags [] = [] procImgTags (x:xs) | isTagOpenName "img" x = let absP = fromAttrib "src" x diff --git a/src/Web/Firefox.hs b/src/Web/Firefox.hs --- a/src/Web/Firefox.hs +++ b/src/Web/Firefox.hs @@ -1,6 +1,6 @@ module Web.Firefox (listPlacesFiles, listHistoryURLs, listAllHistoryURLs) where -import Database.HDBC (disconnect, fromSql, quickQuery') +import Database.HDBC (fromSql, quickQuery') import Database.HDBC.Sqlite3 (connectSqlite3, setBusyTimeout) import Network.URL (importURL, URL) import Data.List (isSuffixOf) diff --git a/src/Wiki4e/Commands.hs b/src/Wiki4e/Commands.hs --- a/src/Wiki4e/Commands.hs +++ b/src/Wiki4e/Commands.hs @@ -1,137 +1,12 @@ -module Wiki4e.Commands where -import Network.Wikipedia -import Web.Firefox -import System.FilePath -import System.Directory -import Network.URL -import Control.Monad (liftM, filterM) -import Data.List (nub, foldl') -import Data.Char (toLower) -import System.IO -import Network.HTTP -import Codec.EBook -import qualified Data.ByteString.Lazy as B - --- Fetching state where first number is total and second is current item. -type FetchingState = (Int,Int) -type FetchingMethod = (URL -> IO String) - -fs2str :: FetchingState -> String -fs2str (total,current) = "["++(show current)++"/"++(show total)++"] " - -wiki4e_fetch :: FilePath -> FetchingMethod -> FetchingState -> URL -> IO () -wiki4e_fetch outf fm fs x = do - e <- doesFileExist outf - if not e then do - putStrLn $ (fs2str fs) ++ "Fetching : " ++ exportURL x - c <- fm x - withBinaryFile outf WriteMode (flip hPutStr c) - else putStrLn $ (fs2str fs) ++ "Already cached. Skipping download. " ++ outf - -wiki4e_fetchArticles :: FilePath -> [URL] -> IO () -wiki4e_fetchArticles oud xs = mapM_ (\(st,x) -> wiki4e_fetch (nm x) fm st x) $ zip fsls xs - where - fsls = [ (total,i) | i <- [1..total] ] - total = length xs - nm x = oud (articleURL2Title x) - fm x = do - (WikiArticleHTML _ c) <- fetchArticle x - return c - -wiki4e_fetchImages :: FilePath -> [URL] -> IO () -wiki4e_fetchImages oud xs = mapM_ (\(st,x) -> wiki4e_fetch (nm x) fm st x) $ zip fsls xs - where - fsls = [ (total,i) | i <- [1..total] ] - total = length xs - nm x = oud (sanitizeFileName $ takeFileName (url_path x)) - fm x = do - rsp <- Network.HTTP.simpleHTTP (getRequest (exportURL x)) - c <- (getResponseBody rsp) - return c - -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_listArticleImages :: FilePath -> IO [URL] -wiki4e_listArticleImages x = do - h <- openFile x ReadMode - hSetEncoding h utf8 - c <- hGetContents h - return $ getArticleImages (WikiArticleHTML "" c) - -wiki4e_listArticlesImages :: FilePath -> IO [URL] -wiki4e_listArticlesImages ind = do - xs <- wiki4e_listFiles ind - ys <- mapM (wiki4e_listArticleImages) xs - return $ nub $ concat ys - -wiki4e_sanitizeArticles :: FilePath -> FilePath -> IO () -wiki4e_sanitizeArticles ind oud = wiki4e_listFiles ind >>= - mapM_ (\x -> wiki4e_sanitizeArticle x (oud (takeFileName x))) - -wiki4e_listFiles :: FilePath -> IO [FilePath] -wiki4e_listFiles xs = do - nonDot <- liftM (filter (\(c:_) -> c /= '.')) $ getDirectoryContents xs - dirs <- filterM (doesDirectoryExist) (map (xs ) nonDot) - fils <- filterM (\e -> liftM (not) $ doesDirectoryExist e ) (map (xs ) nonDot) - ys <- mapM (wiki4e_listFiles) dirs - return $ (concat ys) ++ fils - -wiki4e_listFirefoxURLs :: IO [URL] -wiki4e_listFirefoxURLs = do - xs <- listAllHistoryURLs - return $ nub $ filter isArticleURL xs - -wiki4e_createEpub :: String -> FilePath -> FilePath -> IO () -wiki4e_createEpub bookName srcDir imgDir = do - let book = emptyBook { - bookID = "http://localhost/"++bookName, - bookAuthor = "wiki4e-firefox-epub", - bookTitle = bookName - } - xs <- wiki4e_listFiles srcDir - itemsA <- mapM (\(i,x) -> loadArticleFile i "wiki" x) $ zip [1..] xs - ys <- wiki4e_listFiles imgDir - itemsI <- mapM (\(i,x) -> loadImgFile i "wiki/img" x) $ zip [(length xs + 1)..] ys - let bookFull = foldl' addItem2Book book (itemsA ++ itemsI) - let epubFName = bookName++".epub" - outdata <- book2Bin' bookFull - B.writeFile epubFName outdata - putStrLn $ epubFName ++ " constructed." - --- Support Functions - -loadArticleFile :: Int -> FilePath -> FilePath -> IO BookItem -loadArticleFile i bookDir fname = do - cs <- B.readFile fname - return (BookItem aid bfile cs opsMediatype (Just (ChapterMetadata name))) - where - aid = show i - bfile = bookDir name - name = takeFileName $ normalise fname - -loadImgFile :: Int -> FilePath -> FilePath -> IO BookItem -loadImgFile i bookDir fname = do - cs <- B.readFile fname - return (BookItem aid bfile cs mimeType Nothing) - where - mimeType | hasExt ".png" name = "image/png" - | hasExt ".jpeg" name = "image/jpeg" - | hasExt ".jpg" name = "image/jpeg" - | hasExt ".gif" name = "image/gif" - | otherwise = "image/png" - hasExt x f = (map toLower $ takeExtension f) == x - aid = show i - bfile = bookDir name - name = takeFileName $ normalise fname +module Wiki4e.Commands ( module Wiki4e.Commands.Common + , module Wiki4e.Commands.Fetching + , module Wiki4e.Commands.Articles + , module Wiki4e.Commands.Images + , module Wiki4e.Commands.EPUB + ) +where +import Wiki4e.Commands.Common +import Wiki4e.Commands.Fetching +import Wiki4e.Commands.Articles +import Wiki4e.Commands.Images +import Wiki4e.Commands.EPUB diff --git a/src/Wiki4e/Commands/Articles.hs b/src/Wiki4e/Commands/Articles.hs new file mode 100644 --- /dev/null +++ b/src/Wiki4e/Commands/Articles.hs @@ -0,0 +1,102 @@ +module Wiki4e.Commands.Articles ( wiki4e_sanitizeArticle + , wiki4e_sanitizeArticles + , wiki4e_fetchArticles + , wiki4e_getArticleFiles + , wiki4e_getArticleSanFiles + , wiki4e_crawlArticlesLinks + , wiki4e_listArticleImages + , wiki4e_listArticlesImages + , wiki4e_readArticle + , loadArticleFile + , articleURL2File + , articleURL2SanFile) +where +import System.FilePath +import Network.URL +import Data.List (nub) +import System.IO +import Codec.EBook +import qualified Data.ByteString as STR +import Network.Wikipedia +import Wiki4e.Commands.Common +import Wiki4e.Commands.Fetching + +wiki4e_sanitizeArticle :: [String] -> FilePath -> FilePath -> IO () +wiki4e_sanitizeArticle alnk inf ouf = withFile inf ReadMode (\hi -> do + hSetEncoding hi utf8 + withFile ouf WriteMode (\ho -> do + hSetEncoding ho utf8 + c <- hGetContents hi + let a = sanitizeArticle alnk $ WikiArticleHTML "" c + hPutStr ho $ waContent a + ) + ) + +wiki4e_fetchArticles :: Wiki4eConfig -> [URL] -> IO () +wiki4e_fetchArticles config xs = mapM_ (\(st,x) -> wiki4e_fetch (nm x) fm st x) $ zip fsls xs + where + fsls = [ (total,i) | i <- [1..total] ] + total = length xs + nm x = articleURL2File config x + fm x = do + (WikiArticleHTML _ c) <- fetchArticle x + return c + +wiki4e_sanitizeArticles :: Wiki4eConfig -> [URL] -> IO () +wiki4e_sanitizeArticles config arts = do + mapM_ (\x -> wiki4e_sanitizeArticle alnk x (outf x)) xs + where + xs = wiki4e_getArticleFiles config arts + alnk = map (articleURL2Title) arts + outf x = (w4confDirSanitized config) (takeFileName x) + +wiki4e_listArticleImages :: FilePath -> IO [URL] +wiki4e_listArticleImages x = do + c <- readFileUTF8 x + return $ nub $ getArticleImages (WikiArticleHTML "" c) + +-- | Method expects already sanitized articles +wiki4e_listArticlesImages :: Wiki4eConfig -> [URL] -> IO [URL] +wiki4e_listArticlesImages config urls = do + let files = wiki4e_getArticleFiles config urls + images <- mapM (wiki4e_listArticleImages) files + return $ nub $ concat images + +wiki4e_crawlArticlesLinks :: Wiki4eConfig -> [URL] -> Int -> IO [URL] +wiki4e_crawlArticlesLinks _ _ 0 = return [] +wiki4e_crawlArticlesLinks _ [] _ = return [] +wiki4e_crawlArticlesLinks config us (l + 1) = do + wiki4e_fetchArticles config us + let fs = map (outd ) $ map (articleURL2Title) us + as <- mapM (wiki4e_readArticle) fs + let xs = nub $ concat $ map getArticleLinksAbs as + ys <- wiki4e_crawlArticlesLinks config xs l + return (nub $ us++xs++ys) + where + outd = w4confDirFetch config + +wiki4e_getArticleFiles :: Wiki4eConfig -> [URL] -> [FilePath] +wiki4e_getArticleFiles config xs = map (articleURL2File config) xs + +wiki4e_getArticleSanFiles :: Wiki4eConfig -> [URL] -> [FilePath] +wiki4e_getArticleSanFiles config xs = map (articleURL2SanFile config) xs + +articleURL2File :: Wiki4eConfig -> URL -> FilePath +articleURL2File config x = (w4confDirFetch config) (articleURL2Title x) + +articleURL2SanFile :: Wiki4eConfig -> URL -> FilePath +articleURL2SanFile config x = (w4confDirSanitized config) (articleURL2Title x) + +loadArticleFile :: Int -> FilePath -> FilePath -> IO BookItem +loadArticleFile i bookDir fname = do + cs <- STR.readFile fname + return (BookItem aid bfile (toLazy cs) opsMediatype (Just (ChapterMetadata name))) + where + aid = show i + bfile = bookDir name + name = takeFileName $ normalise fname + +wiki4e_readArticle :: FilePath -> IO WikiArticle +wiki4e_readArticle inf = do + c <- readFileUTF8 inf + return (WikiArticleHTML "" c) diff --git a/src/Wiki4e/Commands/Common.hs b/src/Wiki4e/Commands/Common.hs new file mode 100644 --- /dev/null +++ b/src/Wiki4e/Commands/Common.hs @@ -0,0 +1,46 @@ +module Wiki4e.Commands.Common ( Wiki4eConfig(..) + , wiki4e_initConfig + , readFileUTF8 + , toLazy + , forceList ) +where +import System.FilePath +import System.IO +import System.Directory +import qualified Data.ByteString.Lazy as STRL +import qualified Data.ByteString as STR + +-- | Basic configuration of the commands +data Wiki4eConfig = Wiki4eConfig { w4confDirFetch :: FilePath, + w4confDirImg :: FilePath, + w4confDirSanitized :: FilePath } + +-- Support Functions +getWiki4eDir :: IO FilePath +getWiki4eDir = getAppUserDataDirectory "wiki4e" + +wiki4e_initConfig :: IO Wiki4eConfig +wiki4e_initConfig = do + tmpDir <- getWiki4eDir + let tmpDirFetch = tmpDir "wiki4e_fetch" + let tmpDirSanitize = tmpDir "wiki4e_sanitize" + let tmpDirImgs = tmpDir "wiki4e_images" + createDirectoryIfMissing True tmpDirFetch + createDirectoryIfMissing True tmpDirSanitize + createDirectoryIfMissing True tmpDirImgs + return (Wiki4eConfig tmpDirFetch tmpDirImgs tmpDirSanitize) + +readFileUTF8 :: FilePath -> IO String +readFileUTF8 x = do + h <- openBinaryFile x ReadMode + hSetEncoding h utf8 + c <- hGetContents h + forceList c `seq` hClose h + return c + +toLazy :: STR.ByteString -> STRL.ByteString +toLazy xs = STRL.pack $ STR.unpack xs + +forceList :: String -> String +forceList [] = [] +forceList (x:xs) = forceList xs `seq` (x:xs) diff --git a/src/Wiki4e/Commands/EPUB.hs b/src/Wiki4e/Commands/EPUB.hs new file mode 100644 --- /dev/null +++ b/src/Wiki4e/Commands/EPUB.hs @@ -0,0 +1,28 @@ +module Wiki4e.Commands.EPUB (wiki4e_createEpub) where +import Network.URL +import Data.List (foldl') +import Codec.EBook +import qualified Data.ByteString.Lazy as STRL +import Wiki4e.Commands.Common +import Wiki4e.Commands.Images +import Wiki4e.Commands.Articles + +-- | Create epub in current directory with bookName +-- | With all articles in directory srcDir and images at +-- | imgDir +wiki4e_createEpub :: Wiki4eConfig -> String -> [URL] -> [URL] -> IO () +wiki4e_createEpub config bookName artURLs imgURLs = do + let book = emptyBook { + bookID = "http://localhost/"++bookName, + bookAuthor = "wiki4e-firefox-epub", + bookTitle = bookName + } + let xs = wiki4e_getArticleSanFiles config artURLs + let ys = wiki4e_getImgFiles config imgURLs + itemsA <- mapM (\(i,x) -> loadArticleFile i "wiki" x) $ zip [1..] xs + itemsI <- mapM (\(i,x) -> loadImgFile i "wiki/img" x) $ zip [(length xs + 1)..] ys + let bookFull = foldl' addItem2Book book (itemsA ++ itemsI) + let epubFName = bookName++".epub" + outdata <- book2Bin' bookFull + STRL.writeFile epubFName outdata + putStrLn $ epubFName ++ " constructed." diff --git a/src/Wiki4e/Commands/Fetching.hs b/src/Wiki4e/Commands/Fetching.hs new file mode 100644 --- /dev/null +++ b/src/Wiki4e/Commands/Fetching.hs @@ -0,0 +1,20 @@ +module Wiki4e.Commands.Fetching where +import System.Directory +import Network.URL +import System.IO + +-- Fetching state where first number is total and second is current item. +type FetchingState = (Int,Int) +type FetchingMethod = (URL -> IO String) + +fs2str :: FetchingState -> String +fs2str (total,current) = "["++(show current)++"/"++(show total)++"] " + +wiki4e_fetch :: FilePath -> FetchingMethod -> FetchingState -> URL -> IO () +wiki4e_fetch outf fm fs x = do + e <- doesFileExist outf + if not e then do + putStrLn $ (fs2str fs) ++ "Fetching : " ++ exportURL x + c <- fm x + withBinaryFile outf WriteMode (flip hPutStr c) + else putStrLn $ (fs2str fs) ++ "Already cached. Skipping download. " ++ outf diff --git a/src/Wiki4e/Commands/Images.hs b/src/Wiki4e/Commands/Images.hs new file mode 100644 --- /dev/null +++ b/src/Wiki4e/Commands/Images.hs @@ -0,0 +1,47 @@ +module Wiki4e.Commands.Images ( wiki4e_fetchImages + , wiki4e_getImgFiles + , imgURL2File + , loadImgFile ) +where +import System.FilePath +import Network.URL +import Data.Char (toLower) +import Network.HTTP +import Codec.EBook +import qualified Data.ByteString as STR +import Network.Wikipedia +import Wiki4e.Commands.Common +import Wiki4e.Commands.Fetching + +wiki4e_fetchImages :: Wiki4eConfig -> [URL] -> IO () +wiki4e_fetchImages config xs = mapM_ (\(st,x) -> wiki4e_fetch (nm x) fm st x) $ zip fsls xs + where + fsls = [ (total,i) | i <- [1..total] ] + total = length xs + nm x = imgURL2File config x + fm x = do + rsp <- Network.HTTP.simpleHTTP (getRequest (exportURL x)) + c <- (getResponseBody rsp) + return c + +loadImgFile :: Int -> FilePath -> FilePath -> IO BookItem +loadImgFile i bookDir fname = do + cs <- STR.readFile fname + return (BookItem aid bfile (toLazy cs) mimeType Nothing) + where + mimeType | hasExt ".png" name = "image/png" + | hasExt ".jpeg" name = "image/jpeg" + | hasExt ".jpg" name = "image/jpeg" + | hasExt ".gif" name = "image/gif" + | otherwise = "image/png" + hasExt x f = (map toLower $ takeExtension f) == x + aid = show i + bfile = bookDir name + name = takeFileName $ normalise fname + + +imgURL2File :: Wiki4eConfig -> URL -> FilePath +imgURL2File config x = (w4confDirImg config) (sanitizeFileName $ takeFileName (url_path x)) + +wiki4e_getImgFiles :: Wiki4eConfig -> [URL] -> [FilePath] +wiki4e_getImgFiles config xs = map (imgURL2File config) xs diff --git a/src/wiki4e-mkepub-cache.hs b/src/wiki4e-mkepub-cache.hs new file mode 100644 --- /dev/null +++ b/src/wiki4e-mkepub-cache.hs @@ -0,0 +1,44 @@ +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 ++ " []" + +cache2epub bookName = do + config <- wiki4e_initConfig + arts <- wiki4e_listCacheURLs config + putStrLn "# STAGE 1/4 - Verify 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." + +-- | 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) diff --git a/src/wiki4e-mkepub-firefox.hs b/src/wiki4e-mkepub-firefox.hs --- a/src/wiki4e-mkepub-firefox.hs +++ b/src/wiki4e-mkepub-firefox.hs @@ -2,9 +2,12 @@ import System.Environment import System.Directory import System.FilePath -import Wiki4e.Commands +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" @@ -20,24 +23,21 @@ usageHelp name = putStrLn $ "Usage: " ++ name ++ " [<Title Name of new e-book>]" -getWiki4eDir = getAppUserDataDirectory "wiki4e" - firefox2epub bookName = do - xs <- wiki4e_listFirefoxURLs - tmpDir <- getWiki4eDir - let tmpDirFetch = tmpDir </> "wiki4e_fetch" - let tmpDirSanitize = tmpDir </> "wiki4e_sanitize" - let tmpDirImgs = tmpDir </> "wiki4e_images" - createDirectoryIfMissing True tmpDirFetch - createDirectoryIfMissing True tmpDirSanitize - createDirectoryIfMissing True tmpDirImgs + arts <- wiki4e_listFirefoxURLs + config <- wiki4e_initConfig putStrLn "# STAGE 1/4 - Download Articles..." - wiki4e_fetchArticles tmpDirFetch xs + wiki4e_fetchArticles config arts putStrLn "# STAGE 2/4 - Sanitize Articles..." - wiki4e_sanitizeArticles tmpDirFetch tmpDirSanitize + wiki4e_sanitizeArticles config arts putStrLn "# STAGE 3/4 - Download Images..." - imgs <- wiki4e_listArticlesImages tmpDirFetch - wiki4e_fetchImages tmpDirImgs imgs + imgs <- wiki4e_listArticlesImages config arts + wiki4e_fetchImages config imgs putStrLn "# STAGE 4/4 - Constructing EPUB..." - wiki4e_createEpub bookName tmpDirSanitize tmpDirImgs + wiki4e_createEpub config bookName arts imgs putStrLn "Done." + +wiki4e_listFirefoxURLs :: IO [URL] +wiki4e_listFirefoxURLs = do + xs <- listAllHistoryURLs + return $ nub $ filter isArticleURL xs diff --git a/src/wiki4e-mkepub-subtree.hs b/src/wiki4e-mkepub-subtree.hs new file mode 100644 --- /dev/null +++ b/src/wiki4e-mkepub-subtree.hs @@ -0,0 +1,41 @@ +import Text.HTML.TagSoup +import System.Environment +import System.Directory +import System.FilePath +import Wiki4e.Commands +import Network.Wikipedia (articleURL2Title) +import System.IO +import Network.URL +import Data.Maybe (fromJust) + +-- Download only intermediate children +defaultDepth = 1 + +main = do + name <- getProgName + args <- getArgs + case args of + ['-':_] -> usageHelp name + ['/':_] -> usageHelp name + [u] -> subtree2epub u defaultDepth + _ -> usageHelp name + +usageHelp name = putStrLn $ "Usage: " ++ name ++ " <Start URL>" + +subtree2epub cs l = do + let u = fromJust $ importURL cs + config <- wiki4e_initConfig + putStrLn $ "# STAGE 1/4 - Fetch starting article: " ++ (exportURL u) + arts <- wiki4e_crawlArticlesLinks config [u] l + putStrLn $ "# STAGE 2/4 - Fetch children articles: " ++ (show (length arts)) + wiki4e_fetchArticles config arts + putStrLn "# STAGE 3/4 - Sanitize articles" + wiki4e_sanitizeArticles config arts + putStrLn "# STAGE 4/4 - Download images" + imgs <- wiki4e_listArticlesImages config arts + putStrLn $ "Count = " ++ (show $ length imgs) + wiki4e_fetchImages config imgs + putStrLn "# STAGE 5/4 - Constructing EPUB" + wiki4e_createEpub config (articleURL2Title u) arts imgs + putStrLn "Done." + diff --git a/wikipedia4epub.cabal b/wikipedia4epub.cabal --- a/wikipedia4epub.cabal +++ b/wikipedia4epub.cabal @@ -1,5 +1,5 @@ Name: wikipedia4epub -Version: 0.0.4 +Version: 0.0.5 License: BSD3 License-File: LICENSE Homepage: http://rampa.sk/static/wikipedia4epub.html @@ -47,9 +47,22 @@ Exposed-modules: Wiki4e.Commands + Wiki4e.Commands.Common + Wiki4e.Commands.Articles + Wiki4e.Commands.Images + 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