Browse Source

Working on the new vimeta tool, one source file at a time

tags/v0.2.0.0
Peter J. Jones 4 years ago
parent
commit
e7b283522b
6 changed files with 236 additions and 35 deletions
  1. 52
    0
      src/Vimeta/Config.hs
  2. 47
    0
      src/Vimeta/Context.hs
  3. 34
    21
      src/Vimeta/Download.hs
  4. 13
    8
      src/Vimeta/Format.hs
  5. 66
    0
      src/Vimeta/Tagger.hs
  6. 24
    6
      vimeta.cabal

+ 52
- 0
src/Vimeta/Config.hs View File

@@ -0,0 +1,52 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
-- | The configuration file.
module Vimeta.Config
( Config (..)
, defaultConfig
) where

--------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import Data.Text (Text)
import Vimeta.Tagger

--------------------------------------------------------------------------------
-- | Vimeta configuration.
data Config = Config
{ configTMDBKey :: Text
, configFormatMovie :: Text
, configFormatTV :: Text
}

--------------------------------------------------------------------------------
instance FromJSON Config where
parseJSON (Object v) =
Config <$> v .: "tmdb_key"
<*> v .: "cmd_movie"
<*> v .: "cmd_tv"
parseJSON x = typeMismatch "configuration" x

--------------------------------------------------------------------------------
defaultConfig :: Tagger -> Config
defaultConfig tagger =
Config { configTMDBKey = "your API key goes here"
, configFormatMovie = fmtMovie
, configFormatTV = fmtTV
}

where (fmtMovie, fmtTV) = formatStringsForTagger tagger

+ 47
- 0
src/Vimeta/Context.hs View File

@@ -0,0 +1,47 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Vimeta.Context
( Vimeta (..)
, Context (..)
, runVimeta
, ask
, asks
, liftIO
) where

--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad.Reader
import Network.HTTP.Client (Manager, withManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)

--------------------------------------------------------------------------------
data Context = Context
{ ctxManager :: Manager
}

--------------------------------------------------------------------------------
newtype Vimeta a = Vimeta {unV :: ReaderT Context IO a}
deriving (Functor, Applicative, Monad, MonadIO,
MonadReader Context)

--------------------------------------------------------------------------------
context :: Manager -> Context
context man = Context man

--------------------------------------------------------------------------------
runVimeta :: Vimeta a -> IO a
runVimeta m = withManager tlsManagerSettings go
where go manager = runReaderT (unV m) (context manager)

+ 34
- 21
src/Vimeta/Download.hs View File

@@ -1,8 +1,8 @@
{-

This file is part of the Haskell package vimeta. It is subject to the
license terms in the LICENSE file found in the top-level directory of
this distribution and at git://pmade.com/vimeta/LICENSE. No part of
This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.
@@ -10,32 +10,44 @@ the LICENSE file.
-}

--------------------------------------------------------------------------------
-- | Utility functions for downloading files.
module Vimeta.Download (download) where

--------------------------------------------------------------------------------
-- | Imports.
import qualified Data.ByteString.Lazy as BS
import qualified Network.HTTP.Client as HC
import Network.HTTP.Types
import System.IO
import System.IO (Handle, hFlush)
import System.IO.Temp (withSystemTempFile)
import Vimeta.Context

--------------------------------------------------------------------------------
download :: Maybe String -- ^ URL.
-> (Maybe FilePath -> IO a) -- ^ Function to run on downloaded file.
-> IO a -- ^ Result of above function.
download url f =
case url of
Nothing -> f Nothing
Just url' -> withSystemTempFile "vimeta.img" $ \name handle -> $ do
downloadTo url' handle
f (Just name)
-- | Download the given URL to a temporary file and pass the file
-- name to the given function.
download :: Maybe String
-- ^ URL.

-> (Maybe FilePath -> Vimeta a)
-- ^ Function to call and pass the file name to.

-> Vimeta a
-- ^ Result of above function.

download Nothing f = f Nothing
download (Just url) f = do
manager <- asks ctxManager

name <- liftIO $ withSystemTempFile "vimeta" $ \name handle -> do
downloadToHandle manager url handle
return name

f (Just name)

--------------------------------------------------------------------------------
downloadTo :: String -> Handle -> IO ()
downloadTo url handle = do
request <- HC.parseUrl url
withManager $ \manager -> do
response <- HC.httpLbs request manager
BS.hPut handle (HC.responseBody r)
hFlush handle
-- | Helper function to the actual HTTP downloading into a file handle.
downloadToHandle :: HC.Manager -> String -> Handle -> IO ()
downloadToHandle manager url handle = do
request <- HC.parseUrl url
response <- HC.httpLbs request manager
BS.hPut handle (HC.responseBody response)
hFlush handle

+ 13
- 8
src/Vimeta/Format.hs View File

@@ -2,9 +2,9 @@

{-

This file is part of the Haskell package vimeta. It is subject to the
license terms in the LICENSE file found in the top-level directory of
this distribution and at git://pmade.com/vimeta/LICENSE. No part of
This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.
@@ -17,20 +17,25 @@ module Vimeta.Format (format) where
--------------------------------------------------------------------------------
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text

--------------------------------------------------------------------------------
-- | Replace format characters prefixed with a @%@ with the
-- replacement text found in the given 'Map'.
format :: Map Char Text -- ^ Format character mapping.
-> Text -- ^ Input text.
-> Text -- ^ Output text.
format map input = Text.concat $ replaceAll $ Text.splitOn "%" input
format table = Text.concat . replaceAll . Text.splitOn "%"
where
replaceAll :: [Text] -> [Text]
replaceAll [] = []
replaceAll (left:matches) = left ; map replaceOne matches
replaceAll (left:matches) = left : map replaceOne matches

replaceOne :: Text -> Text
replaceOne raw = case Map.lookup (Text.take 1 raw) map of
Nothing -> raw
Just new -> new <> Text.drop 1 raw
replaceOne raw
| Text.null raw = raw
| otherwise = case Map.lookup (raw `Text.index` 0) table of
Nothing -> raw
Just new -> new <> Text.drop 1 raw

+ 66
- 0
src/Vimeta/Tagger.hs View File

@@ -0,0 +1,66 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the vimeta package. It is subject to the license
terms in the LICENSE file found in the top-level directory of this
distribution and at git://pmade.com/vimeta/LICENSE. No part of the
vimeta package, including this file, may be copied, modified,
propagated, or distributed except according to the terms contained in
the LICENSE file.

-}

--------------------------------------------------------------------------------
module Vimeta.Tagger
( Tagger (..)
, formatStringsForTagger
) where

--------------------------------------------------------------------------------
import Data.Text (Text)
import qualified Data.Text as Text

--------------------------------------------------------------------------------
data Tagger = AtomicParsley

--------------------------------------------------------------------------------
formatStringsForTagger :: Tagger -> (Text, Text)
formatStringsForTagger AtomicParsley = (apMovie, apTV)

--------------------------------------------------------------------------------
-- | Common strings for AtomicParsley.
apPrefix, apSuffix :: Text
apPrefix = "AtomicParsley"
apSuffix = "--overWrite"

--------------------------------------------------------------------------------
-- | Format string for movies.
apMovie :: Text
apMovie = Text.intercalate " "
[ apPrefix
, "--stik value=9"
, "--year %y"
, "--title %t"
, "--description %d"
, "--genre %g"
, "--artwork REMOVE_ALL --artwork %a"
, apSuffix
]

--------------------------------------------------------------------------------
-- | Format string for TV episodes.
apTV :: Text
apTV = Text.intercalate " "
[ apPrefix
, "--stik 'TV Show'"
, "--year %y"
, "--title %t"
, "--description %d"
, "--TVShowName %n"
, "--TVSeasonNum %s"
, "--TVEpisodeNum %e"
, "--tracknum %e"
, "--artwork REMOVE_ALL --artwork %a"
, apSuffix
]

+ 24
- 6
vimeta.cabal View File

@@ -34,21 +34,30 @@ flag maintainer
default: False

--------------------------------------------------------------------------------
executable vimeta
default-language: Haskell2010
hs-source-dirs: src
main-is: Main.hs
other-modules:
library
exposed-modules:
Vimeta.Config
Vimeta.Context
Vimeta.Download
Vimeta.Format
Vimeta.Tagger

hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall -fwarn-incomplete-uni-patterns
ghc-prof-options: -prof -auto-all

if flag(maintainer)
ghc-options: -Werror

build-depends: base >= 4.6 && < 5.0
build-depends: aeson >= 0.8 && < 0.9
, base >= 4.6 && < 5.0
, bytestring >= 0.10 && < 0.11
, containers >= 0.5 && < 0.6
, http-client >= 0.4 && < 0.5
, http-client-tls >= 0.2.2 && < 0.3
, http-types >= 0.8 && < 0.9
, mtl >= 2.1 && < 2.2
, old-locale >= 1.0 && < 1.1
, optparse-applicative >= 0.11 && < 0.12
, process >= 1.1 && < 1.3
@@ -56,3 +65,12 @@ executable vimeta
, text >= 0.11 && < 1.3
, themoviedb >= 1.0 && < 1.1
, time >= 1.2 && < 1.6

--------------------------------------------------------------------------------
-- executable vimeta
-- default-language: Haskell2010
-- hs-source-dirs: src
-- main-is: Main.hs

-- if flag(maintainer)
-- ghc-options: -Werror

Loading…
Cancel
Save