Browse Source

Add support for tagging TV episodes in several different ways

tags/v0.2.0.0
Peter J. Jones 4 years ago
parent
commit
5eb2b8586d

+ 1
- 1
default.nix View File

@@ -47,9 +47,9 @@ in stdenv.mkDerivation rec {
cabal sandbox add-source vendor/themoviedb
cabal sandbox add-source vendor/byline
cabal install --only-dependencies
cabal configure -fmaintainer
fi

cabal configure -fmaintainer
cabal build || exit 1
) && hlint src
'';

+ 0
- 61
src/Vimeta/CommandLine.hs View File

@@ -1,67 +0,0 @@
{-

This file is part of the Haskell package vimeta. It is subject to the
license terms in the LICENSE file found in the top-level directory of
this distribution and at git://pmade.com/vimeta/LICENSE. No part of
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Vimeta.CommandLine (parseAndDispatch) where

--------------------------------------------------------------------------------
import Data.Monoid
import Options.Applicative
import qualified Vimeta.Movie as VM
import qualified Vimeta.TV as VT

--------------------------------------------------------------------------------
data CommandLine = MovieCmd VM.Config
| TVCmd VT.Config
deriving (Show)

--------------------------------------------------------------------------------
movie :: Parser VM.Config
movie = VM.Config
<$> option auto (short 'i' <> long "movie-id" <> metavar "ID" <>
help "Movie ID assigned by TheMovieDB.org")
<*> argument str (metavar "FILE")

--------------------------------------------------------------------------------
tv :: Parser VT.Config
tv = VT.Config
<$> option auto (short 'i' <> long "series" <> metavar "ID" <>
help "TV series ID assigned by TheTVDB.com")
<*> option auto (short 's' <> long "season" <> metavar "NUM" <>
help "Which season number to store in the episodes")
<*> optional (option auto (short 'e' <> long "episode" <> metavar "NUM" <>
help "The starting episode number to use"))
<*> some (argument str (metavar "FILE [FILE...]"))

--------------------------------------------------------------------------------
config :: Parser CommandLine
config = subparser
( command "movie" (info (MovieCmd <$> movie) (progDesc movieDesc))
<> command "tv" (info (TVCmd <$> tv) (progDesc tvDesc))
)
where movieDesc = "Set movie metadata using TheMovieDB"
tvDesc = "Set TV episode metadata using TheTVDB"

--------------------------------------------------------------------------------
dispatch :: CommandLine -> IO ()
dispatch (MovieCmd c) = VM.update c
dispatch (TVCmd c) = VT.update c

--------------------------------------------------------------------------------
parseAndDispatch :: IO ()
parseAndDispatch = execParser opts >>= dispatch
where opts = info (config <**> helper) idm

+ 0
- 18
src/Vimeta/Context.hs View File

@@ -19,12 +19,10 @@ module Vimeta.Context
, die
, runIO
, runIOE
, byline
, tmdb
, verbose
, execVimetaWithContext
, execVimeta
, execVimetaBylineApp
, runVimeta
, ask
, asks
@@ -37,14 +35,11 @@ import Control.Exception
import Control.Monad.Reader
import Control.Monad.Trans.Either
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Network.API.TheMovieDB (TheMovieDB, Key, runTheMovieDBWithManager)
import qualified Network.API.TheMovieDB as TheMovieDB
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Console.Byline hiding (ask)
import System.Exit (exitSuccess, exitFailure)
import System.IO (Handle, stdout)
import Vimeta.Config

@@ -77,11 +72,6 @@ runIO io = liftIO (try io) >>= sinkIO
runIOE :: (MonadIO m) => IO (Either String a) -> Vimeta m a
runIOE io = runIO io >>= either (die . show) return

--------------------------------------------------------------------------------
byline :: Byline IO a -> Vimeta (Byline IO) a
byline = Vimeta . lift . lift

--------------------------------------------------------------------------------
-- | Run a 'TheMovieDB' operation.
tmdb :: (MonadIO m) => TheMovieDB a -> Vimeta m a
@@ -141,16 +131,6 @@ execVimeta cf vimeta = runEitherT $ do
tc <- loadTMDBConfig manager (configTMDBKey config)
EitherT $ execVimetaWithContext (Context manager config tc stdout) vimeta

--------------------------------------------------------------------------------
execVimetaBylineApp :: (Config -> Config) -> Vimeta (Byline IO) () -> IO ()
execVimetaBylineApp cf vimeta = runByline $ do
v <- execVimeta cf vimeta

case v of
Right _ -> liftIO exitSuccess
Left e -> reportLn Error (text $ Text.pack e) >> liftIO exitFailure

--------------------------------------------------------------------------------
-- | Simple wrapper around 'execVimeta'.
runVimeta :: (MonadIO m) => Vimeta m a -> m (Either String a)

+ 128
- 0
src/Vimeta/MappingFile.hs View File

@@ -0,0 +1,128 @@
{-# LANGUAGE ScopedTypeVariables #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
-- | Mapping files can be used to map file names to other information.
module Vimeta.MappingFile
( Parser
, parseMappingFile
) where

--------------------------------------------------------------------------------
import Control.Applicative hiding ((<|>))
import Control.Monad.Identity
import Data.Char (isSpace)
import Data.Either
import Data.List
import Data.Text (Text)
import qualified Data.Text.IO as Text
import System.Directory (doesFileExist)
import System.FilePath (takeExtension)
import Text.Parsec
import Vimeta.Context

--------------------------------------------------------------------------------
-- | Parser type.
type Parser a = ParsecT Text () Identity a

--------------------------------------------------------------------------------
-- | Internal token used for parsing.
data Token a = Comment | Entry FilePath a

--------------------------------------------------------------------------------
-- | Parse a mapping file.
parseMappingFile :: (MonadIO m)
=> FilePath -- ^ File name for the mapping file.
-> Parser a -- ^ Parser for the second column.
-> Vimeta m [(FilePath, a)]
parseMappingFile filename p = do
contents <- runIO $ Text.readFile filename

case runIdentity $ runParserT (mapping p) () filename contents of
Left e -> die (show e)
Right m -> checkFileMappingOrDie m

--------------------------------------------------------------------------------
checkFileMappingOrDie :: (MonadIO m)
=> [(FilePath, a)]
-> Vimeta m [(FilePath, a)]
checkFileMappingOrDie xs =
do ys <- checkFileMapping xs
if null (lefts ys)
then return (rights ys)
else die $ report (lefts ys)
where
report :: [(FilePath, a)] -> String
report fs = "the following files are listed in the mapping file " ++
"but they don't exist: \n" ++ intercalate "\n" (map fst fs)

--------------------------------------------------------------------------------
-- | Checks to see that all of the file names mentioned exist. If a
-- file doesn't exist the @m4v@ file extension is added to it and the
-- existence checking happens again.
checkFileMapping :: (MonadIO m)
=> [(FilePath, a)] -- ^ The mapping.
-> Vimeta m [Either (FilePath, a) (FilePath, a)]
checkFileMapping = mapM checkFile where
checkFile :: (MonadIO m) => (FilePath, a)
-> Vimeta m (Either (FilePath, a) (FilePath, a))
checkFile f@(filename, a) = do
let ext = takeExtension filename
exists <- runIO (doesFileExist filename)

case exists of
False | null ext -> checkFile (filename ++ ".m4v", a)
| otherwise -> return $ Left f
True -> return $ Right f

--------------------------------------------------------------------------------
-- | The actual file parser.
mapping :: Parser a -> Parser [(FilePath, a)]
mapping p = entries <$> manyTill (whitespace <|> comment <|> fileName p) eof
where
entries :: [Token a] -> [(FilePath, a)]
entries = concatMap extract . filter predicate

predicate :: Token a -> Bool
predicate (Entry _ _) = True
predicate Comment = False

extract :: Token a -> [(FilePath, a)]
extract (Entry f a) = [(f, a)]
extract Comment = []

--------------------------------------------------------------------------------
-- | Parse a file name followed by whatever the second column parser
-- extracts.
fileName :: Parser a -> Parser (Token a)
fileName p =
do first <- anyChar
others <- manyTill anyChar (lookAhead space)
a <- spaceWithoutNewline >> p
return $ Entry (first:others) a
<?> "filename and mapping"

--------------------------------------------------------------------------------
-- | Skip whitespace.
whitespace :: Parser (Token a)
whitespace = skipMany1 space >> return Comment

--------------------------------------------------------------------------------
-- | Like whitespace, but doesn't span multiple lines.
spaceWithoutNewline :: Parser ()
spaceWithoutNewline = skipMany1 $ satisfy (\c -> isSpace c && c /= '\n')

--------------------------------------------------------------------------------
-- | Skip comments.
comment :: Parser (Token a)
comment = (char '#' >> manyTill anyChar newline >> return Comment) <?> "comment"

+ 0
- 63
src/Vimeta/TV.hs View File

@@ -1,63 +0,0 @@
{-

This file is part of the Haskell package vimeta. It is subject to the
license terms in the LICENSE file found in the top-level directory of
this distribution and at git://pmade.com/vimeta/LICENSE. No part of
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

module Vimeta.TV (Config(..), update) where
import Data.Maybe (fromMaybe, fromJust)
import Data.Text (unpack)
import System.Exit (exitFailure)
import Vimeta.Download (download)
import qualified Network.API.TheTVDB as TVDB
import qualified Network.API.TheTVDB.Zipper as Z
import qualified Vimeta.AtomicParsley as AP

data Config = Config
{ seriesID :: TVDB.UniqueID
, seasonNumber :: TVDB.UniqueID
, startingEpisodeNumber :: Maybe TVDB.UniqueID
, episodeFiles :: [FilePath]
} deriving (Eq, Show)


atomicParsleyOptions :: Z.Zipper -> Maybe FilePath -> AP.Options
atomicParsleyOptions z poster =
[ ("--stik", "TV Show")
, ("--year", maybe "" AP.formatDate $ TVDB.episodeDate episode)
, ("--title", unpack $ TVDB.episodeName episode)
, ("--description", unpack $ TVDB.episodeOverview episode)
, ("--TVShowName", unpack $ TVDB.seriesName series)
, ("--TVSeasonNum", show $ TVDB.seasonNumber season)
, ("--TVEpisodeNum", show $ TVDB.episodeNumber episode)
, ("--tracknum", show $ TVDB.episodeNumber episode)
, ("--artwork", fromMaybe "REMOVE_ALL" poster)
]
where series = Z.series z
season = Z.season z
episode = Z.episode z

update :: Config -> IO ()
update c =
do key <- TVDB.loadKeyMaybe >>= maybe keyErr return
ctx <- TVDB.defaultContext key
tv <- TVDB.fetch ctx (seriesID c)
case Z.find tv (seasonNumber c) episodeNumber of
Nothing -> fail epErr
Just z -> download (fmap unpack $ TVDB.seriesPosterURL tv) (updateAll z)
where episodeNumber = fromMaybe 1 (startingEpisodeNumber c)
keyErr = fail "failed to load TheTVDB API key"
epErr = "failed to find episode number " ++ show episodeNumber
updateAll z p = mapM_ (uncurry $ updateWithMetadata p) (zipped z)
zipped z = zip (Z.episodes z) (episodeFiles c)

updateWithMetadata :: Maybe FilePath -> Z.Zipper -> FilePath -> IO ()
updateWithMetadata poster z file =
do putStrLn $ file ++ " --> " ++ unpack (TVDB.episodeName episode)
AP.update file $ atomicParsleyOptions z poster
where episode = Z.episode z

+ 22
- 8
src/Vimeta/UI/CommandLine.hs View File

@@ -19,25 +19,38 @@ import System.Exit

--------------------------------------------------------------------------------
import qualified Vimeta.UI.CommandLine.Config as Config
import qualified Vimeta.UI.CommandLine.Movie as Movie
import qualified Vimeta.UI.CommandLine.Movie as Movie
import qualified Vimeta.UI.CommandLine.TV as TV

--------------------------------------------------------------------------------
data Command = CmdConfig Config.Options
| CmdMovie Movie.Options
| CmdTV TV.Options

--------------------------------------------------------------------------------
optionsParser :: Parser Command
optionsParser = subparser $ mconcat [config, movie]
optionsParser = subparser $ mconcat [config, movie, tv]
where
config = command "config"
(info (CmdConfig <$> Config.optionsParser) (progDesc configDesc))
config =
command "config"
(info (CmdConfig <$> Config.optionsParser) (progDesc configDesc))

configDesc = "Create a new configuration file"
movie =
command "movie"
(info (CmdMovie <$> Movie.optionsParser) (progDesc movieDesc))

movie = command "movie"
(info (CmdMovie <$> Movie.optionsParser) (progDesc movieDesc))
tv =
command "tv"
(info (CmdTV <$> TV.optionsParser) (progDesc tvDesc))

movieDesc = "Tag a movie file using data from TheMovieDB.org"
configDesc =
"Create a new configuration file"

movieDesc =
"Tag a movie file using data from TheMovieDB.org"

tvDesc =
"Tag episode files using data from TheMovieDB.org"

--------------------------------------------------------------------------------
run :: IO ()
@@ -47,5 +60,6 @@ run = do
case options of
CmdConfig o -> Config.run o
CmdMovie o -> Movie.run o
CmdTV o -> TV.run o

exitSuccess

+ 1
- 0
src/Vimeta/UI/CommandLine/Movie.hs View File

@@ -33,6 +33,7 @@ import Vimeta.Download
import Vimeta.Format
import Vimeta.Process
import Vimeta.UI.CommandLine.Common
import Vimeta.UI.Term.Common
import qualified Vimeta.UI.Term.MovieSearch as MovieSearch

--------------------------------------------------------------------------------

+ 90
- 0
src/Vimeta/UI/CommandLine/TV.hs View File

@@ -0,0 +1,90 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Vimeta.UI.CommandLine.TV
( Options
, optionsParser
, run
) where

--------------------------------------------------------------------------------
import Control.Monad
import Network.API.TheMovieDB
import Options.Applicative
import Vimeta.Context
import Vimeta.UI.CommandLine.Common
import Vimeta.UI.Common.TV
import Vimeta.UI.Term.Common
import qualified Vimeta.UI.Term.TVSearch as TVSearch

--------------------------------------------------------------------------------
data Options = Options
{ optsTVID :: Maybe ItemID
, optsStartSeason :: Maybe Int
, optsStartEpisode :: Maybe Int
, optsMappingFile :: Maybe FilePath
, optsFiles :: [FilePath]
, optsCommon :: CommonOptions
}

--------------------------------------------------------------------------------
optionsParser :: Parser Options
optionsParser = Options <$> optional (option auto infoTVID)
<*> optional (option auto infoStartSeason)
<*> optional (option auto infoStartEpisode)
<*> optional (strOption infoMappingFile)
<*> many (argument str (metavar "[FILE...]"))
<*> commonOptions
where
infoTVID =
short 'i' <> long "id" <> metavar "ID" <>
help "Series ID assigned by TheMovieDB.org"

infoStartSeason =
short 's' <> long "season" <> metavar "NUM" <>
help "Starting season number"

infoStartEpisode =
short 'e' <> long "episode" <> metavar "NUM" <>
help "Starting episode number"

infoMappingFile =
short 'm' <> long "map" <> metavar "FILE" <>
help "File to map files to seasons/episodes"

--------------------------------------------------------------------------------
run :: Options -> IO ()
run opts = execVimetaBylineApp (updateConfig $ optsCommon opts) $ do
tv <- case optsTVID opts of
Nothing -> TVSearch.search
Just n -> tmdb (fetchFullTVSeries n)

case optsMappingFile opts of
Nothing -> fromFiles opts tv
Just fn -> fromMappingFile opts tv fn

--------------------------------------------------------------------------------
fromFiles :: (MonadIO m) => Options -> TV -> Vimeta m ()
fromFiles opts tv = case (optsStartSeason opts, optsStartEpisode opts) of
(Just s, Nothing) -> tagWithFileOrder tv (EpisodeSpec s 1) (optsFiles opts)
(Just s, Just e) -> tagWithFileOrder tv (EpisodeSpec s e) (optsFiles opts)
(_, _) -> die "please use the --season option"

--------------------------------------------------------------------------------
fromMappingFile :: (MonadIO m) => Options -> TV -> FilePath -> Vimeta m ()
fromMappingFile opts tv filename = do
unless (null $ optsFiles opts) $
die "don't give file arguments when using a mapping file"

tagWithMappingFile tv filename

+ 179
- 0
src/Vimeta/UI/Common/TV.hs View File

@@ -0,0 +1,179 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Vimeta.UI.Common.TV
( EpisodeSpec (..)
, tagWithMappingFile
, tagWithSpec
, tagWithFileOrder
, episodeSpec
) where

--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Data.Either
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import Network.API.TheMovieDB
import Text.Parsec
import Vimeta.Config
import Vimeta.Context
import Vimeta.Download
import Vimeta.Format
import Vimeta.MappingFile
import Vimeta.Process

--------------------------------------------------------------------------------
-- | A simple way to specify a single episode.
data EpisodeSpec = EpisodeSpec Int Int deriving (Show, Eq, Ord)

--------------------------------------------------------------------------------
-- | An episode along with the season.
data EpisodeCtx = EpisodeCtx TV Season Episode deriving (Show, Eq, Ord)

--------------------------------------------------------------------------------
-- | Tag a single file with the given 'EpisodeCtx'.
tagFileWithEpisode :: (MonadIO m) => FilePath -> EpisodeCtx -> Vimeta m ()
tagFileWithEpisode file (EpisodeCtx tv season episode) = do
context <- ask

let format = configFormatTV (ctxConfig context)
tmdbCfg = ctxTMDBCfg context

withArtwork (seasonPosterURLs tmdbCfg season) $ \artwork ->
case fromFormatString (formatMap artwork) "config.tv" format of
Left e -> die e
Right cmd -> tagFile (Text.unpack cmd)

where
formatMap :: Maybe FilePath -> FormatTable
formatMap artwork = Map.fromList
[ ('Y', formatFullDate $ episodeAirDate episode)
, ('a', Text.pack <$> artwork)
, ('d', Just $ episodeOverview episode)
, ('e', Just . Text.pack . show $ episodeNumber episode)
, ('f', Just $ Text.pack file)
, ('n', Just $ tvName tv)
, ('s', Just . Text.pack . show $ episodeSeasonNumber episode)
, ('t', Just $ episodeName episode)
, ('y', formatYear $ episodeAirDate episode)
]

--------------------------------------------------------------------------------
-- | Handy tagging function using mapping files.
tagWithMappingFile :: (MonadIO m) => TV -> FilePath -> Vimeta m ()
tagWithMappingFile tv filename = do
mapping <- parseMappingFile filename episodeSpecParser
tagWithSpec tv mapping

--------------------------------------------------------------------------------
-- | Tag all of the given files with their matching 'EpisodeSpec'.
tagWithSpec :: (MonadIO m)
=> TV -- ^ Full TV series.
-> [(FilePath, EpisodeSpec)] -- ^ File mapping.
-> Vimeta m ()
tagWithSpec tv specs = do
let unmapped = lefts mapping
taggable = rights mapping

unless (null unmapped) $
die ("the following files can't be mapped to episodes " <>
Text.unpack (badFiles unmapped))

mapM_ (uncurry tagFileWithEpisode) taggable

where
table :: Map EpisodeSpec EpisodeCtx
table = makeTVMap tv

mapping :: [Either (FilePath, EpisodeSpec) (FilePath, EpisodeCtx)]
mapping = map (\(f, s) -> check (Map.lookup s table) f s) specs

check :: Maybe EpisodeCtx -> FilePath -> EpisodeSpec
-> Either (FilePath, EpisodeSpec) (FilePath, EpisodeCtx)
check Nothing f s = Left (f, s)
check (Just e) f _ = Right (f, e)

badFiles :: [(FilePath, EpisodeSpec)] -> Text
badFiles = Text.intercalate "\n" .
map (\(f, s) -> Text.pack f <> " " <> episodeSpecAsText s)

--------------------------------------------------------------------------------
-- | Tag the given files, starting at the given 'EpisodeSpec'.
tagWithFileOrder :: (MonadIO m)
=> TV -- ^ Full TV series.
-> EpisodeSpec -- ^ Starting episode.
-> [FilePath] -- ^ List of files to tag.
-> Vimeta m ()
tagWithFileOrder tv spec files = tagWithSpec tv mapping
where
mapping :: [(FilePath, EpisodeSpec)]
mapping = zipWith (\f e -> (f, episodeSpecFromCtx e)) files episodes

episodes :: [EpisodeCtx]
episodes = take (length files) $ startingAt spec $ flattenTV tv

--------------------------------------------------------------------------------
-- | Create an 'EpisodeSpec' from an 'Episode'.
episodeSpec :: Episode -> EpisodeSpec
episodeSpec e = EpisodeSpec (episodeSeasonNumber e) (episodeNumber e)

--------------------------------------------------------------------------------
-- | Create an 'EpisodeSpec' from an 'EpisodeCtx'.
episodeSpecFromCtx :: EpisodeCtx -> EpisodeSpec
episodeSpecFromCtx (EpisodeCtx _ _ e) = episodeSpec e

--------------------------------------------------------------------------------
-- | Turn an 'EpisodeSpec' into something that can be printed.
episodeSpecAsText :: EpisodeSpec -> Text
episodeSpecAsText (EpisodeSpec s e) = "S" <> Text.pack (show s) <>
"E" <> Text.pack (show e)

--------------------------------------------------------------------------------
-- | Flatten a TV/Season/Episode tree into a list of episodes.
flattenTV :: TV -> [EpisodeCtx]
flattenTV t = concatMap (\s -> forSeason s (seasonEpisodes s)) (tvSeasons t)
where
forSeason :: Season -> [Episode] -> [EpisodeCtx]
forSeason s = map (EpisodeCtx t s)

--------------------------------------------------------------------------------
-- | Drop all episodes until the matching 'EpisodeSpec' is found.
startingAt :: EpisodeSpec -> [EpisodeCtx] -> [EpisodeCtx]
startingAt spec = dropWhile (\(EpisodeCtx _ _ e)-> spec /= episodeSpec e)

--------------------------------------------------------------------------------
-- | Make an episode look-up table.
makeTVMap :: TV -> Map EpisodeSpec EpisodeCtx
makeTVMap = foldr insert Map.empty . flattenTV
where
insert :: EpisodeCtx -> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx
insert e = Map.insert (episodeSpecFromCtx e) e

--------------------------------------------------------------------------------
episodeSpecParser :: Parser EpisodeSpec
episodeSpecParser =
do void (oneOf "Ss")
season <- many1 digit

void (oneOf "Ee")
episode <- many1 digit

return $ EpisodeSpec (read season) (read episode)
<?> "episode spec (S#E#)"

+ 52
- 0
src/Vimeta/UI/Term/Common.hs View File

@@ -0,0 +1,52 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Vimeta.UI.Term.Common
( byline
, bylineMaybe
, execVimetaBylineApp
) where

--------------------------------------------------------------------------------
import Control.Monad.Trans.Class (lift)
import Data.Text (Text)
import qualified Data.Text as Text
import System.Console.Byline hiding (ask)
import System.Exit (exitSuccess, exitFailure)
import Vimeta.Config
import Vimeta.Context

--------------------------------------------------------------------------------
-- | Run a 'Byline' operation.
byline :: Byline IO a -> Vimeta (Byline IO) a
byline = Vimeta . lift . lift

--------------------------------------------------------------------------------
bylineMaybe :: Text -> Byline IO (Maybe a) -> Vimeta (Byline IO) a
bylineMaybe msg bm = do
result <- byline bm

case result of
Nothing -> die (Text.unpack msg)
Just a -> return a

--------------------------------------------------------------------------------
-- | Helper function to run a 'Vimeta' value based in 'Byline'.
execVimetaBylineApp :: (Config -> Config) -> Vimeta (Byline IO) () -> IO ()
execVimetaBylineApp cf vimeta = runByline $ do
v <- execVimeta cf vimeta

case v of
Right _ -> liftIO exitSuccess
Left e -> reportLn Error (text $ Text.pack e) >> liftIO exitFailure

+ 5
- 12
src/Vimeta/UI/Term/MovieSearch.hs View File

@@ -22,18 +22,17 @@ import Control.Applicative
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (formatTime)
import Network.API.TheMovieDB
import System.Console.Byline
import System.Locale (defaultTimeLocale)
import Vimeta.Context hiding (ask)
import Vimeta.UI.Term.Common
import Vimeta.UI.Util

--------------------------------------------------------------------------------
-- | Search for a movie and interact with the user through the terminal.
search :: Text -> Vimeta (Byline IO) Movie
search initial = do
name <- byline $ fromMaybe initial <$> ask "search: " (Just initial)
name <- byline $ fromMaybe initial <$> ask "search (movie name): " (Just initial)
movies <- tmdb (searchMovies name)
answer <- byline $ askWithMenuRepeatedly (mkMenu movies) prompt eprompt

@@ -43,7 +42,7 @@ search initial = do

where
-- The Menu.
mkMenu movies = banner "Choose a movie: " (menu movies displayMovie)
mkMenu movies = banner "Choose a movie:" (menu movies displayMovie)

-- Menu prompt.
prompt = "movie> "
@@ -53,11 +52,5 @@ search initial = do

-- Menu item display for a movie.
displayMovie m = mconcat [ text (movieTitle m)
, " ("
, text (year $ movieReleaseDate m)
, ")"
, text (parens $ dayAsYear $ movieReleaseDate m)
]

-- The movie's release date as a year.
year Nothing = "----"
year (Just d) = Text.pack (formatTime defaultTimeLocale "%Y" d)

+ 51
- 0
src/Vimeta/UI/Term/TVSearch.hs View File

@@ -0,0 +1,51 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
-- | Search for a TV series by interacting with the user through the terminal.
module Vimeta.UI.Term.TVSearch
( search
) where

--------------------------------------------------------------------------------
import Data.Monoid
import Network.API.TheMovieDB
import System.Console.Byline
import Vimeta.Context hiding (ask)
import Vimeta.UI.Term.Common
import Vimeta.UI.Util

--------------------------------------------------------------------------------
search :: Vimeta (Byline IO) TV
search = do
let prompt = "search (series name): "
message = "a search term is required"
mprompt = "tv> "
eprompt = text message <> fg red

name <- bylineMaybe message $ ask prompt Nothing
series <- tmdb (searchTV name)
answer <- byline $ askWithMenuRepeatedly (mkMenu series) mprompt eprompt

case answer of
Match tv -> tmdb $ fetchFullTVSeries (tvID tv)
_ -> die "you need to pick a valid TV series"


where
mkMenu series = banner "Choose a TV series:" (menu series displayTV)

displayTV series =
mconcat [ text (tvName series)
, text (parens $ dayRange (tvFirstAirDate series) (tvLastAirDate series))
]

+ 43
- 0
src/Vimeta/UI/Util.hs View File

@@ -0,0 +1,43 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Vimeta.UI.Util
( parens
, dayAsYear
, dayRange
) where

--------------------------------------------------------------------------------
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (Day, formatTime)
import System.Locale (defaultTimeLocale)

--------------------------------------------------------------------------------
-- | Wrap some text with parenthesis.
parens :: Text -> Text
parens t = "(" <> t <> ")"

--------------------------------------------------------------------------------
-- | Format a 'Maybe Day' as a year ('Text').
dayAsYear :: Maybe Day -> Text
dayAsYear Nothing = "----"
dayAsYear (Just d) = Text.pack (formatTime defaultTimeLocale "%Y" d)

--------------------------------------------------------------------------------
-- | Given a start 'Day' and an end 'Day', produce a string
-- representing a range.
dayRange :: Maybe Day -> Maybe Day -> Text
dayRange d1 d2 = dayAsYear d1 <> " - " <> dayAsYear d2

+ 1
- 1
vendor/themoviedb

@@ -1 +1 @@
Subproject commit e81eba0b81bbbc84734c95f5798de0590ba8b0ef
Subproject commit 59f75d5ab6e31c6a4b5ea317956d09576032af53

+ 6
- 0
vimeta.cabal View File

@@ -40,13 +40,19 @@ library
Vimeta.Context
Vimeta.Download
Vimeta.Format
Vimeta.MappingFile
Vimeta.Process
Vimeta.Tagger
Vimeta.UI.CommandLine
Vimeta.UI.CommandLine.Common
Vimeta.UI.CommandLine.Config
Vimeta.UI.CommandLine.Movie
Vimeta.UI.CommandLine.TV
Vimeta.UI.Common.TV
Vimeta.UI.Term.Common
Vimeta.UI.Term.MovieSearch
Vimeta.UI.Term.TVSearch
Vimeta.UI.Util

hs-source-dirs: src
default-language: Haskell2010

Loading…
Cancel
Save