kino/src/UI.hs

166 lines
5.3 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-|
Module : UI
Description : This is the code which interacts with Brick
-}
module UI where
import Data.Maybe (fromMaybe)
import Brick hiding (Direction(..))
import Brick.Types (handleEventLensed)
import Brick.Util (fg)
import Brick.Widgets.Edit (Editor(..), handleEditorEvent, editorText, editAttr, getEditContents)
import Graphics.Vty (defAttr)
import Graphics.Vty.Input.Events
import Graphics.Vty.Attributes (withStyle, reverseVideo)
import Graphics.Vty.Attributes.Color (brightBlack)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import Lens.Micro
import System.Clipboard
import JSONTypes
import Request
import Misc
import UI.Widgets
import AppTypes
import 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
}
-- | 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
setMovies :: AppS -> IO (Either T.Text JSONListMovies) -> IO AppS
setMovies s mb = do
m <- mb
case m of
(Left t) -> pure (displayMessage s True (T.unpack t))
(Right m) -> pure (s & appListing .~ m
& appCursor .~ 0
& appDetails .~ (moviesMovies m !? 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)
-- | 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
-- | 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)))
-- | 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 str = s & appMode .~ Message
& appMessage .~ Just str
& appContinue .~ not fatal
-- | 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!")
-- 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
Search -> case k of
(KEnter) -> do
let queryText = T.unlines (getEditContents (s ^. appEditor))
newS <- liftIO (setMovies s (queryMovies queryText))
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 ' ') -> 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 's') -> continue (s & appMode .~ Search)
_ -> 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) ]