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

added functionality to copy magnets, added todo, lightly documented code

Browse Source
This commit is contained in:
Rachel Lambda Samuelsson 2021-09-17 17:36:58 +02:00
parent f71cee3ffa
commit 56e1a7ce0b
11 changed files with 271 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
TODO Normal file
View File

@ -0,0 +1,7 @@
COMMENT YOUR CODE!!!!!!!
make it look nicer :)
fix import/exports to be conservative
write tests

11
app/Main.hs
View File

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

3
kino.cabal
View File

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

28
src/AppTypes.hs
View File

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

73
src/JSONTypes.hs
View File

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

6
src/Misc.hs
View File

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

8
src/Request.hs
View File

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

62
src/Torrent.hs
View File

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

79
src/UI.hs
View File

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

83
src/UI/Widgets.hs Normal file
View File

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

64
src/Widgets.hs
View File

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