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

restructured, made prettier and more proper

master
Rachel Lambda Samuelsson 2021-09-20 14:19:48 +02:00
parent 8b6443164a
commit d9ae2671d6
12 changed files with 141 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CHANGELOG.md
View File

@ -1,5 +0,0 @@
# Revision history for kino
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

4
TODO
View File

@ -1,9 +1,5 @@
handle clipboard errors
make it look nicer :)
fix import/exports to be conservative
write tests
theme selection config

9
app/Main.hs
View File

@ -1,13 +1,6 @@
module Main where
import qualified Data.Text as T
import qualified JSONTypes as J
import Request
import Torrent
import UI
import System.Environment
import Kino.UI
main :: IO ()
main = runApp >> pure ()

17
kino.cabal
View File

@ -14,13 +14,12 @@ category: Movie
extra-source-files: CHANGELOG.md
library
exposed-modules: Request
, JSONTypes
, UI
, UI.Widgets
, Torrent
, Misc
, AppTypes
exposed-modules: Kino.Request
, Kino.UI
, Kino.UI.Widgets
, Kino.Torrent
, Kino.Misc
, Kino.Types
other-modules:
-- other-extensions:
ghc-options: -Wall
@ -43,13 +42,11 @@ library
executable kino
main-is: Main.hs
-- other-modules:
other-modules:
-- other-extensions:
ghc-options: -Wall -threaded
build-depends: base ^>=4.14.1.0
, kino
, brick
, text
hs-source-dirs: app
default-language: Haskell2010

42
src/AppTypes.hs
View File

@ -1,42 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
{-|
Module : AppTypes
Description : Contains the types related to our Brick application
-}
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
data Ident = Listing | Input | ListItem Int
deriving (Eq, Ord, Show)
-- | 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 -- ^ 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

20
src/Kino/Misc.hs 100644
View File

@ -0,0 +1,20 @@
{-|
Module : Kino.Misc
Description : Contains miscellaneous helper functions which do not fit elsewhere
Contains miscellaneous helper functions which do not fit elsewhere
-}
module Kino.Misc where
infixl 3 !?
-- | Safe version of (!!)
(!?) :: [a] -> Int -> Maybe a
[] !? _ = Nothing
(x:_) !? 0 = Just x
(_:xs) !? n = xs !? (n-1)
infixl 0 $>
-- | Backwards function application
($>) :: a -> (a -> b) -> b
x $> f = f x

16
src/Request.hs → src/Kino/Request.hs
View File

@ -1,25 +1,27 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : Request
Module : Kino.Request
Description : Contains code for issuing http requests
Contains code for issuing http requests
-}
module Request where
module Kino.Request (getMovies, queryMovies) where
import JSONTypes
import Network.Wreq
import qualified Network.Wreq as WR (Options)
import Control.Lens
import Data.Aeson
import Network.Wreq hiding (Options)
import qualified Data.Text as T
import qualified Network.Wreq as WR (Options)
import Kino.Types
-- | 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
pure $ case (r ^. responseBody) of
pure $ case r ^. responseBody of
(JSONResponse "ok" _ (Just d)) -> Right d
(JSONResponse _ m _) -> Left m

19
src/Torrent.hs → src/Kino/Torrent.hs
View File

@ -1,17 +1,18 @@
{-|
Module : Torrent
Module : Kino.Torrent
Description : Contains code for formatting torrent info and retrieving magnet links
Contains code for formatting torrent info and retrieving magnet links
-}
module Torrent where
module Kino.Torrent (listTorrents, toMagnets) where
import JSONTypes
import Network.HTTP.Base
import qualified Data.Text as T
import Data.List (intercalate)
-- | Makes type signature a bit clearer
type Quality = String
import Network.HTTP.Base
import qualified Data.Text as T
import Kino.Types
-- | A list of recommended trackers
trackerList :: [String]
@ -37,7 +38,7 @@ listTorrents m = intercalate ", " (zipWith3 (\x y z -> x ++ y ++ z) numbers qual
where
qualities = map quality (movieTorrents m)
seeders = map (\x -> ' ':'(':seeds x ++ ")") (movieTorrents m)
numbers = map (\x -> '[':show x ++ "] ") [1..]
numbers = map (\x -> '[':show x ++ "] ") ([1..] :: [Int])
seeds = show . torrentSeeds
quality = T.unpack . torrentQuality
@ -53,4 +54,4 @@ toMagnets m = map (toMagnet name . hash) torrents
-- a valid magnet link
toMagnet :: String -> String -> String
toMagnet longName hash = "magnet:?xt=urn:btih:" <> hash <> "&dn"
<> (urlEncode longName) <> trackerString
<> urlEncode longName <> trackerString

82
src/JSONTypes.hs → src/Kino/Types.hs
View File

@ -1,19 +1,23 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : JSONTypes
Description : Contains all the types used for data extracted from JSON responses
Module : Kino.Types
Description : Contains the types needed for the program
Self explanatory
Includes types for the Brick application as well as the types
used to represent the JSON data received from the API.
-}
module JSONTypes where
module Kino.Types where
import Data.Aeson
import Data.Aeson.Types
import Data.Maybe (fromMaybe)
import Brick.Widgets.Edit (Editor(..))
import Lens.Micro.TH
import qualified Data.Text as T
-- | The general response structure returned by the API
data JSONResponse d = JSONResponse
{ respStatus :: T.Text
, respMessage :: T.Text
@ -29,6 +33,7 @@ instance (FromJSON d) => FromJSON (JSONResponse d) where
prependFailure "parsing JSONResponse failed, "
(typeMismatch "Object" invalid)
-- | The returned data for the list movies endpoint
data JSONListMovies = JSONListMovies
{ moviesCount :: Int
, moviesLimit :: Int
@ -46,11 +51,9 @@ instance FromJSON JSONListMovies where
prependFailure "parsing JSONListMovies failed, "
(typeMismatch "Object" invalid)
-- | An entry in the list returned by the list movies endpoint
data JSONMovie = JSONMovie
{ movieId :: Int
, movieUrl :: T.Text
, imdbCode :: T.Text
, movieTitle :: T.Text
{ movieTitle :: T.Text
, movieTitleLong :: T.Text
, movieYear :: Int
, movieRating :: Double
@ -58,16 +61,12 @@ data JSONMovie = JSONMovie
, 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
<$> v .: "id"
<*> v .: "url"
<*> v .: "imdb_code"
<*> v .: "title"
<$> v .: "title"
<*> v .: "title_long"
<*> v .: "year"
<*> v .: "rating"
@ -75,37 +74,52 @@ instance FromJSON JSONMovie where
<*> v .: "genres"
<*> v .: "summary"
<*> v .: "language"
<*> v .: "state"
<*> v .: "torrents"
parseJSON invalid =
parseJSON invalid =
prependFailure "parsing JSONMovie failed, "
(typeMismatch "Object" invalid)
-- | A torrent in the list in the movie object
data JSONTorrent = JSONTorrent
{ torrentUrl :: T.Text
, torrentHash :: 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
<$> v .: "url"
<*> v .: "hash"
<$> v .: "hash"
<*> v .: "quality"
<*> v .: "type"
<*> v .: "seeds"
<*> v .: "peers"
<*> v .: "size"
<*> v .: "size_bytes"
<*> v .: "date_uploaded"
<*> v .: "date_uploaded_unix"
parseJSON invalid =
parseJSON invalid =
prependFailure "parsing JSONTorrent failed, "
(typeMismatch "Object" invalid)
-- | Contains the different elements which we
-- might want brick to be able to identify
data Ident = Listing | Input | ListItem Int
deriving (Eq, Ord, Show)
-- | Used to distinguish 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 -- ^ 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

42
src/UI.hs → src/Kino/UI.hs
View File

@ -1,33 +1,30 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : UI
Module : Kino.UI
Description : This is the code which interacts with Brick
This is the code which interacts with Brick
-}
module UI where
import Data.Maybe (fromMaybe)
module Kino.UI (runApp) where
import Brick hiding (Direction(..))
import Brick.Types (handleEventLensed)
import Brick.Util (fg)
import Brick.Widgets.Edit (Editor(..), handleEditorEvent, editorText, editAttr, getEditContents)
import Brick.Widgets.Edit (handleEditorEvent, editorText, editAttr, getEditContents)
import Control.Monad.IO.Class (liftIO)
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 Graphics.Vty.Input.Events
import Lens.Micro
import System.Clipboard
import qualified Data.Text as T
import JSONTypes
import Request
import Misc
import UI.Widgets
import AppTypes
import Torrent
import Kino.Types
import Kino.Request
import Kino.Misc
import Kino.UI.Widgets
import Kino.Torrent
-- | The initial state of our application
initialState :: AppS
@ -57,14 +54,15 @@ app = App
runApp :: IO AppS
runApp = defaultMain app initialState
-- | Updates the state given a way to request a new movie listing
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
(Right l) -> pure (s & appListing .~ l
& appCursor .~ 0
& appDetails .~ (moviesMovies m !? 0))
& appDetails .~ (moviesMovies l !? 0))
-- | The starting event which grabs the inital listing
startEvent :: AppS -> EventM Ident AppS
@ -92,7 +90,7 @@ scroll d s = s & appCursor .~ newCursor
& appDetails .~ (moviesMovies (s ^. appListing) !? newCursor)
where
upperLimit = length (moviesMovies (s ^. appListing)) - 1
new = case d of { Up -> (subtract 1); Down -> (+1) }
new = case d of { Up -> subtract 1; Down -> (+1) }
newCursor = max 0 (min upperLimit (new (s ^. appCursor)))
@ -100,8 +98,8 @@ scroll d s = s & appCursor .~ newCursor
-- 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
displayMessage s fatal msg = s & appMode .~ Message
& appMessage ?~ msg
& appContinue .~ not fatal
-- | Copy the magnet link of the focused movie at
@ -116,7 +114,7 @@ copyMagnet s i = case (do
liftIO (setClipboardString magnet)
continue (displayMessage s False "Copied magnet link to clipboard!")
-- The event handler, takes care of keyboard events.
-- | The event handler, takes care of keyboard events.
eventHandler :: AppS -> BrickEvent Ident () -> EventM Ident (Next AppS)
eventHandler s (VtyEvent e@(EvKey k _)) =
case s ^. appMode of

53
src/UI/Widgets.hs → src/Kino/UI/Widgets.hs
View File

@ -1,31 +1,26 @@
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : UI.Widgets
Module : Kino.UI.Widgets
Description : This is the code which builds the Brick frontend
This is the code which builds the Brick frontend
-}
module UI.Widgets where
module Kino.UI.Widgets (messageWidget, searchWidget, browseWidget) where
import Data.Maybe (fromMaybe)
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
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import Lens.Micro
import qualified Data.Text as T
import Data.Maybe
import JSONTypes
import Request
import Misc
import AppTypes
import Torrent
import Kino.Types
import Kino.Misc
import Kino.Torrent
-- | Wrap a widget in the selected attribute
select :: Widget Ident -> Widget Ident
@ -38,9 +33,9 @@ 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
then expandedWidget m
else movieWidget m
else movieWidget m
where
embed x = (x <=> w, s)
@ -50,17 +45,20 @@ movieWidgets s = let (items, _) = foldr widgetCons (emptyWidget, s) (moviesMovie
in items
-- | Returns a single movie listing
movieWidget :: AppS -> JSONMovie -> Widget Ident
movieWidget s m = txt (movieTitle m) <+> padLeft Max (str (show (movieYear m)))
movieWidget :: JSONMovie -> Widget Ident
movieWidget 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
expandedWidget :: JSONMovie -> Widget Ident
expandedWidget m = movieWidget 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 "Runtime") <+> str (show hours <> "h " <> show minutes <> "m"))
<=> (padRight (Pad 2) (str "Magnets") <+> str (listTorrents m))
<=> (padRight (Pad 2) (str "Summary") <+> txtWrap (movieSummary m))
where
(hours, minutes) = divMod (movieRuntime m) 60
-- | The search mode widget. Uses the brick built in Editor widget
searchWidget :: AppS -> Widget Ident
@ -68,13 +66,14 @@ searchWidget s = center $ border $
padAll 1 (editorRenderer (s ^. appEditor))
<=> padAll 1 (hCenter (str "[Press enter to search]"))
-- | Takes an editor and returns a widget to represent it
editorRenderer :: Editor T.Text Ident -> Widget Ident
editorRenderer e = renderEditor render True e
editorRenderer = renderEditor txtRender True
where
render :: [T.Text] -> Widget Ident
render [] = txt "Enter query term" $> withAttr editAttr
render [""] = txt "Enter query term" $> withAttr editAttr
render (t:_) = txt t
txtRender :: [T.Text] -> Widget Ident
txtRender [] = txt "Enter query term" $> withAttr editAttr
txtRender [""] = txt "Enter query term" $> withAttr editAttr
txtRender (t:_) = txt t
-- | The browse mode widget which returns a full listing of movies
-- or reports that there are no movies to list

18
src/Misc.hs
View File

@ -1,18 +0,0 @@
{-|
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
(x:xs) !? n = xs !? (n-1)
infixl 0 $>
-- | Backwards function application
($>) :: a -> (a -> b) -> b
x $> f = f x