kino/src/Kino/UI.hs

{-# 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  = liftIO . setMovies

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