added page scrolling
This commit is contained in:
parent
9e833a2e5d
commit
ce27b3eca5
2
TODO
2
TODO
|
@ -1,3 +1,5 @@
|
||||||
|
sort by
|
||||||
|
|
||||||
handle clipboard errors
|
handle clipboard errors
|
||||||
|
|
||||||
write tests
|
write tests
|
||||||
|
|
|
@ -7,6 +7,10 @@ Contains miscellaneous helper functions which do not fit elsewhere
|
||||||
|
|
||||||
module Kino.Misc where
|
module Kino.Misc where
|
||||||
|
|
||||||
|
import Lens.Micro
|
||||||
|
|
||||||
|
import Kino.Types
|
||||||
|
|
||||||
infixl 3 !?
|
infixl 3 !?
|
||||||
-- | Safe version of (!!)
|
-- | Safe version of (!!)
|
||||||
(!?) :: [a] -> Int -> Maybe a
|
(!?) :: [a] -> Int -> Maybe a
|
||||||
|
@ -18,3 +22,11 @@ infixl 0 $>
|
||||||
-- | Backwards function application
|
-- | Backwards function application
|
||||||
($>) :: a -> (a -> b) -> b
|
($>) :: a -> (a -> b) -> b
|
||||||
x $> f = f x
|
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
|
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 Control.Lens
|
||||||
import Data.Aeson
|
import Data.Aeson hiding (defaultOptions)
|
||||||
import Network.Wreq hiding (Options)
|
import Network.Wreq hiding (Options)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Network.Wreq as WR (Options)
|
import qualified Network.Wreq as WR (Options)
|
||||||
|
|
||||||
import Kino.Types
|
import Kino.Types
|
||||||
|
import Kino.Misc
|
||||||
|
|
||||||
-- | Sends a request and unwraps the top level respone data structure
|
-- | Sends a request and unwraps the top level respone data structure
|
||||||
makeRequest :: (FromJSON a) => String -> WR.Options -> IO (Either T.Text a)
|
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 "ok" _ (Just d)) -> Right d
|
||||||
(JSONResponse _ m _) -> Left m
|
(JSONResponse _ m _) -> Left m
|
||||||
|
|
||||||
-- | Requests a list of all movies
|
-- | Sends a request with the given parameters
|
||||||
getMovies :: IO (Either T.Text JSONListMovies)
|
getMovies :: WR.Options -> IO (Either SomeException (Either T.Text JSONListMovies))
|
||||||
getMovies = makeRequest "https://yts.mx/api/v2/list_movies.json"
|
getMovies = try . makeRequest "https://yts.mx/api/v2/list_movies.json"
|
||||||
(defaults & param "limit" .~ ["50"])
|
|
||||||
|
|
||||||
-- | Requests a list of all movies matching a query term
|
-- | The default options for our requests
|
||||||
queryMovies :: T.Text -> IO (Either T.Text JSONListMovies)
|
defaultOptions :: WR.Options
|
||||||
queryMovies q = makeRequest "https://yts.mx/api/v2/list_movies.json"
|
defaultOptions = defaults & param "limit" .~ ["50"]
|
||||||
(defaults & param "query_term" .~ [q]
|
& param "page" .~ ["1"]
|
||||||
& param "limit" .~ ["50"])
|
|
||||||
|
-- | 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 Brick.Widgets.Edit (Editor(..))
|
||||||
import Lens.Micro.TH
|
import Lens.Micro.TH
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import qualified Network.Wreq as WR (Options)
|
||||||
|
|
||||||
-- | The general response structure returned by the API
|
-- | The general response structure returned by the API
|
||||||
data JSONResponse d = JSONResponse
|
data JSONResponse d = JSONResponse
|
||||||
|
@ -120,6 +121,7 @@ data AppS = AppS
|
||||||
, _appMessage :: Maybe String -- ^ The message to be shown in message mode
|
, _appMessage :: Maybe String -- ^ The message to be shown in message mode
|
||||||
, _appContinue :: Bool -- ^ If to continue after showing message
|
, _appContinue :: Bool -- ^ If to continue after showing message
|
||||||
, _appEditor :: Editor T.Text Ident -- ^ The state for the editor widget
|
, _appEditor :: Editor T.Text Ident -- ^ The state for the editor widget
|
||||||
|
, _appReqOpts :: WR.Options -- ^ The options to use to make our requests
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
makeLenses ''AppS
|
makeLenses ''AppS
|
||||||
|
|
|
@ -9,8 +9,6 @@ This is the code which interacts with Brick
|
||||||
|
|
||||||
module Kino.UI (runApp) where
|
module Kino.UI (runApp) where
|
||||||
|
|
||||||
import Control.Exception
|
|
||||||
|
|
||||||
import Brick hiding (Direction(..))
|
import Brick hiding (Direction(..))
|
||||||
import Brick.Widgets.Edit (handleEditorEvent, editorText, editAttr, getEditContents)
|
import Brick.Widgets.Edit (handleEditorEvent, editorText, editAttr, getEditContents)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
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.Attributes.Color (brightBlack)
|
||||||
import Graphics.Vty.Input.Events
|
import Graphics.Vty.Input.Events
|
||||||
import Lens.Micro
|
import Lens.Micro
|
||||||
|
import Network.Wreq
|
||||||
import System.Clipboard
|
import System.Clipboard
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
@ -40,6 +39,7 @@ initialState = AppS
|
||||||
, _appMessage = Nothing
|
, _appMessage = Nothing
|
||||||
, _appContinue = True
|
, _appContinue = True
|
||||||
, _appEditor = editorText Input (Just 1) mempty
|
, _appEditor = editorText Input (Just 1) mempty
|
||||||
|
, _appReqOpts = defaultOptions
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Our brick app specification
|
-- | Our brick app specification
|
||||||
|
@ -56,23 +56,11 @@ app = App
|
||||||
runApp :: IO AppS
|
runApp :: IO AppS
|
||||||
runApp = defaultMain app initialState
|
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
|
-- | The starting event which grabs the inital listing
|
||||||
startEvent :: AppS -> EventM Ident AppS
|
startEvent :: AppS -> EventM Ident AppS
|
||||||
startEvent s = do
|
startEvent s = do
|
||||||
-- todo move unwrapping our response structure into a function
|
-- 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
|
-- | The drawing function which defers to the proper function
|
||||||
-- from UI.Widgets
|
-- from UI.Widgets
|
||||||
|
@ -96,15 +84,17 @@ scroll d s = s & appCursor .~ newCursor
|
||||||
upperLimit = length (moviesMovies (s ^. appListing)) - 1
|
upperLimit = length (moviesMovies (s ^. appListing)) - 1
|
||||||
new = case d of { Up -> subtract 1; Down -> (+1) }
|
new = case d of { Up -> subtract 1; Down -> (+1) }
|
||||||
newCursor = max 0 (min upperLimit (new (s ^. appCursor)))
|
newCursor = max 0 (min upperLimit (new (s ^. appCursor)))
|
||||||
|
|
||||||
|
|
||||||
-- | Given a String, modify our state so that string
|
-- | Scrolls to the next page
|
||||||
-- is displayed as a message, alternatively forcing
|
scrollPage :: ScrollDirection -> AppS -> IO AppS
|
||||||
-- an exit after the message is aknowledged.
|
scrollPage d s = do
|
||||||
displayMessage :: AppS -> Bool -> String -> AppS
|
setMovies $ s & appPage .~ newPage
|
||||||
displayMessage s fatal msg = s & appMode .~ Message
|
where
|
||||||
& appMessage ?~ msg
|
listing = s ^. appListing
|
||||||
& appContinue .~ not fatal
|
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
|
-- | Copy the magnet link of the focused movie at
|
||||||
-- the given index
|
-- the given index
|
||||||
|
@ -126,12 +116,15 @@ eventHandler s (VtyEvent e@(EvKey k _)) =
|
||||||
then continue (s & appMode .~ Browse
|
then continue (s & appMode .~ Browse
|
||||||
& appMessage .~ Nothing)
|
& appMessage .~ Nothing)
|
||||||
else halt s
|
else halt s
|
||||||
|
|
||||||
Search -> case k of
|
Search -> case k of
|
||||||
(KEnter) -> do
|
(KEnter) -> do
|
||||||
let queryText = T.unlines (getEditContents (s ^. appEditor))
|
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 (newS & appMode .~ Browse)
|
||||||
_ -> continue =<< handleEventLensed s appEditor handleEditorEvent e
|
_ -> continue =<< handleEventLensed s appEditor handleEditorEvent e
|
||||||
|
|
||||||
Browse -> case k of
|
Browse -> case k of
|
||||||
(KChar 'q') -> halt s
|
(KChar 'q') -> halt s
|
||||||
(KEsc) -> halt s
|
(KEsc) -> halt s
|
||||||
|
@ -141,6 +134,11 @@ eventHandler s (VtyEvent e@(EvKey k _)) =
|
||||||
(KDown) -> continue (scroll Down s)
|
(KDown) -> continue (scroll Down s)
|
||||||
(KUp) -> continue (scroll Up 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)
|
(KChar ' ') -> continue (s & appExpanded %~ not)
|
||||||
(KEnter) -> continue (s & appExpanded %~ not)
|
(KEnter) -> continue (s & appExpanded %~ not)
|
||||||
|
|
||||||
|
|
|
@ -81,6 +81,12 @@ browseWidget :: AppS -> Widget Ident
|
||||||
browseWidget s =
|
browseWidget s =
|
||||||
str "Title" <+> padLeft Max (str "Year")
|
str "Title" <+> padLeft Max (str "Year")
|
||||||
<=> viewport Listing Vertical (movieWidgets s)
|
<=> 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 message widget which simply shows a message and informs
|
||||||
-- the user of how to escape
|
-- the user of how to escape
|
||||||
|
|
Loading…
Reference in New Issue
Block a user