diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,11 @@ # Version History +## 0.3.0.0 (July 29, 2020) + + - Restore the ability to use `--help` with subcommands + + - Update dependencies (minor changes for Byline and themoviedb) + ## 0.2.5.1 (April 16, 2019) - Update dependency versions diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013-2019 Peter J. Jones +Copyright (c) 2013-2020 Peter J. Jones All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,261 +1,42 @@ -% VIMETA(1) Vimeta User Manual -% Peter J. Jones -% May 19, 2015 +# Vimeta: frontend for video metadata tagging tools -# NAME +[![CI](https://github.com/pjones/vimeta/workflows/CI/badge.svg)](https://github.com/pjones/vimeta/actions) +[![GitHub tag (latest by date)](https://img.shields.io/github/v/tag/pjones/vimeta?label=release)](https://github.com/pjones/vimeta/releases) +[![Hackage](https://img.shields.io/hackage/v/vimeta)](https://hackage.haskell.org/package/vimeta) -vimeta - frontend for video metadata tagging tools -[![Build Status](https://travis-ci.org/pjones/vimeta.svg?branch=master)](https://travis-ci.org/pjones/vimeta) - -# SYNOPSIS - -vimeta --version - -vimeta config [*options*] - -vimeta movie [*options*] *FILE* - -vimeta tv [*options*] [*FILE*]... - -# DESCRIPTION - Vimeta is a tool to fetch video metadata from the interwebs and update video files using a tagging tool. -[TheMovieDB][] is used as the source for movie and TV series metadata. -This means that an API key for TheMovieDB is required in order to use -Vimeta. Sign up for an account at TheMovieDB.com and create an API -key. See the *config* command for details on how to create a -configuration file that includes your API key. +![screenshot](doc/screenshot.png) -[AtomicParsley][] is the default tagging tool used to update the -metadata in a video file. Any video tagging utility can be used as -long as it can be called from the command line. See the CONFIGURATION -section for details on specifying a tagging tool to Vimeta. If you -decide to use AtomicParsley it's highly recommended that you use the -fork maintained by `wez` at . +## Documentation -# OPTIONS +You can read the man page [online](doc/vimeta.1.md). -The following command-line options are available to all of the -commands listed in the COMMANDS section. +### Generating the `man` Page from Source -`--verbose` -: Enable verbose output + $ pandoc -s -t man doc/vimeta.1.md -o doc/vimeta.1 -`-d`, `--dry-run` -: Don't actually do anything. Instead, print out what would be - done. Automatically enables `--verbose`. +## Installing Vimeta -# COMMANDS +### Pre-Built Binaries -## vimeta \--version +Each release includes binaries for Windows, macOS, and Linux. -Display the Vimeta version number and then exit. +### Building via `nixpkgs` -## vimeta config [*options*] +The easiest way to build vimeta from source is to use [`nix`][nix]: -Create a configuration file for Vimeta. + 1. Install [`nix`][nix] -`-k`, `--key`=*STRING* -: The API key for TheMovieDB to record into the configuration file. + 2. Install vimeta: -## vimeta movie [*options*] *FILE* + $ nix-env -f https://github.com/pjones/vimeta/archive/trunk.tar.gz -i -Look up movie metadata from TheMovieDB and tag a video file. Vimeta -will interactively prompt for a movie name and provide a list of -matching movies to choose from. +### Building via `cabal` -`-i`, `--id`=*ID* -: Avoid interactive prompting by supplying a movie ID - assigned by TheMovieDB.com. -## vimeta tv [*options*] [*FILE*]... - -Look up TV series metadata from TheMovieDB and tag one or more video -files. Episode video files can be given on the command line or -specified using a mapping file. See MAPPING FILES for more -information about creating a file that maps episodes to video files. - -Vimeta will interactively prompt for a search string and then list -matching TV series. The starting season number and starting episode -number should be given on the command line or they will default to 1. -Each video file will be assigned the next episode number in the -series. Vimeta is smart enough to switch to the next season after the -last episode of the specified season. - -`-s`, `--season`=*NUMBER* -: Specify the starting season number to tag into the episode files. - The season number will be incremented after the last episode of a - season is tagged. If the season number isn't specified it will - default to 1. - -`-e`, `--episode`=*NUMBER* -: Specify the staring episode number. If not specified it defaults - to 1. - -`-m`, `--map`=*FILE* -: Use *FILE* as a mapping file. The mapping file should contain - two columns, the first specifies the season and episode numbers - and the second the file name for the episode video file. See the - MAPPING FILE section for more details about mapping files. - -`-i`, `--id`=*ID* -: Avoid interactive prompting by supplying a TV series ID - assigned by TheMovieDB.com. - -# CONFIGURATION - -The Vimeta configuration file is a YAML file containing a few keys. -You should begin by creating a default configuration file using the -*config* command. - -## Description of Keys - -`tmdb_key` -: The API key issued by TheMovieDB. - -`cmd_movie` -: A format string used to execute a tagging tool for movie files. - See FORMAT STRINGS for more information. - -`cmd_tv` -: A format string used to execute a tagging tool for TV episode - files. See FORMAT STRINGS for more information. - -# FORMAT STRINGS - -## Description - -Vimeta uses format strings to specify the command to run in order to -tag video files, and the arguments needed to pass metadata to the -tagging utility. These format strings are similar to those used with -the `printf` family of functions and utilities. - -In format stings, the percent character (`%`), followed by a single -character, is replaced by one of the metadata attributes. Percent -characters are removed and do not appear in the output string. -Therefore, if you need a literal percent character to appear in the -output string, you should use two percent characters (`%%`). - -Format strings in Vimeta can also contain conditional parts. These -are introduced with the `%{` format specifier, which must be -terminated with the `%}` format specifier. The text and any format -specifiers enclosed inside the opening and closing brackets are only -injected into the output string if all of the enclosed format -specifiers have valid values. - -As an example, not all movies have release dates. Supplying a -command-line flag along with a blank release date to a tagging tool -will most likely cause a problem. It would be best to avoid using the -command-line flag altogether. The following example does just this: - - somecommand %{ --release-date %Y %} - -Here, `%Y` stands in for the full release date. If it's not present -in the metadata then none of the text between the brackets will be -injected into the output string. If multiple format specifiers are -used, all of them have to be present in the metadata for any of the -text between the brackets to be included in the output text. - -## Format Specifiers for Movies - -The following format specifiers are available for tagging movie files. -Not all specifiers are guaranteed to be present. Consider using -conditional specifiers. - -`%Y` -: Full release date in XML schema notation. - -`%a` -: Path to a temporary file containing a movie poster image file. - -`%d` -: Movie description (summary text, truncated to 255 characters). - -`%f` -: Path to the video file to be tagged. - -`%g` -: Name of first listed genre. - -`%t` -: Movie title. - -`%y` -: Release year. - -## Format Specifiers for Episodes - -The following format specifiers are available for tagging TV episode -files. Not all specifiers are guaranteed to be present. Consider -using conditional specifiers. - -`%Y` -: Full air date in XML schema notation. - -`%a` -: Path to a temporary file containing a season poster image file. - -`%d` -: Episode description (summary text, truncated to 255 characters). - -`%e` -: Episode number. - -`%f` -: Path to the video file to be tagged. - -`%n` -: Name of the TV series. - -`%s` -: Season number. - -`%t` -: Episode name. - -`%y` -: Year that the episode aired. - -# MAPPING FILES - -Vimeta can use mapping files that specify hints about metadata and -which video files to tag. For example, the *tv* command can use -mapping files to link video files to specific season and episode -numbers. - -Mapping files are plain text files that contain two columns separated -by whitespace. Comments and blank lines are ignored. Comments begin -with a pound sign (`#`) and continue to the end of the line. - -The first column should contain information relevant to the command -using the mapping file. For example, the *tv* command expects the -first column to specify the season and episode number. - -The second column is always a file name. If the file doesn't exist -and the file name lacks a file extension, `.m4v` will be added to the -file name automatically. - -Example mapping file for the *tv* command: - - # This is a comment. - S2E3 track03.m4v # Season 2, Episode 3 - S3E1 track01.m4v # Season 3, Episode 1 - -# EXAMPLES - -## Tag Several Episode Files - - vimeta tv -s 3 -e 10 file01.m4v file02.m4v - -With this command, Vimeta will prompt for the name of the TV series -and then search TheMovieDB. It will then generate a menu where the -correct TV series can be chosen. Both files will be tagged as -belonging to season 3. The first file is episode 10 and the second -file is episode 11. (For more control over how season and episode -numbers are assigned to files, see the section on MAPPING FILES.) + $ cabal install vimeta -[TheMovieDB]: http://www.themoviedb.org/ -[AtomicParsley]: https://bitbucket.org/wez/atomicparsley +[nix]: https://nixos.org/ diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,16 @@ +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause import Distribution.Simple main = defaultMain diff --git a/TODO.org b/TODO.org deleted file mode 100644 --- a/TODO.org +++ /dev/null @@ -1,27 +0,0 @@ -* Milestone: Release 0.2.0.0 -** DONE Cache TMDB.Configuration - CLOSED: [2015-07-22 Wed 19:27] -** DONE Add support for --version - CLOSED: [2015-07-21 Tue 21:00] -** DONE Search for FIXME and undefined and remove - CLOSED: [2015-05-20 Wed 16:30] -** DONE "a search term is required" shouldn't be used twice - CLOSED: [2015-05-20 Wed 16:23] -** DONE Trim description to 255 characters - CLOSED: [2015-05-20 Wed 16:19] -** DONE Reorg files and reduce imports - CLOSED: [2015-05-20 Wed 16:17] -** DONE Write a man page in README.md - CLOSED: [2015-05-20 Wed 09:04] -** DONE Don't draw menus for empty lists - CLOSED: [2015-05-19 Tue 15:10] -** DONE Missing space in movie menu before paren - CLOSED: [2015-05-19 Tue 15:19] -** DONE Print the movie/tv ID after it's found so that someone can reuse it if necessary - CLOSED: [2015-05-19 Tue 15:19] -** DONE Add interactive search - CLOSED: [2015-05-09 Sat 13:41] -** DONE One configuration file (and place for keys) - CLOSED: [2015-05-09 Sat 13:41] -** DONE Use format strings to support other media editors - CLOSED: [2015-05-09 Sat 13:41] diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,20 @@ +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause +module Main (main) where + +import qualified Vimeta.UI.CommandLine as CommandLine + +main :: IO () +main = CommandLine.run diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,20 +0,0 @@ -{- - -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 Main (main) where - --------------------------------------------------------------------------------- -import qualified Vimeta.UI.CommandLine as CommandLine - --------------------------------------------------------------------------------- -main :: IO () -main = CommandLine.run diff --git a/src/Vimeta/Core.hs b/src/Vimeta/Core.hs --- a/src/Vimeta/Core.hs +++ b/src/Vimeta/Core.hs @@ -1,26 +1,24 @@ -{- - -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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.Core (module Export) where --------------------------------------------------------------------------------- -import Vimeta.Core.Config as Export -import Vimeta.Core.Download as Export -import Vimeta.Core.Format as Export +import Vimeta.Core.Config as Export +import Vimeta.Core.Download as Export +import Vimeta.Core.Format as Export import Vimeta.Core.MappingFile as Export hiding (Parser) -import Vimeta.Core.Process as Export -import Vimeta.Core.Tagger as Export - --------------------------------------------------------------------------------- --- Only export the public interface from the Vimeta module. +import Vimeta.Core.Process as Export +import Vimeta.Core.Tagger as Export import Vimeta.Core.Vimeta as Export (Vimeta) import Vimeta.Core.Vimeta as Export hiding (Vimeta) diff --git a/src/Vimeta/Core/Cache.hs b/src/Vimeta/Core/Cache.hs --- a/src/Vimeta/Core/Cache.hs +++ b/src/Vimeta/Core/Cache.hs @@ -1,96 +1,101 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- --- | Caching functions. +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause +-- +-- Caching functions. module Vimeta.Core.Cache - ( cacheTMDBConfig - ) where + ( cacheTMDBConfig, + ) +where --------------------------------------------------------------------------------- -import Control.Monad (liftM) -import Control.Monad.IO.Class import Data.Aeson as Aeson -import qualified Data.ByteString.Lazy as BL import Data.Time.Calendar import Data.Time.Clock import qualified Network.API.TheMovieDB as TheMovieDB -import System.Directory (doesFileExist, getModificationTime, createDirectoryIfMissing) -import System.Environment.XDG.BaseDir (getUserCacheFile) -import System.FilePath (takeDirectory) +import System.Directory + ( XdgDirectory (..), + createDirectoryIfMissing, + doesFileExist, + getModificationTime, + getXdgDirectory, + ) +import System.FilePath (takeDirectory, ()) --------------------------------------------------------------------------------- -- | Manage cache file expiration. -data Age = MaxDays Int -- ^ Cap to N days. +newtype Age + = -- | Cap to N days. + MaxDays Int --------------------------------------------------------------------------------- ageAsTime :: Age -> UTCTime -> UTCTime ageAsTime (MaxDays days) now = - now {utctDay = addDays (fromIntegral (-days)) (utctDay now)} + now {utctDay = addDays (fromIntegral (- days)) (utctDay now)} --------------------------------------------------------------------------------- -- | The file name for catching @TheMovieDB.Configuration@. tmdbCacheFile :: IO FilePath -tmdbCacheFile = getUserCacheFile "vimeta" "tmdb-config.json" +tmdbCacheFile = + getXdgDirectory XdgCache "vimeta" + <&> ( "tmdb-config.json") --------------------------------------------------------------------------------- -- | Produce a cached version of @TheMovieDB.Configuration@ or use -- the given action to create a cache a new value. -cacheTMDBConfig :: (MonadIO m) - => m (Either e TheMovieDB.Configuration) - -> m (Either e TheMovieDB.Configuration) +cacheTMDBConfig :: + (MonadIO m) => + m (Either e TheMovieDB.Configuration) -> + m (Either e TheMovieDB.Configuration) cacheTMDBConfig action = do file <- liftIO tmdbCacheFile cache file (MaxDays 3) action --------------------------------------------------------------------------------- -- | Generic cache reader. readCache :: (MonadIO m, FromJSON a) => FilePath -> Age -> m (Maybe a) readCache filename age = do exists <- liftIO (doesFileExist filename) if not exists then return Nothing else go - where go = do - now <- liftIO getCurrentTime + now <- liftIO getCurrentTime modtime <- liftIO (getModificationTime filename) if fresh now modtime - then Aeson.decode' `liftM` liftIO (BL.readFile filename) - else return Nothing - + then Aeson.decode' <$> readFileLBS filename + else return Nothing fresh :: UTCTime -> UTCTime -> Bool fresh now modtime = ageAsTime age now <= modtime --------------------------------------------------------------------------------- -- | Generic cache writer. writeCache :: (MonadIO m, ToJSON a) => FilePath -> a -> m () writeCache filename value = liftIO $ do createDirectoryIfMissing True (takeDirectory filename) - BL.writeFile filename (Aeson.encode value) + writeFileLBS filename (Aeson.encode value) --------------------------------------------------------------------------------- -- | Generic caching function. -cache :: (MonadIO m, FromJSON a, ToJSON a) - => FilePath -- ^ Cache file. - -> Age -- ^ Age of cache file. - -> m (Either e a) -- ^ Action to generate new value. - -> m (Either e a) -- ^ Cached or new value. +cache :: + (MonadIO m, FromJSON a, ToJSON a) => + -- | Cache file. + FilePath -> + -- | Age of cache file. + Age -> + -- | Action to generate new value. + m (Either e a) -> + -- | Cached or new value. + m (Either e a) cache file age action = do cached <- liftIO (readCache file age) case cached of - Just c -> return (Right c) - Nothing -> do result <- action - either (const $ return ()) (writeCache file) result - return result + Just c -> return (Right c) + Nothing -> do + result <- action + either (const $ return ()) (writeCache file) result + return result diff --git a/src/Vimeta/Core/Config.hs b/src/Vimeta/Core/Config.hs --- a/src/Vimeta/Core/Config.hs +++ b/src/Vimeta/Core/Config.hs @@ -1,118 +1,108 @@ -{-# LANGUAGE OverloadedStrings,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. - --} - --------------------------------------------------------------------------------- --- | The configuration file. +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause +-- +-- The configuration file. module Vimeta.Core.Config - ( Config (..) - , defaultConfig - , configFileName - , readConfig - , writeConfig - ) where + ( Config (..), + defaultConfig, + configFileName, + readConfig, + writeConfig, + ) +where --------------------------------------------------------------------------------- --- Library imports: -import Control.Applicative -import Control.Monad import Control.Monad.Except -import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson hiding (encodeFile) import Data.Aeson.Types (typeMismatch) -import Data.Text (Text) import Data.Yaml (decodeFileEither, encodeFile) import Network.API.TheMovieDB (Key) -import System.Directory (doesFileExist, createDirectoryIfMissing) -import System.Environment.XDG.BaseDir (getUserConfigFile) -import System.FilePath (takeDirectory) - --------------------------------------------------------------------------------- --- Local imports: +import System.Directory + ( XdgDirectory (XdgConfig), + createDirectoryIfMissing, + doesFileExist, + getXdgDirectory, + ) +import System.FilePath (takeDirectory, ()) import Vimeta.Core.Tagger --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Vimeta configuration. data Config = Config - { configTMDBKey :: Key - , configFormatMovie :: Text - , configFormatTV :: Text - , configVerbose :: Bool - , configDryRun :: Bool + { configTMDBKey :: Key, + configFormatMovie :: Text, + configFormatTV :: Text, + configVerbose :: Bool, + configDryRun :: Bool } --------------------------------------------------------------------------------- instance FromJSON Config where parseJSON (Object v) = - Config <$> v .: "tmdb_key" - <*> v .: "cmd_movie" - <*> v .: "cmd_tv" - <*> v .:? "verbose" .!= False - <*> v .:? "dryrun" .!= False + Config <$> v .: "tmdb_key" + <*> v .: "cmd_movie" + <*> v .: "cmd_tv" + <*> v .:? "verbose" .!= False + <*> v .:? "dryrun" .!= False parseJSON x = typeMismatch "configuration" x --------------------------------------------------------------------------------- instance ToJSON Config where - toJSON c = object [ "tmdb_key" .= configTMDBKey c - , "cmd_movie" .= configFormatMovie c - , "cmd_tv" .= configFormatTV c - ] + toJSON c = + object + [ "tmdb_key" .= configTMDBKey c, + "cmd_movie" .= configFormatMovie c, + "cmd_tv" .= configFormatTV c + ] --------------------------------------------------------------------------------- defaultConfig :: Tagger -> Config defaultConfig tagger = - Config { configTMDBKey = "your API key goes here" - , configFormatMovie = fmtMovie - , configFormatTV = fmtTV - , configVerbose = False - , configDryRun = False - } - - where (fmtMovie, fmtTV) = formatStringsForTagger tagger + Config + { configTMDBKey = "your API key goes here", + configFormatMovie = fmtMovie, + configFormatTV = fmtTV, + configVerbose = False, + configDryRun = False + } + where + (fmtMovie, fmtTV) = formatStringsForTagger tagger --------------------------------------------------------------------------------- -- | Get the name of the configuration file. configFileName :: IO FilePath -configFileName = getUserConfigFile "vimeta" "config.yml" +configFileName = + getXdgDirectory XdgConfig "vimeta" + <&> ( "config.yml") --------------------------------------------------------------------------------- -- | Read the configuration file and return a 'Config' value or an error. readConfig :: (MonadIO m) => ExceptT String m Config readConfig = do filename <- liftIO configFileName - exists <- liftIO (doesFileExist filename) + exists <- liftIO (doesFileExist filename) if exists then decodeConfig filename else throwError $ missingFile filename - where decodeConfig :: (MonadIO m) => FilePath -> ExceptT String m Config - decodeConfig fn = do result <- liftIO $ decodeFileEither fn - case result of - Left e -> throwError (show e) - Right a -> return a - + decodeConfig fn = do + result <- liftIO $ decodeFileEither fn + case result of + Left e -> throwError (show e) + Right a -> return a missingFile :: FilePath -> String - missingFile fn = "no config file found, use the `config' command " ++ - "to create " ++ fn + missingFile fn = + "no config file found, use the `config' command " + ++ "to create " + ++ fn --------------------------------------------------------------------------------- writeConfig :: (MonadIO m) => Config -> ExceptT String m FilePath writeConfig c = do (filename, exists) <- liftIO $ do @@ -125,7 +115,6 @@ liftIO (createDirectoryIfMissing True (takeDirectory filename)) liftIO (encodeFile filename c) return filename - where existError :: FilePath -> String existError fn = "please remove the existing config file first: " ++ fn diff --git a/src/Vimeta/Core/Download.hs b/src/Vimeta/Core/Download.hs --- a/src/Vimeta/Core/Download.hs +++ b/src/Vimeta/Core/Download.hs @@ -1,61 +1,52 @@ -{-# LANGUAGE OverloadedStrings, 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. - --} - --------------------------------------------------------------------------------- --- | Utility functions for downloading files. +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause +-- +-- Utility functions for downloading files. module Vimeta.Core.Download - ( withArtwork - , withDownload - ) where + ( withArtwork, + withDownload, + ) +where --------------------------------------------------------------------------------- --- Library imports: -import qualified Data.ByteString.Lazy as BS -import Data.Maybe -import Data.Monoid -import Data.Text (Text) +import qualified Data.ByteString.Lazy as LByteString import qualified Data.Text as Text import qualified Network.HTTP.Client as HC import System.FilePath -import System.IO (Handle, hFlush) +import System.IO (hFlush) import System.IO.Temp (withSystemTempFile) - --------------------------------------------------------------------------------- --- Local imports: import Vimeta.Core.Config import Vimeta.Core.Vimeta --------------------------------------------------------------------------------- -- | Try to download artwork and run the given function. The -- function will be passed a 'FilePath' if the artwork was downloaded. -- -- See the 'withDownload' function for more details. -withArtwork :: (MonadIO m) - => [Text] - -> (Maybe FilePath -> Vimeta IO a) - -> Vimeta m a +withArtwork :: + (MonadIO m) => + [Text] -> + (Maybe FilePath -> Vimeta IO a) -> + Vimeta m a withArtwork urls = withDownload (listToMaybe $ candidates urls) where candidates :: [Text] -> [Text] candidates = filter checkExtension . reverse - checkExtension :: Text -> Bool - checkExtension = goodExtension . takeExtension . Text.unpack . Text.toLower - + checkExtension = goodExtension . takeExtension . toString . Text.toLower goodExtension :: String -> Bool goodExtension ext = ext == ".jpg" || ext == ".png" --------------------------------------------------------------------------------- -- | Download the given URL to a temporary file and pass the file -- name to the given function. -- @@ -63,67 +54,65 @@ -- result of using 'withSystemTempFile' to store the downloaded file. -- The file will be automatically removed after the given function -- completes. -withDownload :: (MonadIO m) - => Maybe Text - -- ^ URL. - - -> (Maybe FilePath -> Vimeta IO a) - -- ^ Function to call and pass the file name to. - - -> Vimeta m a - -- ^ Result of above function. - +withDownload :: + (MonadIO m) => + -- | URL. + Maybe Text -> + -- | Function to call and pass the file name to. + (Maybe FilePath -> Vimeta IO a) -> + -- | Result of above function. + Vimeta m a withDownload Nothing f = do verbose "no URL to download" runIOE $ runVimeta (f Nothing) - withDownload url f = do context <- ask - let dryRun = configDryRun $ ctxConfig context + let dryRun = configDryRun $ ctxConfig context manager = ctxManager context case (dryRun, url) of - (True, Nothing) -> verbose "dry-run: nothing to download" >> - runWithoutTempFile f - - (False, Nothing) -> verbose "nothing to download" >> - runWithoutTempFile f - - (True, Just u) -> verbose ("dry-run:" <> u) >> - runWithoutTempFile f - - (False, Just u) -> verbose u >> - runWithTempFile u manager f + (True, Nothing) -> + verbose "dry-run: nothing to download" + >> runWithoutTempFile f + (False, Nothing) -> + verbose "nothing to download" + >> runWithoutTempFile f + (True, Just u) -> + verbose ("dry-run:" <> u) + >> runWithoutTempFile f + (False, Just u) -> + verbose u + >> runWithTempFile u manager f --------------------------------------------------------------------------------- -- | Helper function to run the download action with a temporary file. -runWithTempFile :: (MonadIO m) - => Text - -> HC.Manager - -> (Maybe FilePath -> Vimeta IO a) - -> Vimeta m a +runWithTempFile :: + (MonadIO m) => + Text -> + HC.Manager -> + (Maybe FilePath -> Vimeta IO a) -> + Vimeta m a runWithTempFile url manager vio = do context <- ask - runIOE $ withSystemTempFile "vimeta" $ \name h -> do - downloadToHandle manager (Text.unpack url) h - execVimetaWithContext context $ vio (Just name) + runIOE $ + withSystemTempFile "vimeta" $ \name h -> do + downloadToHandle manager (toString url) h + execVimetaWithContext context $ vio (Just name) --------------------------------------------------------------------------------- -- | Helper function to run an action without needing a temporary file. -runWithoutTempFile :: (MonadIO m) - => (Maybe FilePath -> Vimeta IO a) - -> Vimeta m a +runWithoutTempFile :: + (MonadIO m) => + (Maybe FilePath -> Vimeta IO a) -> + Vimeta m a runWithoutTempFile vio = do context <- ask runIOE $ execVimetaWithContext context $ vio Nothing --------------------------------------------------------------------------------- -- | Helper function to the actual HTTP downloading into a file handle. downloadToHandle :: HC.Manager -> String -> Handle -> IO () downloadToHandle manager url handle = do - request <- HC.parseRequest url + request <- HC.parseRequest url response <- HC.httpLbs request manager - BS.hPut handle (HC.responseBody response) + LByteString.hPut handle (HC.responseBody response) hFlush handle diff --git a/src/Vimeta/Core/Format.hs b/src/Vimeta/Core/Format.hs --- a/src/Vimeta/Core/Format.hs +++ b/src/Vimeta/Core/Format.hs @@ -1,148 +1,121 @@ -{-# LANGUAGE OverloadedStrings, TupleSections #-} - -{- - -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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.Core.Format - ( FormatTable - , fromFormatString - , formatYear - , formatFullDate - ) where + ( FormatTable, + fromFormatString, + formatYear, + formatFullDate, + ) +where --------------------------------------------------------------------------------- --- Library imports: -import Control.Applicative hiding ((<|>)) -- Use the one from Parsec. -import Control.Monad -import Control.Monad.Reader -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Maybe -import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Time (Day(..), formatTime) -import Data.Time.Locale.Compat (defaultTimeLocale) +import Data.Time (Day (..), defaultTimeLocale, formatTime) +import Relude.Extra.Map import System.Process.Internals (translate) -import Text.Parsec - --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude +import Text.Parsec hiding ((<|>)) --------------------------------------------------------------------------------- -- | Mapping of format characters to their possible replacement text. type FormatTable = Map Char (Maybe Text) --------------------------------------------------------------------------------- -- | Syntax tree for format strings. -data Replacement = Replace Char - -- ^ Replace the given character. - - | Condition [(Text, Replacement)] - -- ^ Conditional section. - - | EndOfInput - -- ^ End of input (or condition). +data Replacement + = -- | Replace the given character. + Replace Char + | -- | Conditional section. + Condition [(Text, Replacement)] + | -- | End of input (or condition). + EndOfInput --------------------------------------------------------------------------------- -- | Parser type. type Parser a = ParsecT Text () (Reader FormatTable) a --------------------------------------------------------------------------------- -- | Replace format characters prefixed with a @%@ with the -- replacement text found in the given 'Map'. -fromFormatString :: FormatTable -- ^ Format character mapping. - -> String -- ^ Name of format string. - -> Text -- ^ Input text. - -> Either String Text -- ^ Output text or error. +fromFormatString :: + -- | Format character mapping. + FormatTable -> + -- | Name of format string. + String -> + -- | Input text. + Text -> + -- | Output text or error. + Either String Text fromFormatString table name input = case runReader (runParserT parseFormatString () name input) table of - Left e -> Left (show e) + Left e -> Left (show e) Right t -> Right t --------------------------------------------------------------------------------- -- | Format a 'Day' using the XML schema notation. formatFullDate :: Maybe Day -> Maybe Text formatFullDate = formatDay "%Y-%m-%dT00:00:00Z" --------------------------------------------------------------------------------- -- | Format a 'Day' displaying just the year. formatYear :: Maybe Day -> Maybe Text formatYear = formatDay "%Y" --------------------------------------------------------------------------------- formatDay :: String -> Maybe Day -> Maybe Text -formatDay fmt d = Text.pack . formatTime defaultTimeLocale fmt <$> d +formatDay fmt d = toText . formatTime defaultTimeLocale fmt <$> d --------------------------------------------------------------------------------- parseFormatString :: Parser Text parseFormatString = manyTill go eof >>= renderFormatString - where go = findFormatCharacter >>= mkReplacement + where + go = findFormatCharacter >>= mkReplacement --------------------------------------------------------------------------------- -- | Render a format string syntax table as a 'Text' value. renderFormatString :: [(Text, Replacement)] -> Parser Text -renderFormatString rs = do table <- ask - return (Text.concat $ map (render table) rs) +renderFormatString rs = do + table <- ask + return (mconcat $ map (render table) rs) where escape :: Text -> Text - escape = Text.pack . translate . Text.unpack - + escape = toText . translate . toString findChar :: FormatTable -> Char -> Text - findChar t c = fromMaybe "" $ join (Map.lookup c t) - + findChar t c = fromMaybe "" $ join (lookup c t) render :: FormatTable -> (Text, Replacement) -> Text - render tbl (txt, Replace c) = txt <> escape (findChar tbl c) + render tbl (txt, Replace c) = txt <> escape (findChar tbl c) render tbl (txt, Condition c) = txt <> renderCondition tbl c - render _ (txt, EndOfInput) = txt - + render _ (txt, EndOfInput) = txt renderCondition :: FormatTable -> [(Text, Replacement)] -> Text renderCondition tbl conds = if all (checkCondition tbl) conds - then Text.concat $ map (render tbl) conds - else Text.empty - + then mconcat $ map (render tbl) conds + else mempty checkCondition :: FormatTable -> (Text, Replacement) -> Bool - checkCondition tbl (_, Replace c) = isJust (join $ Map.lookup c tbl) + checkCondition tbl (_, Replace c) = isJust (join $ lookup c tbl) checkCondition tbl (_, Condition c) = all (checkCondition tbl) c - checkCondition _ (_, EndOfInput) = True + checkCondition _ (_, EndOfInput) = True --------------------------------------------------------------------------------- -- | Location a format character preceded by a @'%'@ character. -- Returns the text leading up to the format character and the -- character itself. findFormatCharacter :: Parser (Text, Maybe Char) findFormatCharacter = do - beforeText <- Text.pack <$> manyTill anyChar (try eofOrFormatChar) + beforeText <- toText <$> manyTill anyChar (try eofOrFormatChar) formatChar <- try $ (Just <$> anyChar) <|> return Nothing return (beforeText, formatChar) - where eofOrFormatChar :: Parser () eofOrFormatChar = eof <|> void (char '%') --------------------------------------------------------------------------------- -- | Translate the output from 'findFormatCharacter' into a syntax node. mkReplacement :: (Text, Maybe Char) -> Parser (Text, Replacement) mkReplacement (beforeText, formatChar) = case formatChar of - Nothing -> return (beforeText, EndOfInput) + Nothing -> return (beforeText, EndOfInput) Just '{' -> (beforeText,) <$> (Condition <$> parseConditional) - Just c -> return (beforeText, Replace c) + Just c -> return (beforeText, Replace c) --------------------------------------------------------------------------------- -- | Parse a conditional section out of a format string. parseConditional :: Parser [(Text, Replacement)] parseConditional = do @@ -151,14 +124,14 @@ case formatChar of -- Reached the end of the format string. Nothing -> unexpected "end of format string, expected `%}'" - -- Start another conditional. - Just '{' -> do other <- parseConditional - return [(beforeText, Condition other)] + Just '{' -> do + other <- parseConditional + return [(beforeText, Condition other)] -- End this conditional. Just '}' -> return [(beforeText, EndOfInput)] - -- Add this replacement to the list, fetch the next one. - Just c -> do next <- parseConditional - return ((beforeText, Replace c) : next) + Just c -> do + next <- parseConditional + return ((beforeText, Replace c) : next) diff --git a/src/Vimeta/Core/MappingFile.hs b/src/Vimeta/Core/MappingFile.hs --- a/src/Vimeta/Core/MappingFile.hs +++ b/src/Vimeta/Core/MappingFile.hs @@ -1,138 +1,125 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause +-- -- | Mapping files can be used to map file names to other information. module Vimeta.Core.MappingFile - ( Parser - , parseMappingFile - ) where + ( Parser, + parseMappingFile, + ) +where --------------------------------------------------------------------------------- --- Library imports: -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 - --------------------------------------------------------------------------------- --- Local imports: +import Text.Parsec hiding ((<|>)) import Vimeta.Core.Vimeta --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | 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 :: + (MonadIO m) => + -- | File name for the mapping file. + FilePath -> + -- | Parser for the second column. + Parser a -> + Vimeta m [(FilePath, a)] parseMappingFile filename p = do - contents <- runIO $ Text.readFile filename + contents <- runIO $ readFileText filename case runIdentity $ runParserT (mapping p) () filename contents of - Left e -> die (show e) + Left e -> throwError (show e) Right m -> checkFileMappingOrDie m --------------------------------------------------------------------------------- -checkFileMappingOrDie :: (MonadIO m) - => [(FilePath, a)] - -> Vimeta m [(FilePath, a)] +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) + do + ys <- checkFileMapping xs + if null (lefts ys) + then return (rights ys) + else throwError $ 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) + 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) +checkFileMapping :: + (MonadIO m) => + -- | The mapping. + [(FilePath, a)] -> + 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 + 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 - + predicate Comment = False extract :: Token a -> [(FilePath, a)] extract (Entry f a) = [(f, a)] - extract Comment = [] + 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" + 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" diff --git a/src/Vimeta/Core/Process.hs b/src/Vimeta/Core/Process.hs --- a/src/Vimeta/Core/Process.hs +++ b/src/Vimeta/Core/Process.hs @@ -1,54 +1,46 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause +-- -- | Utility functions for running external commands. module Vimeta.Core.Process - ( tagFile - ) where + ( tagFile, + ) +where --------------------------------------------------------------------------------- --- Library imports: -import Control.Applicative -import qualified Data.Text as Text import System.Exit (ExitCode (..)) import System.Process - --------------------------------------------------------------------------------- --- Local imports: import Vimeta.Core.Config import Vimeta.Core.Vimeta --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Run the tagging command unless dry-run mode is in effect. -tagFile :: String -> Vimeta IO () +tagFile :: Text -> Vimeta IO () tagFile cmd = do dryRun <- configDryRun <$> asks ctxConfig if dryRun then doDryRun else doRealRun - where doDryRun :: Vimeta IO () - doDryRun = verbose "dry run: skipping tagging command" >> - verbose (Text.pack cmd) - + doDryRun = + verbose "dry run: skipping tagging command" + >> verbose cmd doRealRun :: Vimeta IO () - doRealRun = do code <- liftIO (spawnCommand cmd >>= waitForProcess) - case code of - ExitSuccess -> return () - ExitFailure _ -> die ("command failed: " ++ cmd) + doRealRun = do + verbose cmd + code <- liftIO (spawnCommand (toString cmd) >>= waitForProcess) + + case code of + ExitSuccess -> + pass + ExitFailure n -> + throwError ("command failed (" ++ show n ++ "): " ++ toString cmd) diff --git a/src/Vimeta/Core/Tagger.hs b/src/Vimeta/Core/Tagger.hs --- a/src/Vimeta/Core/Tagger.hs +++ b/src/Vimeta/Core/Tagger.hs @@ -1,68 +1,66 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.Core.Tagger - ( Tagger (..) - , formatStringsForTagger - ) where + ( Tagger (..), + formatStringsForTagger, + ) +where --------------------------------------------------------------------------------- -import Data.Text (Text) import qualified Data.Text as Text --------------------------------------------------------------------------------- data Tagger = AtomicParsley --------------------------------------------------------------------------------- formatStringsForTagger :: Tagger -> (Text, Text) formatStringsForTagger AtomicParsley = (apMovie, apTV) --------------------------------------------------------------------------------- -- | Common strings for AtomicParsley. apPrefix, apSuffix :: Text apPrefix = "AtomicParsley" apSuffix = "--overWrite" --------------------------------------------------------------------------------- -- | Format string for movies. apMovie :: Text -apMovie = Text.intercalate " " - [ apPrefix - , "%f" - , "--stik value=9" - , "%{--year %Y%}" - , "--title %t" - , "--description %d" - , "%{--genre %G%}" - , "--artwork REMOVE_ALL %{--artwork %a%}" - , apSuffix - ] +apMovie = + Text.intercalate + " " + [ apPrefix, + "%f", + "--stik value=9", + "%{--year %Y%}", + "--title %t", + "--description %d", + "%{--genre %G%}", + "--artwork REMOVE_ALL %{--artwork %a%}", + apSuffix + ] --------------------------------------------------------------------------------- -- | Format string for TV episodes. apTV :: Text -apTV = Text.intercalate " " - [ apPrefix - , "%f" - , "--stik 'TV Show'" - , "%{--year %Y%}" - , "--title %t" - , "--description %d" - , "--TVShowName %n" - , "--TVSeasonNum %s" - , "--TVEpisodeNum %e" - , "--tracknum %e" - , "--artwork REMOVE_ALL %{--artwork %a%}" - , apSuffix - ] +apTV = + Text.intercalate + " " + [ apPrefix, + "%f", + "--stik 'TV Show'", + "%{--year %Y%}", + "--title %t", + "--description %d", + "--TVShowName %n", + "--TVSeasonNum %s", + "--TVEpisodeNum %e", + "--tracknum %e", + "--artwork REMOVE_ALL %{--artwork %a%}", + apSuffix + ] diff --git a/src/Vimeta/Core/Vimeta.hs b/src/Vimeta/Core/Vimeta.hs --- a/src/Vimeta/Core/Vimeta.hs +++ b/src/Vimeta/Core/Vimeta.hs @@ -1,146 +1,148 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.Core.Vimeta - ( Vimeta (..) - , Context (..) - , MonadIO - , die - , runIO - , runIOE - , tmdb - , verbose - , execVimetaWithContext - , execVimeta - , runVimeta - , ask - , asks - , liftIO - ) where + ( Vimeta (..), + Context (..), + MonadIO, + throwError, + runIO, + runIOE, + tmdb, + verbose, + execVimetaWithContext, + execVimeta, + runVimeta, + ) +where --------------------------------------------------------------------------------- --- Library imports: -import Control.Applicative -import Control.Exception +import Byline (BylineT, MonadByline, runBylineT) +import Control.Monad.Catch import Control.Monad.Except -import Control.Monad.Reader -import Data.Text (Text) import qualified Data.Text.IO as Text -import Network.API.TheMovieDB (TheMovieDB, Key, runTheMovieDBWithManager) -import qualified Network.API.TheMovieDB as TheMovieDB +import GHC.IO.Encoding (setLocaleEncoding, utf8) +import qualified Network.API.TheMovieDB as TMDb import Network.HTTP.Client (Manager, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) -import System.IO (Handle, stdout) - --------------------------------------------------------------------------------- --- Local imports: import Vimeta.Core.Cache import Vimeta.Core.Config --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- data Context = Context - { ctxManager :: Manager - , ctxConfig :: Config - , ctxTMDBCfg :: TheMovieDB.Configuration - , ctxVerboseH :: Handle + { ctxManager :: Manager, + ctxConfig :: Config, + ctxTMDBCfg :: TMDb.Configuration, + ctxVerboseH :: Handle } --------------------------------------------------------------------------------- -newtype Vimeta m a = - Vimeta {unV :: ReaderT Context (ExceptT String m) a} - deriving (Functor, Applicative, Monad, MonadIO, MonadReader Context) - --------------------------------------------------------------------------------- --- | Terminate a 'Vimeta' session with an error message. -die :: (Monad m) => String -> Vimeta m a -die message = Vimeta $ lift (throwError message) +newtype Vimeta m a = Vimeta + {unV :: ReaderT Context (BylineT (ExceptT String m)) a} + deriving + ( Functor, + Applicative, + Monad, + MonadIO, + MonadReader Context, + MonadError String, + MonadByline + ) --------------------------------------------------------------------------------- runIO :: (MonadIO m) => IO a -> Vimeta m a runIO io = liftIO (try io) >>= sinkIO - where sinkIO :: (Monad m) => Either SomeException a -> Vimeta m a - sinkIO (Left e) = die (show e) - sinkIO (Right a) = return a + where + sinkIO :: (Monad m) => Either SomeException a -> Vimeta m a + sinkIO (Left e) = throwError (show e) + sinkIO (Right a) = return a --------------------------------------------------------------------------------- runIOE :: (MonadIO m) => IO (Either String a) -> Vimeta m a -runIOE io = runIO io >>= either (die . show) return +runIOE io = runIO io >>= either (throwError . show) return --------------------------------------------------------------------------------- -- | Run a 'TheMovieDB' operation. -tmdb :: (MonadIO m) => TheMovieDB a -> Vimeta m a +tmdb :: (MonadIO m) => TMDb.TheMovieDB a -> Vimeta m a tmdb t = do context' <- ask let manager = ctxManager context' - key = configTMDBKey (ctxConfig context') + key = configTMDBKey (ctxConfig context') + settings = TMDb.defaultSettings key - result <- liftIO (runTheMovieDBWithManager manager key t) + result <- liftIO (TMDb.runTheMovieDBWithManager manager settings t) case result of - Left e -> die (show e) + Left e -> throwError (show e) Right r -> return r --------------------------------------------------------------------------------- verbose :: (MonadIO m) => Text -> Vimeta m () verbose msg = do context <- ask - let okay = configVerbose (ctxConfig context) || - configDryRun (ctxConfig context) + let okay = + configVerbose (ctxConfig context) + || configDryRun (ctxConfig context) when okay $ liftIO $ Text.hPutStrLn (ctxVerboseH context) msg --------------------------------------------------------------------------------- -loadTMDBConfig :: (MonadIO m) => Manager -> Key -> ExceptT String m TheMovieDB.Configuration -loadTMDBConfig manager key = do - result <- cacheTMDBConfig (liftIO $ runTheMovieDBWithManager manager key TheMovieDB.config) +loadTMDBConfig :: + (MonadIO m) => + Manager -> + TMDb.Settings -> + ExceptT String m TMDb.Configuration +loadTMDBConfig manager settings = do + result <- + cacheTMDBConfig + ( liftIO $ TMDb.runTheMovieDBWithManager manager settings TMDb.config + ) case result of - Left e -> throwError (show e) + Left e -> throwError (show e) Right c -> return c --------------------------------------------------------------------------------- -- | Very primitive way of running a 'Vimeta' value with the given 'Context'. -- Mostly useful for running vimeta action within another vimeta -- action. -execVimetaWithContext :: Context - -> Vimeta m a - -> m (Either String a) +execVimetaWithContext :: + (MonadIO m, MonadMask m) => + Context -> + Vimeta m a -> + m (Either String a) execVimetaWithContext context vimeta = - runExceptT $ runReaderT (unV vimeta) context + unV vimeta + & (`runReaderT` context) + & runBylineT + & (>>= maybe (throwError "EOF") pure) + & runExceptT --------------------------------------------------------------------------------- +-- | Force the current process to use UTF-8 for output. +forceUTF8 :: IO () +forceUTF8 = setLocaleEncoding utf8 + -- | Run a 'Vimeta' operation after loading the configuration file -- from disk. -execVimeta :: (MonadIO m) - => (Config -> Config) -- ^ Modify configuration before running. - -> Vimeta m a -- ^ The Vimeta value to execute. - -> m (Either String a) -- ^ The result. +execVimeta :: + (MonadIO m, MonadMask m) => + -- | Modify configuration before running. + (Config -> Config) -> + -- | The Vimeta value to execute. + Vimeta m a -> + -- | The result. + m (Either String a) execVimeta cf vimeta = runExceptT $ do + liftIO forceUTF8 config <- cf <$> readConfig manager <- liftIO $ newManager tlsManagerSettings - tc <- loadTMDBConfig manager (configTMDBKey config) + tc <- loadTMDBConfig manager (TMDb.defaultSettings (configTMDBKey config)) ExceptT $ execVimetaWithContext (Context manager config tc stdout) vimeta --------------------------------------------------------------------------------- -- | Simple wrapper around 'execVimeta'. -runVimeta :: (MonadIO m) => Vimeta m a -> m (Either String a) +runVimeta :: (MonadIO m, MonadMask m) => Vimeta m a -> m (Either String a) runVimeta = execVimeta id diff --git a/src/Vimeta/UI/CommandLine.hs b/src/Vimeta/UI/CommandLine.hs --- a/src/Vimeta/UI/CommandLine.hs +++ b/src/Vimeta/UI/CommandLine.hs @@ -9,77 +9,56 @@ -} --------------------------------------------------------------------------------- module Vimeta.UI.CommandLine (run) where --------------------------------------------------------------------------------- -import Data.Monoid +import qualified Byline.Exit as B import Data.Version (showVersion) import Options.Applicative -import System.Exit - --------------------------------------------------------------------------------- -import qualified Vimeta.UI.CommandLine.Config as Config -import qualified Vimeta.UI.CommandLine.Movie as Movie -import qualified Vimeta.UI.CommandLine.TV as TV - --------------------------------------------------------------------------------- --- Cabal generated source files: import Paths_vimeta (version) - --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude +import qualified Vimeta.UI.CommandLine.Config as Config +import qualified Vimeta.UI.CommandLine.Movie as Movie +import qualified Vimeta.UI.CommandLine.TV as TV --------------------------------------------------------------------------------- -data Command = CmdVersion - | CmdConfig Config.Options - | CmdMovie Movie.Options - | CmdTV TV.Options +data Command + = CmdVersion + | CmdConfig Config.Options + | CmdMovie Movie.Options + | CmdTV TV.Options --------------------------------------------------------------------------------- optionsParser :: Parser Command optionsParser = verbose <|> commands where verbose = - flag' CmdVersion - (long "version" <> help "Print version and exit") - + flag' + CmdVersion + (long "version" <> help "Print version and exit") commands = subparser $ mconcat [config, movie, tv] - + subcommand name desc parser = + command name (info (parser <**> helper) (progDesc desc)) config = - command "config" - (info (CmdConfig <$> Config.optionsParser) (progDesc configDesc)) - + subcommand "config" configDesc (CmdConfig <$> Config.optionsParser) movie = - command "movie" - (info (CmdMovie <$> Movie.optionsParser) (progDesc movieDesc)) - + subcommand "movie" movieDesc (CmdMovie <$> Movie.optionsParser) tv = - command "tv" - (info (CmdTV <$> TV.optionsParser) (progDesc tvDesc)) - + subcommand "tv" tvDesc (CmdTV <$> TV.optionsParser) 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 () run = do options <- execParser $ info (optionsParser <**> helper) idm - case options of - CmdVersion -> putStrLn (showVersion version) - CmdConfig o -> Config.run o - CmdMovie o -> Movie.run o - CmdTV o -> TV.run o + result <- case options of + CmdVersion -> putStrLn (showVersion version) $> Right () + CmdConfig o -> Config.run o $> Right () + CmdMovie o -> Movie.run o + CmdTV o -> TV.run o - exitSuccess + case result of + Left e -> B.die (B.text $ toText e) + Right () -> exitSuccess diff --git a/src/Vimeta/UI/CommandLine/Common.hs b/src/Vimeta/UI/CommandLine/Common.hs --- a/src/Vimeta/UI/CommandLine/Common.hs +++ b/src/Vimeta/UI/CommandLine/Common.hs @@ -1,50 +1,50 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause +-- -- | Common types/functions used in the command line interface. module Vimeta.UI.CommandLine.Common - ( CommonOptions - , commonOptions - , updateConfig - ) where + ( CommonOptions, + commonOptions, + updateConfig, + ) +where --------------------------------------------------------------------------------- -import Data.Monoid import Options.Applicative import Vimeta.Core --------------------------------------------------------------------------------- -- | Common command line options among all of the apps. data CommonOptions = CommonOptions - { optsVerbose :: Bool - , optsDryRun :: Bool + { optsVerbose :: Bool, + optsDryRun :: Bool } --------------------------------------------------------------------------------- -- | Common option parser. commonOptions :: Parser CommonOptions -commonOptions = CommonOptions <$> switch infoVerbose - <*> switch infoDryRun - +commonOptions = + CommonOptions <$> switch infoVerbose + <*> switch infoDryRun where infoVerbose = long "verbose" <> help "Enable verbose output" - infoDryRun = short 'd' <> long "dry-run" <> - help "Don't tag files, implies --verbose" + infoDryRun = + short 'd' <> long "dry-run" + <> help "Don't tag files, implies --verbose" --------------------------------------------------------------------------------- -- | Update the configuration file base on the common command line options. updateConfig :: CommonOptions -> Config -> Config -updateConfig o c = c { configVerbose = configVerbose c || optsVerbose o - , configDryRun = configDryRun c || optsDryRun o - } +updateConfig o c = + c + { configVerbose = configVerbose c || optsVerbose o, + configDryRun = configDryRun c || optsDryRun o + } diff --git a/src/Vimeta/UI/CommandLine/Config.hs b/src/Vimeta/UI/CommandLine/Config.hs --- a/src/Vimeta/UI/CommandLine/Config.hs +++ b/src/Vimeta/UI/CommandLine/Config.hs @@ -1,86 +1,67 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.UI.CommandLine.Config - ( Options - , optionsParser - , run - ) where + ( Options, + optionsParser, + run, + ) +where --------------------------------------------------------------------------------- -import Control.Monad -import Control.Monad.Except -import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as Text +import qualified Byline.Exit as B import Options.Applicative -import System.Console.Byline -import System.Exit import Vimeta.Core --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- data Options = Options - { optsKey :: Maybe Text - , optsTagger :: Tagger + { optsKey :: Maybe Text, + optsTagger :: Tagger } --------------------------------------------------------------------------------- optionsParser :: Parser Options -optionsParser = Options <$> optional (Text.pack <$> strOption getKey) - <*> pure AtomicParsley - - where - -- Parser options for @optsKey@ - getKey = mconcat [ short 'k' - , long "key" - , metavar "KEY" - , help "Set the API key to KEY" - ] +optionsParser = + Options + <$> optional + ( strOption $ + mconcat + [ short 'k', + long "key", + metavar "KEY", + help "Set the API key to KEY" + ] + ) + <*> pure AtomicParsley --------------------------------------------------------------------------------- run :: Options -> IO () run opts = do - let def = defaultConfig (optsTagger opts) + let def = defaultConfig (optsTagger opts) config = case optsKey opts of - Nothing -> def - Just k -> def {configTMDBKey = k} + Nothing -> def + Just k -> def {configTMDBKey = k} result <- runExceptT (app opts config) case result of - Left e -> byline Error e >> exitFailure - Right (Just w) -> byline Warning w - Right Nothing -> return () - - where - byline :: ReportType -> String -> IO () - byline rt = void . runByline . reportLn rt . text . Text.pack + Left e -> B.die (B.text $ toText e) + Right (Just msg) -> B.warn (B.text $ toText msg) + Right Nothing -> return () --------------------------------------------------------------------------------- app :: Options -> Config -> ExceptT String IO (Maybe String) app opts config = do filename <- writeConfig config return $ case optsKey opts of - Just _ -> Nothing -- No warnings. + Just _ -> Nothing -- No warnings. Nothing -> Just (missingKey filename) - where missingKey = ("please edit the config file and set the API key: " ++) diff --git a/src/Vimeta/UI/CommandLine/Movie.hs b/src/Vimeta/UI/CommandLine/Movie.hs --- a/src/Vimeta/UI/CommandLine/Movie.hs +++ b/src/Vimeta/UI/CommandLine/Movie.hs @@ -1,76 +1,63 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.UI.CommandLine.Movie - ( Options - , optionsParser - , run - ) where + ( Options, + optionsParser, + run, + ) +where --------------------------------------------------------------------------------- -import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as Text import Network.API.TheMovieDB import Options.Applicative import System.FilePath import Vimeta.Core import Vimeta.UI.CommandLine.Common import Vimeta.UI.Common.Movie -import Vimeta.UI.Term.Common import Vimeta.UI.Term.Movie --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- data Options = Options - { optsMovieID :: Maybe ItemID - , optsFile :: FilePath - , optsCommon :: CommonOptions + { optsMovieID :: Maybe ItemID, + optsFile :: FilePath, + optsCommon :: CommonOptions } --------------------------------------------------------------------------------- optionsParser :: Parser Options -optionsParser = Options <$> optional (option auto getMovieID) - <*> argument str (metavar "FILE") - <*> commonOptions - +optionsParser = + Options <$> optional (option auto getMovieID) + <*> argument str (metavar "FILE") + <*> commonOptions where -- Parser options for @optsMovieID@. - getMovieID = mconcat [ short 'i' - , long "id" - , metavar "ID" - , help "Movie ID assigned by TheMovieDB.org" - ] + getMovieID = + mconcat + [ short 'i', + long "id", + metavar "ID", + help "Movie ID assigned by TheMovieDB.org" + ] --------------------------------------------------------------------------------- -run :: Options -> IO () -run opts = execVimetaBylineApp (updateConfig $ optsCommon opts) $ +run :: Options -> IO (Either String ()) +run opts = execVimeta (updateConfig $ optsCommon opts) $ case optsMovieID opts of Just mid -> do movie <- tmdb (fetchMovie mid) tagMovie (optsFile opts) movie - Nothing -> do movie <- movieSearch initialTitle tagMovie (optsFile opts) movie - where -- Calculate an initial search title from the file name. initialTitle :: Text - initialTitle = Text.pack $ dropExtension (takeFileName $ optsFile opts) + initialTitle = toText $ dropExtension (takeFileName $ optsFile opts) diff --git a/src/Vimeta/UI/CommandLine/TV.hs b/src/Vimeta/UI/CommandLine/TV.hs --- a/src/Vimeta/UI/CommandLine/TV.hs +++ b/src/Vimeta/UI/CommandLine/TV.hs @@ -1,91 +1,81 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.UI.CommandLine.TV - ( Options - , optionsParser - , run - ) where + ( Options, + optionsParser, + run, + ) +where --------------------------------------------------------------------------------- -import Control.Monad -import Data.Monoid import Network.API.TheMovieDB import Options.Applicative import Vimeta.Core import Vimeta.UI.CommandLine.Common import Vimeta.UI.Common.TV -import Vimeta.UI.Term.Common import Vimeta.UI.Term.TV --------------------------------------------------------------------------------- data Options = Options - { optsTVID :: Maybe ItemID - , optsStartSeason :: Maybe Int - , optsStartEpisode :: Maybe Int - , optsMappingFile :: Maybe FilePath - , optsFiles :: [FilePath] - , optsCommon :: CommonOptions + { 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 +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" - + short 'i' <> long "id" <> metavar "ID" + <> help "Series ID assigned by TheMovieDB.org" infoStartSeason = - short 's' <> long "season" <> metavar "NUM" <> - help "Starting season number" - + short 's' <> long "season" <> metavar "NUM" + <> help "Starting season number" infoStartEpisode = - short 'e' <> long "episode" <> metavar "NUM" <> - help "Starting episode number" - + 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" + short 'm' <> long "map" <> metavar "FILE" + <> help "File to map files to seasons/episodes" --------------------------------------------------------------------------------- -run :: Options -> IO () -run opts = execVimetaBylineApp (updateConfig $ optsCommon opts) $ do +run :: Options -> IO (Either String ()) +run opts = execVimeta (updateConfig $ optsCommon opts) $ do tv <- case optsTVID opts of - Nothing -> tvSearch - Just n -> tmdb (fetchFullTVSeries n) + Nothing -> tvSearch + 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" + (Just s, Nothing) -> tagWithFileOrder tv (EpisodeSpec s 1) (optsFiles opts) + (Just s, Just e) -> tagWithFileOrder tv (EpisodeSpec s e) (optsFiles opts) + (_, _) -> throwError "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" + throwError "don't give file arguments when using a mapping file" tagWithMappingFile tv filename diff --git a/src/Vimeta/UI/Common/Movie.hs b/src/Vimeta/UI/Common/Movie.hs --- a/src/Vimeta/UI/Common/Movie.hs +++ b/src/Vimeta/UI/Common/Movie.hs @@ -1,57 +1,47 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.UI.Common.Movie - ( tagMovie - ) where + ( tagMovie, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative -import qualified Data.Map as Map -import Data.Maybe import qualified Data.Text as Text import Network.API.TheMovieDB import Vimeta.Core --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Run the tagger for the given file/movie combo. tagMovie :: (MonadIO m) => FilePath -> Movie -> Vimeta m () tagMovie filename movie = do context <- ask - let format = configFormatMovie (ctxConfig context) + let format = configFormatMovie (ctxConfig context) tmdbCfg = ctxTMDBCfg context withArtwork (moviePosterURLs tmdbCfg movie) $ \artwork -> case fromFormatString (formatMap artwork) "config.cmd_movie" format of - Left e -> die e - Right cmd -> tagFile (Text.unpack cmd) - + Left e -> throwError e + Right cmd -> tagFile cmd where formatMap :: Maybe FilePath -> FormatTable - formatMap artwork = Map.fromList - [ ('Y', formatFullDate $ movieReleaseDate movie) - , ('a', Text.pack <$> artwork) - , ('d', Just (Text.take 255 $ movieOverview movie)) - , ('g', genreName <$> listToMaybe (movieGenres movie)) - , ('t', Just $ movieTitle movie) - , ('y', formatYear $ movieReleaseDate movie) - , ('f', Just $ Text.pack filename) - ] + formatMap artwork = + fromList + [ ('Y', formatFullDate $ movieReleaseDate movie), + ('a', toText <$> artwork), + ('d', Just (Text.take 255 $ movieOverview movie)), + ('g', genreName <$> listToMaybe (movieGenres movie)), + ('t', Just $ movieTitle movie), + ('y', formatYear $ movieReleaseDate movie), + ('f', Just $ toText filename) + ] diff --git a/src/Vimeta/UI/Common/TV.hs b/src/Vimeta/UI/Common/TV.hs --- a/src/Vimeta/UI/Common/TV.hs +++ b/src/Vimeta/UI/Common/TV.hs @@ -1,156 +1,137 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.UI.Common.TV - ( EpisodeSpec (..) - , tagWithMappingFile - , tagWithSpec - , tagWithFileOrder - , episodeSpec - ) where + ( 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 Relude.Extra.Map import Text.Parsec - --------------------------------------------------------------------------------- --- Local imports: import Vimeta.Core import qualified Vimeta.Core.MappingFile as MF --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | 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) + 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) - + Left e -> throwError e + Right cmd -> tagFile cmd where formatMap :: Maybe FilePath -> FormatTable - formatMap artwork = Map.fromList - [ ('Y', formatFullDate $ episodeAirDate episode) - , ('a', Text.pack <$> artwork) - , ('d', Just (Text.take 255 $ 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) - ] + formatMap artwork = + fromList + [ ('Y', formatFullDate $ episodeAirDate episode), + ('a', toText <$> artwork), + ('d', Just (Text.take 255 $ episodeOverview episode)), + ('e', Just . show $ episodeNumber episode), + ('f', Just $ toText file), + ('n', Just $ tvName tv), + ('s', Just . 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 :: + (MonadIO m) => + -- | Full TV series. + TV -> + -- | File mapping. + [(FilePath, EpisodeSpec)] -> + Vimeta m () tagWithSpec tv specs = do - let unmapped = lefts mapping + let unmapped = lefts mapping taggable = rights mapping unless (null unmapped) $ - die ("the following files can't be mapped to episodes " <> - Text.unpack (badFiles unmapped)) + throwError + ( "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) + mapping = map (\(f, s) -> check (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) + badFiles = + Text.intercalate "\n" + . map (\(f, s) -> toText 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 :: + (MonadIO m) => + -- | Full TV series. + TV -> + -- | Starting episode. + EpisodeSpec -> + -- | List of files to tag. + [FilePath] -> + 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) +episodeSpecAsText (EpisodeSpec s e) = "S" <> show s <> "E" <> 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) @@ -158,27 +139,29 @@ 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) +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 +makeTVMap = foldr insert mempty . flattenTV where insert :: EpisodeCtx -> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx - insert e = Map.insert (episodeSpecFromCtx e) e + insert e = (<> one (episodeSpecFromCtx e, e)) --------------------------------------------------------------------------------- episodeSpecParser :: MF.Parser EpisodeSpec -episodeSpecParser = - do void (oneOf "Ss") - season <- many1 digit +episodeSpecParser = go "episode spec (S#E#)" + where + go = do + void (oneOf "Ss") + season <- num "season number" - void (oneOf "Ee") - episode <- many1 digit + void (oneOf "Ee") + episode <- num "episode number" - return $ EpisodeSpec (read season) (read episode) - "episode spec (S#E#)" + return $ EpisodeSpec season episode + num = + many1 digit + <&> readMaybe + >>= maybe (fail "invalid number") pure diff --git a/src/Vimeta/UI/Common/Util.hs b/src/Vimeta/UI/Common/Util.hs --- a/src/Vimeta/UI/Common/Util.hs +++ b/src/Vimeta/UI/Common/Util.hs @@ -1,42 +1,35 @@ -{-# 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. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- Copyright: +-- This file is part of the package vimeta. It is subject to the +-- license terms in the LICENSE file found in the top-level +-- directory of this distribution and at: +-- +-- https://github.com/pjones/vimeta +-- +-- No part of this package, including this file, may be copied, +-- modified, propagated, or distributed except according to the terms +-- contained in the LICENSE file. +-- +-- License: BSD-2-Clause module Vimeta.UI.Common.Util - ( parens - , dayAsYear - , dayRange - ) where + ( parens, + dayAsYear, + dayRange, + ) +where --------------------------------------------------------------------------------- -import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Time (Day, formatTime) -import Data.Time.Locale.Compat (defaultTimeLocale) +import Data.Time (Day, defaultTimeLocale, formatTime) --------------------------------------------------------------------------------- -- | 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) +dayAsYear Nothing = "----" +dayAsYear (Just d) = toText (formatTime defaultTimeLocale "%Y" d) --------------------------------------------------------------------------------- -- | Given a start 'Day' and an end 'Day', produce a string -- representing a range. dayRange :: Maybe Day -> Maybe Day -> Text diff --git a/src/Vimeta/UI/Term/Common.hs b/src/Vimeta/UI/Term/Common.hs --- a/src/Vimeta/UI/Term/Common.hs +++ b/src/Vimeta/UI/Term/Common.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - {- This file is part of the vimeta package. It is subject to the license @@ -11,43 +9,19 @@ -} --------------------------------------------------------------------------------- module Vimeta.UI.Term.Common - ( byline - , notEmpty - , execVimetaBylineApp - ) where + ( notBlank, + ) +where --------------------------------------------------------------------------------- -import Control.Monad -import Control.Monad.Trans.Class (lift) -import Data.Text (Text) +import Byline import qualified Data.Text as Text -import System.Console.Byline hiding (ask) -import System.Exit (exitSuccess, exitFailure) -import Vimeta.Core -import Vimeta.Core.Vimeta (Vimeta(..)) --------------------------------------------------------------------------------- --- | Run a 'Byline' operation. -byline :: Byline IO a -> Vimeta (Byline IO) a -byline = Vimeta . lift . lift - --------------------------------------------------------------------------------- -notEmpty :: Stylized -> Text -> IO (Either Stylized Text) -notEmpty errortxt input = return $ if Text.length clean > 0 - then Right clean - else Left errortxt - where - clean :: Text - clean = Text.strip input - --------------------------------------------------------------------------------- --- | Helper function to run a 'Vimeta' value based in 'Byline'. -execVimetaBylineApp :: (Config -> Config) -> Vimeta (Byline IO) () -> IO () -execVimetaBylineApp cf vimeta = void $ runByline $ do - v <- execVimeta cf vimeta - - case v of - Right _ -> liftIO exitSuccess - Left e -> reportLn Error (text $ Text.pack e) >> liftIO exitFailure +-- | Check the input text to see if it is blank. If it is, return the +-- given error message in 'Left'. +notBlank :: Stylized Text -> Text -> Either (Stylized Text) Text +notBlank errortxt input = + let clean = Text.strip input + in if Text.null clean + then Left errortxt + else Right clean diff --git a/src/Vimeta/UI/Term/Movie.hs b/src/Vimeta/UI/Term/Movie.hs --- a/src/Vimeta/UI/Term/Movie.hs +++ b/src/Vimeta/UI/Term/Movie.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - {- This file is part of the vimeta package. It is subject to the license @@ -11,55 +9,53 @@ -} --------------------------------------------------------------------------------- -- | Search for a movie and interact with the user through the terminal. module Vimeta.UI.Term.Movie - ( movieSearch - ) where + ( movieSearch, + ) +where --------------------------------------------------------------------------------- -import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as Text +import Byline.Menu import Network.API.TheMovieDB -import System.Console.Byline -import Vimeta.Core hiding (ask) +import Vimeta.Core import Vimeta.UI.Common.Util import Vimeta.UI.Term.Common --------------------------------------------------------------------------------- --- | Search for a movie and interact with the user through the terminal. -movieSearch :: Text -> Vimeta (Byline IO) Movie -movieSearch initial = do - name <- byline $ askUntil searchPrompt (Just initial) (notEmpty searchErr) - movies <- tmdb (searchMovies name) - answer <- byline $ askWithMenuRepeatedly (mkMenu movies) prompt eprompt +-- | A wrapper around a movie. +newtype MovieItem = MovieItem Movie - case answer of - Match movie -> logID movie >> tmdb (fetchMovie (movieID movie)) - _ -> die "you need to pick a valid movie" +instance ToStylizedText MovieItem where + toStylizedText (MovieItem m) = + mconcat + [ text (movieTitle m), + text (parens $ dayAsYear $ movieReleaseDate m) + ] +-- | Search for a movie and interact with the user through the terminal. +movieSearch :: MonadIO m => Text -> Vimeta m Movie +movieSearch initial = do + name <- askUntil searchPrompt (Just initial) (return . notBlank searchErr) + movies <- + tmdb (searchMovies name) + >>= ( nonEmpty >>> \case + Nothing -> throwError ("no matches for: " <> toString name) + Just ms -> pure (MovieItem <$> ms) + ) + MovieItem movie <- askWithMenuRepeatedly (mkMenu movies) prompt eprompt + logID movie >> tmdb (fetchMovie (movieID movie)) where -- The Menu. - mkMenu movies = banner "Choose a movie:" (menu movies displayMovie) - + mkMenu movies = menuBanner (text "Choose a movie:") (menu movies) -- Search prompt. - searchPrompt = "search (movie name): " - + searchPrompt = text "search (movie name): " -- Search error text. searchErr = "please enter a valid search term" <> fg red - -- Menu prompt. - prompt = "Which is the correct movie? " - + prompt = text "Which is the correct movie? " -- Prompt when someone fails to pick a movie. eprompt = "please choose a valid movie" <> fg red - - -- Menu item display for a movie. - displayMovie m = mconcat [ text (movieTitle m) - , text (parens $ dayAsYear $ movieReleaseDate m) - ] - -- Log a movie ID. - logID movie = verbose $ "using movie ID: " <> - Text.pack (show $ movieID movie) + logID movie = + verbose $ + "using movie ID: " + <> show (movieID movie) diff --git a/src/Vimeta/UI/Term/TV.hs b/src/Vimeta/UI/Term/TV.hs --- a/src/Vimeta/UI/Term/TV.hs +++ b/src/Vimeta/UI/Term/TV.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - {- This file is part of the vimeta package. It is subject to the license @@ -11,47 +9,43 @@ -} --------------------------------------------------------------------------------- --- | Search for a TV series by interacting with the user through the terminal. +-- | Search for a TV series by interacting with the user through the +-- terminal. module Vimeta.UI.Term.TV - ( tvSearch - ) where + ( tvSearch, + ) +where --------------------------------------------------------------------------------- -import Data.Monoid -import qualified Data.Text as Text +import Byline.Menu import Network.API.TheMovieDB -import System.Console.Byline -import Vimeta.Core hiding (ask) +import Vimeta.Core import Vimeta.UI.Common.Util import Vimeta.UI.Term.Common --------------------------------------------------------------------------------- -tvSearch :: Vimeta (Byline IO) TV +newtype TVItem = TVItem TV + +instance ToStylizedText TVItem where + toStylizedText (TVItem series) = + mconcat + [ text (tvName series), + text (parens $ dayRange (tvFirstAirDate series) (tvLastAirDate series)) + ] + +tvSearch :: MonadIO m => Vimeta m TV tvSearch = do - let prompt = "search (series name): " - mprompt = "Which is the correct TV series? " + let prompt = text "search (series name): " + mprompt = text "Which is the correct TV series? " sprompt = "a search term is required" <> fg red eprompt = "please choose a TV series" <> fg red - - name <- byline (askUntil prompt Nothing $ notEmpty sprompt) - series <- tmdb (searchTV name) - answer <- byline $ askWithMenuRepeatedly (mkMenu series) mprompt eprompt - - case answer of - Match tv -> logID tv >> tmdb (fetchFullTVSeries (tvID tv)) - _ -> die "you need to pick a valid TV series" - - - where - -- The menu. - mkMenu series = banner "Choose a TV series:" (menu series displayTV) - - -- Function to display possible matches. - displayTV series = - mconcat [ text (tvName series) - , text (parens $ dayRange (tvFirstAirDate series) (tvLastAirDate series)) - ] + mkMenu = menuBanner (text "Choose a TV series:") . menu + logID tv = verbose $ "using TV ID: " <> show (tvID tv) - -- Log the TV ID. - logID tv = verbose $ "using TV ID: " <> Text.pack (show $ tvID tv) + name <- askUntil prompt Nothing (return . notBlank sprompt) + series <- + tmdb (searchTV name) + >>= ( nonEmpty >>> \case + Nothing -> throwError ("no matches for " <> toString name) + Just xs -> pure (TVItem <$> xs) + ) + TVItem tv <- askWithMenuRepeatedly (mkMenu series) mprompt eprompt + logID tv >> tmdb (fetchFullTVSeries (tvID tv)) diff --git a/vimeta.cabal b/vimeta.cabal --- a/vimeta.cabal +++ b/vimeta.cabal @@ -1,18 +1,18 @@ --------------------------------------------------------------------------------- -name: vimeta -version: 0.2.5.1 -synopsis: Frontend for video metadata tagging tools -homepage: https://code.devalot.com/open/vimeta -bug-reports: https://code.devalot.com/open/vimeta/issues -license: BSD2 -license-file: LICENSE -author: Peter Jones -maintainer: Peter Jones -copyright: Copyright (c) 2013-2019 Peter Jones -category: Video -stability: experimental -build-type: Simple -cabal-version: 1.18 +cabal-version: 2.2 +name: vimeta +version: 0.3.0.0 +synopsis: Frontend for video metadata tagging tools +homepage: https://github.com/pjones/vimeta +bug-reports: https://github.com/pjones/vimeta/issues +license: BSD-2-Clause +license-file: LICENSE +author: Peter Jones +maintainer: Peter Jones +copyright: Copyright (c) 2013-2020 Peter Jones +category: Video +stability: experimental +build-type: Simple +tested-with: GHC ==8.6.5 || ==8.8.3 || ==8.10.1 description: Vimeta is a tool to fetch video metadata from the interwebs and update video files using a tagging tool. @@ -21,15 +21,64 @@ extra-source-files: CHANGES.md README.md - TODO.org -------------------------------------------------------------------------------- source-repository head - type: git - location: https://code.devalot.com/open/vimeta.git + type: git + location: https://github.com/pjones/vimeta.git -------------------------------------------------------------------------------- +common options + default-language: Haskell2010 + ghc-options: + -Wall -Wno-name-shadowing -Werror=incomplete-record-updates + -Werror=incomplete-uni-patterns -Werror=missing-home-modules + -Widentities -Wmissing-export-lists -Wredundant-constraints + +-------------------------------------------------------------------------------- +common extensions + default-extensions: + DerivingStrategies + GeneralizedNewtypeDeriving + LambdaCase + MultiParamTypeClasses + OverloadedStrings + RecordWildCards + ScopedTypeVariables + TupleSections + +-------------------------------------------------------------------------------- +common dependencies + build-depends: + , aeson >=0.8 && <1.6 + , base >=4.6 && <5.0 + , byline ^>=1.0 + , bytestring ^>=0.10 + , directory >=1.2.3 && <1.4 + , exceptions ^>=0.10 + , filepath >=1.3 && <1.5 + , http-client >=0.4.30 && <0.8 + , http-client-tls >=0.2.2 && <0.4 + , http-types >=0.8 && <0.13 + , mtl >=2.1 && <2.3 + , optparse-applicative >=0.11 && <0.16 + , parsec ^>=3.1 + , process >=1.1 && <1.7 + , relude >=0.6 && <0.8 + , temporary >=1.1 && <1.4 + , text >=0.11 && <1.3 + , themoviedb ^>=1.2 + , time >=1.2 && <1.11 + , yaml >=0.8 && <0.12 + + mixins: + base hiding (Prelude), + relude (Relude as Prelude, Relude.Extra.Map) + +-------------------------------------------------------------------------------- library + import: options, extensions, dependencies + hs-source-dirs: src exposed-modules: Vimeta.Core Vimeta.Core.Cache @@ -52,41 +101,12 @@ Vimeta.UI.Term.Movie Vimeta.UI.Term.TV - other-modules: - Paths_vimeta - - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall -fwarn-incomplete-uni-patterns - - build-depends: base >= 4.6 && < 5.0 - , aeson >= 0.8 && < 1.5 - , byline >= 0.1 && < 1.0 - , bytestring >= 0.10 && < 0.11 - , containers >= 0.5 && < 0.7 - , directory >= 1.2 && < 1.4 - , either >= 4.3 && < 6 - , filepath >= 1.3 && < 1.5 - , http-client >= 0.4.30 && < 0.7 - , http-client-tls >= 0.2.2 && < 0.4 - , http-types >= 0.8 && < 0.13 - , mtl >= 2.1 && < 2.3 - , old-locale >= 1.0 && < 1.1 - , optparse-applicative >= 0.11 && < 0.15 - , parsec >= 3.1 && < 3.2 - , process >= 1.1 && < 1.7 - , temporary >= 1.1 && < 1.4 - , text >= 0.11 && < 1.3 - , themoviedb >= 1.1 && < 1.2 - , time >= 1.2 && < 1.10 - , time-locale-compat >= 0.1 && < 0.2 - , transformers >= 0.3 && < 0.6 - , xdg-basedir >= 0.2 && < 0.3 - , yaml >= 0.8 && < 0.12 + other-modules: Paths_vimeta + autogen-modules: Paths_vimeta -------------------------------------------------------------------------------- executable vimeta - default-language: Haskell2010 - main-is: src/Main.hs - build-depends: base, vimeta - ghc-options: -Wall -fwarn-incomplete-uni-patterns + import: options, extensions, dependencies + hs-source-dirs: app + main-is: Main.hs + build-depends: vimeta