diff --git a/src/Network/Wikipedia.hs b/src/Network/Wikipedia.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wikipedia.hs @@ -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) diff --git a/src/Web/Firefox.hs b/src/Web/Firefox.hs new file mode 100644 --- /dev/null +++ b/src/Web/Firefox.hs @@ -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) diff --git a/src/Wikipedia4epub/Commands.hs b/src/Wikipedia4epub/Commands.hs new file mode 100644 --- /dev/null +++ b/src/Wikipedia4epub/Commands.hs @@ -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 diff --git a/wikipedia4epub.cabal b/wikipedia4epub.cabal --- a/wikipedia4epub.cabal +++ b/wikipedia4epub.cabal @@ -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