From d9ae2671d6f4ab82c6ac97f18764defffa538761 Mon Sep 17 00:00:00 2001 From: depsterr Date: Mon, 20 Sep 2021 14:19:48 +0200 Subject: [PATCH] restructured, made prettier and more proper --- CHANGELOG.md | 5 -- TODO | 4 -- app/Main.hs | 9 +--- kino.cabal | 17 +++--- src/AppTypes.hs | 42 --------------- src/Kino/Misc.hs | 20 +++++++ src/{ => Kino}/Request.hs | 16 +++--- src/{ => Kino}/Torrent.hs | 19 +++---- src/{JSONTypes.hs => Kino/Types.hs} | 82 +++++++++++++++++------------ src/{ => Kino}/UI.hs | 42 +++++++-------- src/{ => Kino}/UI/Widgets.hs | 53 +++++++++---------- src/Misc.hs | 18 ------- 12 files changed, 141 insertions(+), 186 deletions(-) delete mode 100644 CHANGELOG.md delete mode 100644 src/AppTypes.hs create mode 100644 src/Kino/Misc.hs rename src/{ => Kino}/Request.hs (82%) rename src/{ => Kino}/Torrent.hs (85%) rename src/{JSONTypes.hs => Kino/Types.hs} (51%) rename src/{ => Kino}/UI.hs (87%) rename src/{ => Kino}/UI/Widgets.hs (70%) delete mode 100644 src/Misc.hs diff --git a/CHANGELOG.md b/CHANGELOG.md deleted file mode 100644 index b278f4d..0000000 --- a/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for kino - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/TODO b/TODO index e07ca36..85b9301 100644 --- a/TODO +++ b/TODO @@ -1,9 +1,5 @@ handle clipboard errors -make it look nicer :) - -fix import/exports to be conservative - write tests theme selection config diff --git a/app/Main.hs b/app/Main.hs index d7c2b31..62d7772 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 () diff --git a/kino.cabal b/kino.cabal index 03ff405..7069665 100644 --- a/kino.cabal +++ b/kino.cabal @@ -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 diff --git a/src/AppTypes.hs b/src/AppTypes.hs deleted file mode 100644 index d545a52..0000000 --- a/src/AppTypes.hs +++ /dev/null @@ -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 diff --git a/src/Kino/Misc.hs b/src/Kino/Misc.hs new file mode 100644 index 0000000..0143371 --- /dev/null +++ b/src/Kino/Misc.hs @@ -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 diff --git a/src/Request.hs b/src/Kino/Request.hs similarity index 82% rename from src/Request.hs rename to src/Kino/Request.hs index ad20ce2..a8f524b 100644 --- a/src/Request.hs +++ b/src/Kino/Request.hs @@ -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 diff --git a/src/Torrent.hs b/src/Kino/Torrent.hs similarity index 85% rename from src/Torrent.hs rename to src/Kino/Torrent.hs index ee5d431..ce6d762 100644 --- a/src/Torrent.hs +++ b/src/Kino/Torrent.hs @@ -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 diff --git a/src/JSONTypes.hs b/src/Kino/Types.hs similarity index 51% rename from src/JSONTypes.hs rename to src/Kino/Types.hs index 873353d..206ad5d 100644 --- a/src/JSONTypes.hs +++ b/src/Kino/Types.hs @@ -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 diff --git a/src/UI.hs b/src/Kino/UI.hs similarity index 87% rename from src/UI.hs rename to src/Kino/UI.hs index d6b2833..60b5a21 100644 --- a/src/UI.hs +++ b/src/Kino/UI.hs @@ -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 diff --git a/src/UI/Widgets.hs b/src/Kino/UI/Widgets.hs similarity index 70% rename from src/UI/Widgets.hs rename to src/Kino/UI/Widgets.hs index 1ed4d04..573d2c0 100644 --- a/src/UI/Widgets.hs +++ b/src/Kino/UI/Widgets.hs @@ -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 diff --git a/src/Misc.hs b/src/Misc.hs deleted file mode 100644 index 2ec51e3..0000000 --- a/src/Misc.hs +++ /dev/null @@ -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