197 lines
6.3 KiB
Haskell
197 lines
6.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-|
|
|
Module : Kino.UI
|
|
Description : This is the code which interacts with Brick
|
|
|
|
This is the code which interacts with Brick
|
|
-}
|
|
|
|
module Kino.UI (runApp) where
|
|
|
|
import Data.Char
|
|
|
|
import Brick hiding (Direction(..))
|
|
import Brick.Widgets.Edit (handleEditorEvent, editorText, editAttr, getEditContents)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Graphics.Vty (defAttr)
|
|
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
|
|
|
|
import Kino.Types
|
|
import Kino.Request
|
|
import Kino.Misc
|
|
import Kino.UI.Widgets
|
|
import Kino.Torrent
|
|
|
|
-- | The initial state of our application
|
|
initialState :: AppS
|
|
initialState = AppS
|
|
{ _appMode = Browse
|
|
, _appCursor = 0
|
|
, _appExpanded = False
|
|
, _appPage = 1
|
|
, _appListing = JSONListMovies 0 0 0 []
|
|
, _appDetails = Nothing
|
|
, _appMessage = Nothing
|
|
, _appContinue = True
|
|
, _appEditor = editorText Input (Just 1) mempty
|
|
, _appReqOpts = defaultOptions
|
|
, _appSort = UploadDate
|
|
, _appSortMode = Descending
|
|
}
|
|
|
|
-- | Our brick app specification
|
|
app :: App AppS () Ident
|
|
app = App
|
|
{ appDraw = draw
|
|
, appChooseCursor = chooseCursor
|
|
, appHandleEvent = eventHandler
|
|
, appStartEvent = startEvent
|
|
, appAttrMap = attributeMap
|
|
}
|
|
|
|
-- | A small wrapper to run the brick app
|
|
runApp :: IO AppS
|
|
runApp = defaultMain app initialState
|
|
|
|
-- | 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)
|
|
|
|
-- | The drawing function which defers to the proper function
|
|
-- from UI.Widgets
|
|
draw :: AppS -> [Widget Ident]
|
|
draw s = pure $ case s ^. appMode of
|
|
Browse -> browseWidget s
|
|
Search -> searchWidget s
|
|
Message -> messageWidget s
|
|
Sort -> sortWidget
|
|
|
|
|
|
-- | Currently just showFirstCursor
|
|
chooseCursor :: AppS -> [CursorLocation Ident] -> Maybe (CursorLocation Ident)
|
|
chooseCursor = showFirstCursor
|
|
|
|
-- | Scrolls our cursor and updates the app details
|
|
scroll :: ScrollDirection -> AppS -> AppS
|
|
scroll d s = s & appCursor .~ newCursor
|
|
& appExpanded .~ False
|
|
& appDetails .~ (moviesMovies (s ^. appListing) !? newCursor)
|
|
where
|
|
upperLimit = length (moviesMovies (s ^. appListing)) - 1
|
|
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)))
|
|
|
|
|
|
-- | Copy the magnet link of the focused movie at
|
|
-- the given index
|
|
copyMagnet :: AppS -> Int -> EventM Ident (Next AppS)
|
|
copyMagnet s i = case (do
|
|
m <- s ^. appDetails
|
|
_ <- movieTorrents m !? i - 1
|
|
toMagnets m !? i - 1) of
|
|
Nothing -> continue s
|
|
(Just magnet) -> do
|
|
liftIO (setClipboardString magnet)
|
|
continue (displayMessage s False "Copied magnet link to clipboard!")
|
|
|
|
-- | Continue with a new sort mode
|
|
setSort :: AppS -> SortOrder -> EventM Ident (Next AppS)
|
|
setSort st so = continue =<< (liftIO $ setMovies (st & appSort .~ so
|
|
& appMode .~ Browse))
|
|
|
|
-- | The event handler, takes care of keyboard events.
|
|
eventHandler :: AppS -> BrickEvent Ident () -> EventM Ident (Next AppS)
|
|
eventHandler s (VtyEvent e@(EvKey k _)) =
|
|
case s ^. appMode of
|
|
Message -> if s ^. appContinue
|
|
then continue (s & appMode .~ Browse
|
|
& appMessage .~ Nothing)
|
|
else halt s
|
|
|
|
Sort -> case k of
|
|
(KChar c) -> let s' = s & appSortMode .~ if isUpper c then Ascending else Descending
|
|
in case toLower c of
|
|
't' -> setSort s' Title
|
|
'y' -> setSort s' Year
|
|
'r' -> setSort s' Rating
|
|
's' -> setSort s' Seeds
|
|
'd' -> setSort s' Downloads
|
|
'l' -> setSort s' Likes
|
|
'u' -> setSort s' UploadDate
|
|
|
|
'q' -> continue (s & appMode .~ Browse)
|
|
|
|
_ -> continueWithoutRedraw s
|
|
|
|
|
|
_ -> continueWithoutRedraw s
|
|
|
|
Search -> case k of
|
|
(KEnter) -> do
|
|
let queryText = T.unlines (getEditContents (s ^. appEditor))
|
|
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
|
|
|
|
(KChar 'j') -> continue (scroll Down s)
|
|
(KChar 'k') -> continue (scroll Up s)
|
|
(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)
|
|
|
|
(KChar '1') -> copyMagnet s 1
|
|
(KChar '2') -> copyMagnet s 2
|
|
(KChar '3') -> copyMagnet s 3
|
|
(KChar '4') -> copyMagnet s 4
|
|
(KChar '5') -> copyMagnet s 5
|
|
(KChar '6') -> copyMagnet s 6
|
|
(KChar '7') -> copyMagnet s 7
|
|
(KChar '8') -> copyMagnet s 8
|
|
(KChar '9') -> copyMagnet s 9
|
|
|
|
(KChar '/') -> continue (s & appMode .~ Search)
|
|
(KChar 'f') -> continue (s & appMode .~ Search)
|
|
|
|
(KChar 's') -> continue (s & appMode .~ Sort)
|
|
|
|
_ -> continueWithoutRedraw s
|
|
|
|
eventHandler s _ = continue s
|
|
|
|
-- | The attribute map, currently not dependant on state
|
|
attributeMap :: AppS -> AttrMap
|
|
attributeMap = const $ attrMap defAttr [ (attrName "selected", withStyle defAttr reverseVideo)
|
|
, (editAttr, fg brightBlack) ]
|