Browse Source

Add the `config' command

tags/v0.2.0.0
Peter J. Jones 4 years ago
parent
commit
56e5861586
7 changed files with 217 additions and 14 deletions
  1. 2
    0
      default.nix
  2. 10
    6
      src/Main.hs
  3. 58
    0
      src/Vimeta/Config.hs
  4. 20
    8
      src/Vimeta/Context.hs
  5. 45
    0
      src/Vimeta/UI/CommandLine.hs
  6. 68
    0
      src/Vimeta/UI/CommandLine/Config.hs
  7. 14
    0
      vimeta.cabal

+ 2
- 0
default.nix View File

@@ -29,6 +29,8 @@ let
time
transformers
unix
xdg-basedir
yaml
]);

in stdenv.mkDerivation rec {

+ 10
- 6
src/Main.hs View File

@@ -1,16 +1,20 @@
{-

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.

-}

module Main where
import Vimeta.CommandLine (parseAndDispatch)
--------------------------------------------------------------------------------
module Main (main) where

--------------------------------------------------------------------------------
import qualified Vimeta.UI.CommandLine as CommandLine

--------------------------------------------------------------------------------
main :: IO ()
main = parseAndDispatch
main = CommandLine.run

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

@@ -16,6 +16,9 @@ the LICENSE file.
module Vimeta.Config
( Config (..)
, defaultConfig
, configFileName
, readConfig
, writeConfig
) where

--------------------------------------------------------------------------------
@@ -23,6 +26,10 @@ import Control.Applicative
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import Data.Text (Text)
import Data.Yaml (decodeFileEither, encodeFile)
import System.Directory (doesFileExist, createDirectoryIfMissing)
import System.Environment.XDG.BaseDir (getUserConfigFile)
import System.FilePath (takeDirectory)
import Vimeta.Tagger

--------------------------------------------------------------------------------
@@ -41,6 +48,13 @@ instance FromJSON Config where
<*> v .: "cmd_tv"
parseJSON x = typeMismatch "configuration" x

--------------------------------------------------------------------------------
instance ToJSON Config where
toJSON c = object [ "tmdb_key" .= configTMDBKey c
, "cmd_movie" .= configFormatMovie c
, "cmd_tv" .= configFormatTV c
]

--------------------------------------------------------------------------------
defaultConfig :: Tagger -> Config
defaultConfig tagger =
@@ -50,3 +64,47 @@ defaultConfig tagger =
}

where (fmtMovie, fmtTV) = formatStringsForTagger tagger

--------------------------------------------------------------------------------
-- | Get the name of the configuration file.
configFileName :: IO FilePath
configFileName = getUserConfigFile "vimeta" "config.yml"

--------------------------------------------------------------------------------
-- | Read the configuration file and return a 'Config' value or an error.
readConfig :: IO (Either String Config)
readConfig = do
filename <- configFileName
exists <- doesFileExist filename

if exists
then decodeConfig filename
else return (Left $ missingFile filename)

where
decodeConfig :: FilePath -> IO (Either String Config)
decodeConfig fn = do result <- decodeFileEither fn
return $ case result of
Left e -> Left (show e)
Right a -> Right a

missingFile :: FilePath -> String
missingFile fn = "no config file found, use the `config' command " ++
"to create " ++ fn

--------------------------------------------------------------------------------
writeConfig :: Config -> IO (Either String FilePath)
writeConfig c = do
filename <- configFileName
exists <- doesFileExist filename

-- mkdir -p `dirname filename`
createDirectoryIfMissing True (takeDirectory filename)

if exists
then return (Left $ existError filename)
else encodeFile filename c >> return (Right filename)

where
existError :: FilePath -> String
existError fn = "please remove the existing config file first: " ++ fn

+ 20
- 8
src/Vimeta/Context.hs View File

@@ -24,24 +24,36 @@ module Vimeta.Context
--------------------------------------------------------------------------------
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Trans.Either
import Network.HTTP.Client (Manager, withManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Vimeta.Config

--------------------------------------------------------------------------------
data Context = Context
{ ctxManager :: Manager
, ctxConfig :: Config
}

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

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

--------------------------------------------------------------------------------
runVimeta :: Vimeta a -> IO a
runVimeta m = withManager tlsManagerSettings go
where go manager = runReaderT (unV m) (context manager)
runVimeta :: Vimeta a -> IO (Either String a)
runVimeta m = do
configE <- readConfig

case configE of
Left e -> return (Left e)
Right cfg -> withManager tlsManagerSettings (go cfg)

where
go config manager =
let ctx = context manager config
in runEitherT $ runReaderT (unV m) ctx

+ 45
- 0
src/Vimeta/UI/CommandLine.hs View File

@@ -0,0 +1,45 @@
{-

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.UI.CommandLine (run) where

--------------------------------------------------------------------------------
import Data.Monoid
import qualified Data.Text as Text
import Options.Applicative
import System.Console.Byline
import System.Exit
import qualified Vimeta.UI.CommandLine.Config as Config

--------------------------------------------------------------------------------
data Command = CmdConfig Config.Options

--------------------------------------------------------------------------------
optionsParser :: Parser Command
optionsParser = subparser $ mconcat [config]
where
config = command "config"
(info (CmdConfig <$> Config.optionsParser) (progDesc configDesc))

configDesc = "Create a new configuration file"

--------------------------------------------------------------------------------
run :: IO ()
run = do
options <- execParser $ info (optionsParser <**> helper) idm
result <- case options of
CmdConfig o -> Config.run o

case result of
Right _ -> exitSuccess
Left e -> do runByline (reportLn Error $ text $ Text.pack e)
exitFailure

+ 68
- 0
src/Vimeta/UI/CommandLine/Config.hs View File

@@ -0,0 +1,68 @@
{-# 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.UI.CommandLine.Config
( Options
, optionsParser
, run
) where

--------------------------------------------------------------------------------
import Control.Monad.Error
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import Options.Applicative
import System.Console.Byline
import Vimeta.Config
import Vimeta.Tagger

--------------------------------------------------------------------------------
data Options = Options
{ optsKey :: Maybe Text
, optsTagger :: Tagger
}

--------------------------------------------------------------------------------
optionsParser :: Parser Options
optionsParser = Options <$> (optional $ Text.pack <$> strOption getKey)
<*> pure AtomicParsley

where
-- Parser options for @optsKey@
getKey = mconcat [ short 'k'
, long "key"
, metavar "KEY"
, help "Set the API key to KEY"
]

--------------------------------------------------------------------------------
run :: Options -> IO (Either String ())
run opts = do
let def = defaultConfig (optsTagger opts)
config = case optsKey opts of
Nothing -> def
Just k -> def {configTMDBKey = k}

runErrorT $ do
result <- ErrorT $ writeConfig config

case optsKey opts of
Just _ -> return ()
Nothing -> liftIO (reportMissing result)

where
reportMissing fn = runByline (reportLn Warning $ missingKey fn)
missingKey fn = "please edit the config file and set the API key: " <>
text (Text.pack fn)

+ 14
- 0
vimeta.cabal View File

@@ -41,6 +41,8 @@ library
Vimeta.Download
Vimeta.Format
Vimeta.Tagger
Vimeta.UI.CommandLine
Vimeta.UI.CommandLine.Config

hs-source-dirs: src
default-language: Haskell2010
@@ -52,8 +54,12 @@ library

build-depends: aeson >= 0.8 && < 0.9
, base >= 4.6 && < 5.0
, byline >= 0.1 && < 0.2
, bytestring >= 0.10 && < 0.11
, containers >= 0.5 && < 0.6
, directory >= 1.2 && < 1.3
, either >= 4.3 && < 4.4
, filepath >= 1.3 && < 1.4
, http-client >= 0.4 && < 0.5
, http-client-tls >= 0.2.2 && < 0.3
, http-types >= 0.8 && < 0.9
@@ -65,12 +71,14 @@ library
, text >= 0.11 && < 1.3
, themoviedb >= 1.0 && < 1.1
, time >= 1.2 && < 1.6
, xdg-basedir >= 0.2 && < 0.3
, yaml >= 0.8 && < 0.9

--------------------------------------------------------------------------------
executable vimeta
default-language: Haskell2010
main-is: src/Main.hs
build-depends: base, vimeta

if flag(maintainer)
ghc-options: -Werror

Loading…
Cancel
Save