app-settings (empty) → 0.1.0.0

raw patch · 6 files changed

+509/−0 lines, 6 filesdep +HUnitdep +basedep +containerssetup-changed

Dependencies added: HUnit, base, containers, directory, hspec, mtl, parsec, text

Files

Data/AppSettings.hs +233/−0
Data/Serialization.hs +78/−0
LICENSE +30/−0
Setup.hs +2/−0
app-settings.cabal +46/−0
tests/Tests.hs +120/−0

+ Data/AppSettings.hs view

@@ -0,0 +1,233 @@+{-# LANGUAGE RankNTypes #-}++-- |+-- A library to deal with application settings.+-- This library deals with read-write application settings.+-- You will have to specify the settings that your application+-- uses, their name, types and default values.+-- Setting types must implement the 'Read' and 'Show' typeclasses. +--+-- The settings are saved in a file in an INI-like key-value format+-- (without sections).+--+-- Reading and updating settings is done in pure code, the IO+-- monad is only used to load settings and save them to disk.+-- It is advised for the user to create a module in your project+-- holding settings handling.+--+-- You can then declare settings:+--+-- > fontSize :: Setting Double+-- > fontSize = Setting "fontSize" 14+-- > +-- > dateFormat :: Setting String+-- > dateFormat = Setting "dateFormat" "%x"+-- > +-- > backgroundColor :: Setting (Int, Int, Int)+-- > backgroundColor = Setting "backcolor" (255, 0, 0)+--+-- Optionally you can declare the list of all your settings:+--+-- > defaultConfig :: DefaultConfig+-- > defaultConfig = getDefaultConfig $ do+-- >     setting fontSize+-- >     setting dateFormat+-- >     setting backgroundColor+--+-- If you do it, 'saveSettings' will also save settings+-- which have not been modified, which are still at their+-- default value in the configuration file, in a commented+-- form, as a documentation to the user who may open the+-- configuration file.+-- So for instance if you declare this default configuration+-- and have set the font size to 16 but left the other+-- settings untouched, the configuration file which will be+-- saved will be:+--+-- > fontSize=16+-- > # dateFormat="%x"+-- > # backcolor=(255,0,0)+--+-- If you did not specify the list of settings, only the+-- first line would be present in the configuration file.+--+-- Once we declared the settings, we can read the configuration+-- from disk (and your settings module should export your wrapper+-- around the function offered by this library):+--+-- > readResult <- try $ readSettings (AutoFromAppName "test")+-- > case readResult of+-- > 	Right (conf, GetSetting getSetting) -> do+-- > 		let textSize = getSetting textSizeFromWidth+-- > 		saveSettings getDefaultConfig (AutoFromAppName "test") conf+-- > 	Left (x :: SomeException) -> error "Error reading the config file!"+--+-- 'AutoFromAppName' specifies where to save the configuration file.+-- And we've already covered the getSetting in this snippet, see +-- the 'readSettings' documentation for further information.++module Data.AppSettings (+	Conf,+	DefaultConfig,+	Setting(..),+	GetSetting(..),+	setting,+	getDefaultConfig,+	emptyDefaultConfig,+	FileLocation(..),+	readSettings,+	ParseException,+	saveSettings,+	setSetting) where++import System.Directory+import qualified Data.Map as M+import Control.Monad.State+import Text.Read (readMaybe)+import Data.Maybe (fromMaybe)++import Data.Serialization++-- http://stackoverflow.com/questions/23117205/+newtype GetSetting = GetSetting (forall a. Read a => Setting a -> a)++-- for the tests...+instance Show GetSetting where+	show _ = "GetSetting"++-- | The type of a setting.+-- It contains the setting name+-- (key in the configuration file) and its default value.+--+-- It is advised to have a module in your project handling settings.+-- In this module, you'd have all the settings declared at the+-- toplevel, and exported.+-- The rest of the application can then do+--+-- @+-- getSetting \<setting\>+-- setSetting \<setting\> \<value\>+-- @+--+-- and so on.+data Setting a = Setting { name :: String, defaultValue :: a }++-- | Information about the default configuration. Contains+-- all the settings (that you declare using 'getDefaultConfig')+-- and their default values. It is useful when you save a+-- configuration file, if you give this information to 'saveSettings',+-- it will save default options in the configuration file+-- in a commented form, as a form of documentation to a user+-- who would edit the configuration file.+-- However this is completely optional, you can give+-- 'emptyDefaultConfig' if you don't want this behaviour.+newtype DefaultConfig = DefaultConfig Conf++-- | Default configuration containing no options. It's fine+-- to give that to 'saveSettings' if you don't want default+-- settings being written to the configuration file in+-- commented form (see 'DefaultConfig')+emptyDefaultConfig :: DefaultConfig+emptyDefaultConfig = DefaultConfig M.empty++-- | see the 'getDefaultConfig' documentation.+setting :: (Show a) => Setting a -> State Conf ()+setting (Setting nameV defaultV) = do+	soFar <- get+	put $ M.insert nameV (SettingInfo { value = show defaultV, userSet = False }) soFar++-- | Used in combination with 'setting' to register settings.+-- Registering settings is optional, see 'DefaultConfig'.+--+-- @+-- defaultSettings :: DefaultConfig+-- defaultSettings = getDefaultConfig $ do+--     setting \<setting1\>+--     setting \<setting2\>+-- @+getDefaultConfig :: State Conf () -> DefaultConfig+getDefaultConfig actions = do+	DefaultConfig $ execState actions M.empty++-- | Where to look for or store the configuration file.+data FileLocation = AutoFromAppName String+		    -- ^ Automatically build the location based on the+		    -- application name. It will be ~\/.\<app name\>\/config.ini.+		  | Path FilePath+		    -- ^ Absolute path to a location on disk.++getPathForLocation :: FileLocation -> IO FilePath+getPathForLocation location = case location of+	AutoFromAppName appName -> getConfigFileName appName+	Path path -> return path++-- | Read settings from disk.+-- Because it is doing file I/O it is smart to wrap the call+-- with a 'try', as I/O exceptions can be thrown.+-- Also, the function will throw a 'ParseException' if the+-- file is not properly formatted.+-- NOTE that if the file is properly formatted in general,+-- but a value is stored in an invalid format (for instance \"hello\"+-- for a Double), you will get no error and get the default value+-- for that setting when you attempt to read it.+--+-- This function returns a pair. The first element+-- is the configuration itself, which you can use to save+-- back or modify the configuration.+-- The second element is a function wrapped in the 'GetSetting'+-- newtype. This function allows you to read a configuration+-- option simply by giving that option (without that callback+-- you'd have to call getSetting settings \<setting\>, so+-- the callback lets you save a parameter).+--+-- Example of use:+--+-- @+-- readResult <- try $ readSettings (Path \"my.config\")+-- case readResult of+-- 	Right (conf, GetSetting getSetting) -> do+-- 		let textSize = getSetting textSizeFromWidth+-- 		saveSettings getDefaultConfig (Path \"my.config\") conf+-- 	Left (x :: SomeException) -> error \"Error reading the config file!\"+-- @+readSettings :: FileLocation -> IO (Conf, GetSetting)+readSettings location = do+	filePath <- getPathForLocation location+	exists <- doesFileExist filePath+	conf <- if exists+		then readConfigFile filePath+		else return M.empty+	return (conf, GetSetting $ getSetting' conf)++-- | It is advised to run the save within a try call+-- because it does disk I/O, otherwise the call is straightforward.+saveSettings :: DefaultConfig -> FileLocation -> Conf -> IO ()+saveSettings (DefaultConfig defaults) location conf = do+	filePath <- getPathForLocation location+	writeConfigFile filePath (M.union conf defaults)++-- TODO maybe another getSetting that'll tell you+-- if the setting is invalid in the config file instead of silently+-- give you the default?+getSetting' :: (Read a) => Conf -> Setting a -> a+getSetting' conf (Setting key defaultV) = fromMaybe defaultV $ getSettingValueFromConf conf key++getSettingValueFromConf :: Read a => Conf -> String -> Maybe a+getSettingValueFromConf conf key = do+	asString <- M.lookup key conf+	readMaybe $ value asString++-- | Change the value of a setting. You'll have to call+-- 'saveSettings' so that the change is written to disk.+setSetting :: (Show a) => Conf -> Setting a -> a -> Conf+setSetting conf (Setting key _) v = M.insert key (SettingInfo { value = show v, userSet=True }) conf++getSettingsFolder :: String -> IO FilePath+getSettingsFolder appName = do+	home <- getHomeDirectory+	let result = home ++ "/." ++ appName ++ "/"+	createDirectoryIfMissing False result+	return result++getConfigFileName :: String -> IO String+getConfigFileName appName = fmap (++"config.ini") $ getSettingsFolder appName

+ Data/Serialization.hs view

@@ -0,0 +1,78 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module Data.Serialization (+	Conf,+	SettingInfo(..),+	readConfigFile,+	writeConfigFile,+	ParseException) where++import System.IO+import qualified Data.Text.IO as T+import qualified Data.Map as M+import Text.ParserCombinators.Parsec+import Text.Parsec.Text as T+import Control.Monad (unless, when)+import Control.Exception (throwIO, Exception)+import Data.Typeable (Typeable)+import System.Directory (doesFileExist, copyFile)++data SettingInfo = SettingInfo { value :: String, userSet :: Bool } deriving (Show, Eq)++-- | The in-memory configuration data.+type Conf = M.Map String SettingInfo++-- | The configuration file is in an invalid format.+data ParseException = ParseException FilePath String+	deriving (Show, Typeable)+instance Exception ParseException++readConfigFile :: FilePath -> IO Conf+readConfigFile path = do+	contents <- T.readFile path+	case parse parseConfigFile "" contents of+		Left _ -> throwIO $ ParseException path "Invalid configuration file"+		Right v -> return v++data ConfigElement = ConfigEntry String String+	| Comment++isConfigEntry :: ConfigElement -> Bool+isConfigEntry (ConfigEntry _ _) = True+isConfigEntry _ = False++parseConfigFile :: T.GenParser st Conf+parseConfigFile = do+	elements <- many $ parseComment <|> parseConfigEntry+	let configEntries = filter isConfigEntry elements+	return $ M.fromList $ map (\(ConfigEntry a b) ->+		(a, SettingInfo {value=b, userSet=True})) configEntries++parseComment :: T.GenParser st ConfigElement+parseComment = do+	char '#'+	many $ noneOf "\r\n"+	many $ oneOf "\r\n"+	return Comment++parseConfigEntry :: T.GenParser st ConfigElement+parseConfigEntry = do+	key <- many $ noneOf "=\r\n"+	char '='+	val <- many $ noneOf "\r\n"+	many $ oneOf "\r\n"+	return $ ConfigEntry key val++writeConfigFile :: FilePath -> Conf -> IO ()+writeConfigFile path config = do+	whenM (doesFileExist path) $+		copyFile path $ path ++ ".bak"+	withFile path WriteMode $ \handle -> do+		hPutStrLn handle "# This file is autogenerated. You can change, comment and uncomment settings but text comments you may add will be lost."+		mapM_ (uncurry $ writeConfigEntry handle) $ M.toList config+	where whenM s r = s >>= flip when r++writeConfigEntry :: Handle -> String -> SettingInfo -> IO ()+writeConfigEntry handle key (SettingInfo sValue sUserSet) = do+	unless sUserSet $ hPutStr handle "# "+	hPutStrLn handle $ key ++ "=" ++ sValue

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2014, Emmanuel Touzery++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Emmanuel Touzery nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app-settings.cabal view

@@ -0,0 +1,46 @@+-- Initial app-settings.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                app-settings+version:             0.1.0.0+synopsis:            A library to manage application settings (INI file-like)+-- description:         +homepage:            https://github.com/emmanueltouzery/app-settings+license:             BSD3+license-file:        LICENSE+author:              Emmanuel Touzery+maintainer:          etouzery@gmail.com+-- copyright:           +category:            Configuration+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Data.AppSettings+  other-modules:       Data.Serialization+  -- other-extensions:    +  build-depends:       base >=4.6 && <4.7,+                       mtl == 2.1.*,+                       containers == 0.5.*,+                       directory == 1.2.*,+                       text >= 0.10,+                       parsec == 3.1.*+  -- hs-source-dirs:      +  default-language:    Haskell2010+  Ghc-Options:         -Wall++test-suite             tests+  type:                 exitcode-stdio-1.0+  hs-source-dirs: ., tests+  main-is: Tests.hs+  default-language:    Haskell2010+  build-depends:       base,+                       hspec >= 1.8 && <1.9,+                       HUnit >= 1.2 && <1.3,+                       mtl == 2.1.*,+                       containers == 0.5.*,+                       directory == 1.2.*,+                       text >= 0.10,+                       parsec == 3.1.*+  Ghc-Options:         -Wall

+ tests/Tests.hs view

@@ -0,0 +1,120 @@+{-# LANGUAGE ScopedTypeVariables #-}++import Data.AppSettings++import Test.Hspec+import Test.HUnit (assertBool)++import System.Directory (removeFile, copyFile, doesFileExist)+import Control.Exception (try, SomeException)++textSizeFromWidth :: Setting Double+textSizeFromWidth = Setting "textSizeFromWidth" 0.04++textFill :: Setting (Double,Double,Double,Double)+textFill = Setting "textFill" (1, 1, 0, 1)++textSizeFromHeight :: Setting Double+textSizeFromHeight = Setting "textSizeFromHeight" 12.4++defaultConfig :: DefaultConfig+defaultConfig = getDefaultConfig $ do+	setting textSizeFromWidth+	setting textSizeFromHeight+	setting textFill++main :: IO ()+main = hspec $ do+	describe "load config" $ do+		testEmptyFileDefaults+		testPartialFileDefaults+		testFileWithComments+		testInvalidFile+		testInvalidValue+		testNonExistingFile+	describe "save config" $ do+		testSaveUserSetAndDefaults+		createBakBeforeSaving++testEmptyFileDefaults :: Spec+testEmptyFileDefaults = it "parses correctly an empty file with defaults" $ do+	readResult <- try $ readSettings (Path "tests/empty.config")+	case readResult of+		Right (_, GetSetting getSetting) -> do+			getSetting textSizeFromWidth `shouldBe` 0.04+			getSetting textSizeFromHeight `shouldBe` 12.4+			getSetting textFill `shouldBe` (1,1,0,1)+		Left (x :: SomeException) -> assertBool (show x) False++testPartialFileDefaults :: Spec+testPartialFileDefaults = it "parses correctly a partial file with defaults" $ do+	readResult <- try $ readSettings (Path "tests/partial.config")+	case readResult of+		Right (_, GetSetting getSetting) -> do+			getSetting textSizeFromWidth `shouldBe` 1.02+			getSetting textSizeFromHeight `shouldBe` 12.4+			getSetting textFill `shouldBe` (1,2,3,4)+		Left (x :: SomeException) -> assertBool (show x) False++testFileWithComments :: Spec+testFileWithComments = it "parses correctly a partial file with comments" $ do+	readResult <- try $ readSettings (Path "tests/test-save.txt")+	case readResult of+		Right (_, GetSetting getSetting) -> do+			getSetting textSizeFromWidth `shouldBe` 1.02+			getSetting textSizeFromHeight `shouldBe` 12.4+			getSetting textFill `shouldBe` (1,2,3,4)+		Left (x :: SomeException) -> assertBool (show x) False++testInvalidValue :: Spec+testInvalidValue = it "parses correctly a file with invalid values" $ do+	readResult <- try $ readSettings (Path "tests/brokenvalue.config")+	case readResult of+		Right (_, GetSetting getSetting) -> do+			-- give the default for the invalid value+			getSetting textSizeFromWidth `shouldBe` 0.04+			getSetting textSizeFromHeight `shouldBe` 12.4+			getSetting textFill `shouldBe` (1,2,3,4)+		Left (x :: SomeException) -> assertBool (show x) False++testNonExistingFile :: Spec+testNonExistingFile = it "returns empty config for a non-existing file" $ do+	readResult <- try $ readSettings (Path "tests/dontexist.conf")+	case readResult of+		Right (_, GetSetting getSetting) -> do+			getSetting textSizeFromWidth `shouldBe` 0.04+			getSetting textSizeFromHeight `shouldBe` 12.4+			getSetting textFill `shouldBe` (1,1,0,1)+		Left (x :: SomeException) -> assertBool (show x) False++testInvalidFile :: Spec+testInvalidFile = it "reports errors properly for invalid files" $ do+	readResult <- try $ readSettings (Path "tests/broken.config")+	case readResult of+		Left (_ :: SomeException) -> assertBool "ok" True+		Right _ -> assertBool "did not get an error!" False++testSaveUserSetAndDefaults :: Spec+testSaveUserSetAndDefaults = it "saves a file with user-set and default settings" $ do+	readResult <- try $ readSettings (Path "tests/partial.config") +	case readResult of +		Right (conf, _) -> do+			saveSettings defaultConfig (Path "test.txt") conf+			actual <- readFile "test.txt"+			reference <- readFile "tests/test-save.txt"+			actual `shouldBe` reference+			removeFile "test.txt"+		Left (x :: SomeException) -> assertBool (show x) False++createBakBeforeSaving :: Spec+createBakBeforeSaving = it "creates a backup of the config file before overwriting it" $ do+	readResult <- try $ readSettings (Path "tests/partial.config") +	case readResult of +		Right (conf, _) -> do+			copyFile "tests/partial.config" "p.config"+			saveSettings defaultConfig (Path "p.config") conf+			doesFileExist "p.config.bak" >>= (flip shouldBe) True+			doesFileExist "p.config" >>= (flip shouldBe) True+			removeFile "p.config"+			removeFile "p.config.bak"+		Left (x :: SomeException) -> assertBool (show x) False