canteven-config 0.1.0.1 → 1.0.0.0

raw patch · 2 files changed

+14/−139 lines, 2 filesdep −aesondep −directorydep −filepathPVP ok

version bump matches the API change (PVP)

Dependencies removed: aeson, directory, filepath, hslogger, text

API changes (from Hackage documentation)

Files

• canteven-config.cabal +8/−13
• src/Canteven/Config.hs +6/−126

@@ -2,16 +2,14 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                canteven-config-version:             0.1.0.1+version:             1.0.0.0 synopsis:            A pattern for configuring programs. description:         Turns out, all of our executables shared the same sort of-                     pattern: Parse the command line to locate a config file,-                     read and parse the config file, set up `hslogger` based on-                     some stuff found in the config file, and pass the rest of-                     the config to the actual program. This library makes doing-                     that pattern super easy. It is meant to be a rather-                     particular (as opposed to general) solution for this sort-                     of problem.+                     pattern for extracting configuration out of the+                     environment: find a YAML config file based on the command+                     line arguments and parse that file into a haskell value using+                     the yaml package. This package makes that process super+                     trivial. license:             Apache-2.0 license-file:        LICENSE author:              Rick Owens@@ -28,13 +26,10 @@   -- other-modules:          -- other-extensions:       build-depends:-    aeson,     base >= 4 && < 5,-    directory,-    filepath,-    hslogger,-    text,     unix,     yaml   hs-source-dirs:      src   default-language:    Haskell2010+  ghc-options: -Wall+

@@ -7,49 +7,16 @@ ) where  -import Control.Applicative ((<$>), liftA2)-import Data.Aeson (Value(String, Object), (.:?), (.!=), (.:))-import Data.Maybe (fromMaybe)-import Data.Yaml (FromJSON(parseJSON), decodeFileEither)+import Data.Yaml (FromJSON, decodeFileEither) import System.Console.GetOpt(ArgOrder(Permute), ArgDescr(ReqArg, NoArg),   OptDescr(Option), getOpt, usageInfo)-import System.Directory (createDirectoryIfMissing) import System.Environment (getArgs, getProgName) import System.Exit (ExitCode(ExitSuccess, ExitFailure))-import System.FilePath (dropFileName)-import System.IO (stdout)-import System.Log (Priority(INFO, DEBUG))-import System.Log.Formatter (simpleLogFormatter)-import System.Log.Handler (setFormatter)-import System.Log.Handler.Simple (fileHandler, streamHandler)-import System.Log.Logger (updateGlobalLogger, setHandlers, setLevel) import System.Posix.Process (exitImmediately)-import qualified Data.Text as T   canteven :: (FromJSON config) => IO config-canteven = do-  configPath <- parseOptions-  (userConfig, systemConfig) <- loadConfig configPath-  setupLogging systemConfig-  return userConfig---{- |-  Defines all the "system" config, where "system" means everything that-  Moonshine knows about.--}-data SystemConfig =-  SystemConfig {-    logging :: Maybe LoggingConfig-  }--instance FromJSON SystemConfig where-  parseJSON (Object topLevel) = do-    logging <- topLevel .:? "logging"-    return SystemConfig {logging}-  parseJSON value =-    fail $ "Couldn't parse system config from value " ++ show value+canteven = loadConfig =<< parseOptions   {- |@@ -60,74 +27,17 @@          deriving Show  -data LoggingConfig =-  LoggingConfig {-    level :: LogPriority,-    logfile :: Maybe FilePath,-    loggers :: [LoggerDetails]-  }--instance FromJSON LoggingConfig where-  parseJSON (Object logging) = do-    level <- logging .:? "level" .!= LP INFO-    logfile <- logging .:? "logfile"-    loggers <- logging .:? "loggers" .!= []-    return LoggingConfig {level, logfile, loggers}-  parseJSON value =-    fail $ "Couldn't parse logging config from value " ++ show value---setupLogging :: SystemConfig -> IO ()-setupLogging SystemConfig {logging} =-  installLoggingConfig (fromMaybe defaultLoggingConfig logging)---defaultLoggingConfig :: LoggingConfig-defaultLoggingConfig = LoggingConfig {-  level = LP INFO,-  logfile = Nothing,-  loggers = []-  }-- {- |-  Do all of the things that it takes to get logging set up the way we-  want it.--}-installLoggingConfig :: LoggingConfig -> IO ()-installLoggingConfig LoggingConfig {logfile, level = LP level, loggers} = do-  fileHandlers <--    case logfile of-      Nothing -> return []-      Just filename -> do-        createDirectoryIfMissing True (dropFileName filename)-        file <- tweak <$> fileHandler filename DEBUG-        return [file]--  console <- tweak <$> streamHandler stdout DEBUG-  let handlers = console:fileHandlers-  updateGlobalLogger "" (setLevel level . setHandlers handlers)-  sequence_ [-      updateGlobalLogger loggerName (setLevel loggerLevel) |-      LoggerDetails {loggerName, loggerLevel = LP loggerLevel} <- loggers-    ]-  where-    tweak h = setFormatter h (simpleLogFormatter logFormat)-    logFormat = "$prio [$tid] [$time] $loggername - $msg"---{- |   Load the configuration from YAML. -}-loadConfig :: FromJSON a => FilePath -> IO (a, SystemConfig)+loadConfig :: FromJSON a => FilePath -> IO a loadConfig path = do   eUserConfig <- decodeFileEither path-  eSystemConfig <- decodeFileEither path-  case liftA2 (,) eUserConfig eSystemConfig of+  case eUserConfig of     Left errorMsg -> error $       "Couldn't decode YAML config from file "       ++ path ++ ": " ++ show errorMsg-    Right configs -> return configs+    Right config -> return config   {- |@@ -139,7 +49,7 @@   case getOpt Permute options args of     ([], [], []) ->                  return "config.yml"-    ([Config config], [], []) ->+    ([Config config], _, []) ->                  return config     ([Help], [], []) -> do                  usage@@ -163,35 +73,5 @@     die = do       exitImmediately (ExitFailure 1)       error "can't reach this statement"---{- |-  A wrapper for Priority, so we can avoid orphan instances--}-newtype LogPriority = LP Priority--instance FromJSON LogPriority where-  parseJSON (String s) = case reads (T.unpack s) of-    [(priority, "")] -> return (LP priority)-    _ -> fail $ "couldn't parse Priority from string " ++ show s-  parseJSON value = fail $ "Couldn't parse Priority from value " ++ show value---{- |-  A way to set more fined-grained configuration for specific loggers.--}-data LoggerDetails =-  LoggerDetails {-    loggerName :: String,-    loggerLevel :: LogPriority-  }--instance FromJSON LoggerDetails where-  parseJSON (Object details) = do-    loggerName <- details .: "logger"-    loggerLevel <- details .: "level"-    return LoggerDetails {loggerName, loggerLevel}-  parseJSON value =-    fail $ "Couldn't parse logger details from value " ++ show value