restructured, made prettier and more proper

This commit is contained in:
Rachel Lambda Samuelsson 2021-09-20 14:19:48 +02:00
parent 8b6443164a
commit d9ae2671d6
12 changed files with 141 additions and 186 deletions

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 handle clipboard errors
make it look nicer :)
fix import/exports to be conservative
write tests write tests
theme selection config theme selection config

View File

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

View File

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

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 Normal file
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

View File

@ -1,25 +1,27 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-| {-|
Module : Request Module : Kino.Request
Description : Contains code for issuing http requests 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 Control.Lens
import Data.Aeson import Data.Aeson
import Network.Wreq hiding (Options)
import qualified Data.Text as T 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 -- | Sends a request and unwraps the top level respone data structure
makeRequest :: (FromJSON a) => String -> WR.Options -> IO (Either T.Text a) makeRequest :: (FromJSON a) => String -> WR.Options -> IO (Either T.Text a)
makeRequest url opts = do makeRequest url opts = do
r <- asJSON =<< getWith opts url r <- asJSON =<< getWith opts url
pure $ case (r ^. responseBody) of pure $ case r ^. responseBody of
(JSONResponse "ok" _ (Just d)) -> Right d (JSONResponse "ok" _ (Just d)) -> Right d
(JSONResponse _ m _) -> Left m (JSONResponse _ m _) -> Left m

View File

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

View File

@ -1,19 +1,23 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-| {-|
Module : JSONTypes Module : Kino.Types
Description : Contains all the types used for data extracted from JSON responses 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
import Data.Aeson.Types import Data.Aeson.Types
import Data.Maybe (fromMaybe) import Brick.Widgets.Edit (Editor(..))
import Lens.Micro.TH
import qualified Data.Text as T import qualified Data.Text as T
-- | The general response structure returned by the API
data JSONResponse d = JSONResponse data JSONResponse d = JSONResponse
{ respStatus :: T.Text { respStatus :: T.Text
, respMessage :: T.Text , respMessage :: T.Text
@ -29,6 +33,7 @@ instance (FromJSON d) => FromJSON (JSONResponse d) where
prependFailure "parsing JSONResponse failed, " prependFailure "parsing JSONResponse failed, "
(typeMismatch "Object" invalid) (typeMismatch "Object" invalid)
-- | The returned data for the list movies endpoint
data JSONListMovies = JSONListMovies data JSONListMovies = JSONListMovies
{ moviesCount :: Int { moviesCount :: Int
, moviesLimit :: Int , moviesLimit :: Int
@ -46,11 +51,9 @@ instance FromJSON JSONListMovies where
prependFailure "parsing JSONListMovies failed, " prependFailure "parsing JSONListMovies failed, "
(typeMismatch "Object" invalid) (typeMismatch "Object" invalid)
-- | An entry in the list returned by the list movies endpoint
data JSONMovie = JSONMovie data JSONMovie = JSONMovie
{ movieId :: Int { movieTitle :: T.Text
, movieUrl :: T.Text
, imdbCode :: T.Text
, movieTitle :: T.Text
, movieTitleLong :: T.Text , movieTitleLong :: T.Text
, movieYear :: Int , movieYear :: Int
, movieRating :: Double , movieRating :: Double
@ -58,16 +61,12 @@ data JSONMovie = JSONMovie
, movieGenres :: [T.Text] , movieGenres :: [T.Text]
, movieSummary :: T.Text , movieSummary :: T.Text
, movieLanguage :: T.Text , movieLanguage :: T.Text
, movieState :: T.Text
, movieTorrents :: [JSONTorrent] , movieTorrents :: [JSONTorrent]
} deriving (Eq, Show) } deriving (Eq, Show)
instance FromJSON JSONMovie where instance FromJSON JSONMovie where
parseJSON (Object v) = JSONMovie parseJSON (Object v) = JSONMovie
<$> v .: "id" <$> v .: "title"
<*> v .: "url"
<*> v .: "imdb_code"
<*> v .: "title"
<*> v .: "title_long" <*> v .: "title_long"
<*> v .: "year" <*> v .: "year"
<*> v .: "rating" <*> v .: "rating"
@ -75,37 +74,52 @@ instance FromJSON JSONMovie where
<*> v .: "genres" <*> v .: "genres"
<*> v .: "summary" <*> v .: "summary"
<*> v .: "language" <*> v .: "language"
<*> v .: "state"
<*> v .: "torrents" <*> v .: "torrents"
parseJSON invalid = parseJSON invalid =
prependFailure "parsing JSONMovie failed, " prependFailure "parsing JSONMovie failed, "
(typeMismatch "Object" invalid) (typeMismatch "Object" invalid)
-- | A torrent in the list in the movie object
data JSONTorrent = JSONTorrent data JSONTorrent = JSONTorrent
{ torrentUrl :: T.Text { torrentHash :: T.Text
, torrentHash :: T.Text
, torrentQuality :: T.Text , torrentQuality :: T.Text
, torrentType :: T.Text
, torrentSeeds :: Int , torrentSeeds :: Int
, torrentPeers :: Int
, torrentSize :: T.Text
, torrentBytes :: Int
, torrentUploaded :: T.Text
, torrentUploadedUnix :: Int -- TODO: better date type?
} deriving (Eq, Show) } deriving (Eq, Show)
instance FromJSON JSONTorrent where instance FromJSON JSONTorrent where
parseJSON (Object v) = JSONTorrent parseJSON (Object v) = JSONTorrent
<$> v .: "url" <$> v .: "hash"
<*> v .: "hash"
<*> v .: "quality" <*> v .: "quality"
<*> v .: "type"
<*> v .: "seeds" <*> v .: "seeds"
<*> v .: "peers"
<*> v .: "size"
<*> v .: "size_bytes"
<*> v .: "date_uploaded"
<*> v .: "date_uploaded_unix"
parseJSON invalid = parseJSON invalid =
prependFailure "parsing JSONTorrent failed, " prependFailure "parsing JSONTorrent failed, "
(typeMismatch "Object" invalid) (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

View File

@ -1,33 +1,30 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-| {-|
Module : UI Module : Kino.UI
Description : This is the code which interacts with Brick Description : This is the code which interacts with Brick
This is the code which interacts with Brick
-} -}
module UI where module Kino.UI (runApp) where
import Data.Maybe (fromMaybe)
import Brick hiding (Direction(..)) import Brick hiding (Direction(..))
import Brick.Types (handleEventLensed) import Brick.Widgets.Edit (handleEditorEvent, editorText, editAttr, getEditContents)
import Brick.Util (fg) import Control.Monad.IO.Class (liftIO)
import Brick.Widgets.Edit (Editor(..), handleEditorEvent, editorText, editAttr, getEditContents)
import Graphics.Vty (defAttr) import Graphics.Vty (defAttr)
import Graphics.Vty.Input.Events
import Graphics.Vty.Attributes (withStyle, reverseVideo) import Graphics.Vty.Attributes (withStyle, reverseVideo)
import Graphics.Vty.Attributes.Color (brightBlack) import Graphics.Vty.Attributes.Color (brightBlack)
import Control.Monad.IO.Class (liftIO) import Graphics.Vty.Input.Events
import qualified Data.Text as T
import Lens.Micro import Lens.Micro
import System.Clipboard import System.Clipboard
import qualified Data.Text as T
import JSONTypes import Kino.Types
import Request import Kino.Request
import Misc import Kino.Misc
import UI.Widgets import Kino.UI.Widgets
import AppTypes import Kino.Torrent
import Torrent
-- | The initial state of our application -- | The initial state of our application
initialState :: AppS initialState :: AppS
@ -57,14 +54,15 @@ app = App
runApp :: IO AppS runApp :: IO AppS
runApp = defaultMain app initialState 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 :: AppS -> IO (Either T.Text JSONListMovies) -> IO AppS
setMovies s mb = do setMovies s mb = do
m <- mb m <- mb
case m of case m of
(Left t) -> pure (displayMessage s True (T.unpack t)) (Left t) -> pure (displayMessage s True (T.unpack t))
(Right m) -> pure (s & appListing .~ m (Right l) -> pure (s & appListing .~ l
& appCursor .~ 0 & appCursor .~ 0
& appDetails .~ (moviesMovies m !? 0)) & appDetails .~ (moviesMovies l !? 0))
-- | The starting event which grabs the inital listing -- | The starting event which grabs the inital listing
startEvent :: AppS -> EventM Ident AppS startEvent :: AppS -> EventM Ident AppS
@ -92,7 +90,7 @@ scroll d s = s & appCursor .~ newCursor
& appDetails .~ (moviesMovies (s ^. appListing) !? newCursor) & appDetails .~ (moviesMovies (s ^. appListing) !? newCursor)
where where
upperLimit = length (moviesMovies (s ^. appListing)) - 1 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))) 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 -- is displayed as a message, alternatively forcing
-- an exit after the message is aknowledged. -- an exit after the message is aknowledged.
displayMessage :: AppS -> Bool -> String -> AppS displayMessage :: AppS -> Bool -> String -> AppS
displayMessage s fatal str = s & appMode .~ Message displayMessage s fatal msg = s & appMode .~ Message
& appMessage .~ Just str & appMessage ?~ msg
& appContinue .~ not fatal & appContinue .~ not fatal
-- | Copy the magnet link of the focused movie at -- | Copy the magnet link of the focused movie at
@ -116,7 +114,7 @@ copyMagnet s i = case (do
liftIO (setClipboardString magnet) liftIO (setClipboardString magnet)
continue (displayMessage s False "Copied magnet link to clipboard!") 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 :: AppS -> BrickEvent Ident () -> EventM Ident (Next AppS)
eventHandler s (VtyEvent e@(EvKey k _)) = eventHandler s (VtyEvent e@(EvKey k _)) =
case s ^. appMode of case s ^. appMode of

View File

@ -1,31 +1,26 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-| {-|
Module : UI.Widgets Module : Kino.UI.Widgets
Description : This is the code which builds the Brick frontend 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
import Brick.Main
import Brick.Widgets.Center import Brick.Widgets.Center
import Brick.Widgets.Border import Brick.Widgets.Border
import Brick.Widgets.Edit 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 Lens.Micro
import qualified Data.Text as T
import Data.Maybe import Kino.Types
import Kino.Misc
import JSONTypes import Kino.Torrent
import Request
import Misc
import AppTypes
import Torrent
-- | Wrap a widget in the selected attribute -- | Wrap a widget in the selected attribute
select :: Widget Ident -> Widget Ident select :: Widget Ident -> Widget Ident
@ -38,9 +33,9 @@ widgetCons m (w, s) =
embed $ if Just m == (s ^. appDetails) embed $ if Just m == (s ^. appDetails)
then select . visible $ then select . visible $
if s ^. appExpanded if s ^. appExpanded
then expandedWidget s m then expandedWidget m
else movieWidget s m else movieWidget m
else movieWidget s m else movieWidget m
where where
embed x = (x <=> w, s) embed x = (x <=> w, s)
@ -50,17 +45,20 @@ movieWidgets s = let (items, _) = foldr widgetCons (emptyWidget, s) (moviesMovie
in items in items
-- | Returns a single movie listing -- | Returns a single movie listing
movieWidget :: AppS -> JSONMovie -> Widget Ident movieWidget :: JSONMovie -> Widget Ident
movieWidget s m = txt (movieTitle m) <+> padLeft Max (str (show (movieYear m))) movieWidget m = txt (movieTitle m) <+> padLeft Max (str (show (movieYear m)))
-- | Returns an expanded movie listing showing additional info -- | Returns an expanded movie listing showing additional info
expandedWidget :: AppS -> JSONMovie -> Widget Ident expandedWidget :: JSONMovie -> Widget Ident
expandedWidget s m = movieWidget s m expandedWidget m = movieWidget m
<=> (padRight (Pad 3) (str "Rating") <+> str (show (movieRating m))) <=> (padRight (Pad 3) (str "Rating") <+> str (show (movieRating m)))
<=> (padRight (Pad 1) (str "Language") <+> txt (movieLanguage m)) <=> (padRight (Pad 1) (str "Language") <+> txt (movieLanguage m))
<=> (padRight (Pad 3) (str "Genres") <+> txt (T.intercalate ", " (movieGenres 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 "Magnets") <+> str (listTorrents m))
<=> (padRight (Pad 2) (str "Summary") <+> txtWrap (movieSummary 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 -- | The search mode widget. Uses the brick built in Editor widget
searchWidget :: AppS -> Widget Ident searchWidget :: AppS -> Widget Ident
@ -68,13 +66,14 @@ searchWidget s = center $ border $
padAll 1 (editorRenderer (s ^. appEditor)) padAll 1 (editorRenderer (s ^. appEditor))
<=> padAll 1 (hCenter (str "[Press enter to search]")) <=> 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 :: Editor T.Text Ident -> Widget Ident
editorRenderer e = renderEditor render True e editorRenderer = renderEditor txtRender True
where where
render :: [T.Text] -> Widget Ident txtRender :: [T.Text] -> Widget Ident
render [] = txt "Enter query term" $> withAttr editAttr txtRender [] = txt "Enter query term" $> withAttr editAttr
render [""] = txt "Enter query term" $> withAttr editAttr txtRender [""] = txt "Enter query term" $> withAttr editAttr
render (t:_) = txt t txtRender (t:_) = txt t
-- | The browse mode widget which returns a full listing of movies -- | The browse mode widget which returns a full listing of movies
-- or reports that there are no movies to list -- or reports that there are no movies to list

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