{-# LANGUAGE OverloadedStrings #-} {- This file is part of the vimeta package. It is subject to the license terms in the LICENSE file found in the top-level directory of this distribution and at git://pmade.com/vimeta/LICENSE. No part of the vimeta package, including this file, may be copied, modified, propagated, or distributed except according to the terms contained in the LICENSE file. -} -------------------------------------------------------------------------------- module Vimeta.UI.Common.TV ( EpisodeSpec (..) , tagWithMappingFile , tagWithSpec , tagWithFileOrder , episodeSpec ) where -------------------------------------------------------------------------------- import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Data.Either import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid import Data.Text (Text) import qualified Data.Text as Text import Network.API.TheMovieDB import Text.Parsec -------------------------------------------------------------------------------- -- 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) tmdbCfg = ctxTMDBCfg context withArtwork (seasonPosterURLs tmdbCfg season) $ \artwork -> case fromFormatString (formatMap artwork) "config.tv" format of Left e -> die e Right cmd -> tagFile (Text.unpack cmd) where formatMap :: Maybe FilePath -> FormatTable formatMap artwork = Map.fromList [ ('Y', formatFullDate $ episodeAirDate episode) , ('a', Text.pack <$> artwork) , ('d', Just (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) ] -------------------------------------------------------------------------------- -- | Handy tagging function using mapping files. tagWithMappingFile :: (MonadIO m) => TV -> FilePath -> Vimeta m () tagWithMappingFile tv filename = do mapping <- parseMappingFile filename episodeSpecParser tagWithSpec tv mapping -------------------------------------------------------------------------------- -- | Tag all of the given files with their matching 'EpisodeSpec'. tagWithSpec :: (MonadIO m) => TV -- ^ Full TV series. -> [(FilePath, EpisodeSpec)] -- ^ File mapping. -> Vimeta m () tagWithSpec tv specs = do let unmapped = lefts mapping taggable = rights mapping unless (null unmapped) $ die ("the following files can't be mapped to episodes " <> Text.unpack (badFiles unmapped)) mapM_ (uncurry tagFileWithEpisode) taggable where table :: Map EpisodeSpec EpisodeCtx table = makeTVMap tv mapping :: [Either (FilePath, EpisodeSpec) (FilePath, EpisodeCtx)] mapping = map (\(f, s) -> check (Map.lookup s table) f s) specs check :: Maybe EpisodeCtx -> FilePath -> EpisodeSpec -> Either (FilePath, EpisodeSpec) (FilePath, EpisodeCtx) check Nothing f s = Left (f, s) check (Just e) f _ = Right (f, e) badFiles :: [(FilePath, EpisodeSpec)] -> Text badFiles = Text.intercalate "\n" . map (\(f, s) -> Text.pack f <> " " <> episodeSpecAsText s) -------------------------------------------------------------------------------- -- | Tag the given files, starting at the given 'EpisodeSpec'. tagWithFileOrder :: (MonadIO m) => TV -- ^ Full TV series. -> EpisodeSpec -- ^ Starting episode. -> [FilePath] -- ^ List of files to tag. -> Vimeta m () tagWithFileOrder tv spec files = tagWithSpec tv mapping where mapping :: [(FilePath, EpisodeSpec)] mapping = zipWith (\f e -> (f, episodeSpecFromCtx e)) files episodes episodes :: [EpisodeCtx] episodes = take (length files) $ startingAt spec $ flattenTV tv -------------------------------------------------------------------------------- -- | Create an 'EpisodeSpec' from an 'Episode'. episodeSpec :: Episode -> EpisodeSpec episodeSpec e = EpisodeSpec (episodeSeasonNumber e) (episodeNumber e) -------------------------------------------------------------------------------- -- | Create an 'EpisodeSpec' from an 'EpisodeCtx'. episodeSpecFromCtx :: EpisodeCtx -> EpisodeSpec episodeSpecFromCtx (EpisodeCtx _ _ e) = episodeSpec e -------------------------------------------------------------------------------- -- | Turn an 'EpisodeSpec' into something that can be printed. episodeSpecAsText :: EpisodeSpec -> Text episodeSpecAsText (EpisodeSpec s e) = "S" <> Text.pack (show s) <> "E" <> Text.pack (show e) -------------------------------------------------------------------------------- -- | Flatten a TV/Season/Episode tree into a list of episodes. flattenTV :: TV -> [EpisodeCtx] flattenTV t = concatMap (\s -> forSeason s (seasonEpisodes s)) (tvSeasons t) where forSeason :: Season -> [Episode] -> [EpisodeCtx] forSeason s = map (EpisodeCtx t s) -------------------------------------------------------------------------------- -- | Drop all episodes until the matching 'EpisodeSpec' is found. startingAt :: EpisodeSpec -> [EpisodeCtx] -> [EpisodeCtx] startingAt spec = dropWhile (\(EpisodeCtx _ _ e)-> spec /= episodeSpec e) -------------------------------------------------------------------------------- -- | Make an episode look-up table. makeTVMap :: TV -> Map EpisodeSpec EpisodeCtx makeTVMap = foldr insert Map.empty . flattenTV where insert :: EpisodeCtx -> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx insert e = Map.insert (episodeSpecFromCtx e) e -------------------------------------------------------------------------------- episodeSpecParser :: MF.Parser EpisodeSpec episodeSpecParser = do void (oneOf "Ss") season <- many1 digit void (oneOf "Ee") episode <- many1 digit return $ EpisodeSpec (read season) (read episode) "episode spec (S#E#)"