module Vimeta.UI.Common.TV
( EpisodeSpec (..)
, tagWithMappingFile
, tagWithSpec
, tagWithFileOrder
, episodeSpec
) where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Data.Either
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import Network.API.TheMovieDB
import Text.Parsec
import Vimeta.Core
import qualified Vimeta.Core.MappingFile as MF
import Prelude
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 -> 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)
]
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) $
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)
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" <> Text.pack (show s) <>
"E" <> Text.pack (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 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#)"