diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ # pgdl - +[![Build Status](https://travis-ci.org/sifmelcara/pgdl.svg?branch=master)](https://travis-ci.org/sifmelcara/pgdl) ## What can this program do? pgdl is a program for viewing and accessing directory listing webpage in terminal. @@ -35,11 +35,13 @@ '/' for file searching -press Enter to confirm or to download the selected file +press Enter to download the selected file press 'q' to quit the program press 'd' to delete currently selected file (which have been downloaded) + +press Meta+Enter to resume the download progress of the currently selected file (like `curl -C` does) ## Config file diff --git a/pgdl.cabal b/pgdl.cabal --- a/pgdl.cabal +++ b/pgdl.cabal @@ -1,6 +1,6 @@ name: pgdl -version: 9.1 +version: 9.2 license: PublicDomain license-file: LICENSE author: mingchuan @@ -29,23 +29,20 @@ Networking, Utils, Configure, EntryAttrViewer, Types build-depends: base == 4.*, - tagsoup, - directory-listing-webpage-parser, - brick, vty, data-default, vector, text, bytestring, - unix, + Cabal, time, + unix, process, + filepath, directory, + data-default, + tagsoup, + directory-listing-webpage-parser >= 0.1.1.0, + brick, vty, conduit, conduit-extra, - http-conduit, resourcet, + http-conduit, http-types, resourcet, configurator >= 0.3, - directory, - Cabal, - filepath, transformers, - process, - filepath, - time, - binary + binary >= 0.7 ghc-options: -threaded default-language: Haskell2010 diff --git a/src/Cache.hs b/src/Cache.hs --- a/src/Cache.hs +++ b/src/Cache.hs @@ -4,8 +4,8 @@ module Cache where +import Control.Applicative import qualified Data.Text as T -import Data.Text (Text) import Data.Binary import Data.Maybe import Data.Time.LocalTime diff --git a/src/Configure.hs b/src/Configure.hs --- a/src/Configure.hs +++ b/src/Configure.hs @@ -6,6 +6,7 @@ import qualified Data.Text as T import Data.Text (Text) +import Control.Applicative import qualified Data.Configurator as C import qualified Data.Configurator.Types as C diff --git a/src/DownloadInterface.hs b/src/DownloadInterface.hs --- a/src/DownloadInterface.hs +++ b/src/DownloadInterface.hs @@ -2,23 +2,27 @@ {-# LANGUAGE LambdaCase#-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -module DownloadInterface (downloadInterface) +module DownloadInterface (downloadInterface, DownloadSettings(..)) where import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding +import qualified Data.ByteString.Char8 as BC import Data.Conduit import Data.Conduit.Binary import Data.Default +import Data.List import Control.Monad import Control.Monad.Trans.Resource import Control.Monad.IO.Class import Control.Concurrent +import Control.Applicative import qualified Control.Concurrent.Chan as C import Network.HTTP.Conduit +import Network.HTTP.Types.Header import System.Posix.Files import System.Process +import qualified System.IO as IO import Distribution.System import qualified Graphics.Vty as V @@ -33,9 +37,20 @@ import Brick.Widgets.Core import Brick.Util (on) -import qualified Configure as Conf import Networking +data DownloadSettings = + DownloadSettings { networkResource :: NetworkResource + , relativeUrl :: Text + , localStoragePath :: Text + -- ^ file name included + , justOpen :: Bool + -- ^ when True, don't use any network resource + , continueDownload :: Bool + -- ^ when True, continue the download progress (use "Range" in http header) + -- else redownload the whole file + } + -- bytes already downloaded data DownloadState = DownloadState Integer | FinishedState | UserInput DownloadState E.Editor @@ -45,20 +60,18 @@ | UpdateFinishedSize Integer | DownloadFinish --- | Maybe we should try to get file size by other method, --- that would be more accurate and reliable. -downloadInterface :: NetworkResource -> - Text -> -- ^ url (relative) - Text -> -- ^ file path (may be a absolute path) - Integer -> -- ^ filesize in bytes - Bool -> -- ^ is the download already finished? - IO () -downloadInterface nr url filepath filesize alreadyFinished = do +downloadInterface :: DownloadSettings -> IO () +downloadInterface dSettings = do eventChan <- C.newChan - unless alreadyFinished . void . forkIO $ download nr url filepath (C.writeChan eventChan) + unless (justOpen dSettings) . void . forkIO $ + download dSettings (C.writeChan eventChan) + progressBarTotSize <- if justOpen dSettings + then getLocalFileSize (T.unpack $ localStoragePath dSettings) >>= \case + Nothing -> error "file do not exist." + Just s -> return s + else getContentLength dSettings let - initialState :: DownloadState - initialState = if alreadyFinished + initialState = if justOpen dSettings then FinishedState else DownloadState 0 theApp = @@ -70,15 +83,15 @@ , M.appLiftVtyEvent = VtyEvent } appEvent :: DownloadState -> DEvent -> T.EventM (T.Next DownloadState) - appEvent ds@(DownloadState doneB) de = case de of + appEvent ds@(DownloadState _) de = case de of VtyEvent e -> case e of V.EvKey V.KEsc [] -> M.halt ds V.EvKey (V.KChar 'q') _ -> M.halt ds V.EvKey (V.KChar 'o') [] -> M.continue $ UserInput ds (E.editor "command" (str.unlines) (Just 1) "") V.EvKey V.KEnter [] -> do - liftIO $ filepath `openBy` "" + liftIO $ localStoragePath dSettings `openBy` "" M.continue ds - ev -> M.continue ds + _ -> M.continue ds UpdateFinishedSize b -> M.continue . DownloadState $ b DownloadFinish -> M.continue FinishedState appEvent FinishedState de = case de of @@ -86,16 +99,16 @@ V.EvKey (V.KChar 'q') _ -> M.halt FinishedState V.EvKey (V.KChar 'o') [] -> M.continue $ UserInput FinishedState (E.editor "command" (str.unlines) (Just 1) "") V.EvKey V.KEnter [] -> do - liftIO $ filepath `openBy` "" + liftIO $ localStoragePath dSettings `openBy` "" M.halt FinishedState -- ^ file opened, we can quit download interface now - ev -> M.continue FinishedState + _ -> M.continue FinishedState _ -> error "received non vty event after FinishedState was reached." appEvent (UserInput st ed) de = case de of VtyEvent e -> case e of V.EvKey V.KEsc [] -> M.continue st V.EvKey V.KEnter [] -> do - liftIO $ filepath `openBy` concat (E.getEditContents ed) + liftIO $ localStoragePath dSettings `openBy` concat (E.getEditContents ed) case st of DownloadState _ -> M.continue st FinishedState -> M.halt FinishedState @@ -112,7 +125,7 @@ drawUI :: DownloadState -> [Widget] drawUI (DownloadState bytes) = [vBox [bar, note]] where - bar = C.vCenter . C.hCenter $ P.progressBar Nothing (fromIntegral bytes / fromIntegral filesize) + bar = C.vCenter . C.hCenter $ P.progressBar Nothing (fromIntegral bytes / fromIntegral progressBarTotSize) note = C.vCenter . C.hCenter . str $ unlines [ "press Enter to open the file (even if its download has not finished)" , "press 'o' to specify which program should be used to open the file." ] @@ -149,29 +162,59 @@ addq :: String -> String addq s = "\"" ++ s ++ "\"" -download :: NetworkResource -> - Text -> -- ^ url - Text -> -- ^ filepath - (DEvent -> IO ()) -> IO () -download nr url tFilepath tell = do +getContentLength :: DownloadSettings -> IO Integer +getContentLength dSettings = do + let (req, manager) = networkResource dSettings $ relativeUrl dSettings + runResourceT $ do + response <- http req manager + let headers = responseHeaders response + case find (\(hn, bs) -> hn == hContentLength) headers of + Nothing -> error "no content-length presents in response header" + Just (hn, bs) -> case BC.readInteger bs of + Nothing -> error "no integer in content-length header" + Just (sz, _) -> return sz + +getLocalFileSize :: String -> IO (Maybe Integer) +getLocalFileSize path = + fileExist path >>= \case + False -> return Nothing + True -> Just . fromIntegral . fileSize <$> getFileStatus path + +download :: DownloadSettings -> + (DEvent -> IO ()) -> + IO () +download dSettings tell = do -- this implementation needs to be change -- since some filename contains characters that cannot be represented by String let - filepath = T.unpack tFilepath + filepath = T.unpack $ localStoragePath dSettings checkFile :: IO () checkFile = forever $ do - threadDelay $ 1000000 * 1 - exist <- fileExist filepath - when exist $ do - s <- fileSize <$> getFileStatus filepath - tell . UpdateFinishedSize . fromIntegral $ s + threadDelay 100000 -- 0.1 second + getLocalFileSize filepath >>= \case + Nothing -> return () + Just s -> tell . UpdateFinishedSize $ s checkerThreadID <- forkIO checkFile - let (req, manager) = nr url + let (req, manager) = networkResource dSettings $ relativeUrl dSettings + localFileSize <- getLocalFileSize (T.unpack $ localStoragePath dSettings) >>= \case + Nothing -> return 0 + Just s -> return s + remoteFileSize <- getContentLength dSettings + let extraHeaders = [("Range", "bytes=" `BC.append` BC.pack (show localFileSize) `BC.append` "-")] + let req' = if continueDownload dSettings + then req { requestHeaders = extraHeaders ++ requestHeaders req } + else req -- use http and ResumableSource in conduit for constant memory usage runResourceT $ do - response <- http req manager - let body = responseBody response - body $$+- sinkFile filepath + if continueDownload dSettings then + when (localFileSize < remoteFileSize) $ do + response <- http req' manager + let body = responseBody response + body $$+- sinkIOHandle (IO.openBinaryFile filepath IO.AppendMode) + else do + response <- http req' manager + let body = responseBody response + body $$+- sinkIOHandle (IO.openBinaryFile filepath IO.WriteMode) liftIO $ do killThread checkerThreadID tell DownloadFinish diff --git a/src/EntryAttrViewer.hs b/src/EntryAttrViewer.hs --- a/src/EntryAttrViewer.hs +++ b/src/EntryAttrViewer.hs @@ -43,7 +43,7 @@ V.EvKey V.KEsc [] -> M.halt () V.EvKey (V.KChar 'q') [] -> M.halt () V.EvKey V.KLeft [] -> M.halt () - ev -> M.continue () + _ -> M.continue () theMap = A.attrMap V.defAttr [ (P.progressCompleteAttr, V.black `on` V.cyan) , (P.progressIncompleteAttr, V.black `on` V.white) ] diff --git a/src/Local.hs b/src/Local.hs --- a/src/Local.hs +++ b/src/Local.hs @@ -9,8 +9,6 @@ import Data.Text (Text) import qualified Data.Text as T -import Configure - -- | determine whether a file is in specified directory isFileDownloaded :: Text -> -- ^ file name String -> -- ^ local directory diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -12,6 +12,7 @@ import DownloadInterface import Control.Monad import Control.Monad.IO.Class +import Control.Applicative import System.FilePath import System.Environment import System.IO @@ -91,7 +92,7 @@ appEvent ls@(LState father lst) e = case e of V.EvKey V.KEsc [] -> M.halt ls V.EvKey (V.KChar 'q') [] -> M.halt ls - V.EvKey V.KEnter [] -> case L.listSelectedElement lst of + V.EvKey V.KEnter mod -> case L.listSelectedElement lst of Nothing -> M.continue ls Just (rowNum, child) -> case child of Directory entry dnsOp -> do @@ -102,9 +103,12 @@ path <- liftIO $ Conf.getLocaldir >>= \case Nothing -> return fn Just pre -> return $ T.pack (T.unpack pre T.unpack fn) - let - dui = downloadInterface nr url path (fromJust $ fileSize entry) False - -- ^ not good, unsafe + let dui = downloadInterface DownloadSettings { networkResource = nr + , relativeUrl = url + , localStoragePath = path + , justOpen = False + , continueDownload = False + } -- | construct a newList, modify the downloaded -- file's *downloaded state* to True. -- Maybe this is not a good approach? @@ -115,7 +119,12 @@ path <- liftIO $ Conf.getLocaldir >>= \case Nothing -> return fn Just pre -> return $ T.pack (T.unpack pre T.unpack fn) - let dui = downloadInterface nr url path (fromJust $ fileSize entry) True + let dui = downloadInterface DownloadSettings { networkResource = nr + , relativeUrl = url + , localStoragePath = path + , justOpen = mod /= [V.MMeta] + , continueDownload = mod == [V.MMeta] + } -- ^ not good, unsafe M.suspendAndResume $ dui >> return ls V.EvKey V.KLeft [] -> M.continue $ fromMaybe ls father diff --git a/src/Networking.hs b/src/Networking.hs --- a/src/Networking.hs +++ b/src/Networking.hs @@ -18,6 +18,7 @@ import Text.HTML.DirectoryListing.Parser import System.FilePath.Posix import Control.Concurrent +import Control.Applicative import Cache import qualified Configure as Conf @@ -32,11 +33,11 @@ IO NetworkResource genNetworkResource url up = do let genReq :: Text -> Request - genReq rp = case parseUrl path of - Nothing -> error $ "invalid url: " ++ path + genReq rp = case parseUrl absPath of + Nothing -> error $ "invalid url: " ++ absPath Just r -> auth r where - path = T.unpack url T.unpack rp + absPath = T.unpack url T.unpack rp auth = case up of Nothing -> id Just (u, p) -> applyBasicAuth (encodeUtf8 u) (encodeUtf8 p)