made loads of progress on ui

This commit is contained in:
Rachel Lambda Samuelsson 2021-09-14 17:06:34 +02:00
parent 566109306b
commit 64aaf0fbc2
7 changed files with 169 additions and 23 deletions

View File

@ -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

View File

@ -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

27
src/AppTypes.hs Normal file
View File

@ -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

6
src/Misc.hs Normal file
View File

@ -0,0 +1,6 @@
module Misc where
(!?) :: [a] -> Int -> Maybe a
[] !? i = Nothing
(x:xs) !? 0 = Just x
(x:xs) !? n = xs !? (n-1)

View File

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

View File

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

55
src/Widgets.hs Normal file
View File

@ -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