From ce27b3eca5b13bbfad41dc53126ca49e489f4360 Mon Sep 17 00:00:00 2001 From: depsterr Date: Mon, 20 Sep 2021 15:30:10 +0200 Subject: [PATCH] added page scrolling --- TODO | 2 ++ src/Kino/Misc.hs | 12 +++++++++++ src/Kino/Request.hs | 36 +++++++++++++++++++++++---------- src/Kino/Types.hs | 2 ++ src/Kino/UI.hs | 46 ++++++++++++++++++++---------------------- src/Kino/UI/Widgets.hs | 6 ++++++ 6 files changed, 69 insertions(+), 35 deletions(-) diff --git a/TODO b/TODO index 85b9301..ff33804 100644 --- a/TODO +++ b/TODO @@ -1,3 +1,5 @@ +sort by + handle clipboard errors write tests diff --git a/src/Kino/Misc.hs b/src/Kino/Misc.hs index 0143371..1180d54 100644 --- a/src/Kino/Misc.hs +++ b/src/Kino/Misc.hs @@ -7,6 +7,10 @@ Contains miscellaneous helper functions which do not fit elsewhere module Kino.Misc where +import Lens.Micro + +import Kino.Types + infixl 3 !? -- | Safe version of (!!) (!?) :: [a] -> Int -> Maybe a @@ -18,3 +22,11 @@ infixl 0 $> -- | Backwards function application ($>) :: a -> (a -> b) -> b x $> f = f x + +-- | Given a String, modify our state so that string +-- is displayed as a message, alternatively forcing +-- an exit after the message is aknowledged. +displayMessage :: AppS -> Bool -> String -> AppS +displayMessage s fatal msg = s & appMode .~ Message + & appMessage ?~ msg + & appContinue .~ not fatal diff --git a/src/Kino/Request.hs b/src/Kino/Request.hs index a8f524b..b3cd6be 100644 --- a/src/Kino/Request.hs +++ b/src/Kino/Request.hs @@ -7,15 +7,18 @@ Description : Contains code for issuing http requests Contains code for issuing http requests -} -module Kino.Request (getMovies, queryMovies) where +module Kino.Request (setMovies, defaultOptions) where + +import Control.Exception import Control.Lens -import Data.Aeson +import Data.Aeson hiding (defaultOptions) import Network.Wreq hiding (Options) import qualified Data.Text as T import qualified Network.Wreq as WR (Options) import Kino.Types +import Kino.Misc -- | Sends a request and unwraps the top level respone data structure makeRequest :: (FromJSON a) => String -> WR.Options -> IO (Either T.Text a) @@ -25,13 +28,24 @@ makeRequest url opts = do (JSONResponse "ok" _ (Just d)) -> Right d (JSONResponse _ m _) -> Left m --- | Requests a list of all movies -getMovies :: IO (Either T.Text JSONListMovies) -getMovies = makeRequest "https://yts.mx/api/v2/list_movies.json" - (defaults & param "limit" .~ ["50"]) +-- | Sends a request with the given parameters +getMovies :: WR.Options -> IO (Either SomeException (Either T.Text JSONListMovies)) +getMovies = try . makeRequest "https://yts.mx/api/v2/list_movies.json" --- | Requests a list of all movies matching a query term -queryMovies :: T.Text -> IO (Either T.Text JSONListMovies) -queryMovies q = makeRequest "https://yts.mx/api/v2/list_movies.json" - (defaults & param "query_term" .~ [q] - & param "limit" .~ ["50"]) +-- | The default options for our requests +defaultOptions :: WR.Options +defaultOptions = defaults & param "limit" .~ ["50"] + & param "page" .~ ["1"] + +-- | Updates the state given a way to request a new movie listing +setMovies :: AppS -> IO AppS +setMovies s = do + m <- getMovies ((s ^. appReqOpts) & param "page" .~ [T.pack (show (s ^. appPage))]) + pure $ case m of + (Left e) -> displayMessage s True (displayException e) + (Right r) -> case r of + (Left t) -> displayMessage s False (T.unpack t) + (Right l) -> s & appListing .~ l + & appCursor .~ 0 + & appExpanded .~ False + & appDetails .~ (moviesMovies l !? 0) diff --git a/src/Kino/Types.hs b/src/Kino/Types.hs index 206ad5d..e75f2a8 100644 --- a/src/Kino/Types.hs +++ b/src/Kino/Types.hs @@ -16,6 +16,7 @@ import Data.Aeson.Types import Brick.Widgets.Edit (Editor(..)) import Lens.Micro.TH import qualified Data.Text as T +import qualified Network.Wreq as WR (Options) -- | The general response structure returned by the API data JSONResponse d = JSONResponse @@ -120,6 +121,7 @@ data AppS = AppS , _appMessage :: Maybe String -- ^ The message to be shown in message mode , _appContinue :: Bool -- ^ If to continue after showing message , _appEditor :: Editor T.Text Ident -- ^ The state for the editor widget + , _appReqOpts :: WR.Options -- ^ The options to use to make our requests } deriving (Show) makeLenses ''AppS diff --git a/src/Kino/UI.hs b/src/Kino/UI.hs index 112cd72..9964e1d 100644 --- a/src/Kino/UI.hs +++ b/src/Kino/UI.hs @@ -9,8 +9,6 @@ This is the code which interacts with Brick module Kino.UI (runApp) where -import Control.Exception - import Brick hiding (Direction(..)) import Brick.Widgets.Edit (handleEditorEvent, editorText, editAttr, getEditContents) import Control.Monad.IO.Class (liftIO) @@ -19,6 +17,7 @@ import Graphics.Vty.Attributes (withStyle, reverseVideo) import Graphics.Vty.Attributes.Color (brightBlack) import Graphics.Vty.Input.Events import Lens.Micro +import Network.Wreq import System.Clipboard import qualified Data.Text as T @@ -40,6 +39,7 @@ initialState = AppS , _appMessage = Nothing , _appContinue = True , _appEditor = editorText Input (Just 1) mempty + , _appReqOpts = defaultOptions } -- | Our brick app specification @@ -56,23 +56,11 @@ app = App runApp :: IO AppS runApp = defaultMain app initialState --- | Updates the state given a way to request a new movie listing -setMovies :: AppS -> IO (Either T.Text JSONListMovies) -> IO AppS -setMovies s mb = do - m <- try mb :: IO (Either SomeException (Either T.Text JSONListMovies)) - pure $ case m of - (Left e) -> displayMessage s True (displayException e) - (Right r) -> case r of - (Left t) -> displayMessage s False (T.unpack t) - (Right l) -> s & appListing .~ l - & appCursor .~ 0 - & appDetails .~ (moviesMovies l !? 0) - -- | The starting event which grabs the inital listing startEvent :: AppS -> EventM Ident AppS startEvent s = do -- todo move unwrapping our response structure into a function - pure =<< liftIO (setMovies s getMovies) + pure =<< liftIO (setMovies s) -- | The drawing function which defers to the proper function -- from UI.Widgets @@ -96,15 +84,17 @@ scroll d s = s & appCursor .~ newCursor upperLimit = length (moviesMovies (s ^. appListing)) - 1 new = case d of { Up -> subtract 1; Down -> (+1) } newCursor = max 0 (min upperLimit (new (s ^. appCursor))) - --- | Given a String, modify our state so that string --- is displayed as a message, alternatively forcing --- an exit after the message is aknowledged. -displayMessage :: AppS -> Bool -> String -> AppS -displayMessage s fatal msg = s & appMode .~ Message - & appMessage ?~ msg - & appContinue .~ not fatal +-- | Scrolls to the next page +scrollPage :: ScrollDirection -> AppS -> IO AppS +scrollPage d s = do + setMovies $ s & appPage .~ newPage + where + listing = s ^. appListing + upperLimit = moviesCount listing `div` moviesLimit listing + new = case d of { Up -> subtract 1; Down -> (+1) } + newPage = max 1 (min upperLimit (new (s ^. appPage))) + -- | Copy the magnet link of the focused movie at -- the given index @@ -126,12 +116,15 @@ eventHandler s (VtyEvent e@(EvKey k _)) = then continue (s & appMode .~ Browse & appMessage .~ Nothing) else halt s + Search -> case k of (KEnter) -> do let queryText = T.unlines (getEditContents (s ^. appEditor)) - newS <- liftIO (setMovies s (queryMovies queryText)) + newS <- liftIO (setMovies (s & appReqOpts %~ (\o -> o & param "query_term" .~ [queryText]) + & appPage .~ 1)) continue (newS & appMode .~ Browse) _ -> continue =<< handleEventLensed s appEditor handleEditorEvent e + Browse -> case k of (KChar 'q') -> halt s (KEsc) -> halt s @@ -141,6 +134,11 @@ eventHandler s (VtyEvent e@(EvKey k _)) = (KDown) -> continue (scroll Down s) (KUp) -> continue (scroll Up s) + (KChar 'l') -> continue =<< liftIO (scrollPage Down s) + (KChar 'h') -> continue =<< liftIO (scrollPage Up s) + (KRight) -> continue =<< liftIO (scrollPage Down s) + (KLeft) -> continue =<< liftIO (scrollPage Up s) + (KChar ' ') -> continue (s & appExpanded %~ not) (KEnter) -> continue (s & appExpanded %~ not) diff --git a/src/Kino/UI/Widgets.hs b/src/Kino/UI/Widgets.hs index 573d2c0..1ca3efe 100644 --- a/src/Kino/UI/Widgets.hs +++ b/src/Kino/UI/Widgets.hs @@ -81,6 +81,12 @@ browseWidget :: AppS -> Widget Ident browseWidget s = str "Title" <+> padLeft Max (str "Year") <=> viewport Listing Vertical (movieWidgets s) + <=> (str ("results: " <> results) <+> padLeft Max (str ("(" <> page <> "/" <> pages <> ")"))) + where + listing = s ^. appListing + results = show (moviesCount listing) + pages = show ((moviesCount listing `div` moviesLimit listing) + 1) + page = show (s ^. appPage) -- | The message widget which simply shows a message and informs -- the user of how to escape