kino/src/UI.hs

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)]