made loads of progress on ui
This commit is contained in:
parent
566109306b
commit
64aaf0fbc2
12
app/Main.hs
12
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
|
||||
|
|
|
@ -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
27
src/AppTypes.hs
Normal 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
6
src/Misc.hs
Normal 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)
|
|
@ -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"])
|
||||
|
|
74
src/UI.hs
74
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)]
|
||||
|
|
55
src/Widgets.hs
Normal file
55
src/Widgets.hs
Normal 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
|
Loading…
Reference in New Issue
Block a user