{-# LANGUAGE ScopedTypeVariables,OverloadedStrings #-} module Scion.PersistentBrowser.FileUtil where import Control.Applicative import qualified Codec.Archive.Tar as Tar import qualified Codec.Compression.GZip as GZip import Control.Exception (bracket,catch,SomeException) import qualified Data.ByteString as SBS import qualified Data.ByteString.Lazy as LBS import System.Directory import System.FilePath import Scion.PersistentBrowser.TempFile import Network.HTTP.Conduit -- |Takes out the "." and ".." special directory -- entries from a list of file paths. filterDots :: [FilePath] -> [FilePath] filterDots = filter (\d -> d /= "." && d /= "..") -- |Downloads a file from the internet. downloadFileLazy :: String -> IO (Maybe LBS.ByteString) downloadFileLazy s = (Just <$> (simpleHttp s)) -- yes it's bad practice to catch them all, but I don't know what could be thrown here -- StatusCodeException, yes, and maybe ASN1 exceptions, and probably others... `catch` \(_ :: SomeException)->return Nothing -- |Downloads a file from the internet. downloadFileStrict :: String -> IO (Maybe SBS.ByteString) downloadFileStrict = (fmap LBS.toStrict <$>) . downloadFileLazy -- |Downloads a file from the internet and check it's a Hoogle file. downloadHoogleFile :: Manager -> String -> IO (Maybe SBS.ByteString) downloadHoogleFile mgr url = do req <- parseUrl url getHoogleFile <$> LBS.toStrict <$> responseBody <$> httpLbs req mgr -- yes it's bad practice to catch them all, but I don't know what could be thrown here -- StatusCodeException, yes, and maybe ASN1 exceptions, and probably others... `catch` \(_ :: SomeException)->return Nothing --downloadHoogleFile' :: String -> BrowserAction (HandleStream String) (Maybe SBS.ByteString) --downloadHoogleFile' url = do -- (_,res) <- request $ getRequest url -- return $ getHoogleFile $ rspBody res getHoogleFile :: SBS.ByteString -> Maybe SBS.ByteString getHoogleFile response=if "-- Hoogle documentation" `SBS.isPrefixOf` response then Just response else Nothing -- |Downloads a file from the internet, using the system proxy --fetchURL :: String -> IO (String) --fetchURL url=do -- pr<-fetchProxy False -- (_,res) <- browse $ do -- setErrHandler logToStdout -- setOutHandler logToStdout -- setProxy pr -- request $ getRequest url -- return $ rspBody res -- |Un-gzip and un-tar a file into a folder. unTarGzip :: LBS.ByteString -> FilePath -> IO () unTarGzip cnts folder = let ungzip = GZip.decompress cnts entries = Tar.read ungzip in do createDirectories entries Tar.unpack folder entries where createDirectories Tar.Done = return () createDirectories (Tar.Fail _) = return () createDirectories (Tar.Next e es) = case Tar.entryContent e of Tar.NormalFile _ _ -> do let dir = folder takeDirectory (Tar.entryPath e) createDirectoryIfMissing True dir createDirectories es Tar.Directory -> do let dir = folder Tar.entryPath e createDirectoryIfMissing True dir createDirectories es _ -> createDirectories es -- HACK: Taken from Unixutils. -- The version in Hackage conflicts with some of our packages. -- |temporarily change the working directory to |dir| while running |action| withWorkingDirectory :: FilePath -> IO a -> IO a withWorkingDirectory dir action = bracket getCurrentDirectory setCurrentDirectory (\ _ -> setCurrentDirectory dir >> action) -- |create a temporary directory, run the action, remove the temporary directory -- the directory will be created inside the system temporary directory (cf bug 3413186) -- the temporary directory will be automatically removed afterwards. -- your working directory is not altered withTemporaryDirectory :: (FilePath -> IO a) -> IO a withTemporaryDirectory f = do home <- getTemporaryDirectory bracket (createTempDirectory home ".scion") removeDirectoryRecursive f