pgdl 6.2 → 6.3

raw patch · 10 files changed

+281/−2 lines, 10 files

Files

• pgdl.cabal +2/−2
• src/Beaut.hs +25/−0
• src/Chkcfg.hs +28/−0
• src/FetchHtml.hs +35/−0
• src/Getconfig.hs +25/−0
• src/Log.hs +58/−0
• src/PlayVid.hs +38/−0
• src/PrsVid.hs +40/−0
• src/Search.hs +14/−0
• src/Video.hs +16/−0

@@ -1,6 +1,6 @@  name:                pgdl-version:             6.2+version:             6.3 license:             PublicDomain license-file:        LICENSE author:              sifmelcara@@ -19,7 +19,7 @@ executable pgdl   hs-source-dirs:      src   main-is:             Main.hs-  -- other-modules:       +  other-modules:       Beaut, Chkcfg, FetchHtml, Getconfig, Log, PlayVid, PrsVid, Search, Video    -- other-extensions:       build-depends:       base <= 5, split, process,                         directory, http-conduit, bytestring,

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++module Beaut where++import Data.List+import qualified Data.Text as T+import Video++beaut :: Video -> T.Text+beaut vid+    | length dat < 3 = "\n" `app` str+    | otherwise      = T.intercalate "\n" [tb 4 `app` sbt, +                                           tb 10 `app` nme, +                                           tb 30 `app` eps+                                          ]+    where str = vidName vid+          dat = spl str+          (sbt:nme:eps:_) = dat+          tb n = T.replicate n " "+          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+++

@@ -0,0 +1,28 @@++module Chkcfg where++import System.Directory+import Control.Monad+import System.FilePath++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/?C=M;O=D\"",+                    "# localdir = \"/home/jack/Downloads/\"", +                    "",+                    "username = ",+                    "password = ",+                    "servpath = ",+                    "localdir = ",+                    ""+                 ]+

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module FetchHtml where+  +import Getconfig++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+    username <- getUsername+    password <- getPassword+    servpath <- getServpath+    return $ applyBasicAuth (tob username) (tob password) . fromJust . parseUrl $ "http://" ++ T.unpack servpath+    where tob = encodeUtf8++fetchHtml :: IO T.Text+fetchHtml = do+    rq <- genReq+    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++

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++module Getconfig where++import qualified Data.Text as T+import qualified Data.Configurator as C+import Control.Monad+import Data.Maybe++getConfig :: IO (T.Text, T.Text, T.Text, T.Text)+getConfig = do+    config <- C.load [C.Required "$(HOME)/.pgdl"]+    username <- C.lookup config "username"+    password <- C.lookup config "password"+    servpath <- C.lookup config "servpath"+    localdir <- C.lookup config "localdir"+    mapM_ (\x -> when (isNothing x) $ error "please edit config file.") [username, password, servpath, localdir]+    return (fj username, fj password, fj servpath, fj localdir)+    where fj = fromJust++getUsername = fmap (\(r, _, _, _) -> r) getConfig+getPassword = fmap (\(_, r, _, _) -> r) getConfig+getServpath = fmap (\(_, _, r, _) -> r) getConfig+getLocaldir = fmap (\(_, _, _, r) -> r) getConfig+

@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++module Log where++import Video+import Data.Binary+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+        return Video { vidName = name+                     , vidLink = ""+                     , vidDate = ""+                     , vidSize = ""+                     }++logname = ".pgdl.cache"++writeVid :: [Video] -> IO ()+writeVid vs = do+    hdir <- getHomeDirectory+    B.writeFile (hdir </> logname) $ encode vs  ++readVid :: IO [Video]+readVid = do+    hdir <- getHomeDirectory+    let absdir = hdir </> logname+    fex <- doesFileExist absdir+    case fex of+        True -> do+            dat <- B.readFile (hdir </> logname)+            let res = decodeOrFail dat+            case res of+                Right (_, _, vs) -> return vs+                _                -> return dlnVid+        False -> do+            return dlnVid+    where dlnVid = [Video { vidName = "Downloading..."+                          , vidLink = ""+                          , vidDate = ""+                          , vidSize = ""+                          }+                   ]

@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}++module PlayVid where++import Getconfig++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++playVid :: Video -> IO ()+playVid vid = do+    username <- fmap T.unpack getUsername+    password <- fmap T.unpack getPassword+    servpath <- fmap T.unpack getServpath+    localdir <- fmap T.unpack getLocaldir++    let localloc = localdir </> vn+    fex <- doesFileExist localdir+    when fex $ removeFile localloc++    let purepath = reverse . dropWhile (/= '/') . reverse $ servpath+    let url = "http://" ++ username ++ ":" ++ password ++ "@" ++ purepath ++ vu+    runCommand $ "nohup curl " ++ addq url ++ " -o " ++ addq localloc ++ "&>/dev/null &"+    let checkFile = doesFileExist localloc >>= \ready -> unless ready checkFile+    checkFile+    runCommand $ "nohup vlc -f " ++ addq localloc ++ " &>/dev/null &"+    exitSuccess+  where vn = T.unpack . vidName $ vid+        vu = T.unpack . vidLink $ vid+        addq s = "\"" ++ s ++ "\""++

@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module PrsVid where++import Text.HTML.TagSoup+import Data.List+import Data.Function+import qualified Data.Text as T+import Video++prsVid :: T.Text -> [Video]+prsVid = 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+          isSizeTag tg+            | isTagText tg = any (`T.isSuffixOf` fromTagText tg) ["K", "M", "G"]+            | otherwise = False+          isDateTag tg+            | isTagText tg = all (`T.isInfixOf` fromTagText tg)  ["-", ":"]+            | otherwise = False+          getInf tg+            | isNameTag tg = fromTagText tg+            | isLinkTag tg = fromAttrib "href" tg+            | isSizeTag tg = fromTagText tg+            | isDateTag tg = fromTagText tg+            | otherwise = ""+          genVidInf [lnk, nm, dt, sz] = Video {vidLink = lnk, vidName = nm, vidDate = dt, vidSize = sz}  +          getVidInf _ = Video {vidLink = T.empty, vidName = "parse error", vidDate = "", vidSize = ""}+          vdfmt = [".avi", ".mp4", ".mkv"]++++

@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++module Search where++import qualified Data.Text as T+import Data.Function+import Video++search :: [Video] -> [String] -> [Video]+search vlst param = foldl (\vs ps -> filter (targ ps . vidName) vs) vlst pt+    where pt = map T.pack param+          targ = T.isInfixOf `on` T.toUpper++

@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedStrings #-}++module Video where++import qualified Data.Text as T++data Video = Video { vidName :: T.Text+                   , vidLink :: T.Text+                   , vidSize :: T.Text+                   , vidDate :: T.Text+                   }++instance Eq Video where+    x == y = vidName x == vidName y+    +