pgdl 9.1 → 9.2
raw patch · 9 files changed
+115/−64 lines, 9 filesdep +http-typesdep ~binarydep ~brickdep ~directory-listing-webpage-parser
Dependencies added: http-types
Dependency ranges changed: binary, brick, directory-listing-webpage-parser
Files
- README.md +4/−2
- pgdl.cabal +10/−13
- src/Cache.hs +1/−1
- src/Configure.hs +1/−0
- src/DownloadInterface.hs +80/−37
- src/EntryAttrViewer.hs +1/−1
- src/Local.hs +0/−2
- src/Main.hs +14/−5
- src/Networking.hs +4/−3
README.md view
@@ -1,5 +1,5 @@ # pgdl-+[](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
pgdl.cabal view
@@ -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
src/Cache.hs view
@@ -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
src/Configure.hs view
@@ -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
src/DownloadInterface.hs view
@@ -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
src/EntryAttrViewer.hs view
@@ -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) ]
src/Local.hs view
@@ -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
src/Main.hs view
@@ -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
src/Networking.hs view
@@ -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)