added page scrolling
This commit is contained in:
parent
9e833a2e5d
commit
ce27b3eca5
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user