kino/src/UI.hs

95 lines
2.6 KiB
Haskell

module UI where
import Data.Maybe (fromMaybe)
import Brick hiding (Direction(..))
import Graphics.Vty (defAttr)
import Graphics.Vty.Input.Events
import Graphics.Vty.Attributes (withStyle, reverseVideo)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import Lens.Micro
import JSONTypes
import Request
import Misc
import Widgets
import AppTypes
initialState :: AppS
initialState = AppS
{ _appMode = Browse
, _appCursor = 0
, _appExpanded = False
, _appPage = 1
, _appListing = Nothing
, _appDetails = Nothing
, _appError = Nothing
}
app :: App AppS () Ident
app = App
{ appDraw = draw
, appChooseCursor = chooseCursor
, appHandleEvent = eventHandler
, appStartEvent = startEvent
, appAttrMap = attributeMap
}
runApp :: IO AppS
runApp = defaultMain app initialState
startEvent :: AppS -> EventM Ident AppS
startEvent s = do
-- todo move unwrapping our response structure into a function
response <- liftIO getMovies
pure $ case response of
(Left msg) -> s & appError .~ Just (T.unpack msg)
(Right listing) -> s & appListing .~ Just listing
& appDetails .~ (movies listing !? s ^. appCursor)
draw :: AppS -> [Widget Ident]
draw s = pure $ case s ^. appMode of
Browse -> browseWidget s
Search -> searchWidget s
Error -> errorWidget s
chooseCursor :: AppS -> [CursorLocation Ident] -> Maybe (CursorLocation Ident)
chooseCursor = showFirstCursor -- replace if needed
-- todo: lenses? NO OVERFLOW
scroll :: ScrollDirection -> AppS -> AppS
scroll d s = s & appCursor %~ (\x -> max 0 (min upperLimit (new x)))
& appExpanded .~ False
where
upperLimit = fromMaybe 0 (subtract 1 . length . movies <$> s ^. appListing)
new = case d of { Up -> (subtract 1); Down -> (+1) }
eventHandler :: AppS -> BrickEvent Ident () -> EventM Ident (Next AppS)
eventHandler s (VtyEvent (EvKey k _)) = do
case s ^. appMode of
Error -> halt s
Search -> undefined
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 '/') -> continue (s & appMode .~ Search)
(KChar 's') -> continue (s & appMode .~ Search)
_ -> continue s
eventHandler s _ = continue s
attributeMap :: AppS -> AttrMap
attributeMap = const $ attrMap defAttr [(attrName "selected", withStyle defAttr reverseVideo)]