From 8b6443164a3aa586ecd6c1d04c5866c799065095 Mon Sep 17 00:00:00 2001 From: depsterr Date: Mon, 20 Sep 2021 13:21:48 +0200 Subject: [PATCH] 1.0 - first working version! --- TODO | 6 ++++++ src/AppTypes.hs | 19 +++++++++------- src/JSONTypes.hs | 9 ++++---- src/Misc.hs | 5 +++++ src/UI.hs | 55 +++++++++++++++++++++++++++++++---------------- src/UI/Widgets.hs | 34 +++++++++++++++++++---------- 6 files changed, 87 insertions(+), 41 deletions(-) diff --git a/TODO b/TODO index 36d737e..e07ca36 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,11 @@ +handle clipboard errors + make it look nicer :) fix import/exports to be conservative write tests + +theme selection config + +refactor to use more Text? diff --git a/src/AppTypes.hs b/src/AppTypes.hs index bef05e0..d545a52 100644 --- a/src/AppTypes.hs +++ b/src/AppTypes.hs @@ -9,6 +9,8 @@ module AppTypes where import JSONTypes import Lens.Micro.TH +import Brick.Widgets.Edit (Editor(..)) +import qualified Data.Text as T -- | Contains the different elements which we -- might want brick to be able to identify @@ -26,14 +28,15 @@ data ScrollDirection = Up | Down -- | The state of our app data AppS = AppS - { _appMode :: Mode -- ^ The current mode of the app - , _appCursor :: Int -- ^ The selected into the listing - , _appExpanded :: Bool -- ^ If the currently selected listing is expanded - , _appPage :: Int -- ^ The page currently being viewed - , _appListing :: Maybe JSONListMovies -- ^ The movies being browsed - , _appDetails :: Maybe JSONMovie -- ^ The movie being focused - , _appMessage :: Maybe String -- ^ The message to be shown in message mode - , _appContinue :: Bool -- ^ If to continue after showing message + { _appMode :: Mode -- ^ The current mode of the app + , _appCursor :: Int -- ^ The selected into the listing + , _appExpanded :: Bool -- ^ If the currently selected listing is expanded + , _appPage :: Int -- ^ The page currently being viewed + , _appListing :: JSONListMovies -- ^ The movies being browsed + , _appDetails :: Maybe JSONMovie -- ^ The movie being focused + , _appMessage :: Maybe String -- ^ The message to be shown in message mode + , _appContinue :: Bool -- ^ If to continue after showing message + , _appEditor :: Editor T.Text Ident -- ^ The state for the editor widget } deriving (Show) makeLenses ''AppS diff --git a/src/JSONTypes.hs b/src/JSONTypes.hs index 38c5132..873353d 100644 --- a/src/JSONTypes.hs +++ b/src/JSONTypes.hs @@ -11,6 +11,7 @@ module JSONTypes where import Data.Aeson import Data.Aeson.Types +import Data.Maybe (fromMaybe) import qualified Data.Text as T data JSONResponse d = JSONResponse @@ -23,7 +24,7 @@ instance (FromJSON d) => FromJSON (JSONResponse d) where parseJSON (Object v) = JSONResponse <$> v .: "status" <*> v .: "status_message" - <*> v .: "data" + <*> v .:? "data" parseJSON invalid = prependFailure "parsing JSONResponse failed, " (typeMismatch "Object" invalid) @@ -31,8 +32,8 @@ instance (FromJSON d) => FromJSON (JSONResponse d) where data JSONListMovies = JSONListMovies { moviesCount :: Int , moviesLimit :: Int - , pagenumber :: Int - , movies :: [JSONMovie] + , moviesPage :: Int + , moviesMovies :: [JSONMovie] } deriving (Eq, Show) instance FromJSON JSONListMovies where @@ -40,7 +41,7 @@ instance FromJSON JSONListMovies where <$> v .: "movie_count" <*> v .: "limit" <*> v .: "page_number" - <*> v .: "movies" + <*> v .:? "movies" .!= [] parseJSON invalid = prependFailure "parsing JSONListMovies failed, " (typeMismatch "Object" invalid) diff --git a/src/Misc.hs b/src/Misc.hs index bd29455..2ec51e3 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -11,3 +11,8 @@ infixl 3 !? [] !? i = Nothing (x:xs) !? 0 = Just x (x:xs) !? n = xs !? (n-1) + +infixl 0 $> +-- | Backwards function application +($>) :: a -> (a -> b) -> b +x $> f = f x diff --git a/src/UI.hs b/src/UI.hs index f0d193e..d6b2833 100644 --- a/src/UI.hs +++ b/src/UI.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + {-| Module : UI Description : This is the code which interacts with Brick @@ -8,9 +10,13 @@ module UI where import Data.Maybe (fromMaybe) import Brick hiding (Direction(..)) +import Brick.Types (handleEventLensed) +import Brick.Util (fg) +import Brick.Widgets.Edit (Editor(..), handleEditorEvent, editorText, editAttr, getEditContents) import Graphics.Vty (defAttr) import Graphics.Vty.Input.Events import Graphics.Vty.Attributes (withStyle, reverseVideo) +import Graphics.Vty.Attributes.Color (brightBlack) import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import Lens.Micro @@ -30,10 +36,11 @@ initialState = AppS , _appCursor = 0 , _appExpanded = False , _appPage = 1 - , _appListing = Nothing + , _appListing = JSONListMovies 0 0 0 [] , _appDetails = Nothing , _appMessage = Nothing , _appContinue = True + , _appEditor = editorText Input (Just 1) mempty } -- | Our brick app specification @@ -50,16 +57,20 @@ app = App runApp :: IO AppS runApp = defaultMain app initialState +setMovies :: AppS -> IO (Either T.Text JSONListMovies) -> IO AppS +setMovies s mb = do + m <- mb + case m of + (Left t) -> pure (displayMessage s True (T.unpack t)) + (Right m) -> pure (s & appListing .~ m + & appCursor .~ 0 + & appDetails .~ (moviesMovies m !? 0)) + -- | The starting event which grabs the inital listing startEvent :: AppS -> EventM Ident AppS startEvent s = do -- todo move unwrapping our response structure into a function - response <- liftIO getMovies - pure $ case response of - (Left msg) -> s & appMessage .~ Just (T.unpack msg) - & appContinue .~ False - (Right listing) -> s & appListing .~ Just listing - & appDetails .~ (movies listing !? s ^. appCursor) + pure =<< liftIO (setMovies s getMovies) -- | The drawing function which defers to the proper function -- from UI.Widgets @@ -78,18 +89,20 @@ chooseCursor = showFirstCursor scroll :: ScrollDirection -> AppS -> AppS scroll d s = s & appCursor .~ newCursor & appExpanded .~ False - & appDetails .~ (s ^. appListing >>= ((!? newCursor) . movies)) + & appDetails .~ (moviesMovies (s ^. appListing) !? newCursor) where - upperLimit = fromMaybe 0 (subtract 1 . length . movies <$> s ^. appListing) + upperLimit = length (moviesMovies (s ^. appListing)) - 1 new = case d of { Up -> (subtract 1); Down -> (+1) } newCursor = max 0 (min upperLimit (new (s ^. appCursor))) -- | Given a String, modify our state so that string --- is displayed as a message -displayMessage :: AppS -> String -> AppS -displayMessage s str = s & appMode .~ Message - & appMessage .~ Just str +-- is displayed as a message, alternatively forcing +-- an exit after the message is aknowledged. +displayMessage :: AppS -> Bool -> String -> AppS +displayMessage s fatal str = s & appMode .~ Message + & appMessage .~ Just str + & appContinue .~ not fatal -- | Copy the magnet link of the focused movie at -- the given index @@ -101,17 +114,22 @@ copyMagnet s i = case (do Nothing -> continue s (Just magnet) -> do liftIO (setClipboardString magnet) - continue (displayMessage s "Copied magnet link to clipboard!") + continue (displayMessage s False "Copied magnet link to clipboard!") -- The event handler, takes care of keyboard events. eventHandler :: AppS -> BrickEvent Ident () -> EventM Ident (Next AppS) -eventHandler s (VtyEvent (EvKey k _)) = +eventHandler s (VtyEvent e@(EvKey k _)) = case s ^. appMode of Message -> if s ^. appContinue then continue (s & appMode .~ Browse & appMessage .~ Nothing) else halt s - Search -> undefined + Search -> case k of + (KEnter) -> do + let queryText = T.unlines (getEditContents (s ^. appEditor)) + newS <- liftIO (setMovies s (queryMovies queryText)) + continue (newS & appMode .~ Browse) + _ -> continue =<< handleEventLensed s appEditor handleEditorEvent e Browse -> case k of (KChar 'q') -> halt s (KEsc) -> halt s @@ -137,10 +155,11 @@ eventHandler s (VtyEvent (EvKey k _)) = (KChar '/') -> continue (s & appMode .~ Search) (KChar 's') -> continue (s & appMode .~ Search) - _ -> continue s + _ -> 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)] +attributeMap = const $ attrMap defAttr [ (attrName "selected", withStyle defAttr reverseVideo) + , (editAttr, fg brightBlack) ] diff --git a/src/UI/Widgets.hs b/src/UI/Widgets.hs index 8ae8f56..1ed4d04 100644 --- a/src/UI/Widgets.hs +++ b/src/UI/Widgets.hs @@ -11,6 +11,7 @@ import Brick import Brick.Main import Brick.Widgets.Center import Brick.Widgets.Border +import Brick.Widgets.Edit import Brick.AttrMap (attrMap) import Graphics.Vty (defAttr) import Graphics.Vty.Input.Events @@ -44,9 +45,9 @@ widgetCons m (w, s) = embed x = (x <=> w, s) -- | Returns a big list of all movies -movieWidgets :: AppS -> JSONListMovies -> Widget Ident -movieWidgets s m = let (items, _) = foldr widgetCons (emptyWidget, s) (movies m) - in items +movieWidgets :: AppS -> Widget Ident +movieWidgets s = let (items, _) = foldr widgetCons (emptyWidget, s) (moviesMovies (s ^. appListing)) + in items -- | Returns a single movie listing movieWidget :: AppS -> JSONMovie -> Widget Ident @@ -61,23 +62,34 @@ expandedWidget s m = movieWidget s m <=> (padRight (Pad 2) (str "Magnets") <+> str (listTorrents m)) <=> (padRight (Pad 2) (str "Summary") <+> txtWrap (movieSummary m)) --- | The search mode widget (unimplemented) +-- | The search mode widget. Uses the brick built in Editor widget searchWidget :: AppS -> Widget Ident -searchWidget = undefined +searchWidget s = center $ border $ + padAll 1 (editorRenderer (s ^. appEditor)) + <=> padAll 1 (hCenter (str "[Press enter to search]")) + +editorRenderer :: Editor T.Text Ident -> Widget Ident +editorRenderer e = renderEditor render True e + where + render :: [T.Text] -> Widget Ident + render [] = txt "Enter query term" $> withAttr editAttr + render [""] = txt "Enter query term" $> withAttr editAttr + render (t:_) = txt t -- | The browse mode widget which returns a full listing of movies -- or reports that there are no movies to list browseWidget :: AppS -> Widget Ident browseWidget s = - headings <=> case (s ^. appListing) of - Nothing -> center $ str "No movies found matching query." - (Just m) -> (viewport Listing Vertical (movieWidgets s m)) - where - headings = str "Title" <+> padLeft Max (str "Year") + str "Title" <+> padLeft Max (str "Year") + <=> viewport Listing Vertical (movieWidgets s) -- | The message widget which simply shows a message and informs -- the user of how to escape messageWidget :: AppS -> Widget Ident messageWidget s = center $ border $ padAll 1 (hCenter (str (fromMaybe "Unkown Error!" (s ^. appMessage)))) - <=> padAll 1 (hCenter (str "(Press any key to continue)")) + <=> padAll 1 (hCenter (str ("[Press any key to " <> action <> "]"))) + where + action = if s ^. appContinue + then "continue" + else "exit"