pgdl 7.5 → 7.6
raw patch · 11 files changed
+72/−53 lines, 11 files
Files
- README.md +8/−3
- pgdl.cabal +3/−4
- src/Beaut.hs +1/−1
- src/GenStat.hs +8/−1
- src/Log.hs +4/−1
- src/Main.hs +21/−32
- src/PlayVid.hs +2/−0
- src/PrsVid.hs +5/−3
- src/Search.hs +3/−2
- src/SortVid.hs +4/−3
- src/Video.hs +13/−3
README.md view
@@ -1,10 +1,15 @@ # pgdl a terminal user interface program that downloads a video from html and call vlc to play it immediately.+(Linux: vlc -f "video.mp4", MACOSX: open "video.mp4" -a vlc) Client: Only for Linux and MACOSX. 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.++The program will sort the video files and folders by date while files in nginx's download page just sort by name.++## Installing++cabal update <br>+cabal install pgdl
pgdl.cabal view
@@ -1,6 +1,6 @@ name: pgdl-version: 7.5+version: 7.6 license: PublicDomain license-file: LICENSE author: sifmelcara@@ -10,13 +10,12 @@ extra-source-files: README.md cabal-version: >=1.10 description: a terminal user interface program that downloads a video from html and call vlc to play it immediately.+ (Linux: vlc -f "video.mp4", MACOSX: open "video.mp4" -a vlc) . Client: Only for Linux and MACOSX.- . 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.+ The program will sort the video files and folders by date while files in nginx's download page just sort by name. synopsis: pgdownloader
src/Beaut.hs view
@@ -8,7 +8,7 @@ beaut :: Video -> T.Text beaut (Video str _ _ _) = beautT str-beaut (Folder str _ _) = "\n" `T.append` str+beaut (Folder str _ _) = beautT str beautT :: T.Text -> T.Text beautT str
src/GenStat.hs view
@@ -19,7 +19,14 @@ where spc :: Int -> T.Text spc i = T.replicate i " " -genStat (Folder {}) = return "I'm a folder"+genStat (Folder name _ date) = do+ return $ T.concat [ spc 3+ , date+ , spc 5+ , "I'm a folder"+ , spc 99+ ]+ where spc i = T.replicate i " " waitingBar :: T.Text waitingBar = " Waiting for data..." `T.append` T.replicate 99 " "
src/Log.hs view
@@ -12,7 +12,10 @@ import qualified Data.Text.IO as T encVid :: [Video] -> T.Text-encVid vs = T.intercalate "\n" $ map vidName vs+encVid vs = T.intercalate "\n" $ map genName vs+ where genName v+ | isVid v = vidName v+ | otherwise = fldName v decVid :: T.Text -> [Video] decVid = map (\t -> Video t "" "" "") . T.lines
src/Main.hs view
@@ -53,7 +53,8 @@ dfcg `onKeyPressed` tryExit lfg `onKeyPressed` tryExit- + + -- four button in ask scene's action onScePlay dlg $ \_ -> do Just (_, (itm, _)) <- getSelected lst justPlay itm@@ -64,6 +65,7 @@ onSceRemv dlg $ \_ -> do Just (_, (itm, _)) <- getSelected lst removeVid itm+ ifsfg <- newFocusGroup onKeyPressed ifsfg $ \_ key _ -> case key of KLeft -> chgls >> return True @@ -77,12 +79,11 @@ join $ addToCollection c inf ifsfg return True _ -> return False- if null args || head args /= "-f" - then schedule $ do+ schedule $ do forkIO $ do- rd <- prsVid <$> fetchHtml+ rd <- prsHtm <$> fetchHtml let vdlst = search rd args- when (length vdlst < 1) $ error "no video found!"+ when (length vdlst < 1) $ error "no video or folder found!" Just (_, (oldItm, _)) <- getSelected lst clearList lst forM_ vdlst $ \v -> addToList lst v =<< plainText (beaut v)@@ -90,32 +91,30 @@ Just ind -> setSelected lst ind Nothing -> return () - vLstAction lst chgdl statBar+ onSelectionChange lst $ \sle -> case sle of+ SelectionOn _ itm _ -> if isFld itm then setFocusAttribute lst (black `on` magenta)+ else 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 () (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 + ctnt <- (map (attcLink lnk) . prsHtm) <$> 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 () + -- User chose a folder or video ! onKeyPressed lst $ \_ key _ -> case key of KEnter -> do Just (_, (itm, _)) <- getSelected lst@@ -131,21 +130,11 @@ runUi c $ defaultContext {normalAttr = white `on` black, focusAttr = black `on` blue }- where fex itm = downloaded $ vidName itm- tryExit _ key _ = case key of+ where tryExit _ key _ = case key of 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+fex itm+ | isVid itm = downloaded $ vidName itm+ | otherwise = return False
src/PlayVid.hs view
@@ -16,6 +16,8 @@ playVid :: Video -> IO () playVid vid = do+ when (isFld vid) $ error "give playVid a folder."+ username <- getUsername password <- getPassword servpath <- getServpath
src/PrsVid.hs view
@@ -9,9 +9,11 @@ import Text.HTML.TagSoup import qualified Data.Text as T +prsHtm :: T.Text -> [Video]+prsHtm t = sortVid $ (prsVid t) ++ (prsFld t)+ prsVid :: T.Text -> [Video]-prsVid = sortVid .- map (genVid . filter (not . T.null) . map pullText) .+prsVid = map (genVid . filter (not . T.null) . map pullText) . filter isVidLn . map parseTags . T.lines where isVidLn = any isVidLnk isVidLnk tg@@ -31,7 +33,7 @@ fmts = [".mp4", ".avi", ".mkv"] prsFld :: T.Text -> [Video]-prsFld = sortVid . map (mkFld . filter (not . T.null) . map pullText) . filter isFldLn . map parseTags . T.lines+prsFld = 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) "/"
src/Search.hs view
@@ -4,11 +4,12 @@ import Video -+import Data.Function import qualified Data.Text as T search :: [Video] -> [String] -> [Video] search vids par = filter ok vids- where ok v = all (\tar -> T.pack tar `T.isInfixOf` name) par+ where ok v = all (\tar -> (T.pack tar) `ifx` name) par where name = if isVid v then vidName v else fldName v+ ifx = T.isInfixOf `on` T.toCaseFold
src/SortVid.hs view
@@ -12,9 +12,10 @@ sortVid = sortBy cmpv cmpv :: Video -> Video -> Ordering-cmpv v1 v2- | isVid v1 = (cmp `on` vidDate) v1 v2- | otherwise = (cmp `on` fldDate) v1 v2+cmpv = cmp `on` dt+ where dt v+ | isVid v = vidDate v+ | otherwise = fldDate v cmp :: T.Text -> T.Text -> Ordering cmp = flip compare `on` prs
src/Video.hs view
@@ -16,7 +16,10 @@ } instance Eq Video where- x == y = vidName x == vidName y+ x == y + | isVid x && isVid y = vidName x == vidName y+ | isFld x && isFld y = fldName x == fldName y+ | otherwise = False isVid :: Video -> Bool isVid Video {} = True@@ -27,12 +30,19 @@ attcLink :: T.Text -> Video -> Video-attcLink fnt vid = Video { vidName = name+attcLink fnt (Video name linkt size date) = 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+attcLink fnt (Folder name linkt date) = Folder+ { fldName = name+ , fldLink = T.pack $ fn </> link+ , fldDate = date+ }+ where fn = T.unpack fnt link = T.unpack linkt