pgdl 10.8 → 10.9
raw patch · 10 files changed
+81/−76 lines, 10 filesdep ~brick
Dependency ranges changed: brick
Files
- README.md +9/−10
- pgdl.cabal +2/−2
- src/Cache.hs +3/−3
- src/Configure.hs +6/−6
- src/DList.hs +6/−6
- src/DownloadInterface.hs +23/−19
- src/EntryAttrViewer.hs +5/−5
- src/Main.hs +20/−18
- src/Networking.hs +3/−3
- src/Utils.hs +4/−4
README.md view
@@ -14,16 +14,15 @@ by cabal: ```shell-cabal update +cabal update cabal install pgdl ```+In case of the versions of dependencies cannot be resolved, you may need to `rm -rf ~/.ghc`. via nix: ```shell-nix-env -iA nixos.haskellPackages.pgdl-```-Or,-```shell+git clone https://github.com/sifmelcara/pgdl.git+cd pgdl nix-env -i -f pgdl.nix ``` @@ -32,7 +31,7 @@ ```shell pgdl https://www.kernel.org/pub/linux/ ```-or simply type pgdl if you have set servpath attribute in the config file.+or simply type `pgdl` if you have set servpath attribute in the config file (config file will be explained later). ## Shortcut keys @@ -49,15 +48,15 @@ ## Config file -If you want to access webpage that uses basic authentication, you should at least set-*username* attribute in config file.-(if password is not set, you need to enter password manually when program launch)+If you want to access webpage that uses basic authentication, you should at least set *username* attribute in config file.+(if password is not set, you will need to enter password manually when you launch the program) (~/.pgdl) ```bash-# example: +# example: username = "jack" # should be set if the webpage have basic authentication password = "mypassw" # optional servpath = "example.org/videodir/" # default server location, optional localdir = "/home/jack/Downloads/" # where to store downloaded files, optional ```+
pgdl.cabal view
@@ -1,6 +1,6 @@ name: pgdl-version: 10.8+version: 10.9 license: PublicDomain license-file: LICENSE author: mingchuan@@ -38,7 +38,7 @@ filepath, directory, tagsoup, directory-listing-webpage-parser >= 0.1.1.0,- brick >= 0.13 && < 0.19, vty, microlens,+ brick >= 0.17 && < 0.21, vty, microlens, conduit, conduit-extra, http-conduit, http-types, resourcet, configurator >= 0.3,
src/Cache.hs view
@@ -15,7 +15,7 @@ import Text.HTML.DirectoryListing.Type import Configure-import Types +import Types -- | this conversion may lose accuracy? instance Binary LocalTime where@@ -38,7 +38,7 @@ , lastModified = l , fileSize = f }- + writeCache :: [Entry] -> IO () writeCache es = do p <- getCacheFileLocation@@ -63,4 +63,4 @@ downloaded <- doesFileExist $ lcd </> T.unpack (decodedName e) return $ File e "offline mode" downloaded noData = error "offline mode"- +
src/Configure.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} -module Configure +module Configure where import qualified Data.Text as T@@ -21,25 +21,25 @@ doesFileExist cfgFile >>= \case False -> return Nothing True -> Just <$> C.load [C.Required cfgFile]- + getUsername :: IO (Maybe Text) getUsername = getConfig >>= \case Nothing -> return Nothing- Just cfg -> C.lookup cfg "username" + Just cfg -> C.lookup cfg "username" getPassword :: IO (Maybe Text)-getPassword = +getPassword = getConfig >>= \case Nothing -> return Nothing- Just cfg -> C.lookup cfg "password" + Just cfg -> C.lookup cfg "password" getLocaldir :: IO (Maybe Text) getLocaldir = getConfig >>= \case Nothing -> return Nothing- Just cfg -> C.lookup cfg "localdir" + Just cfg -> C.lookup cfg "localdir" -- | return Nothing if there are no servpath or config file do not exist getServpath :: IO (Maybe Text)
src/DList.hs view
@@ -23,8 +23,8 @@ -- ^ DNode pool -newDList :: [DNode] -> DList -newDList = pushDList (DList S.empty []) +newDList :: [DNode] -> DList+newDList = pushDList (DList S.empty []) -- | filter the elements in a DList, this action directly modify -- the state of the top element of directory stack. The purpose of this function is@@ -42,10 +42,10 @@ 0 -> Nothing _ -> Just . fromMaybe 0 $ do oldSelVal <- oldSelectionVal- V.elemIndex oldSelVal newElements + V.elemIndex oldSelVal newElements -- | pop the directory stack (used when leaving a directory or exiting a filtered list)-popDList :: DList -> DList +popDList :: DList -> DList popDList dl@(DList _ [_]) = dl popDList (DList sDn (x:y:xs)) = DList sDn (x':xs) where@@ -84,7 +84,7 @@ return $ DList (S.update i e' sDn) (x:xs) replaceSelectedDNode :: DList -> DNode -> Maybe DList-replaceSelectedDNode dlst d = join $ mapSelectedDNodeM dlst (const $ Just d) +replaceSelectedDNode dlst d = join $ mapSelectedDNodeM dlst (const $ Just d) adjustCurrentBrickList :: Monad m => DList -> (L.List String Int -> m (L.List String Int)) -> m DList adjustCurrentBrickList (DList sDn (x:xs)) f = do@@ -95,4 +95,4 @@ renderDList (DList sDn (x:_)) render = L.renderList render True actualList where actualList = x & listElementsL %~ V.map (S.index sDn)- +
src/DownloadInterface.hs view
@@ -14,7 +14,7 @@ import Data.List import Data.Monoid import Control.Monad-import Control.Monad.Trans.Resource +import Control.Monad.Trans.Resource import Control.Monad.IO.Class import Control.Concurrent import Control.Applicative@@ -25,9 +25,7 @@ import qualified System.IO as IO import Distribution.System import qualified Control.Concurrent.Chan as C-#if MIN_VERSION_brick(0, 16, 0) import qualified Brick.BChan as BC-#endif import qualified Graphics.Vty as V import qualified Brick.Main as M@@ -63,17 +61,11 @@ data DownloadEvent = UpdateFinishedSize Integer | DownloadFinish -downloadInterface :: DownloadSettings -> IO () +downloadInterface :: DownloadSettings -> IO () downloadInterface dSettings = do-#if MIN_VERSION_brick(0, 16, 0) eventChan <- BC.newBChan 100000000 -- select a big enough number unless (justOpen dSettings) . void . forkIO $ download dSettings (BC.writeBChan eventChan)-#else- eventChan <- C.newChan - unless (justOpen dSettings) . void . forkIO $- download dSettings (C.writeChan eventChan)-#endif progressBarTotSize <- if justOpen dSettings then getLocalFileSize (T.unpack $ localStoragePath dSettings) >>= \case Nothing -> error "file do not exist."@@ -88,14 +80,18 @@ , M.appChooseCursor = M.neverShowCursor , M.appHandleEvent = appEvent , M.appStartEvent = return- , M.appAttrMap = const theMap + , M.appAttrMap = const theMap } appEvent :: DownloadState -> T.BrickEvent String DownloadEvent -> T.EventM String (T.Next DownloadState) appEvent ds@(DownloadState _) be = case be of T.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) "")+#if MIN_VERSION_brick(0, 19, 0)+ V.EvKey (V.KChar 'o') [] -> M.continue $ UserInput ds (E.editor "command" (Just 1) "")+#else+ V.EvKey (V.KChar 'o') [] -> M.continue $ UserInput ds (E.editor "command" (str . unlines) (Just 1) "")+#endif V.EvKey V.KEnter [] -> do liftIO $ localStoragePath dSettings `openBy` "" M.continue ds@@ -106,7 +102,11 @@ appEvent FinishedState be = case be of T.VtyEvent e -> case e of V.EvKey (V.KChar 'q') _ -> M.halt FinishedState- V.EvKey (V.KChar 'o') [] -> M.continue $ UserInput FinishedState (E.editor "command" (str.unlines) (Just 1) "")+#if MIN_VERSION_brick(0, 19, 0)+ V.EvKey (V.KChar 'o') [] -> M.continue $ UserInput FinishedState (E.editor "command" (Just 1) "")+#else+ V.EvKey (V.KChar 'o') [] -> M.continue $ UserInput FinishedState (E.editor "command" (str . unlines) (Just 1) "")+#endif V.EvKey V.KEnter [] -> do liftIO $ localStoragePath dSettings `openBy` "" M.halt FinishedState@@ -149,12 +149,16 @@ drawUI (UserInput (UserInput _ _) _) = error "unexpected state in UserInput state." drawUI (UserInput s ed) = (padTop (T.Pad 1) . vLimit 5 $ ask) : drawUI s where- ask = C.vCenter . C.hCenter . - hLimit 50 . vLimit 5 . + ask = C.vCenter . C.hCenter .+ hLimit 50 . vLimit 5 . B.borderWithLabel (str "please input a program name") .- forceAttr "input box" . + forceAttr "input box" . hLimit 40 $+#if MIN_VERSION_brick(0, 19, 0)+ E.renderEditor (str . unlines) True ed+#else E.renderEditor True ed+#endif M.customMain (V.mkVty mempty) (Just eventChan) theApp initialState return () @@ -172,7 +176,7 @@ filepath = T.unpack file addq :: String -> String addq s = "\"" ++ s ++ "\""- + getContentLength :: DownloadSettings -> IO Integer getContentLength dSettings = do let (req, manager) = networkResource dSettings $ relativeUrl dSettings@@ -190,8 +194,8 @@ fileExist path >>= \case False -> return Nothing True -> Just . fromIntegral . fileSize <$> getFileStatus path- -download :: DownloadSettings -> ++download :: DownloadSettings -> (DownloadEvent -> IO ()) -> IO () download dSettings tell = do
src/EntryAttrViewer.hs view
@@ -21,14 +21,14 @@ (C.txt info :: Widget String) where info = T.unlines $- zipWith (\describ s -> T.intercalate "\n" . + zipWith (\describ s -> T.intercalate "\n" . U.cutTextByDisplayLength U.terminalWidth $ describ `T.append` ": " `T.append` s )- [ "visible name" - , "decoded name" - , "url" - , "file size" + [ "visible name"+ , "decoded name"+ , "url"+ , "file size" , "downloaded" ] [ visibleName entry
src/Main.hs view
@@ -61,7 +61,7 @@ , M.appChooseCursor = M.neverShowCursor , M.appHandleEvent = appEvent , M.appStartEvent = return- , M.appAttrMap = const theMap + , M.appAttrMap = const theMap } appEvent :: MainState -> T.BrickEvent String e -> T.EventM String (T.Next MainState) appEvent ls@(LState dlst) (T.VtyEvent e) = case e of@@ -76,7 +76,7 @@ File entry url False -> do let fn = decodedName entry path <- liftIO $ Conf.getLocaldir >>= \case- Nothing -> return fn + Nothing -> return fn Just pre -> return $ T.pack (T.unpack pre </> T.unpack fn) let dui = downloadInterface DownloadSettings { networkResource = nr , relativeUrl = url@@ -87,26 +87,30 @@ M.suspendAndResume $ do dui ex <- doesFileExist (T.unpack path)- return $ LState (fromJust $ replaceSelectedDNode dlst (File entry url ex)) + return $ LState (fromJust $ replaceSelectedDNode dlst (File entry url ex)) -- ^ this fromJust is ok since we can be sure that -- there has something been selected. However this need to perform refactor in the future File entry url True -> do -- already downloaded file let fn = decodedName entry path <- liftIO $ Conf.getLocaldir >>= \case- Nothing -> return fn + Nothing -> return fn Just pre -> return $ T.pack (T.unpack pre </> T.unpack fn) let dui = downloadInterface DownloadSettings { networkResource = nr , relativeUrl = url , localStoragePath = path , justOpen = mdf /= [V.MMeta]- , continueDownload = mdf == [V.MMeta] + , continueDownload = mdf == [V.MMeta] } M.suspendAndResume $ dui >> return ls V.EvKey V.KLeft [] -> M.continue . LState $ popDList dlst V.EvKey V.KRight [] -> case extractSelectedDNode dlst of Nothing -> M.continue ls Just d -> M.suspendAndResume $ entryAttrViewer d >> return ls- V.EvKey (V.KChar '/') [] -> M.continue $ SearchState (dupDList dlst) (E.editor "searchBar" (str.unlines) (Just 1) "")+#if MIN_VERSION_brick(0, 19, 0)+ V.EvKey (V.KChar '/') [] -> M.continue $ SearchState (dupDList dlst) (E.editor "searchBar" (Just 1) "")+#else+ V.EvKey (V.KChar '/') [] -> M.continue $ SearchState (dupDList dlst) (E.editor "searchBar" (str . unlines) (Just 1) "")+#endif V.EvKey (V.KChar 'd') [] -> case extractSelectedDNode dlst of Nothing -> M.continue ls Just dnode -> case dnode of@@ -115,7 +119,7 @@ File entry url True -> do -- already downloaded file let fn = decodedName entry path <- liftIO $ Conf.getLocaldir >>= \case- Nothing -> return $ T.unpack fn + Nothing -> return $ T.unpack fn Just pre -> return $ T.unpack pre </> T.unpack fn liftIO $ removeFile path ex <- liftIO $ doesFileExist path@@ -132,7 +136,7 @@ _ -> M.continue $ LState dlst ev -> do newEd <- E.handleEditorEvent ev ed- let + let linesToALine [l] = l linesToALine _ = error "not one line of words in the search bar, why?" keyword = T.pack . linesToALine $ E.getEditContents newEd@@ -155,7 +159,7 @@ -- | use cropping to draw UI in the future? drawUI :: MainState -> [Widget String] drawUI mainState = case mainState of- (LState dlst) -> [ C.hCenter . hLimit U.terminalWidth $ + (LState dlst) -> [ C.hCenter . hLimit U.terminalWidth $ vBox [entryList dlst, statusBar (extractSelectedDNode dlst)] ] (SearchState dlst e) -> [ C.hCenter . hLimit U.terminalWidth $@@ -166,9 +170,7 @@ listDrawElement :: Bool -> DNode -> [Widget String] listDrawElement sel dn = [ color (not sel) attrName . vLimit 3 . hLimit 1 $ fill ' ' , color sel attrName text-#if MIN_VERSION_brick(0, 14, 0) , color (not sel) attrName . vLimit 3 . hLimit 1 $ fill ' '-#endif ] where attrName = case dn of@@ -178,11 +180,7 @@ name = case dn of Directory a _ -> a File a _ _ -> a-#if MIN_VERSION_brick(0, 14, 0) text = txt . placeTextIntoRectangle 3 (U.terminalWidth-2) . stripWidth $ decodedName name-#else- text = txt . placeTextIntoRectangle 3 (U.terminalWidth-1) . stripWidth $ decodedName name-#endif color True attr = withAttr attr color False _ = id stripWidth :: Text -> Text@@ -190,7 +188,11 @@ [] -> "" [singleLine] -> singleLine (x:_) -> x `T.append` "..."+#if MIN_VERSION_brick(0, 19, 0)+ searchBar ed = forceAttr "searchBar" $ hBox [txt " search: ", E.renderEditor (str . unlines) True ed]+#else searchBar ed = forceAttr "searchBar" $ hBox [txt " search: ", E.renderEditor True ed]+#endif statusBar = withAttr "statusBar" . str . expand . info info Nothing = " Nothing selected by user" info (Just sel) = " " ++ show (lastModified etr) ++ " " ++ maybe "Directory" friendlySize (fileSize etr)@@ -201,7 +203,7 @@ expand s = s ++ replicate 88 ' ' initializeResource :: IO ([DNode], NetworkResource)-initializeResource = +initializeResource = getArgs >>= \case ["--offline"] -> readCache >>= \case Nothing -> error "no offline data or data corrupted."@@ -213,7 +215,7 @@ Just ru -> Conf.getUsername >>= \case Nothing -> return (ru, Nothing) Just user -> Conf.getPassword >>= \case- Nothing -> do + Nothing -> do pass <- U.askPassword return (ru, Just (user, pass)) Just pass -> return (ru, Just (user, pass))@@ -222,6 +224,6 @@ putStrLn "loading webpage..." putStrLn "(you can use 'pgdl --offline' to browse the webpage you load last time)" nr <- genNetworkResource rootUrl up- dNodes <- fetch nr + dNodes <- fetch nr return (dNodes, nr)
src/Networking.hs view
@@ -25,7 +25,7 @@ import qualified Configure as Conf import Types -type NetworkResource = Text -> (Request, Manager) +type NetworkResource = Text -> (Request, Manager) -- ^ relative path genNetworkResource :: Text -> -- ^ webpage url (root)@@ -43,9 +43,9 @@ Just (u, p) -> applyBasicAuth (encodeUtf8 u) (encodeUtf8 p) manager <- newManager tlsManagerSettings return $ \t -> (genReq t, manager)- -getWebpage :: NetworkResource -> ++getWebpage :: NetworkResource -> Text -> -- relative path IO Text getWebpage nr rp = do
src/Utils.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} -module Utils +module Utils where import qualified Data.Text as T@@ -10,7 +10,7 @@ import System.IO import qualified Graphics.Text.Width as TW --- | give a file size in bytes, return pretty file size +-- | give a file size in bytes, return pretty file size -- represent in KB, MB, GB or TB friendlySize :: Integer -> String friendlySize b@@ -56,7 +56,7 @@ go _ acc [] | null acc = [] | otherwise = [reverse acc]- go lsum acc str@(x:xs) + go lsum acc str@(x:xs) | lsum + snd x <= len = go (lsum + snd x) (fst x : acc) xs | otherwise = reverse acc : go 0 "" str @@ -73,7 +73,7 @@ placeTextIntoRectangle :: Int -> -- ^ height Int -> -- ^ width Text -> Text-placeTextIntoRectangle h w t +placeTextIntoRectangle h w t | l > w = error "placeTextIntoRectangle: text too long" | otherwise = T.unlines $ replicate (h `div` 2) (T.replicate w " ") ++