From 64aaf0fbc252d54f3a107316b3ed8307f402490c Mon Sep 17 00:00:00 2001 From: depsterr Date: Tue, 14 Sep 2021 17:06:34 +0200 Subject: [PATCH] made loads of progress on ui --- app/Main.hs | 12 ++++---- kino.cabal | 9 +++++- src/AppTypes.hs | 27 ++++++++++++++++++ src/Misc.hs | 6 ++++ src/Request.hs | 9 ++++-- src/UI.hs | 74 +++++++++++++++++++++++++++++++++++++++---------- src/Widgets.hs | 55 ++++++++++++++++++++++++++++++++++++ 7 files changed, 169 insertions(+), 23 deletions(-) create mode 100644 src/AppTypes.hs create mode 100644 src/Misc.hs create mode 100644 src/Widgets.hs diff --git a/app/Main.hs b/app/Main.hs index 83e0688..688cf5d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,18 +1,20 @@ module Main where -import Request -import qualified JSONTypes as J -import Torrent import qualified Data.Text as T +import qualified JSONTypes as J +import Request +import Torrent +import UI + import System.Environment main :: IO () main = do args <- getArgs case args of - ([]) -> print =<< getMovies - (x:xs) -> do + ([]) -> runApp >> pure () + (x:_) -> do movies <- queryMovies (T.pack x) case movies of diff --git a/kino.cabal b/kino.cabal index a471680..76e3632 100644 --- a/kino.cabal +++ b/kino.cabal @@ -18,6 +18,9 @@ library , JSONTypes , UI , Torrent + , Misc + , AppTypes + , Widgets other-modules: -- other-extensions: ghc-options: -Wall @@ -30,6 +33,10 @@ library , text , brick , HTTP + , vty + , transformers + , microlens + , microlens-th hs-source-dirs: src default-language: Haskell2010 @@ -37,7 +44,7 @@ executable kino main-is: Main.hs -- other-modules: -- other-extensions: - ghc-options: -Wall + ghc-options: -Wall -threaded build-depends: base ^>=4.14.1.0 , kino , brick diff --git a/src/AppTypes.hs b/src/AppTypes.hs new file mode 100644 index 0000000..c32cc98 --- /dev/null +++ b/src/AppTypes.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE TemplateHaskell #-} + +module AppTypes where + +import JSONTypes +import Lens.Micro.TH + +data Ident = Listing | Input | ListItem Int + deriving (Eq, Ord, Show) + +data Mode = Search | Browse | Error + deriving (Eq, Ord, Show) + +data ScrollDirection = Up | Down + deriving (Eq, Show) + +data AppS = AppS + { _appMode :: Mode + , _appCursor :: Int + , _appExpanded :: Bool + , _appPage :: Int + , _appListing :: Maybe JSONListMovies + , _appDetails :: Maybe JSONMovie + , _appError :: Maybe String + } deriving (Show) + +makeLenses ''AppS diff --git a/src/Misc.hs b/src/Misc.hs new file mode 100644 index 0000000..90c9e75 --- /dev/null +++ b/src/Misc.hs @@ -0,0 +1,6 @@ +module Misc where + +(!?) :: [a] -> Int -> Maybe a +[] !? i = Nothing +(x:xs) !? 0 = Just x +(x:xs) !? n = xs !? (n-1) diff --git a/src/Request.hs b/src/Request.hs index 68078c8..546991a 100644 --- a/src/Request.hs +++ b/src/Request.hs @@ -8,7 +8,7 @@ import Network.Wreq import qualified Network.Wreq as WR (Options) import Control.Lens import Data.Aeson -import Data.Text as T +import qualified Data.Text as T makeRequest :: (FromJSON a) => String -> WR.Options -> IO (Either T.Text a) makeRequest url opts = do @@ -18,7 +18,10 @@ makeRequest url opts = do (JSONResponse _ m _) -> Left m getMovies :: IO (Either T.Text JSONListMovies) -getMovies = makeRequest "https://yts.mx/api/v2/list_movies.json" defaults +getMovies = makeRequest "https://yts.mx/api/v2/list_movies.json" + (defaults & param "limit" .~ ["50"]) queryMovies :: T.Text -> IO (Either T.Text JSONListMovies) -queryMovies q = makeRequest "https://yts.mx/api/v2/list_movies.json" (defaults & param "query_term" .~ [q]) +queryMovies q = makeRequest "https://yts.mx/api/v2/list_movies.json" + (defaults & param "query_term" .~ [q] + & param "limit" .~ ["50"]) diff --git a/src/UI.hs b/src/UI.hs index 61e3672..2a2dd6f 100644 --- a/src/UI.hs +++ b/src/UI.hs @@ -1,11 +1,31 @@ module UI where -import Brick -import Brick.Main +import Data.Maybe (fromMaybe) -data Ident = Nil +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 -data AppS = Null +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 @@ -19,20 +39,46 @@ app = App runApp :: IO AppS runApp = defaultMain app initialState -initialState :: AppS -initialState = undefined - -startEvent :: EventM Ident (Next Apps) -startEvent = return -- replace if needed +startEvent :: AppS -> EventM Ident AppS +startEvent (AppS m c e p l d err) = do + -- todo move unwrapping our response structure into a function + response <- liftIO getMovies + case response of + (Left msg) -> pure (AppS m c e p l d (Just (T.unpack msg))) + (Right listing) -> do + pure (AppS m c e p (Just listing) (movies listing !? c) err) draw :: AppS -> [Widget Ident] -draw = undefined +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 -eventHandler :: AppS -> BrickEvent Identifier () -> EventM Ident (Next AppS) -eventHandler = undefined +-- 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) } -attributeMap :: AttrMap -attributeMap = undefined + +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 + (KChar 'j') -> continue (scroll Down s) + (KChar 'k') -> continue (scroll Up s) + (KChar ' ') -> continue (s & appExpanded %~ not) + _ -> continue s + +eventHandler s _ = continue s + +attributeMap :: AppS -> AttrMap +attributeMap = const $ attrMap defAttr [(attrName "selected", withStyle defAttr reverseVideo)] diff --git a/src/Widgets.hs b/src/Widgets.hs new file mode 100644 index 0000000..dd38b42 --- /dev/null +++ b/src/Widgets.hs @@ -0,0 +1,55 @@ +module Widgets where + +import Brick +import Brick.Main +import Brick.Widgets.Center +import Brick.AttrMap (attrMap) +import Graphics.Vty (defAttr) +import Graphics.Vty.Input.Events +import Control.Monad.IO.Class (liftIO) +import qualified Data.Text as T +import Lens.Micro + +import JSONTypes +import Request +import Misc +import AppTypes + +widgetCons :: JSONMovie -> (Widget Ident, Int, AppS) -> (Widget Ident, Int, AppS) +widgetCons m (w, i, s) = + if s ^. appCursor == i + then embed . visible . select $ + if s ^. appExpanded + then expandedWidget s m i + else movieWidget s m i + else embed (movieWidget s m i) + where + embed x = (w <=> x, i+1, s) + select = (withAttr (attrName "selected")) + + +movieWidgets :: AppS -> JSONListMovies -> Widget Ident +movieWidgets s m = let (items, _, _) = foldr widgetCons (emptyWidget, 0, s) (movies m) + in items + +movieWidget :: AppS -> JSONMovie -> Int -> Widget Ident +movieWidget s m i = txt (movie_title m) <+> padLeft Max (str (show (movie_year m))) + +expandedWidget :: AppS -> JSONMovie -> Int -> Widget Ident +expandedWidget s m i = movieWidget s m i <=> txtWrap (movie_summary m) + +searchWidget :: AppS -> Widget Ident +searchWidget = undefined + +browseWidget :: AppS -> Widget Ident +browseWidget s = + case (s ^. appListing) of + Nothing -> center $ str "No movies found matching query." + (Just m) -> headings <=> (viewport Listing Vertical (movieWidgets s m)) + where headings = str "Title" <+> padLeft Max (str "Year") + +errorWidget :: AppS -> Widget Ident +errorWidget s = center $ + case (s ^. appError) of + Nothing -> str "Unknown Error." + (Just e) -> str e