From 56e1a7ce0be458ace6282d0baef04bad76feddc0 Mon Sep 17 00:00:00 2001 From: depsterr Date: Fri, 17 Sep 2021 17:36:58 +0200 Subject: [PATCH] added functionality to copy magnets, added todo, lightly documented code --- TODO | 7 ++++ app/Main.hs | 11 +------ kino.cabal | 3 +- src/AppTypes.hs | 28 +++++++++++----- src/JSONTypes.hs | 73 ++++++++++++++++++++++------------------- src/Misc.hs | 6 ++++ src/Request.hs | 8 +++++ src/Torrent.hs | 62 +++++++++++++++++++++-------------- src/UI.hs | 79 ++++++++++++++++++++++++++++++++++++-------- src/UI/Widgets.hs | 83 +++++++++++++++++++++++++++++++++++++++++++++++ src/Widgets.hs | 64 ------------------------------------ 11 files changed, 271 insertions(+), 153 deletions(-) create mode 100644 TODO create mode 100644 src/UI/Widgets.hs delete mode 100644 src/Widgets.hs diff --git a/TODO b/TODO new file mode 100644 index 0000000..bdfaea1 --- /dev/null +++ b/TODO @@ -0,0 +1,7 @@ +COMMENT YOUR CODE!!!!!!! + +make it look nicer :) + +fix import/exports to be conservative + +write tests diff --git a/app/Main.hs b/app/Main.hs index 688cf5d..d7c2b31 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,13 +10,4 @@ import UI import System.Environment main :: IO () -main = do - args <- getArgs - case args of - ([]) -> runApp >> pure () - (x:_) -> do - movies <- queryMovies (T.pack x) - - case movies of - (Left m) -> print m - (Right d) -> mapM_ printMagnets (J.movies d) +main = runApp >> pure () diff --git a/kino.cabal b/kino.cabal index 76e3632..03ff405 100644 --- a/kino.cabal +++ b/kino.cabal @@ -17,10 +17,10 @@ library exposed-modules: Request , JSONTypes , UI + , UI.Widgets , Torrent , Misc , AppTypes - , Widgets other-modules: -- other-extensions: ghc-options: -Wall @@ -37,6 +37,7 @@ library , transformers , microlens , microlens-th + , Clipboard hs-source-dirs: src default-language: Haskell2010 diff --git a/src/AppTypes.hs b/src/AppTypes.hs index c32cc98..bef05e0 100644 --- a/src/AppTypes.hs +++ b/src/AppTypes.hs @@ -1,27 +1,39 @@ {-# LANGUAGE TemplateHaskell #-} +{-| +Module : AppTypes +Description : Contains the types related to our Brick application +-} + module AppTypes where import JSONTypes import Lens.Micro.TH +-- | Contains the different elements which we +-- might want brick to be able to identify data Ident = Listing | Input | ListItem Int deriving (Eq, Ord, Show) -data Mode = Search | Browse | Error +-- | Used to distiguish what set of +-- widgets should currently be rendered. +data Mode = Search | Browse | Message deriving (Eq, Ord, Show) +-- | Used for scrolling data ScrollDirection = Up | Down deriving (Eq, Show) +-- | The state of our app data AppS = AppS - { _appMode :: Mode - , _appCursor :: Int - , _appExpanded :: Bool - , _appPage :: Int - , _appListing :: Maybe JSONListMovies - , _appDetails :: Maybe JSONMovie - , _appError :: Maybe String + { _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 } deriving (Show) makeLenses ''AppS diff --git a/src/JSONTypes.hs b/src/JSONTypes.hs index ffae0f2..38c5132 100644 --- a/src/JSONTypes.hs +++ b/src/JSONTypes.hs @@ -1,5 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} +{-| +Module : JSONTypes +Description : Contains all the types used for data extracted from JSON responses + +Self explanatory +-} + module JSONTypes where import Data.Aeson @@ -7,10 +14,10 @@ import Data.Aeson.Types import qualified Data.Text as T data JSONResponse d = JSONResponse - { resp_status :: T.Text - , resp_message :: T.Text - , response_data :: Maybe d - } deriving (Show) + { respStatus :: T.Text + , respMessage :: T.Text + , respData :: Maybe d + } deriving (Eq, Show) instance (FromJSON d) => FromJSON (JSONResponse d) where parseJSON (Object v) = JSONResponse @@ -22,11 +29,11 @@ instance (FromJSON d) => FromJSON (JSONResponse d) where (typeMismatch "Object" invalid) data JSONListMovies = JSONListMovies - { movies_count :: Int - , movies_limit :: Int - , page_number :: Int + { moviesCount :: Int + , moviesLimit :: Int + , pagenumber :: Int , movies :: [JSONMovie] - } deriving (Show) + } deriving (Eq, Show) instance FromJSON JSONListMovies where parseJSON (Object v) = JSONListMovies @@ -39,20 +46,20 @@ instance FromJSON JSONListMovies where (typeMismatch "Object" invalid) data JSONMovie = JSONMovie - { movie_id :: Int - , movie_url :: T.Text - , imdb_code :: T.Text - , movie_title :: T.Text - , movie_title_long :: T.Text - , movie_year :: Int - , movie_rating :: Double - , movie_runtime :: Int - , movie_genres :: [T.Text] - , movie_summary :: T.Text - , movie_language :: T.Text - , movie_state :: T.Text - , movie_torrents :: [JSONTorrent] - } deriving (Show) + { movieId :: Int + , movieUrl :: T.Text + , imdbCode :: T.Text + , movieTitle :: T.Text + , movieTitleLong :: T.Text + , movieYear :: Int + , movieRating :: Double + , movieRuntime :: Int + , movieGenres :: [T.Text] + , movieSummary :: T.Text + , movieLanguage :: T.Text + , movieState :: T.Text + , movieTorrents :: [JSONTorrent] + } deriving (Eq, Show) instance FromJSON JSONMovie where parseJSON (Object v) = JSONMovie @@ -74,17 +81,17 @@ instance FromJSON JSONMovie where (typeMismatch "Object" invalid) data JSONTorrent = JSONTorrent - { torrent_url :: T.Text - , torrent_hash :: T.Text - , torrent_quality :: T.Text - , torrent_type :: T.Text - , torrent_seeds :: Int - , torrent_peers :: Int - , torrent_size :: T.Text - , torrent_bytes :: Int - , torrent_uploaded :: T.Text - , torrent_uploaded_unix :: Int -- TODO: better date type? - } deriving (Show) + { torrentUrl :: T.Text + , torrentHash :: T.Text + , torrentQuality :: T.Text + , torrentType :: T.Text + , torrentSeeds :: Int + , torrentPeers :: Int + , torrentSize :: T.Text + , torrentBytes :: Int + , torrentUploaded :: T.Text + , torrentUploadedUnix :: Int -- TODO: better date type? + } deriving (Eq, Show) instance FromJSON JSONTorrent where parseJSON (Object v) = JSONTorrent diff --git a/src/Misc.hs b/src/Misc.hs index 1e72a34..bd29455 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -1,6 +1,12 @@ +{-| +Module : Misc +Description : Contains miscelaneous helper functions which do not fit elsewhere +-} + module Misc where infixl 3 !? +-- | Safe version of (!!) (!?) :: [a] -> Int -> Maybe a [] !? i = Nothing (x:xs) !? 0 = Just x diff --git a/src/Request.hs b/src/Request.hs index 546991a..5c6cc72 100644 --- a/src/Request.hs +++ b/src/Request.hs @@ -1,5 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} +{-| +Module : Request +Description : Contains code for issuing http requests +-} + module Request where import JSONTypes @@ -10,6 +15,7 @@ import Control.Lens import Data.Aeson import qualified Data.Text as T +-- | Sends a request and unwraps the top level respone data structure makeRequest :: (FromJSON a) => String -> WR.Options -> IO (Either T.Text a) makeRequest url opts = do r <- asJSON =<< getWith opts url @@ -17,10 +23,12 @@ makeRequest url opts = do (JSONResponse "ok" _ (Just d)) -> Right d (JSONResponse _ m _) -> Left m +-- | Requests a list of all movies getMovies :: IO (Either T.Text JSONListMovies) getMovies = makeRequest "https://yts.mx/api/v2/list_movies.json" (defaults & param "limit" .~ ["50"]) +-- | Requests a list of all movies matching a query term queryMovies :: T.Text -> IO (Either T.Text JSONListMovies) queryMovies q = makeRequest "https://yts.mx/api/v2/list_movies.json" (defaults & param "query_term" .~ [q] diff --git a/src/Torrent.hs b/src/Torrent.hs index b0ba7c8..ee5d431 100644 --- a/src/Torrent.hs +++ b/src/Torrent.hs @@ -1,3 +1,8 @@ +{-| +Module : Torrent +Description : Contains code for formatting torrent info and retrieving magnet links +-} + module Torrent where import JSONTypes @@ -5,38 +10,47 @@ import Network.HTTP.Base import qualified Data.Text as T import Data.List (intercalate) +-- | Makes type signature a bit clearer type Quality = String +-- | A list of recommended trackers trackerList :: [String] trackerList = [ "udp://open.demonii.com:1337/announce" - , "udp://tracker.openbittorrent.com:80" - , "udp://tracker.coppersurfer.tk:6969" - , "udp://glotorrents.pw:6969/announce" - , "udp://tracker.opentrackr.org:1337/announce" - , "udp://torrent.gresille.org:80/announce" - , "udp://p4p.arenabg.com:1337" - , "udp://tracker.leechers-paradise.org:6969" - ] + , "udp://tracker.openbittorrent.com:80" + , "udp://tracker.coppersurfer.tk:6969" + , "udp://glotorrents.pw:6969/announce" + , "udp://tracker.opentrackr.org:1337/announce" + , "udp://torrent.gresille.org:80/announce" + , "udp://p4p.arenabg.com:1337" + , "udp://tracker.leechers-paradise.org:6969" + ] + +-- | A string to be embedded into the magnet link trackerString :: String trackerString = "&tr=" <> intercalate "&tr=" trackerList -toMagnets :: JSONMovie -> [(Quality, String)] -toMagnets m = map (\t -> (quality t, toMagnet name (hash t))) torrents +-- | Creates a String enumerating and listing the different torrents +-- quality and amount of peers +listTorrents :: JSONMovie -> String +listTorrents m = intercalate ", " (zipWith3 (\x y z -> x ++ y ++ z) numbers qualities seeders) where - name = T.unpack (movie_title_long m) - quality = T.unpack . torrent_quality - hash = T.unpack . torrent_hash - torrents = movie_torrents m - + qualities = map quality (movieTorrents m) + seeders = map (\x -> ' ':'(':seeds x ++ ")") (movieTorrents m) + numbers = map (\x -> '[':show x ++ "] ") [1..] + seeds = show . torrentSeeds + quality = T.unpack . torrentQuality +-- | Creates a list of magnet names given a movie +toMagnets :: JSONMovie -> [String] +toMagnets m = map (toMagnet name . hash) torrents + where + name = T.unpack (movieTitleLong m) + hash = T.unpack . torrentHash + torrents = movieTorrents m + +-- | Takes the longName of a movie and a torrent hash and returns +-- a valid magnet link toMagnet :: String -> String -> String -toMagnet long_name hash = "magnet:?xt=urn:btih:" <> hash <> "&dn" - <> (urlEncode long_name) <> trackerString - -printMagnets :: JSONMovie -> IO () -printMagnets movie = do - putStrLn $ '\n' : title ++ '\n' : replicate (length title) '=' - mapM_ ( \(q, m) -> putStrLn (q ++ '\t' : m)) (toMagnets movie) - where - title = T.unpack (movie_title movie) +toMagnet longName hash = "magnet:?xt=urn:btih:" <> hash <> "&dn" + <> (urlEncode longName) <> trackerString diff --git a/src/UI.hs b/src/UI.hs index 9b50e8c..36d5b0b 100644 --- a/src/UI.hs +++ b/src/UI.hs @@ -1,3 +1,8 @@ +{-| +Module : UI +Description : This is the code which interacts with Brick +-} + module UI where import Data.Maybe (fromMaybe) @@ -9,13 +14,16 @@ import Graphics.Vty.Attributes (withStyle, reverseVideo) import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import Lens.Micro +import System.Clipboard import JSONTypes import Request import Misc -import Widgets +import UI.Widgets import AppTypes +import Torrent +-- | The initial state of our application initialState :: AppS initialState = AppS { _appMode = Browse @@ -24,9 +32,11 @@ initialState = AppS , _appPage = 1 , _appListing = Nothing , _appDetails = Nothing - , _appError = Nothing + , _appMessage = Nothing + , _appContinue = True } +-- | Our brick app specification app :: App AppS () Ident app = App { appDraw = draw @@ -36,42 +46,74 @@ app = App , appAttrMap = attributeMap } +-- | A small wrapper to run the brick app runApp :: IO AppS runApp = defaultMain app initialState +-- | 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 & appError .~ Just (T.unpack msg) + (Left msg) -> s & appMessage .~ Just (T.unpack msg) + & appContinue .~ False (Right listing) -> s & appListing .~ Just listing & appDetails .~ (movies listing !? s ^. appCursor) +-- | The drawing function which defers to the proper function +-- from UI.Widgets draw :: AppS -> [Widget Ident] draw s = pure $ case s ^. appMode of - Browse -> browseWidget s - Search -> searchWidget s - Error -> errorWidget s + Browse -> browseWidget s + Search -> searchWidget s + Message -> messageWidget s + +-- | Currently just showFirstCursor chooseCursor :: AppS -> [CursorLocation Ident] -> Maybe (CursorLocation Ident) -chooseCursor = showFirstCursor -- replace if needed +chooseCursor = showFirstCursor --- todo: lenses? NO OVERFLOW +-- | Scrolls our cursor and updates the app details scroll :: ScrollDirection -> AppS -> AppS -scroll d s = s & appCursor %~ (\x -> max 0 (min upperLimit (new x))) +scroll d s = s & appCursor .~ newCursor & appExpanded .~ False + & appDetails .~ (s ^. appListing >>= ((!? newCursor) . movies)) where upperLimit = fromMaybe 0 (subtract 1 . length . movies <$> s ^. appListing) new = case d of { Up -> (subtract 1); Down -> (+1) } + oldCursor = s ^. appCursor + newCursor = max 0 (min upperLimit (new oldCursor)) + +-- | 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 +-- | Copy the magnet link of the focused movie at +-- the given index +copyMagnet :: AppS -> Int -> EventM Ident (Next AppS) +copyMagnet s i = case (do + m <- s ^. appDetails + _ <- movieTorrents m !? i - 1 + toMagnets m !? i - 1) of + Nothing -> continue s + (Just magnet) -> do + liftIO (setClipboardString magnet) + continue (displayMessage s "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 _)) = do +eventHandler s (VtyEvent (EvKey k _)) = case s ^. appMode of - Error -> halt s - Search -> undefined - Browse -> case k of + Message -> if s ^. appContinue + then continue (s & appMode .~ Browse + & appMessage .~ Nothing) + else halt s + Search -> undefined + Browse -> case k of (KChar 'q') -> halt s (KEsc) -> halt s @@ -83,6 +125,16 @@ eventHandler s (VtyEvent (EvKey k _)) = do (KChar ' ') -> continue (s & appExpanded %~ not) (KEnter) -> continue (s & appExpanded %~ not) + (KChar '1') -> copyMagnet s 1 + (KChar '2') -> copyMagnet s 2 + (KChar '3') -> copyMagnet s 3 + (KChar '4') -> copyMagnet s 4 + (KChar '5') -> copyMagnet s 5 + (KChar '6') -> copyMagnet s 6 + (KChar '7') -> copyMagnet s 7 + (KChar '8') -> copyMagnet s 8 + (KChar '9') -> copyMagnet s 9 + (KChar '/') -> continue (s & appMode .~ Search) (KChar 's') -> continue (s & appMode .~ Search) @@ -90,5 +142,6 @@ eventHandler s (VtyEvent (EvKey k _)) = do eventHandler s _ = continue s +-- | The attribute map, currently not dependant on state attributeMap :: AppS -> AttrMap attributeMap = const $ attrMap defAttr [(attrName "selected", withStyle defAttr reverseVideo)] diff --git a/src/UI/Widgets.hs b/src/UI/Widgets.hs new file mode 100644 index 0000000..39100df --- /dev/null +++ b/src/UI/Widgets.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : UI.Widgets +Description : This is the code which builds the Brick frontend +-} + +module UI.Widgets where + +import Brick +import Brick.Main +import Brick.Widgets.Center +import Brick.Widgets.Border +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 Data.Maybe + +import JSONTypes +import Request +import Misc +import AppTypes +import Torrent + +-- | Wrap a widget in the selected attribute +select :: Widget Ident -> Widget Ident +select = withAttr (attrName "selected") + +-- | Given a movie and a tuple of widgets and state, append the +-- movie to the widgets. Used by movieWidgets +widgetCons :: JSONMovie -> (Widget Ident, AppS) -> (Widget Ident, AppS) +widgetCons m (w, s) = + embed $ if Just m == (s ^. appDetails) + then select . visible $ + if s ^. appExpanded + then expandedWidget s m + else movieWidget s m + else movieWidget s m + where + 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 + +-- | Returns a single movie listing +movieWidget :: AppS -> JSONMovie -> Widget Ident +movieWidget s m = txt (movieTitle m) <+> padLeft Max (str (show (movieYear m))) + +-- | Returns an expanded movie listing showing additional info +expandedWidget :: AppS -> JSONMovie -> Widget Ident +expandedWidget s m = movieWidget s m + <=> (padRight (Pad 3) (str "Rating") <+> str (show (movieRating m))) + <=> (padRight (Pad 1) (str "Language") <+> txt (movieLanguage m)) + <=> (padRight (Pad 3) (str "Genres") <+> txt (T.intercalate ", " (movieGenres m))) + <=> (padRight (Pad 2) (str "Magnets") <+> str (listTorrents m)) + <=> (padRight (Pad 2) (str "Summary") <+> txtWrap (movieSummary m)) + +-- | The search mode widget (unimplemented) +searchWidget :: AppS -> Widget Ident +searchWidget = undefined + +-- | 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") + +-- | 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)")) diff --git a/src/Widgets.hs b/src/Widgets.hs deleted file mode 100644 index 1668fcc..0000000 --- a/src/Widgets.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Widgets where - -import Brick -import Brick.Main -import Brick.Widgets.Center -import Brick.Widgets.Table -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 - -select :: Widget Ident -> Widget Ident -select = (withAttr (attrName "selected")) - -widgetCons :: JSONMovie -> (Widget Ident, Int, AppS) -> (Widget Ident, Int, AppS) -widgetCons m (w, i, s) = - embed $ if s ^. appCursor == i - then select . visible $ - if s ^. appExpanded - then expandedWidget s m - else movieWidget s m - else movieWidget s m - where - embed x = (w <=> x, i+1, s) - - -movieWidgets :: AppS -> JSONListMovies -> Widget Ident -movieWidgets s m = let (items, _, _) = foldr widgetCons (emptyWidget, 0, s) (movies m) - in items - -movieWidget :: AppS -> JSONMovie -> Widget Ident -movieWidget s m = txt (movie_title m) <+> padLeft Max (str (show (movie_year m))) - -expandedWidget :: AppS -> JSONMovie -> Widget Ident -expandedWidget s m = movieWidget s m - <=> (padRight (Pad 3) (str "Rating") <+> str (show (movie_rating m))) - <=> (padRight (Pad 1) (str "Language") <+> txt (movie_language m)) - <=> (padRight (Pad 3) (str "Genres") <+> txt (T.intercalate ", " (movie_genres m))) - <=> (padRight (Pad 2) (str "Summary") <+> 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