pgdl-7.77: src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}

import FetchHtml
import PrsVid
import NameAlgo 
import RealWorld
import Chkcfg
import Video
import Log
import GenStat
import CrtInf
import AskScene

import Data.IORef
import Data.Maybe
import Control.Applicative
import Control.Concurrent
import Control.Monad
import System.Exit
import System.Environment

import Graphics.Vty
import Graphics.Vty.Widgets.All

main :: IO ()
main = do
    chkcfg 
    -- check if there exists a configuration file, if not, then create one

    c <- newCollection

    lst <- newList 3
    -- the main list will display on screen

    diskrd <- readVid
    -- read cache in the disk, if the cache do not exists, return "downloading"

    args <- getArgs
    let diskV = if null args then diskrd
                             else dlnVid
    -- if user want to search a video, then don't load cache to the screen 

    forM_ diskV $ \v -> addToList lst v =<< plainText (beaut v)
    -- add disk videos to list

    lfg <- newFocusGroup
    addToFocusGroup lfg lst

    statBar <- plainText waitingBar
    -- the state bar show in the bottom
    setNormalAttribute statBar (black `on` green)

    ui <- centered =<< hFixed 80 =<< vBox lst statBar
    -- ui consists of a list and a state bar
    chgls <- addToCollection c ui lfg

    (dlg, dfcg) <- newAskScene
    dui <- centered =<< hFixed 50 (sceneWidget dlg)
    chgdl <- addToCollection c dui dfcg

    
    -- four button in ask scene's action
    onScePlay dlg $ \_ -> do
        Just (_, (itm, _)) <- getSelected lst
        justPlay itm
    onSceDown dlg $ \_ -> do
        Just (_, (itm, _)) <- getSelected lst
        playVid itm
    onSceQuit dlg $ const exitSuccess
    onSceRemv dlg $ \_ -> do
        Just (_, (itm, _)) <- getSelected lst
        removeVid itm

    ifsfg <- newFocusGroup
    -- a focus group for information page

    -- this function will show the focused item's information to user
    let chgInf = do
          Just (_, (vid, _)) <- getSelected lst
          inf <- centered =<< plainText (crtInfPg vid)
          addToFocusGroup ifsfg inf
          join $ addToCollection c inf ifsfg

    -- the information scene
    onKeyPressed ifsfg $ \_ key _ -> case key of
        KLeft -> do
            chgls -- return to the list
            return True
        KUp   -> do
            scrollUp lst
            chgInf
            return True
        KDown -> do
            scrollDown lst
            chgInf
            return True
        _     -> return False


    onKeyPressed lst $ \_ key _ -> case key of
        KRight -> do
            chgInf
            return True
        _ -> return False

    lfg `onKeyPressed` tryExit
    dfcg `onKeyPressed` tryExit
    ifsfg `onKeyPressed` tryExit

    -- let's download video from internet !
    schedule $ do
        forkIO $ do
            rd <- prsHtm <$> fetchHtml
            -- prsHtm :: Text -> [Video (whether video or folder)]

            let vdlst = search rd args
            when (length vdlst < 1) $ error "no search result found (or it's empty)."

            Just (_, (oldItm, _)) <- getSelected lst
            -- store the location before page refresh

            clearList lst
            forM_ vdlst $ \v -> addToList lst v =<< plainText (beaut v)
            -- show new list

            listFindFirst lst oldItm >>= \case
                Just ind -> setSelected lst ind
                Nothing  -> return ()

            onSelectionChange lst $ \sle -> case sle of
                SelectionOn _ itm _ -> case isFld itm of
                    True -> setFocusAttribute lst (black `on` magenta)
                            -- folder's color
                    _    -> fex itm >>= \case
                        True  -> setFocusAttribute lst (black `on` red) 
                                 -- if video have been download, use red color
                        False -> setFocusAttribute lst (black `on` cyan)
                                 -- if video haven't been download, use cyan
                _                   -> return ()

            onSelectionChange lst $ \sle -> case sle of
                SelectionOn _ itm _ -> setText statBar =<< genStat itm
                -- refresh state bar after any scroll
                _ -> return ()

            astr <- newIORef []
            -- we store ancestors list element in the astr
            -- (those old list we leaved)
            let push = do
            -- store the state into astr
                  sz <- getListSize lst
                  Just (loc, _) <- getSelected lst
                  lem <- catMaybes <$> forM [0..sz-1] (getListItem lst)
                  modifyIORef astr ((lem, loc):)
            let pop = do
            -- pop a state from astr and give it to lst
                  ast <- readIORef astr
                  case ast of
                    [] -> return ()
                    ((itms, loc):_) -> do
                        clearList lst
                        forM_ itms $ \(v, w) -> addToList lst v w
                        setSelected lst loc
                        modifyIORef astr tail
                    
            let openFld lnk = do
                  ctnt <- (map (attcLink lnk) . prsHtm) <$> fetchFld lnk 
                  -- attach folder link to the videos in the folder
                  when (null ctnt) $ error "there is no video in the folder!" 
                  push
                  clearList lst 
                  forM_ ctnt $ \v -> addToList lst v =<< plainText (beaut v) 
                  return ()

            onKeyPressed lst $ \_ key _ -> case key of
                KEnter -> do
                -- User can choose a folder or a video !
                    Just (_, (itm, _)) <- getSelected lst
                    case itm of
                        Folder _ lnk _ -> openFld lnk
                        v -> fex v >>= \case
                            True -> chgdl
                            False -> playVid itm
                    return True
                KLeft -> do
                -- return to the old list
                    pop
                    return True
                KChar 's' -> do
                    push
                    Just (_, (itm, _)) <- getSelected lst
                    size <- getListSize lst
                    let itemIdxs = reverse [0..size-1]
                    isLik <- forM itemIdxs $ \idx -> do
                        Just (now, _) <- getListItem lst idx
                        return $ isAlike itm now
                    forM_ (zip itemIdxs isLik) $ \(idx, lik) -> unless lik $ do
                        removeFromList lst idx
                        return ()
                    return True
                _   -> return False

            when (null args) $ void . forkIO . writeVid $ vdlst
            -- only write cache when user didn't search video

            return ()
        return ()

    runUi c $ defaultContext { normalAttr = white `on` black 
                             , focusAttr  = black `on` blue
                             }

    where tryExit _ key _ = case key of
            KChar 'q' -> exitSuccess
            _         -> return False
          fex itm
            | isVid itm = downloaded $ vidName itm
            | otherwise = return False