pgdl (empty) → 6.2

raw patch · 5 files changed

+188/−0 lines, 5 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, configurator, directory, filepath, http-conduit, process, resourcet, split, tagsoup, text, transformers, vty, vty-ui

Files

• LICENSE +25/−0
• README +3/−0
• Setup.hs +2/−0
• pgdl.cabal +33/−0
• src/Main.hs +125/−0

@@ -0,0 +1,25 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org>+

@@ -0,0 +1,3 @@+# pgdl+a terminal user interface program that downloads a video from html and plays immediately.+

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,33 @@++name:                pgdl+version:             6.2+license:             PublicDomain+license-file:        LICENSE+author:              sifmelcara+maintainer:          sifmelcara+category:            Network+build-type:          Simple+extra-source-files:  README+cabal-version:       >=1.10+description:         a terminal user interface program that downloads a video from html and plays immediately.+synopsis:            pgdl++source-repository head+  type:     git+  location: https://github.com/sifmelcara/pgdl++executable pgdl+  hs-source-dirs:      src+  main-is:             Main.hs+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base <= 5, split, process, +                       directory, http-conduit, bytestring,+                       transformers, resourcet, tagsoup, +                       vty, text, vty-ui,+                       configurator,+                       filepath, binary+  ghc-options:         -threaded -O2+  -- hs-source-dirs:      +  default-language:    Haskell2010+

@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++import FetchHtml+import PrsVid+import Beaut+import PlayVid+import Search+import Getconfig+import Chkcfg+import Video+import Log++import Graphics.Vty.Widgets.All+import qualified Data.Text as T+import System.FilePath+import System.Exit+import Graphics.Vty+import System.Environment+import System.Directory+import Control.Monad+import Control.Applicative+import System.IO+import Control.Concurrent++main = do+    chkcfg++    c <- newCollection++    lst <- newList 3 +    diskrd <- readVid+    diskV  <- search diskrd <$> getArgs+    forM_ diskV $ \v -> do+        addToList lst v =<< (plainText $ beaut v)+    lfg <- newFocusGroup+    addToFocusGroup lfg lst+    lui <- centered =<< hFixed 80 lst+    chgls <- addToCollection c lui lfg++    (dlg, dfcg) <- do+        wg <- plainText "redownload it?"+        newDialog wg "File Exists!"+    dui <- centered =<< hFixed 30 (dialogWidget dlg)+    chgdl <- addToCollection c dui dfcg++    setFocusGroupNextKey dfcg KRight []+    setFocusGroupPrevKey dfcg KLeft  []+    dfcg  `onKeyPressed` tryExit++    lfg   `onKeyPressed` tryExit+                                            +    dlg `onDialogCancel` const exitSuccess+    onDialogAccept dlg $ \_ ->  do+        Just (_, (itm, _)) <- getSelected lst+        playVid itm+                         +    ifsfg <- newFocusGroup+    onKeyPressed ifsfg $ \_ key _ -> case key of+        KLeft -> chgls >> return True   +        _     -> return False+    ifsfg `onKeyPressed` tryExit+    onKeyPressed lst $ \_ key _ -> case key of+        KRight -> do+            Just (_, (itm, _)) <- getSelected lst+            inf <- centered =<< (plainText $ crtInfPg itm)+            addToFocusGroup ifsfg inf+            chgif <- addToCollection c inf ifsfg+            chgif+            return True+        _ -> return False++    schedule $ do+        forkIO $ do+            rd    <- prsVid <$> fetchHtml+            vdlst <- search rd <$> getArgs+            when (length vdlst < 1) $ error "empty list!"+            Just (_, (oldItm, _)) <- getSelected lst+            clearList lst+            forM_ vdlst $ \v -> do+                addToList lst v =<< plainText (beaut v)+            listFindFirst lst oldItm >>= \case+                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 ()++            onKeyPressed lst $ \_ key _ -> case key of+                KEnter -> do+                    Just (_, (itm, _)) <- getSelected lst+                    fex itm >>= \case +                        True  -> chgdl+                        False -> playVid itm+                    return True+                _      -> return False++            forkIO $ writeVid vdlst+            return ()+        return ()++    runUi c $ defaultContext {normalAttr = white `on` black, +                              focusAttr  = black `on` cyan+                             }+    where fex itm = do+            locd <- fmap T.unpack getLocaldir+            doesFileExist $ locd </> (T.unpack . vidName $ itm)+          tryExit _ key _ = case key of+            KChar 'q' -> exitSuccess+            _         -> return False++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+                         ]+    where app = T.append+          spl = T.intercalate "\n" . T.chunksOf 60 ++