-- |
--
-- 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 (Int -> EpisodeSpec -> ShowS
[EpisodeSpec] -> ShowS
EpisodeSpec -> String
(Int -> EpisodeSpec -> ShowS)
-> (EpisodeSpec -> String)
-> ([EpisodeSpec] -> ShowS)
-> Show EpisodeSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpisodeSpec] -> ShowS
$cshowList :: [EpisodeSpec] -> ShowS
show :: EpisodeSpec -> String
$cshow :: EpisodeSpec -> String
showsPrec :: Int -> EpisodeSpec -> ShowS
$cshowsPrec :: Int -> EpisodeSpec -> ShowS
Show, EpisodeSpec -> EpisodeSpec -> Bool
(EpisodeSpec -> EpisodeSpec -> Bool)
-> (EpisodeSpec -> EpisodeSpec -> Bool) -> Eq EpisodeSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpisodeSpec -> EpisodeSpec -> Bool
$c/= :: EpisodeSpec -> EpisodeSpec -> Bool
== :: EpisodeSpec -> EpisodeSpec -> Bool
$c== :: EpisodeSpec -> EpisodeSpec -> Bool
Eq, Eq EpisodeSpec
Eq EpisodeSpec
-> (EpisodeSpec -> EpisodeSpec -> Ordering)
-> (EpisodeSpec -> EpisodeSpec -> Bool)
-> (EpisodeSpec -> EpisodeSpec -> Bool)
-> (EpisodeSpec -> EpisodeSpec -> Bool)
-> (EpisodeSpec -> EpisodeSpec -> Bool)
-> (EpisodeSpec -> EpisodeSpec -> EpisodeSpec)
-> (EpisodeSpec -> EpisodeSpec -> EpisodeSpec)
-> Ord EpisodeSpec
EpisodeSpec -> EpisodeSpec -> Bool
EpisodeSpec -> EpisodeSpec -> Ordering
EpisodeSpec -> EpisodeSpec -> EpisodeSpec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EpisodeSpec -> EpisodeSpec -> EpisodeSpec
$cmin :: EpisodeSpec -> EpisodeSpec -> EpisodeSpec
max :: EpisodeSpec -> EpisodeSpec -> EpisodeSpec
$cmax :: EpisodeSpec -> EpisodeSpec -> EpisodeSpec
>= :: EpisodeSpec -> EpisodeSpec -> Bool
$c>= :: EpisodeSpec -> EpisodeSpec -> Bool
> :: EpisodeSpec -> EpisodeSpec -> Bool
$c> :: EpisodeSpec -> EpisodeSpec -> Bool
<= :: EpisodeSpec -> EpisodeSpec -> Bool
$c<= :: EpisodeSpec -> EpisodeSpec -> Bool
< :: EpisodeSpec -> EpisodeSpec -> Bool
$c< :: EpisodeSpec -> EpisodeSpec -> Bool
compare :: EpisodeSpec -> EpisodeSpec -> Ordering
$ccompare :: EpisodeSpec -> EpisodeSpec -> Ordering
$cp1Ord :: Eq EpisodeSpec
Ord)

-- | An episode along with the season.
data EpisodeCtx = EpisodeCtx TV Season Episode deriving (Int -> EpisodeCtx -> ShowS
[EpisodeCtx] -> ShowS
EpisodeCtx -> String
(Int -> EpisodeCtx -> ShowS)
-> (EpisodeCtx -> String)
-> ([EpisodeCtx] -> ShowS)
-> Show EpisodeCtx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpisodeCtx] -> ShowS
$cshowList :: [EpisodeCtx] -> ShowS
show :: EpisodeCtx -> String
$cshow :: EpisodeCtx -> String
showsPrec :: Int -> EpisodeCtx -> ShowS
$cshowsPrec :: Int -> EpisodeCtx -> ShowS
Show, EpisodeCtx -> EpisodeCtx -> Bool
(EpisodeCtx -> EpisodeCtx -> Bool)
-> (EpisodeCtx -> EpisodeCtx -> Bool) -> Eq EpisodeCtx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpisodeCtx -> EpisodeCtx -> Bool
$c/= :: EpisodeCtx -> EpisodeCtx -> Bool
== :: EpisodeCtx -> EpisodeCtx -> Bool
$c== :: EpisodeCtx -> EpisodeCtx -> Bool
Eq, Eq EpisodeCtx
Eq EpisodeCtx
-> (EpisodeCtx -> EpisodeCtx -> Ordering)
-> (EpisodeCtx -> EpisodeCtx -> Bool)
-> (EpisodeCtx -> EpisodeCtx -> Bool)
-> (EpisodeCtx -> EpisodeCtx -> Bool)
-> (EpisodeCtx -> EpisodeCtx -> Bool)
-> (EpisodeCtx -> EpisodeCtx -> EpisodeCtx)
-> (EpisodeCtx -> EpisodeCtx -> EpisodeCtx)
-> Ord EpisodeCtx
EpisodeCtx -> EpisodeCtx -> Bool
EpisodeCtx -> EpisodeCtx -> Ordering
EpisodeCtx -> EpisodeCtx -> EpisodeCtx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EpisodeCtx -> EpisodeCtx -> EpisodeCtx
$cmin :: EpisodeCtx -> EpisodeCtx -> EpisodeCtx
max :: EpisodeCtx -> EpisodeCtx -> EpisodeCtx
$cmax :: EpisodeCtx -> EpisodeCtx -> EpisodeCtx
>= :: EpisodeCtx -> EpisodeCtx -> Bool
$c>= :: EpisodeCtx -> EpisodeCtx -> Bool
> :: EpisodeCtx -> EpisodeCtx -> Bool
$c> :: EpisodeCtx -> EpisodeCtx -> Bool
<= :: EpisodeCtx -> EpisodeCtx -> Bool
$c<= :: EpisodeCtx -> EpisodeCtx -> Bool
< :: EpisodeCtx -> EpisodeCtx -> Bool
$c< :: EpisodeCtx -> EpisodeCtx -> Bool
compare :: EpisodeCtx -> EpisodeCtx -> Ordering
$ccompare :: EpisodeCtx -> EpisodeCtx -> Ordering
$cp1Ord :: Eq EpisodeCtx
Ord)

-- | Tag a single file with the given 'EpisodeCtx'.
tagFileWithEpisode :: (MonadIO m) => FilePath -> EpisodeCtx -> Vimeta m ()
tagFileWithEpisode :: String -> EpisodeCtx -> Vimeta m ()
tagFileWithEpisode String
file (EpisodeCtx TV
tv Season
season Episode
episode) = do
  Context
context <- Vimeta m Context
forall r (m :: * -> *). MonadReader r m => m r
ask

  let format :: Text
format = Config -> Text
configFormatTV (Context -> Config
ctxConfig Context
context)
      tmdbCfg :: Configuration
tmdbCfg = Context -> Configuration
ctxTMDBCfg Context
context

  [Text] -> (Maybe String -> Vimeta IO ()) -> Vimeta m ()
forall (m :: * -> *) a.
MonadIO m =>
[Text] -> (Maybe String -> Vimeta IO a) -> Vimeta m a
withArtwork (Configuration -> Season -> [Text]
seasonPosterURLs Configuration
tmdbCfg Season
season) ((Maybe String -> Vimeta IO ()) -> Vimeta m ())
-> (Maybe String -> Vimeta IO ()) -> Vimeta m ()
forall a b. (a -> b) -> a -> b
$ \Maybe String
artwork ->
    case FormatTable -> String -> Text -> Either String Text
fromFormatString (Maybe String -> FormatTable
formatMap Maybe String
artwork) String
"config.tv" Text
format of
      Left String
e -> String -> Vimeta IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
e
      Right Text
cmd -> Text -> Vimeta IO ()
tagFile Text
cmd
  where
    formatMap :: Maybe FilePath -> FormatTable
    formatMap :: Maybe String -> FormatTable
formatMap Maybe String
artwork =
      [Item FormatTable] -> FormatTable
forall l. IsList l => [Item l] -> l
fromList
        [ (Char
'Y', Maybe Day -> Maybe Text
formatFullDate (Maybe Day -> Maybe Text) -> Maybe Day -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Episode -> Maybe Day
episodeAirDate Episode
episode),
          (Char
'a', String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
artwork),
          (Char
'd', Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
Text.take Int
255 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Episode -> Text
episodeOverview Episode
episode)),
          (Char
'e', Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Int -> Text) -> Int -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Maybe Text) -> Int -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Episode -> Int
episodeNumber Episode
episode),
          (Char
'f', Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
file),
          (Char
'n', Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TV -> Text
tvName TV
tv),
          (Char
's', Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Int -> Text) -> Int -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Maybe Text) -> Int -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Episode -> Int
episodeSeasonNumber Episode
episode),
          (Char
't', Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Episode -> Text
episodeName Episode
episode),
          (Char
'y', Maybe Day -> Maybe Text
formatYear (Maybe Day -> Maybe Text) -> Maybe Day -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Episode -> Maybe Day
episodeAirDate Episode
episode)
        ]

-- | Handy tagging function using mapping files.
tagWithMappingFile :: (MonadIO m) => TV -> FilePath -> Vimeta m ()
tagWithMappingFile :: TV -> String -> Vimeta m ()
tagWithMappingFile TV
tv String
filename = do
  [(String, EpisodeSpec)]
mapping <- String -> Parser EpisodeSpec -> Vimeta m [(String, EpisodeSpec)]
forall (m :: * -> *) a.
MonadIO m =>
String -> Parser a -> Vimeta m [(String, a)]
parseMappingFile String
filename Parser EpisodeSpec
episodeSpecParser
  TV -> [(String, EpisodeSpec)] -> Vimeta m ()
forall (m :: * -> *).
MonadIO m =>
TV -> [(String, EpisodeSpec)] -> Vimeta m ()
tagWithSpec TV
tv [(String, EpisodeSpec)]
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 -> [(String, EpisodeSpec)] -> Vimeta m ()
tagWithSpec TV
tv [(String, EpisodeSpec)]
specs = do
  let unmapped :: [(String, EpisodeSpec)]
unmapped = [Either (String, EpisodeSpec) (String, EpisodeCtx)]
-> [(String, EpisodeSpec)]
forall a b. [Either a b] -> [a]
lefts [Either (String, EpisodeSpec) (String, EpisodeCtx)]
mapping
      taggable :: [(String, EpisodeCtx)]
taggable = [Either (String, EpisodeSpec) (String, EpisodeCtx)]
-> [(String, EpisodeCtx)]
forall a b. [Either a b] -> [b]
rights [Either (String, EpisodeSpec) (String, EpisodeCtx)]
mapping

  Bool -> Vimeta m () -> Vimeta m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(String, EpisodeSpec)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, EpisodeSpec)]
unmapped) (Vimeta m () -> Vimeta m ()) -> Vimeta m () -> Vimeta m ()
forall a b. (a -> b) -> a -> b
$
    String -> Vimeta m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      ( String
"the following files can't be mapped to episodes "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack ([(String, EpisodeSpec)] -> Text
badFiles [(String, EpisodeSpec)]
unmapped)
      )

  ((String, EpisodeCtx) -> Vimeta m ())
-> [(String, EpisodeCtx)] -> Vimeta m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> EpisodeCtx -> Vimeta m ())
-> (String, EpisodeCtx) -> Vimeta m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> EpisodeCtx -> Vimeta m ()
forall (m :: * -> *).
MonadIO m =>
String -> EpisodeCtx -> Vimeta m ()
tagFileWithEpisode) [(String, EpisodeCtx)]
taggable
  where
    table :: Map EpisodeSpec EpisodeCtx
    table :: Map EpisodeSpec EpisodeCtx
table = TV -> Map EpisodeSpec EpisodeCtx
makeTVMap TV
tv
    mapping :: [Either (FilePath, EpisodeSpec) (FilePath, EpisodeCtx)]
    mapping :: [Either (String, EpisodeSpec) (String, EpisodeCtx)]
mapping = ((String, EpisodeSpec)
 -> Either (String, EpisodeSpec) (String, EpisodeCtx))
-> [(String, EpisodeSpec)]
-> [Either (String, EpisodeSpec) (String, EpisodeCtx)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
f, EpisodeSpec
s) -> Maybe EpisodeCtx
-> String
-> EpisodeSpec
-> Either (String, EpisodeSpec) (String, EpisodeCtx)
check (Key (Map EpisodeSpec EpisodeCtx)
-> Map EpisodeSpec EpisodeCtx
-> Maybe (Val (Map EpisodeSpec EpisodeCtx))
forall t. StaticMap t => Key t -> t -> Maybe (Val t)
lookup Key (Map EpisodeSpec EpisodeCtx)
EpisodeSpec
s Map EpisodeSpec EpisodeCtx
table) String
f EpisodeSpec
s) [(String, EpisodeSpec)]
specs
    check ::
      Maybe EpisodeCtx ->
      FilePath ->
      EpisodeSpec ->
      Either (FilePath, EpisodeSpec) (FilePath, EpisodeCtx)
    check :: Maybe EpisodeCtx
-> String
-> EpisodeSpec
-> Either (String, EpisodeSpec) (String, EpisodeCtx)
check Maybe EpisodeCtx
Nothing String
f EpisodeSpec
s = (String, EpisodeSpec)
-> Either (String, EpisodeSpec) (String, EpisodeCtx)
forall a b. a -> Either a b
Left (String
f, EpisodeSpec
s)
    check (Just EpisodeCtx
e) String
f EpisodeSpec
_ = (String, EpisodeCtx)
-> Either (String, EpisodeSpec) (String, EpisodeCtx)
forall a b. b -> Either a b
Right (String
f, EpisodeCtx
e)
    badFiles :: [(FilePath, EpisodeSpec)] -> Text
    badFiles :: [(String, EpisodeSpec)] -> Text
badFiles =
      Text -> [Text] -> Text
Text.intercalate Text
"\n"
        ([Text] -> Text)
-> ([(String, EpisodeSpec)] -> [Text])
-> [(String, EpisodeSpec)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, EpisodeSpec) -> Text)
-> [(String, EpisodeSpec)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
f, EpisodeSpec
s) -> String -> Text
forall a. ToText a => a -> Text
toText String
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EpisodeSpec -> Text
episodeSpecAsText EpisodeSpec
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 -> EpisodeSpec -> [String] -> Vimeta m ()
tagWithFileOrder TV
tv EpisodeSpec
spec [String]
files = TV -> [(String, EpisodeSpec)] -> Vimeta m ()
forall (m :: * -> *).
MonadIO m =>
TV -> [(String, EpisodeSpec)] -> Vimeta m ()
tagWithSpec TV
tv [(String, EpisodeSpec)]
mapping
  where
    mapping :: [(FilePath, EpisodeSpec)]
    mapping :: [(String, EpisodeSpec)]
mapping = (String -> EpisodeCtx -> (String, EpisodeSpec))
-> [String] -> [EpisodeCtx] -> [(String, EpisodeSpec)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
f EpisodeCtx
e -> (String
f, EpisodeCtx -> EpisodeSpec
episodeSpecFromCtx EpisodeCtx
e)) [String]
files [EpisodeCtx]
episodes
    episodes :: [EpisodeCtx]
    episodes :: [EpisodeCtx]
episodes = Int -> [EpisodeCtx] -> [EpisodeCtx]
forall a. Int -> [a] -> [a]
take ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
files) ([EpisodeCtx] -> [EpisodeCtx]) -> [EpisodeCtx] -> [EpisodeCtx]
forall a b. (a -> b) -> a -> b
$ EpisodeSpec -> [EpisodeCtx] -> [EpisodeCtx]
startingAt EpisodeSpec
spec ([EpisodeCtx] -> [EpisodeCtx]) -> [EpisodeCtx] -> [EpisodeCtx]
forall a b. (a -> b) -> a -> b
$ TV -> [EpisodeCtx]
flattenTV TV
tv

-- | Create an 'EpisodeSpec' from an 'Episode'.
episodeSpec :: Episode -> EpisodeSpec
episodeSpec :: Episode -> EpisodeSpec
episodeSpec Episode
e = Int -> Int -> EpisodeSpec
EpisodeSpec (Episode -> Int
episodeSeasonNumber Episode
e) (Episode -> Int
episodeNumber Episode
e)

-- | Create an 'EpisodeSpec' from an 'EpisodeCtx'.
episodeSpecFromCtx :: EpisodeCtx -> EpisodeSpec
episodeSpecFromCtx :: EpisodeCtx -> EpisodeSpec
episodeSpecFromCtx (EpisodeCtx TV
_ Season
_ Episode
e) = Episode -> EpisodeSpec
episodeSpec Episode
e

-- | Turn an 'EpisodeSpec' into something that can be printed.
episodeSpecAsText :: EpisodeSpec -> Text
episodeSpecAsText :: EpisodeSpec -> Text
episodeSpecAsText (EpisodeSpec Int
s Int
e) = Text
"S" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"E" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
e

-- | Flatten a TV/Season/Episode tree into a list of episodes.
flattenTV :: TV -> [EpisodeCtx]
flattenTV :: TV -> [EpisodeCtx]
flattenTV TV
t = (Season -> [EpisodeCtx]) -> [Season] -> [EpisodeCtx]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Season
s -> Season -> [Episode] -> [EpisodeCtx]
forSeason Season
s (Season -> [Episode]
seasonEpisodes Season
s)) (TV -> [Season]
tvSeasons TV
t)
  where
    forSeason :: Season -> [Episode] -> [EpisodeCtx]
    forSeason :: Season -> [Episode] -> [EpisodeCtx]
forSeason Season
s = (Episode -> EpisodeCtx) -> [Episode] -> [EpisodeCtx]
forall a b. (a -> b) -> [a] -> [b]
map (TV -> Season -> Episode -> EpisodeCtx
EpisodeCtx TV
t Season
s)

-- | Drop all episodes until the matching 'EpisodeSpec' is found.
startingAt :: EpisodeSpec -> [EpisodeCtx] -> [EpisodeCtx]
startingAt :: EpisodeSpec -> [EpisodeCtx] -> [EpisodeCtx]
startingAt EpisodeSpec
spec = (EpisodeCtx -> Bool) -> [EpisodeCtx] -> [EpisodeCtx]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(EpisodeCtx TV
_ Season
_ Episode
e) -> EpisodeSpec
spec EpisodeSpec -> EpisodeSpec -> Bool
forall a. Eq a => a -> a -> Bool
/= Episode -> EpisodeSpec
episodeSpec Episode
e)

-- | Make an episode look-up table.
makeTVMap :: TV -> Map EpisodeSpec EpisodeCtx
makeTVMap :: TV -> Map EpisodeSpec EpisodeCtx
makeTVMap = (EpisodeCtx
 -> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx)
-> Map EpisodeSpec EpisodeCtx
-> [EpisodeCtx]
-> Map EpisodeSpec EpisodeCtx
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr EpisodeCtx
-> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx
insert Map EpisodeSpec EpisodeCtx
forall a. Monoid a => a
mempty ([EpisodeCtx] -> Map EpisodeSpec EpisodeCtx)
-> (TV -> [EpisodeCtx]) -> TV -> Map EpisodeSpec EpisodeCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TV -> [EpisodeCtx]
flattenTV
  where
    insert :: EpisodeCtx -> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx
    insert :: EpisodeCtx
-> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx
insert EpisodeCtx
e = (Map EpisodeSpec EpisodeCtx
-> Map EpisodeSpec EpisodeCtx -> Map EpisodeSpec EpisodeCtx
forall a. Semigroup a => a -> a -> a
<> OneItem (Map EpisodeSpec EpisodeCtx) -> Map EpisodeSpec EpisodeCtx
forall x. One x => OneItem x -> x
one (EpisodeCtx -> EpisodeSpec
episodeSpecFromCtx EpisodeCtx
e, EpisodeCtx
e))

episodeSpecParser :: MF.Parser EpisodeSpec
episodeSpecParser :: Parser EpisodeSpec
episodeSpecParser = Parser EpisodeSpec
forall u. ParsecT Text u Identity EpisodeSpec
go Parser EpisodeSpec -> String -> Parser EpisodeSpec
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"episode spec (S#E#)"
  where
    go :: ParsecT Text u Identity EpisodeSpec
go = do
      ParsecT Text u Identity Char -> ParsecT Text u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"Ss")
      Int
season <- ParsecT Text u Identity Int
forall u. ParsecT Text u Identity Int
num ParsecT Text u Identity Int
-> String -> ParsecT Text u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"season number"

      ParsecT Text u Identity Char -> ParsecT Text u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"Ee")
      Int
episode <- ParsecT Text u Identity Int
forall u. ParsecT Text u Identity Int
num ParsecT Text u Identity Int
-> String -> ParsecT Text u Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"episode number"

      EpisodeSpec -> ParsecT Text u Identity EpisodeSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (EpisodeSpec -> ParsecT Text u Identity EpisodeSpec)
-> EpisodeSpec -> ParsecT Text u Identity EpisodeSpec
forall a b. (a -> b) -> a -> b
$ Int -> Int -> EpisodeSpec
EpisodeSpec Int
season Int
episode
    num :: ParsecT Text u Identity Int
num =
      ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
        ParsecT Text u Identity String
-> (String -> Maybe Int) -> ParsecT Text u Identity (Maybe Int)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe
        ParsecT Text u Identity (Maybe Int)
-> (Maybe Int -> ParsecT Text u Identity Int)
-> ParsecT Text u Identity Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParsecT Text u Identity Int
-> (Int -> ParsecT Text u Identity Int)
-> Maybe Int
-> ParsecT Text u Identity Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT Text u Identity Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid number") Int -> ParsecT Text u Identity Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure