pgdl 9.2 → 9.3
raw patch · 10 files changed
+273/−233 lines, 10 filesdep +containersdep +microlensdep ~brick
Dependencies added: containers, microlens
Dependency ranges changed: brick
Files
- pgdl.cabal +6/−6
- src/Cache.hs +2/−2
- src/DList.hs +98/−0
- src/DownloadInterface.hs +5/−5
- src/EntryAttrViewer.hs +3/−40
- src/Local.hs +0/−21
- src/Main.hs +121/−144
- src/Networking.hs +2/−2
- src/Types.hs +3/−3
- src/Utils.hs +33/−10
pgdl.cabal view
@@ -1,6 +1,6 @@ name: pgdl-version: 9.2+version: 9.3 license: PublicDomain license-file: LICENSE author: mingchuan@@ -11,7 +11,7 @@ cabal-version: >=1.10 description: pgdl is a program for viewing and accessing directory listing webpage in terminal. .- Browsing files on directory listings like this and this is often annoying and hard to find the files we want.+ Browsing files on directory listings like <https://www.kernel.org/pub/> and <https://nixos.org/channels/> is often annoying and hard to find the sutff we want. . pgdl provids a simple interface for browsing and downloading the files in web-engine-generated directory listings. @@ -25,11 +25,11 @@ executable pgdl hs-source-dirs: src main-is: Main.hs- other-modules: Cache, DownloadInterface, Local+ other-modules: Cache, DownloadInterface Networking, Utils, Configure,- EntryAttrViewer, Types+ EntryAttrViewer, Types, DList build-depends: base == 4.*,- vector,+ vector, containers, text, bytestring, Cabal, time, unix, process,@@ -37,7 +37,7 @@ data-default, tagsoup, directory-listing-webpage-parser >= 0.1.1.0,- brick, vty,+ brick == 0.7.*, vty, microlens, conduit, conduit-extra, http-conduit, http-types, resourcet, configurator >= 0.3,
src/Cache.hs view
@@ -11,11 +11,11 @@ import Data.Time.LocalTime import Data.Time.Clock.POSIX import System.Directory+import System.FilePath.Posix import Text.HTML.DirectoryListing.Type import Configure import Types -import Local -- | this conversion may lose accuracy? instance Binary LocalTime where@@ -60,7 +60,7 @@ toDNode lcd e | isDirectory e = return $ Directory e noData | otherwise = do- downloaded <- isFileDownloaded (decodedName e) lcd+ downloaded <- doesFileExist $ lcd </> T.unpack (decodedName e) return $ File e "offline mode" downloaded noData = error "offline mode"
+ src/DList.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++module DList+where++import Control.Applicative ((<$>))+import Data.Text (Text)+import Data.Maybe+import qualified Brick.Widgets.List as L+import qualified Brick.Types as T+import Brick.Widgets.List (listSelectedL, listElementsL, listSelectedElement)+import qualified Data.Vector as V+import Data.Vector ((!), Vector)+import Data.Sequence (Seq, (><))+import qualified Data.Sequence as S+import Lens.Micro+import Control.Monad+import Types+++-- | Note: The list in a DList should never be empty+data DList = DList (Seq DNode) [L.List String Int]+-- ^ DNode pool+++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+-- to provide the ability to dynamically filter a list+filterDList :: DList -> (DNode -> Bool) -> DList+filterDList (DList _ [_]) _ = error "try to filter a list without a reference (forgot to dupDList?)"+filterDList (DList sDn (x:ref:xs)) f = DList sDn (x':ref:xs)+ where+ newElements = V.filter (f . S.index sDn) $ ref ^. listElementsL+ x' = (listSelectedL .~ newSelLoc) $ x & listElementsL .~ newElements+ oldSelectionVal = snd <$> listSelectedElement x+ -- determine the new selected location carefully, brick/vector will often crash+ -- if the new location is out of bound.+ newSelLoc = case V.length newElements of+ 0 -> Nothing+ _ -> Just . fromMaybe 0 $ do+ oldSelVal <- oldSelectionVal+ V.elemIndex oldSelVal newElements ++-- | pop the directory stack (used when leaving a directory or exiting a filtered list)+popDList :: DList -> DList +popDList dl@(DList _ [_]) = dl+popDList (DList sDn (x:y:xs)) = DList sDn (x':xs)+ where+ oldSelectionVal = snd <$> listSelectedElement x+ newSelectionLoc = do+ oldVal <- oldSelectionVal+ V.elemIndex oldVal (y ^. listElementsL)+ x' = case newSelectionLoc of+ Nothing -> y+ Just i -> y & listSelectedL .~ Just i++-- | used when moving to the search (filter) state+dupDList :: DList -> DList+dupDList (DList sDn (x:xs)) = DList sDn (x:x:xs)++-- | used when entering a new directory+pushDList :: DList -> [DNode] -> DList+pushDList (DList sDn xs) dns = DList sDn' (x:xs)+ where+ sDn' = sDn >< S.fromList dns+ x = L.list "mainList" (V.enumFromN (S.length sDn) $ length dns) 3++-- | extract the currently selected DNode+extractSelectedDNode :: DList -> Maybe DNode+extractSelectedDNode (DList sDn (x:_)) = do+ (_, i) <- listSelectedElement x+ return $ S.index sDn i++-- | perform a monadic action on the selected element+mapSelectedDNodeM :: Monad m => DList -> (DNode -> m DNode) -> Maybe (m DList)+mapSelectedDNodeM (DList sDn (x:xs)) f = do+ (_, i) <- listSelectedElement x+ return $ do+ let e = S.index sDn i+ e' <- f e+ return $ DList (S.update i e' sDn) (x:xs)++replaceSelectedDNode :: DList -> DNode -> Maybe DList+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+ x' <- f x+ return $ DList sDn (x':xs)++renderDList :: DList -> (Bool -> DNode -> T.Widget String) -> T.Widget String+renderDList (DList sDn (x:_)) render = L.renderList render True actualList+ where+ actualList = x & listElementsL %~ V.map (S.index sDn)+
src/DownloadInterface.hs view
@@ -53,7 +53,7 @@ -- bytes already downloaded data DownloadState = DownloadState Integer | FinishedState- | UserInput DownloadState E.Editor+ | UserInput DownloadState (E.Editor String) -- ^ download progress data DEvent = VtyEvent V.Event@@ -82,7 +82,7 @@ , M.appAttrMap = const theMap , M.appLiftVtyEvent = VtyEvent }- appEvent :: DownloadState -> DEvent -> T.EventM (T.Next DownloadState)+ appEvent :: DownloadState -> DEvent -> T.EventM String (T.Next DownloadState) appEvent ds@(DownloadState _) de = case de of VtyEvent e -> case e of V.EvKey V.KEsc [] -> M.halt ds@@ -114,7 +114,7 @@ FinishedState -> M.halt FinishedState _ -> error "unexpected state in UserInput state." ev -> do- newEd <- T.handleEvent ev ed+ newEd <- E.handleEditorEvent ev ed M.continue $ UserInput st newEd UpdateFinishedSize b -> M.continue (UserInput (DownloadState b) ed) DownloadFinish -> M.continue (UserInput FinishedState ed)@@ -122,7 +122,7 @@ , (P.progressIncompleteAttr, V.black `on` V.white) , ("input box", V.black `on` V.blue) ]- drawUI :: DownloadState -> [Widget]+ drawUI :: DownloadState -> [Widget String] drawUI (DownloadState bytes) = [vBox [bar, note]] where bar = C.vCenter . C.hCenter $ P.progressBar Nothing (fromIntegral bytes / fromIntegral progressBarTotSize)@@ -143,7 +143,7 @@ B.borderWithLabel (str "please input a program name") . forceAttr "input box" . hLimit 40 $- E.renderEditor ed+ E.renderEditor True ed M.customMain (V.mkVty Data.Default.def) eventChan theApp initialState return ()
src/EntryAttrViewer.hs view
@@ -5,55 +5,18 @@ import Data.Text (Text) import qualified Data.Text as T-import Control.Monad--import qualified Graphics.Vty as V import qualified Brick.Main as M-import qualified Brick.Types as T-import qualified Brick.Widgets.ProgressBar as P import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Core as C-import qualified Brick.AttrMap as A-import Brick.Types (Widget)-import Brick.Widgets.Core-import Brick.Util (on) -import Types import Text.HTML.DirectoryListing.Type-+import Types import qualified Utils as U entryAttrViewer :: DNode -> IO ()--- | Temporary use File to process Directory... entryAttrViewer (Directory entry _) = entryAttrViewer (File entry "directory no link." False)-entryAttrViewer (File entry url downloaded) = do- let- initialState :: () - initialState = ()- theApp =- M.App { M.appDraw = drawUI- , M.appChooseCursor = M.neverShowCursor- , M.appHandleEvent = appEvent- , M.appStartEvent = return- , M.appAttrMap = const theMap - , M.appLiftVtyEvent = id- }- appEvent :: () -> V.Event -> T.EventM (T.Next ())- appEvent () e = case e of- V.EvKey V.KEsc [] -> M.halt ()- V.EvKey (V.KChar 'q') [] -> M.halt ()- V.EvKey V.KLeft [] -> M.halt ()- _ -> M.continue ()- theMap = A.attrMap V.defAttr [ (P.progressCompleteAttr, V.black `on` V.cyan)- , (P.progressIncompleteAttr, V.black `on` V.white)- ]- drawUI :: () -> [Widget]- drawUI _ = [ui]- where- ui = C.vCenter . C.hCenter .- C.hLimit U.terminalWidth . C.txt $ info- M.defaultMain theApp initialState- return ()+entryAttrViewer (File entry url downloaded) =+ M.simpleMain . C.vCenter . C.hCenter . C.hLimit U.terminalWidth . C.txt $ info where info = T.unlines $ zipWith (\describ s -> T.intercalate "\n" .
− src/Local.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-}--module Local-where--import System.Directory-import System.FilePath.Posix-import Data.Text (Text)-import qualified Data.Text as T---- | determine whether a file is in specified directory-isFileDownloaded :: Text -> -- ^ file name- String -> -- ^ local directory- IO Bool-isFileDownloaded fn path = doesFileExist $ path </> T.unpack fn- -deleteFile :: Text -> -- ^ file name (may be a absolute path)- IO ()-deleteFile = removeFile . T.unpack-
src/Main.hs view
@@ -6,16 +6,13 @@ where import qualified Data.Text as T-import qualified Data.Vector as V import Data.Text (Text) import Data.Maybe-import DownloadInterface-import Control.Monad import Control.Monad.IO.Class import Control.Applicative-import System.FilePath-import System.Environment-import System.IO+import System.FilePath ((</>))+import System.Environment (getArgs)+import System.Directory (removeFile, doesFileExist) import Text.HTML.DirectoryListing.Type import qualified Graphics.Vty as V@@ -25,61 +22,29 @@ import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Edit as E import qualified Brick.AttrMap as A-import Brick.Types (Widget) import Brick.Widgets.Core+import Brick.Types (Widget) import Brick.Util (on) +import DownloadInterface import EntryAttrViewer import Utils import qualified Configure as Conf import Cache import Types-import Local import Networking+import DList import qualified Utils as U --- | father contents -data MainState = LState (Maybe MainState) (L.List DNode)- | SearchState MainState (L.List DNode) E.Editor-+data MainState = LState DList+ | SearchState DList (E.Editor String) main :: IO () main = do- let askPassword = do- putStr "please input password: "- hFlush stdout- hSetEcho stdin False- pass <- getLine- hSetEcho stdin True- putChar '\n'- return $ T.pack pass- (dNodes, nr) <- getArgs >>= \case- ["--offline"] -> readCache >>= \case- Nothing -> error "no offline data or data corrupted."- Just dlst -> return (dlst, error "no network resource, offline mode.")- online -> do- (rootUrl, up) <- case online of- [] -> Conf.getServpath >>= \case- Nothing -> error "example usage: pgdl https://www.kernel.org/pub/"- Just ru -> Conf.getUsername >>= \case- Nothing -> return (ru, Nothing)- Just user -> Conf.getPassword >>= \case- Nothing -> do - pass <- askPassword- return (ru, Just (user, pass))- Just pass -> return (ru, Just (user, pass))- [r] -> return (T.pack r, Nothing)- _ -> error "too many arguments."- putStrLn "loading webpage..."- putStrLn "(you can use 'pgdl --offline' to browse the webpage you load last time)"- nr <- genNetworkResource rootUrl up- dNodes <- fetch nr - return (dNodes, nr)+ (dNodes, nr) <- initializeResource let initialState :: MainState- initialState = LState Nothing lst- where- lst = L.list (T.Name "root") (V.fromList dNodes) 3+ initialState = LState $ newDList dNodes theApp = M.App { M.appDraw = drawUI , M.appChooseCursor = M.neverShowCursor@@ -88,89 +53,84 @@ , M.appAttrMap = const theMap , M.appLiftVtyEvent = id }- appEvent :: MainState -> V.Event -> T.EventM (T.Next MainState)- appEvent ls@(LState father lst) e = case e of+ appEvent :: MainState -> V.Event -> T.EventM String (T.Next MainState)+ appEvent ls@(LState dlst) e = case e of V.EvKey V.KEsc [] -> M.halt ls V.EvKey (V.KChar 'q') [] -> M.halt ls- V.EvKey V.KEnter mod -> case L.listSelectedElement lst of- Nothing -> M.continue ls- Just (rowNum, child) -> case child of- Directory entry dnsOp -> do- dns <- liftIO dnsOp -- grab the subdirectory- M.continue $ LState (Just ls) $ L.list (T.Name "root") (V.fromList dns) 3- File entry url False -> do- let fn = decodedName entry- path <- liftIO $ Conf.getLocaldir >>= \case- 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 = False- , continueDownload = False- }- -- | construct a newList, modify the downloaded- -- file's *downloaded state* to True.- -- Maybe this is not a good approach?- newList = L.listMoveTo rowNum . L.listInsert rowNum (File entry url True) . L.listRemove rowNum $ lst- M.suspendAndResume $ dui >> return (LState father newList)- File entry url True -> do -- already downloaded file- let fn = decodedName entry- path <- liftIO $ Conf.getLocaldir >>= \case- 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 = mod /= [V.MMeta]- , continueDownload = mod == [V.MMeta] - }- -- ^ not good, unsafe- M.suspendAndResume $ dui >> return ls- V.EvKey V.KLeft [] -> M.continue $ fromMaybe ls father- V.EvKey V.KRight [] -> case L.listSelectedElement lst of- Nothing -> M.continue ls- Just (_, sel) -> M.suspendAndResume $ entryAttrViewer sel >> return ls- V.EvKey (V.KChar '/') [] -> M.continue $ SearchState ls lst (E.editor "searchBar" (str.unlines) (Just 1) "")- V.EvKey (V.KChar 'd') [] -> case L.listSelectedElement lst of- Nothing -> M.continue ls- Just (rowNum, child) -> case child of- Directory _ _ -> M.continue ls- File entry url False -> M.continue ls- File entry url True -> do -- already downloaded file- let fn = decodedName entry- path <- liftIO $ Conf.getLocaldir >>= \case- Nothing -> return fn - Just pre -> return $ T.pack (T.unpack pre </> T.unpack fn)- liftIO $ deleteFile path- -- | very bad approach. File deletion may fail.- let newList = L.listMoveTo rowNum . L.listInsert rowNum (File entry url False) . L.listRemove rowNum $ lst- M.continue $ LState father newList- - -- ^ current list which reactively change with editor- ev -> M.continue =<< (LState father <$> T.handleEvent ev lst)- appEvent ss@(SearchState ms@(LState _ origLst) lst ed) e = case e of+ V.EvKey V.KEnter mdf -> case extractSelectedDNode dlst of+ Nothing -> M.continue ls+ Just dnode -> case dnode of+ Directory entry openOp -> do+ dns <- liftIO openOp -- grab the subdirectory+ M.continue $ LState (pushDList dlst dns)+ File entry url False -> do+ let fn = decodedName entry+ path <- liftIO $ Conf.getLocaldir >>= \case+ 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 = False+ , continueDownload = False+ }+ M.suspendAndResume $ do+ dui+ ex <- doesFileExist (T.unpack path)+ 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 + 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] + }+ 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) "")+ V.EvKey (V.KChar 'd') [] -> case extractSelectedDNode dlst of+ Nothing -> M.continue ls+ Just dnode -> case dnode of+ Directory _ _ -> M.continue ls+ File entry url False -> M.continue ls+ File entry url True -> do -- already downloaded file+ let fn = decodedName entry+ path <- liftIO $ Conf.getLocaldir >>= \case+ Nothing -> return $ T.unpack fn + Just pre -> return $ T.unpack pre </> T.unpack fn+ liftIO $ removeFile path+ ex <- liftIO $ doesFileExist path+ M.continue $ 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+ ev -> M.continue =<< do+ dlst' <- adjustCurrentBrickList dlst $ L.handleListEvent ev+ return $ LState dlst'+ appEvent ss@(SearchState dlst ed) e = case e of V.EvKey V.KEsc [] -> M.halt ss V.EvKey V.KEnter [] -> case E.getEditContents ed of- [""] -> M.continue ms -- ^ do nothing if the editor is empty- _ -> M.continue $ LState (Just ms) lst+ [""] -> M.continue (LState $ popDList dlst)+ _ -> M.continue $ LState dlst ev -> do- newEd <- T.handleEvent ev ed- -- | update the list, lst+ newEd <- E.handleEditorEvent ev ed let linesToALine [l] = l linesToALine _ = error "not one line of words in the search bar, why?"- -- | Why does L.listReplace require an Eq instance of Vector elements...?- applyFilter kw lst = replaceList newElms lst- where- newElms = V.filter (\dn -> kw `isKeyWordOf` getDNText dn) $ L.listElements lst- -- | sometime this will crash? how?- replaceList es l = l {L.listElements = es, L.listSelected = Just 0}- getDNText (Directory e _) = decodedName e- getDNText (File e _ _) = decodedName e - isKeyWordOf t1 t2 = T.toCaseFold t1 `T.isInfixOf` T.toCaseFold t2- M.continue $ SearchState ms (applyFilter (T.pack . linesToALine $ E.getEditContents newEd) origLst) newEd- appEvent SearchState {} _ = error "unexpected prev state in SearchState."+ keyword = T.pack . linesToALine $ E.getEditContents newEd+ cond :: DNode -> Bool+ cond (File entry _ _) = keyword `isKeyWordOf` decodedName entry+ cond (Directory entry _) = keyword `isKeyWordOf` decodedName entry+ isKeyWordOf a b = T.toCaseFold a `T.isInfixOf` T.toCaseFold b+ M.continue $ SearchState (filterDList dlst cond) newEd theMap = A.attrMap V.defAttr [ (L.listAttr, V.white `on` V.black) , ("directory", V.black `on` V.magenta) , ("file", V.black `on` V.cyan)@@ -181,22 +141,17 @@ M.defaultMain theApp initialState return () - -- | use cropping to draw UI in the future?-drawUI :: MainState -> [Widget]+drawUI :: MainState -> [Widget String] drawUI mainState = case mainState of- (LState _ l) -> [ C.hCenter . hLimit U.terminalWidth $- vBox [entryList l, statusBar l]- ]- (SearchState _ l e) -> [ C.hCenter . hLimit U.terminalWidth $- vBox [entryList l, searchBar e]- ]+ (LState dlst) -> [ C.hCenter . hLimit U.terminalWidth $+ vBox [entryList dlst, statusBar (extractSelectedDNode dlst)]+ ]+ (SearchState dlst e) -> [ C.hCenter . hLimit U.terminalWidth $+ vBox [entryList dlst, searchBar e]+ ] where- -- fixme (brick bug?): the vertical size of the list - -- is somewhat strange when the hroizontal size limit- -- is not the multiple of its element size (it is 3)- -- This strange behavior do not occur in vty-ui- entryList lst = L.renderList lst listDrawElement+ entryList dlist = renderDList dlist listDrawElement listDrawElement False (Directory a _) = C.hCenter . txt . mid . stripWidth $ decodedName a listDrawElement False (File a _ _) = C.hCenter . txt . mid . stripWidth $ decodedName a listDrawElement True d@(Directory _ _) = withAttr "directory" $ listDrawElement False d@@ -208,16 +163,38 @@ [] -> "" [singleLine] -> singleLine (x:_) -> x `T.append` "..."-- searchBar ed = forceAttr "searchBar" $ hBox [txt "search: ", E.renderEditor ed]-- statusBar lst = withAttr "statusBar" . str . expand $ info lst+ searchBar ed = forceAttr "searchBar" $ hBox [txt "search: ", E.renderEditor True ed]+ statusBar = withAttr "statusBar" . str . expand . info+ info Nothing = " Nothing selected by user"+ info (Just sel) = " " ++ show (lastModified e) ++ " " ++ maybe "Nothing" friendlySize (fileSize e)+ where+ e = entry sel+ entry (Directory e _) = e+ entry (File e _ _) = e expand s = s ++ replicate 88 ' '- info lst = case L.listSelectedElement lst of- Nothing -> "Nothing selected by user"- Just (_, sel) -> " " ++ show (lastModified entry) ++ " " ++ maybe "Nothing" friendlySize (fileSize entry)- where- entry = case sel of- Directory e _ -> e- File e _ _ -> e++initializeResource :: IO ([DNode], NetworkResource)+initializeResource = + getArgs >>= \case+ ["--offline"] -> readCache >>= \case+ Nothing -> error "no offline data or data corrupted."+ Just dlst -> return (dlst, error "no network resource, offline mode.")+ online -> do+ (rootUrl, up) <- case online of+ [] -> Conf.getServpath >>= \case+ Nothing -> error "example usage: pgdl https://www.kernel.org/pub/"+ Just ru -> Conf.getUsername >>= \case+ Nothing -> return (ru, Nothing)+ Just user -> Conf.getPassword >>= \case+ Nothing -> do + pass <- U.askPassword+ return (ru, Just (user, pass))+ Just pass -> return (ru, Just (user, pass))+ [r] -> return (T.pack r, Nothing)+ _ -> error "too many arguments."+ putStrLn "loading webpage..."+ putStrLn "(you can use 'pgdl --offline' to browse the webpage you load last time)"+ nr <- genNetworkResource rootUrl up+ dNodes <- fetch nr + return (dNodes, nr)
src/Networking.hs view
@@ -16,6 +16,7 @@ import Data.Maybe import Text.HTML.DirectoryListing.Type import Text.HTML.DirectoryListing.Parser+import System.Directory import System.FilePath.Posix import Control.Concurrent import Control.Applicative@@ -23,7 +24,6 @@ import Cache import qualified Configure as Conf import Types-import Local type NetworkResource = Text -> (Request, Manager) -- ^ relative path@@ -67,7 +67,7 @@ toDNode url e | isDirectory e = return $ Directory e childs | otherwise = do- downloaded <- isFileDownloaded (decodedName e) lcd+ downloaded <- doesFileExist $ lcd </> T.unpack (decodedName e) return $ File e (T.pack $ T.unpack url </> T.unpack (href e)) downloaded where childs :: IO [DNode]
src/Types.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE OverloadedStrings #-} module Types where import Text.HTML.DirectoryListing.Type import Data.Text (Text) -data DNode = Directory Entry (IO [DNode]) | File Entry Text Bool--- downloaded?+data DNode = Directory Entry (IO [DNode])+ | File Entry Text Bool+-- ^ is the file downloaded ?
src/Utils.hs view
@@ -4,11 +4,11 @@ module Utils where -import qualified Data.ByteString as B import qualified Data.Text as T import Data.Text (Text) import Text.Printf-import Data.Text.Encoding+import System.IO+import qualified Graphics.Text.Width as TW -- | give a file size in bytes, return pretty file size -- represent in KB, MB, GB or TB@@ -32,18 +32,18 @@ terminalWidth :: Num a => a terminalWidth = 80 +-- | charDisplayLen returns the display length of a character+charDisplayLen :: Char -> Integer+charDisplayLen c+ | w > 0 = fromIntegral w+ | otherwise = 2 -- assume unknown characters occupy 2 widths+ where+ w = TW.safeWcwidth c+ -- | return the estimated display length of a Text displayLength :: Text -> Integer displayLength = sum . map charDisplayLen . T.unpack --- | charDisplayLen determine a unicode character is a wide character or not--- (a wide character occupy 2 space in the terminal)--- this method may seem unreliable, but have no better idea.-charDisplayLen :: Char -> Integer-charDisplayLen c- | (B.length . encodeUtf8 . T.pack $ [c]) > 1 = 2- | otherwise = 1- -- | given a line of Text, cut it to a group of Text -- which have 'len' display length cutTextByDisplayLength :: Integer -> Text -> [Text]@@ -60,4 +60,27 @@ | lsum + snd x <= len = go (lsum + snd x) (fst x : acc) xs | otherwise = reverse acc : go 0 "" str +askPassword :: IO Text+askPassword = do+ putStr "please input password: "+ hFlush stdout+ hSetEcho stdin False+ pass <- getLine+ hSetEcho stdin True+ putChar '\n'+ return $ T.pack pass++placeTextIntoRectangle :: Int -> -- ^ height+ Int -> -- ^ width+ Text -> Text+placeTextIntoRectangle h w t + | l > w = error "placeTextIntoRectangle: text too long"+ | otherwise = T.unlines $+ replicate (h `div` 2) (T.replicate w " ") +++ [T.concat [T.replicate leftspace " ", t, T.replicate rightspace " "]] +++ replicate (h `div` 2) (T.replicate w " ")+ where+ l = fromIntegral $ displayLength t+ leftspace = (w-l) `div` 2+ rightspace = w - leftspace - l