2 files changed, 24 insertions(+), 19 deletions(-)

M rhapsode.cabal
M src/Input.hs

@@ 64,7 64,7 @@ executable rhapsode
         html-conduit, xml-conduit, text, containers, data-default-class,
         network-uri,
         stylist >= 1.1, css-syntax, xml-conduit-stylist, scientific,
-        async, hurl >= 1.1.0.0, filepath
+        async, hurl >= 1.2.0.0, filepath, temporary
   
   -- Directories containing source files.
   hs-source-dirs:      src

@@ 15,6 15,7 @@ import Control.Concurrent.Async
 import System.IO
 import System.Environment
 import System.Directory
+import System.IO.Temp
 import Data.List
 import Data.Default.Class
 import Data.Maybe (fromMaybe)


@@ 76,14 77,28 @@ evalInput http ("-x", url) = fetchDocument http ["text/xml", "text/html", "text/
 evalInput http ("-xml", url) = fetchDocument http ["text/xml", "text/html", "text/plain"] url
 evalInput _ (flag, _) = error ("Unsupported input flag " ++ flag)
 
-fetchDocument http mime uri = fetchURL http mime uri >>= parseDocument
-parseDocument ("text/html", Left text) = return $ HTML.parseLT $ fromStrict text
-parseDocument ("text/html", Right bytes) = return $ HTML.parseLBS bytes
-parseDocument ("text/plain", Left text) = return $ docForText text
-parseDocument ("text/plain", Right bytes) = return $ docForText $ decodeUtf8 $ B.toStrict bytes
-parseDocument (_, Left text) | Right doc <- XML.parseText def $ fromStrict text = return doc
-parseDocument (_, Right bytes) | Right doc <- XML.parseLBS def bytes = return doc
-parseDocument (mime, _) = return $ docForText $ Txt.concat ["Unsupported MIMEtype ", Txt.pack mime]
+fetchDocument http mime uri = fetchURL http mime uri >>= parseDocument http
+parseDocument _ ("text/html", Left text) = return $ HTML.parseLT $ fromStrict text
+parseDocument _ ("text/html", Right bytes) = return $ HTML.parseLBS bytes
+parseDocument _ ("text/plain", Left text) = return $ docForText text
+parseDocument _ ("text/plain", Right bytes) = return $ docForText $ decodeUtf8 $ B.toStrict bytes
+parseDocument _ ("application/xhtml+xml", Left text) | Right doc <- XML.parseText def $ fromStrict text = return doc
+  | otherwise = return $ docForText "Unreadable webpage!"
+parseDocument _ ("application/xhtml+xml", Right bytes) | Right doc <- XML.parseLBS def bytes = return doc
+  | otherwise = return $ docForText "Unreadable webpage!"
+parseDocument session (mime, download) = do
+    localURI <- withSystemTempFile "rhapsode-download" $ writeDownloadToFile download
+    result <- dispatchByMIME session mime localURI
+    case result of
+        Just text -> return $ docForText $ Txt.pack text
+        Nothing -> parseDocument session ("application/xhtml+xml", download)
+
+writeDownloadToFile (Left text) file handle = do
+    hPutStr handle $ Txt.unpack text
+    return $ URI "file:" Nothing file "" ""
+writeDownloadToFile (Right bytes) file handle = do
+    B.hPut handle bytes
+    return $ URI "file:" Nothing file "" ""
 
 docForText txt = XML.Document {
         XML.documentPrologue = XML.Prologue [] Nothing [],


@@ 94,13 109,3 @@ docForText txt = XML.Document {
         },
         XML.documentEpilogue = []
     }
-
-newFilePath filepath count = do
-    let realpath = filepath ++ show count
-    exists <- doesPathExist realpath
-    if exists then newFilePath filepath $ count + 1 else return realpath
-
-downloadsDir = do
-    downloads <- lookupEnv "XDG_DOWNLOAD_DIR"
-    home <- getHomeDirectory
-    return $ fromMaybe (home </> "Downloads") downloads