added page scrolling

This commit is contained in:
Rachel Lambda Samuelsson 2021-09-20 15:30:10 +02:00
parent 9e833a2e5d
commit ce27b3eca5
6 changed files with 69 additions and 35 deletions

2
TODO
View File

@ -1,3 +1,5 @@
sort by
handle clipboard errors
write tests

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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
@ -97,14 +85,16 @@ scroll d s = s & appCursor .~ newCursor
new = case d of { Up -> subtract 1; Down -> (+1) }
newCursor = max 0 (min upperLimit (new (s ^. appCursor)))
-- | 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)))
-- | 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
-- | 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)

View File

@ -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