rachel/kino
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

1.0 - first working version!

Browse Source
This commit is contained in:
Rachel Lambda Samuelsson 2021-09-20 13:21:48 +02:00
parent 5843a137f8
commit 8b6443164a
6 changed files with 87 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
TODO
View File

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

19
src/AppTypes.hs
View File

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

9
src/JSONTypes.hs
View File

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

5
src/Misc.hs
View File

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

55
src/UI.hs
View File

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

34
src/UI/Widgets.hs
View File

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