diff --git a/pgdl.cabal b/pgdl.cabal
--- a/pgdl.cabal
+++ b/pgdl.cabal
@@ -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 and 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,
diff --git a/src/Cache.hs b/src/Cache.hs
--- a/src/Cache.hs
+++ b/src/Cache.hs
@@ -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"
diff --git a/src/DList.hs b/src/DList.hs
new file mode 100644
--- /dev/null
+++ b/src/DList.hs
@@ -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)
+
diff --git a/src/DownloadInterface.hs b/src/DownloadInterface.hs
--- a/src/DownloadInterface.hs
+++ b/src/DownloadInterface.hs
@@ -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 ()
diff --git a/src/EntryAttrViewer.hs b/src/EntryAttrViewer.hs
--- a/src/EntryAttrViewer.hs
+++ b/src/EntryAttrViewer.hs
@@ -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" .
diff --git a/src/Local.hs b/src/Local.hs
deleted file mode 100644
--- a/src/Local.hs
+++ /dev/null
@@ -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
-
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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)
diff --git a/src/Networking.hs b/src/Networking.hs
--- a/src/Networking.hs
+++ b/src/Networking.hs
@@ -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]
diff --git a/src/Types.hs b/src/Types.hs
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -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 ?
diff --git a/src/Utils.hs b/src/Utils.hs
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -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