pgdl 6.7 → 6.8
raw patch · 10 files changed
+65/−56 lines, 10 files
Files
- pgdl.cabal +1/−1
- src/Beaut.hs +2/−1
- src/Chkcfg.hs +1/−1
- src/FetchHtml.hs +5/−8
- src/Getconfig.hs +3/−2
- src/Log.hs +12/−13
- src/Main.hs +30/−22
- src/PlayVid.hs +4/−4
- src/PrsVid.hs +3/−2
- src/Search.hs +4/−2
pgdl.cabal view
@@ -1,6 +1,6 @@ name: pgdl-version: 6.7+version: 6.8 license: PublicDomain license-file: LICENSE author: sifmelcara
src/Beaut.hs view
@@ -2,9 +2,10 @@ module Beaut where +import Video+ import Data.List import qualified Data.Text as T-import Video beaut :: Video -> T.Text beaut vid
src/Chkcfg.hs view
@@ -2,8 +2,8 @@ module Chkcfg where import System.Directory-import Control.Monad import System.FilePath+import Control.Monad chkcfg = do flp <- fmap (</> ".pgdl") getHomeDirectory
src/FetchHtml.hs view
@@ -4,15 +4,14 @@ import Getconfig +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import Data.Text.Encoding+import Data.Maybe import Network.HTTP.Conduit-import qualified Data.ByteString.Char8 as C+ import qualified Data.Text as T import qualified Data.ByteString.Lazy.Char8 as LC-import qualified Data.ByteString as B-import Data.Text.Encoding-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Resource (runResourceT)-import Data.Maybe genReq :: IO Request genReq = do@@ -28,8 +27,6 @@ runResourceT $ do mgr <- liftIO $ newManager conduitManagerSettings res <- httpLbs rq mgr- -- conv <- liftIO $ open "utf-8" Nothing- -- liftIO . return . toUnicode conv . LC.toStrict $ responseBody res return . decodeUtf8 . LC.toStrict $ responseBody res
src/Getconfig.hs view
@@ -2,10 +2,11 @@ module Getconfig where -import qualified Data.Text as T-import qualified Data.Configurator as C import Control.Monad import Data.Maybe++import qualified Data.Text as T+import qualified Data.Configurator as C getConfig :: IO (T.Text, T.Text, T.Text, T.Text) getConfig = do
src/Log.hs view
@@ -1,33 +1,33 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-} module Log where import Video++import Control.Applicative +import Control.Monad import Data.Binary+import Data.Either import System.Directory import System.FilePath-import Control.Applicative ((<$>))+ import qualified Data.Text as T import qualified Data.Text.Encoding as T-import Data.Binary import qualified Data.ByteString.Lazy as B-import Control.Monad-import Data.Either instance Binary T.Text where put = put . T.encodeUtf8 get = T.decodeUtf8 <$> get instance Binary Video where- put vid = do- put $ vidName vid- get = do- name <- get+ put vid = put $ vidName vid+ get = get >>= (\name -> return Video { vidName = name , vidLink = "" , vidDate = "" , vidSize = ""- }+ }) logname = ".pgdl.cache" @@ -40,19 +40,18 @@ readVid = do hdir <- getHomeDirectory let absdir = hdir </> logname- fex <- doesFileExist absdir- case fex of+ doesFileExist absdir >>= \case True -> do dat <- B.readFile (hdir </> logname) let res = decodeOrFail dat case res of Right (_, _, vs) -> return vs _ -> return dlnVid- False -> do- return dlnVid+ False -> return dlnVid where dlnVid = [Video { vidName = "Downloading..." , vidLink = "" , vidDate = "" , vidSize = "" } ]+
src/Main.hs view
@@ -6,23 +6,25 @@ import Beaut import PlayVid import Search-import Getconfig import Chkcfg import Video import Log+import TestExist+import GenStat -import Graphics.Vty.Widgets.All-import qualified Data.Text as T-import System.FilePath+import Control.Applicative+import Control.Concurrent+import Control.Monad+import System.Directory import System.Exit-import Graphics.Vty import System.Environment-import System.Directory-import Control.Monad-import Control.Applicative+import System.FilePath import System.IO-import Control.Concurrent +import Graphics.Vty+import Graphics.Vty.Widgets.All+import qualified Data.Text as T+ main = do chkcfg @@ -31,13 +33,17 @@ lst <- newList 3 diskrd <- readVid diskV <- search diskrd <$> getArgs- forM_ diskV $ \v -> do- addToList lst v =<< (plainText $ beaut v)+ forM_ diskV $ \v -> addToList lst v =<< plainText (beaut v) lfg <- newFocusGroup addToFocusGroup lfg lst- lui <- centered =<< hFixed 80 lst- chgls <- addToCollection c lui lfg + statBar <- plainText ""+ setNormalAttribute statBar (black `on` green)++ ui <- centered =<< hFixed 80 =<< vBox lst statBar+ chgls <- addToCollection c ui lfg++ (dlg, dfcg) <- do wg <- plainText "redownload it?" newDialog wg "File Exists!"@@ -63,10 +69,9 @@ onKeyPressed lst $ \_ key _ -> case key of KRight -> do Just (_, (itm, _)) <- getSelected lst- inf <- centered =<< (plainText $ crtInfPg itm)+ inf <- centered =<< plainText (crtInfPg itm) addToFocusGroup ifsfg inf- chgif <- addToCollection c inf ifsfg- chgif+ join $ addToCollection c inf ifsfg return True _ -> return False @@ -77,8 +82,7 @@ when (length vdlst < 1) $ error "empty list!" Just (_, (oldItm, _)) <- getSelected lst clearList lst- forM_ vdlst $ \v -> do- addToList lst v =<< plainText (beaut v)+ forM_ vdlst $ \v -> addToList lst v =<< plainText (beaut v) listFindFirst lst oldItm >>= \case Just ind -> setSelected lst ind Nothing -> return ()@@ -89,6 +93,11 @@ 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@@ -103,14 +112,13 @@ return () runUi c $ defaultContext {normalAttr = white `on` black, - focusAttr = black `on` cyan+ focusAttr = black `on` blue }- where fex itm = do- locd <- fmap T.unpack getLocaldir- doesFileExist $ locd </> (T.unpack . vidName $ itm)+ where fex itm = downloaded $ vidName itm tryExit _ key _ = case key of KChar 'q' -> exitSuccess _ -> return False+ crtInfPg :: Video -> T.Text crtInfPg vid = T.unlines ["", "",
src/PlayVid.hs view
@@ -3,16 +3,16 @@ module PlayVid where import Getconfig+import Video +import Control.Monad+import Distribution.System import System.Process import System.Directory import System.FilePath.Posix-import Control.Monad-import qualified Data.Text as T import System.IO-import Video import System.Exit-import Distribution.System+import qualified Data.Text as T playVid :: Video -> IO () playVid vid = do
src/PrsVid.hs view
@@ -2,11 +2,12 @@ module PrsVid where -import Text.HTML.TagSoup+import Video+ import Data.List import Data.Function+import Text.HTML.TagSoup import qualified Data.Text as T-import Video prsVid :: T.Text -> [Video] prsVid = map (genVidInf . filter (not. T.null) . map getInf) .
src/Search.hs view
@@ -2,9 +2,11 @@ module Search where -import qualified Data.Text as T-import Data.Function import Video++import Data.Function++import qualified Data.Text as T search :: [Video] -> [String] -> [Video] search vlst param = foldl (\vs ps -> filter (targ ps . vidName) vs) vlst pt