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
data EpisodeSpec = EpisodeSpec Int Int deriving (Show, Eq, Ord)
data EpisodeCtx = EpisodeCtx TV Season Episode deriving (Show, Eq, Ord)
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)
]
tagWithMappingFile :: (MonadIO m) => TV -> FilePath -> Vimeta m ()
tagWithMappingFile tv filename = do
mapping <- parseMappingFile filename episodeSpecParser
tagWithSpec tv mapping
tagWithSpec ::
(MonadIO m) =>
TV ->
[(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)
tagWithFileOrder ::
(MonadIO m) =>
TV ->
EpisodeSpec ->
[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
episodeSpec :: Episode -> EpisodeSpec
episodeSpec e = EpisodeSpec (episodeSeasonNumber e) (episodeNumber e)
episodeSpecFromCtx :: EpisodeCtx -> EpisodeSpec
episodeSpecFromCtx (EpisodeCtx _ _ e) = episodeSpec e
episodeSpecAsText :: EpisodeSpec -> Text
episodeSpecAsText (EpisodeSpec s e) = "S" <> show s <> "E" <> show e
flattenTV :: TV -> [EpisodeCtx]
flattenTV t = concatMap (\s -> forSeason s (seasonEpisodes s)) (tvSeasons t)
where
forSeason :: Season -> [Episode] -> [EpisodeCtx]
forSeason s = map (EpisodeCtx t s)
startingAt :: EpisodeSpec -> [EpisodeCtx] -> [EpisodeCtx]
startingAt spec = dropWhile (\(EpisodeCtx _ _ e) -> spec /= episodeSpec e)
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