rename-movies.hs

#!/usr/bin/env stack
{-
 stack
 --resolver lts-8.11
 --install-ghc
 runghc
 --package aeson
 --package filepath
 --package http-client-tls
 -- -Wall
-}
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import Control.Monad
import Data.Aeson
import Data.Char
import Data.Monoid
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import System.FilePath

data Rename = Rename
    { _rFrom :: FilePath
    , _rTo :: FilePath
    }

data Movie = Movie
    { mTitle :: String
    , mReleaseYear :: String
    }

instance FromJSON Movie where
    parseJSON = withObject "Movie" $ \o -> Movie
        <$> o .: "title"
        <*> (take 4 <$> o .: "release_date")

data SearchResults = SearchResults
    { _sPage :: Int
    , _sTotalPages :: Int
    , _sTotalResults :: Int
    , sResults :: [Movie]
    }

instance FromJSON SearchResults where
    parseJSON = withObject "SearchResults" $ \o -> SearchResults
        <$> o .: "page"
        <*> o .: "total_pages"
        <*> o .: "total_results"
        <*> o .: "results"

main :: IO ()
main = do
    mgr <- newManager tlsManagerSettings
    paths <- lines <$> readFile "movies.txt"
    renames <- mapM (propose mgr) paths

    forM_ renames $ \(Rename from to) ->
        putStrLn $ "aws s3 cp '" <> from <> "' 's3://pb.media/movies/" <> to <> "'"

propose :: Manager -> FilePath -> IO Rename
propose mgr fp =
    either
        (\_ -> Rename fp inferred)
        (\ms -> Rename fp $ fromMovies ms)
        <$> search mgr (toQuery fp)

  where
    inferred = map underscored (toQuery fp) <.> takeExtension fp

    fromMovies (m:_) = map underscored (mTitle m) <> "_" <> mReleaseYear m <.> takeExtension fp
    fromMovies _ = inferred

search :: Manager -> String -> IO (Either String [Movie])
search mgr query = do
    let url = mconcat
            [ apiBase, "/search/movie"
            , "?api_key=", apiToken
            , "&query=", query
            , "&language=en"
            ]

    req <- parseUrlThrow url
    body <- responseBody <$> httpLbs req mgr

    return $ sResults <$> eitherDecode body

  where
    apiBase = "https://api.themoviedb.org/3"
    apiToken = "..."

toQuery :: FilePath -> String
toQuery =
    unwords . map capitalize . words .
    map spaced . dropExtension . takeFileName

capitalize :: String -> String
capitalize [] = []
capitalize (c:cs) = toUpper c : cs

spaced :: Char -> Char
spaced '_' = ' '
spaced x = x

underscored :: Char -> Char
underscored ' ' = '_'
underscored x = x

-- vim: ft=haskell