-- | -- -- 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 import qualified Data.Text as Text import Network.API.TheMovieDB import Relude.Extra.Map import Text.Parsec import Vimeta.Core import qualified Vimeta.Core.MappingFile as MF -- | 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 -> throwError e Right cmd -> tagFile cmd where formatMap :: Maybe FilePath -> FormatTable 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) => -- | Full TV series. TV -> -- | File mapping. [(FilePath, EpisodeSpec)] -> Vimeta m () tagWithSpec tv specs = do let unmapped = lefts mapping taggable = rights mapping unless (null 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 (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) -> toText f <> " " <> episodeSpecAsText s) -- | Tag the given files, starting at the given 'EpisodeSpec'. 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" <> 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) 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 mempty . flattenTV where insert :: EpisodeCtx -> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx insert e = (<> one (episodeSpecFromCtx e, e)) episodeSpecParser :: MF.Parser EpisodeSpec episodeSpecParser = go "episode spec (S#E#)" where go = do void (oneOf "Ss") season <- num "season number" void (oneOf "Ee") episode <- num "episode number" return $ EpisodeSpec season episode num = many1 digit <&> readMaybe >>= maybe (fail "invalid number") pure