made loads of progress on ui

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
+    ([])   -> runApp >> pure ()
-    (x:xs) -> do
+    (x:_) -> do
       movies <- queryMovies (T.pack x)
 
       case movies of

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

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

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)

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

src/UI.hs

@@ -1,11 +1,31 @@
 module UI where
 
-import Brick
+import Data.Maybe (fromMaybe)
-import Brick.Main
 
-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
+startEvent :: AppS -> EventM Ident AppS
-initialState = undefined
+startEvent (AppS m c e p l d err) = do
-
+  -- todo move unwrapping our response structure into a function
-startEvent :: EventM Ident (Next Apps)
+  response <- liftIO getMovies
-startEvent = return -- replace if needed
+  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)
+-- todo: lenses? NO OVERFLOW
-eventHandler = undefined
+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)]

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