diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,4 +6,5 @@ Server: Only for nginx's file download page. The program will sort the files by date while the files in nginx's download page just show in file names' order. +Pass flag -f to read folder. diff --git a/pgdl.cabal b/pgdl.cabal --- a/pgdl.cabal +++ b/pgdl.cabal @@ -1,6 +1,6 @@ name: pgdl -version: 7.4 +version: 7.5 license: PublicDomain license-file: LICENSE author: sifmelcara @@ -16,6 +16,8 @@ Server: Only for nginx's file download page. . The program will sort the files by date while files in nginx's download page just sort in file name. + Pass argument -f to read folder. + synopsis: pgdownloader source-repository head diff --git a/src/AskScene.hs b/src/AskScene.hs --- a/src/AskScene.hs +++ b/src/AskScene.hs @@ -5,7 +5,6 @@ import Graphics.Vty.Widgets.All import Graphics.Vty.Input.Events -import qualified Data.Text as T import Control.Monad data AskScene = AskScene { sceneWidget :: Widget (Bordered Padded) diff --git a/src/Beaut.hs b/src/Beaut.hs --- a/src/Beaut.hs +++ b/src/Beaut.hs @@ -4,11 +4,14 @@ import Video -import Data.List import qualified Data.Text as T beaut :: Video -> T.Text -beaut (Video str _ _ _) +beaut (Video str _ _ _) = beautT str +beaut (Folder str _ _) = "\n" `T.append` str + +beautT :: T.Text -> T.Text +beautT str | length dat < 3 = "\n" `app` str | otherwise = T.intercalate "\n" [tb 4 `app` sbt, tb 10 `app` nme, @@ -20,6 +23,5 @@ app s1 s2 = s1 `T.append` s2 spl = filter (\t -> T.length t /= 0) . getTags ["[", "]"] . return getTags dl s = foldl (\ls d -> concatMap (T.splitOn d) ls) s dl - diff --git a/src/Chkcfg.hs b/src/Chkcfg.hs --- a/src/Chkcfg.hs +++ b/src/Chkcfg.hs @@ -5,26 +5,26 @@ import System.FilePath import Control.Monad +chkcfg :: IO () chkcfg = do flp <- fmap ( ".pgdl") getHomeDirectory fle <- doesFileExist flp unless fle $ do writeFile flp defcfg - error "please config file at ~/.pgdl first!" - -defcfg = unlines [ "", - "# example: ", - "# username = \"jack\" ", - "# password = \"mypassw\" ", - "# servpath = \"example.org/videodir/\" ", - "# localdir = \"/home/jack/Downloads/\" ", - "", - "# username and localdir is optional.", - "", - "username = \"\"", - "password = \"\"", - "servpath = \"\"", - "localdir = \"\"", - "" - ] + error "please config the file \"~/.pgdl\" first!" + where defcfg = unlines [ "" + , "# example: " + , "# username = \"jack\" " + , "# password = \"mypassw\" " + , "# servpath = \"example.org/videodir/\" " + , "# localdir = \"/home/jack/Downloads/\" " + , "" + , "# username and localdir is optional." + , "" + , "username = \"\"" + , "password = \"\"" + , "servpath = \"\"" + , "localdir = \"\"" + , "" + ] diff --git a/src/CrtInf.hs b/src/CrtInf.hs --- a/src/CrtInf.hs +++ b/src/CrtInf.hs @@ -8,13 +8,23 @@ crtInfPg :: Video -> T.Text crtInfPg vid = T.unlines ["", "", - "File name: " `app` (spl . vidName) vid, - "File size: " `app` vidSize vid, - "File date: " `app` vidDate vid, - "File link: " `app` (spl . vidLink) vid + "File name: " `app` (spl . getName) vid, + "File size: " `app` getSize vid, + "File date: " `app` getDate vid, + "File link: " `app` (spl . getLink) vid ] where app = T.append spl = T.intercalate "\n" . T.chunksOf 60 - - + getName v + | isVid v = vidName v + | otherwise = fldName v + getSize v + | isVid v = vidSize v + | otherwise = "I'm a folder" + getDate v + | isVid v = vidDate v + | otherwise = fldDate v + getLink v + | isVid v = vidLink v + | otherwise = fldLink v diff --git a/src/FetchHtml.hs b/src/FetchHtml.hs --- a/src/FetchHtml.hs +++ b/src/FetchHtml.hs @@ -7,17 +7,31 @@ import Network.HTTP import Network.URI import Data.Text.Encoding -import Data.ByteString import Data.Maybe +import System.FilePath +import Control.Applicative import qualified Data.Text as T fetchHtml :: IO T.Text -fetchHtml = do +fetchHtml = getTextContent =<< genURI + +fetchFld :: T.Text -> IO T.Text +fetchFld fnt = do + uri <- ( fn) <$> genURI + getTextContent uri + where fn = T.unpack fnt + +genURI :: IO String +genURI = do usrn <- getUsername usrp <- getPassword servp <- getServpath - let uri = "http://" ++ usrn ++ ":" ++ usrp ++ "@" ++ servp - res <- simpleHTTP . mkRequest GET . fromJust . parseURI $ uri + return $ "http://" ++ usrn ++ ":" ++ usrp ++ "@" ++ servp + +getTextContent :: String -> IO T.Text +getTextContent u = do + res <- simpleHTTP . mkRequest GET . fromJust . parseURI $ u cnt <- getResponseBody res return $ decodeUtf8 cnt + diff --git a/src/GenStat.hs b/src/GenStat.hs --- a/src/GenStat.hs +++ b/src/GenStat.hs @@ -16,10 +16,12 @@ , spc 20, st , spc 30 ] - where app = T.append - spc :: Int -> T.Text + where spc :: Int -> T.Text spc i = T.replicate i " " +genStat (Folder {}) = return "I'm a folder" + +waitingBar :: T.Text waitingBar = " Waiting for data..." `T.append` T.replicate 99 " " toStr :: IO Bool -> IO T.Text diff --git a/src/Getconfig.hs b/src/Getconfig.hs --- a/src/Getconfig.hs +++ b/src/Getconfig.hs @@ -5,7 +5,6 @@ import Control.Monad import Data.Maybe -import qualified Data.Text as T import qualified Data.Configurator as C getConfig :: IO (String, String, String, String) @@ -19,8 +18,15 @@ return (fj username, fj password, fj servpath, fj localdir) where fj = fromJust +getUsername :: IO String getUsername = fmap (\(r, _, _, _) -> r) getConfig + +getPassword :: IO String getPassword = fmap (\(_, r, _, _) -> r) getConfig + +getServpath :: IO String getServpath = fmap (\(_, _, r, _) -> r) getConfig + +getLocaldir :: IO String getLocaldir = fmap (\(_, _, _, r) -> r) getConfig diff --git a/src/Log.hs b/src/Log.hs --- a/src/Log.hs +++ b/src/Log.hs @@ -17,6 +17,7 @@ decVid :: T.Text -> [Video] decVid = map (\t -> Video t "" "" "") . T.lines +logname :: FilePath logname = ".pgdl.cache" writeVid :: [Video] -> IO () @@ -34,6 +35,7 @@ return $ decVid dat False -> return dlnVid +dlnVid :: [Video] dlnVid = [Video "Downloading..." "" "" ""] diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} import FetchHtml import PrsVid @@ -17,16 +18,13 @@ import Control.Applicative import Control.Concurrent import Control.Monad -import System.Directory import System.Exit import System.Environment -import System.FilePath -import System.IO import Graphics.Vty import Graphics.Vty.Widgets.All -import qualified Data.Text as T +main :: IO () main = do chkcfg @@ -35,7 +33,8 @@ lst <- newList 3 diskrd <- readVid args <- getArgs - let diskV = if null args then diskrd else dlnVid + let diskV = if null args then diskrd + else dlnVid forM_ diskV $ \v -> addToList lst v =<< plainText (beaut v) lfg <- newFocusGroup addToFocusGroup lfg lst @@ -78,12 +77,12 @@ join $ addToCollection c inf ifsfg return True _ -> return False - - schedule $ do + if null args || head args /= "-f" + then schedule $ do forkIO $ do - rd <- prsVid <$> fetchHtml - vdlst <- search rd <$> getArgs - when (length vdlst < 1) $ error "empty list!" + rd <- prsVid <$> fetchHtml + let vdlst = search rd args + when (length vdlst < 1) $ error "no video found!" Just (_, (oldItm, _)) <- getSelected lst clearList lst forM_ vdlst $ \v -> addToList lst v =<< plainText (beaut v) @@ -91,32 +90,44 @@ Just ind -> setSelected lst ind Nothing -> return () - onSelectionChange lst $ \sle -> case sle of - SelectionOn _ itm _ -> fex itm >>= \case - True -> setFocusAttribute lst (black `on` red) - False -> setFocusAttribute lst (black `on` cyan) - _ -> return () - - onSelectionChange lst $ \sle -> case sle of - SelectionOn _ itm _ -> setText statBar =<< genStat itm - _ -> return () - - - onKeyPressed lst $ \_ key _ -> case key of - KEnter -> do - Just (_, (itm, _)) <- getSelected lst - fex itm >>= \case - True -> chgdl - False -> playVid itm - return True - _ -> return False + vLstAction lst chgdl statBar - (null <$> getArgs) >>= \case + (null <$> getArgs) >>= \case True -> void . forkIO $ writeVid vdlst _ -> return () return () return () + else schedule $ do + forkIO $ do + rd <- prsFld <$> fetchHtml + let fdlst = search rd (tail args) + when (length fdlst < 1) $ error "no folder found!" + clearList lst + forM_ fdlst $ \v -> addToList lst v =<< plainText (beaut v) + setFocusAttribute lst (black `on` cyan) + return () + return () + let openFld lnk = do + ctnt <- (map (attcLink lnk) . prsVid) <$> fetchFld lnk + when (null ctnt) $ error "no video in the folder!" + clearList lst + forM_ ctnt $ \v -> addToList lst v =<< plainText (beaut v) + vLstAction lst chgdl statBar + return () + + onKeyPressed lst $ \_ key _ -> case key of + KEnter -> do + Just (_, (itm, _)) <- getSelected lst + case itm of + Folder _ lnk _ -> openFld lnk + v -> fex v >>= \case + True -> chgdl + False -> playVid itm + return True + _ -> return False + + runUi c $ defaultContext {normalAttr = white `on` black, focusAttr = black `on` blue } @@ -125,5 +136,16 @@ KChar 'q' -> exitSuccess _ -> return False +vLstAction lst chgdl statBar = do + onSelectionChange lst $ \sle -> case sle of + SelectionOn _ itm _ -> fex itm >>= \case + True -> setFocusAttribute lst (black `on` red) + False -> setFocusAttribute lst (black `on` cyan) + _ -> return () + onSelectionChange lst $ \sle -> case sle of + SelectionOn _ itm _ -> setText statBar =<< genStat itm + _ -> return () + + where fex itm = downloaded $ vidName itm diff --git a/src/PlayVid.hs b/src/PlayVid.hs --- a/src/PlayVid.hs +++ b/src/PlayVid.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module PlayVid where @@ -10,7 +11,6 @@ import System.Process import System.Directory import System.FilePath.Posix -import System.IO import System.Exit import qualified Data.Text as T @@ -44,7 +44,6 @@ justPlay :: Video -> IO () justPlay vid = do - servpath <- getServpath localdir <- getLocaldir let localloc = localdir vn case buildOS of diff --git a/src/PrsVid.hs b/src/PrsVid.hs --- a/src/PrsVid.hs +++ b/src/PrsVid.hs @@ -6,8 +6,6 @@ import GenName import SortVid -import Data.List -import Data.Function import Text.HTML.TagSoup import qualified Data.Text as T @@ -24,7 +22,7 @@ | isTagText tg = fromTagText tg | otherwise = "" genVid [lnk, _, tx] = Video {vidLink = lnk, vidName = nm, vidDate = dt, vidSize = sz} - where dt = T.intercalate " " . take 2 $ T.words tx + where dt = T.intercalate "-" . take 2 $ T.words tx sz = T.pack . hsz . read . last . words . T.unpack $ tx hsz :: Int -> String hsz i = show (i `div` (1024*1024)) ++ "M" @@ -32,30 +30,20 @@ genVid _ = Video "Parse Fail" "" "" "" fmts = [".mp4", ".avi", ".mkv"] - -{- - map (genVidInf . filter (not. T.null) . map getInf) . - filter isVideoLine . - map parseTags . T.lines - where isVideoLine = any isNameTag - isNameTag tg - | isTagText tg = any (`T.isSuffixOf` fromTagText tg) vdfmt - | otherwise = False - isLinkTag tg - | isTagOpen tg = not. T.null $ fromAttrib "href" tg - | otherwise = False - isDtSzTag tg - | isTagText tg = all (`T.isInfixOf` fromTagText tg) ["-", ":"] +prsFld :: T.Text -> [Video] +prsFld = sortVid . map (mkFld . filter (not . T.null) . map pullText) . filter isFldLn . map parseTags . T.lines + where isFldLn = isFldLnk . head + isFldLnk tg + | isTagOpen tg = (`T.isSuffixOf` fromAttrib "href" tg) "/" | otherwise = False - getInf tg - | isNameTag tg = fromTagText tg - | isLinkTag tg = fromAttrib "href" tg - | isDtSzTag tg = $ fromTagText tg + mkFld :: [T.Text] -> Video + mkFld [lnk, _, tx] = Folder {fldName = nm, fldLink = lnk, fldDate = dt} + where nm = T.init . genName $ lnk + dt = T.intercalate "-" . take 2 $ T.words tx + mkFld _ = Folder "Folder Parse Fail" "" "" + pullText tg + | isTagOpen tg = fromAttrib "href" tg + | isTagText tg = fromTagText tg | otherwise = "" - genVidInf [lnk, nm, dt, sz] = Video {vidLink = lnk, vidName = nm, vidDate = dt, vidSize = sz} - genVidInf _ = Video {vidLink = T.empty, vidName = "parse error", vidDate = "", vidSize = ""} - vdfmt = [".avi", ".mp4", ".mkv"] - --} diff --git a/src/Search.hs b/src/Search.hs --- a/src/Search.hs +++ b/src/Search.hs @@ -4,12 +4,11 @@ import Video -import Data.Function import qualified Data.Text as T search :: [Video] -> [String] -> [Video] -search vids par = filter pred vids - where pred v = all (\tar -> (T.pack tar) `T.isInfixOf` name) par - where name = vidName v +search vids par = filter ok vids + where ok v = all (\tar -> T.pack tar `T.isInfixOf` name) par + where name = if isVid v then vidName v else fldName v diff --git a/src/SortVid.hs b/src/SortVid.hs --- a/src/SortVid.hs +++ b/src/SortVid.hs @@ -9,12 +9,17 @@ import Data.Function sortVid :: [Video] -> [Video] -sortVid = sortBy (cmpDate `on` vidDate) +sortVid = sortBy cmpv -cmpDate :: T.Text -> T.Text -> Ordering -cmpDate = flip compare `on` prs +cmpv :: Video -> Video -> Ordering +cmpv v1 v2 + | isVid v1 = (cmp `on` vidDate) v1 v2 + | otherwise = (cmp `on` fldDate) v1 v2 + +cmp :: T.Text -> T.Text -> Ordering +cmp = flip compare `on` prs where prs tx = [year, tranMon mon, day, time] - where [day, mon, year, time] = concat . map (T.splitOn "-") . (T.splitOn " ") $ tx + where [day, mon, year, time] = T.splitOn "-" tx tranMon :: T.Text -> T.Text tranMon m = case m of @@ -30,4 +35,5 @@ "Oct" -> "J" "Nov" -> "K" "Dec" -> "L" + _ -> " " diff --git a/src/TestExist.hs b/src/TestExist.hs --- a/src/TestExist.hs +++ b/src/TestExist.hs @@ -4,7 +4,6 @@ import Getconfig -import Data.Function import System.Directory import System.FilePath @@ -13,6 +12,6 @@ downloaded :: T.Text -> IO Bool downloaded t = do lcd <- getLocaldir - doesFileExist $ lcd (T.unpack t) + doesFileExist $ lcd T.unpack t diff --git a/src/Video.hs b/src/Video.hs --- a/src/Video.hs +++ b/src/Video.hs @@ -2,15 +2,37 @@ module Video where +import System.FilePath import qualified Data.Text as T data Video = Video { vidName :: T.Text , vidLink :: T.Text , vidSize :: T.Text , vidDate :: T.Text - } + } | + Folder { fldName :: T.Text + , fldLink :: T.Text + , fldDate :: T.Text + } instance Eq Video where x == y = vidName x == vidName y +isVid :: Video -> Bool +isVid Video {} = True +isVid _ = False + +isFld :: Video -> Bool +isFld v = not $ isVid v + + +attcLink :: T.Text -> Video -> Video +attcLink fnt vid = Video { vidName = name + , vidLink = T.pack $ fn link + , vidSize = size + , vidDate = date + } + where fn = T.unpack fnt + (Video name linkt size date) = vid + link = T.unpack linkt