diff --git a/Data/AppSettings.hs b/Data/AppSettings.hs --- a/Data/AppSettings.hs +++ b/Data/AppSettings.hs @@ -1,72 +1,7 @@ -{-# 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. +{-# LANGUAGE RankNTypes, GADTs #-} module Data.AppSettings ( + -- $intro Conf, DefaultConfig, Setting(..), @@ -83,10 +18,9 @@ import System.Directory import qualified Data.Map as M import Control.Monad.State -import Text.Read (readMaybe) -import Data.Maybe (fromMaybe) import Data.Serialization +import Data.AppSettingsInternal -- http://stackoverflow.com/questions/23117205/ newtype GetSetting = GetSetting (forall a. Read a => Setting a -> a) @@ -95,23 +29,6 @@ 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 \ --- setSetting \ \ \ --- @ --- --- 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 @@ -132,9 +49,8 @@ -- | 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 +setting (Setting nameV defaultV) = get >>= put . M.insert nameV SettingInfo { value = show defaultV, userSet = False } +setting (ListSetting nameV defaultV) = get >>= put . addListSettings False nameV defaultV 1 -- | Used in combination with 'setting' to register settings. -- Registering settings is optional, see 'DefaultConfig'. @@ -208,22 +124,25 @@ filePath <- getPathForLocation location writeConfigFile filePath (conf `M.union` 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 +-- an empty list for the XX list key is written as XX= in the config file. +setSetting conf (ListSetting key _) [] = M.insert key SettingInfo { value = "", userSet= True} + $ cleanListSetting key conf +setSetting conf (ListSetting key _) elts = addListSettings True key elts 1 + $ cleanListSetting key conf +addListSettings :: Show b => Bool -> String -> [b] -> Int -> Conf -> Conf +addListSettings _ _ [] _ = id +addListSettings uset key (x:xs) index = M.insert keyForIndex SettingInfo { value = show x, userSet=uset } + . addListSettings uset key xs (index+1) + where keyForIndex = key ++ "_" ++ show index + +cleanListSetting :: String -> Conf -> Conf +cleanListSetting key = M.filterWithKey (\k _ -> not $ isKeyForListSetting key k) + getSettingsFolder :: String -> IO FilePath getSettingsFolder appName = do home <- getHomeDirectory @@ -233,3 +152,94 @@ getConfigFileName :: String -> IO String getConfigFileName appName = fmap (++"config.ini") $ getSettingsFolder appName + +-- $intro +-- +-- 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. +-- +-- With an ordinary setting, one row in the configuration file +-- means one setting. That setting may of course be a list +-- for instance. This setup works very well for shorter lists +-- like [1,2,3], however if you have a list of more complex +-- items, you will get very long lines and a configuration +-- file very difficult to edit by hand. +-- For these special cases there is also the 'ListSetting' +-- +-- constructor: +-- +-- > testList :: Setting [String] +-- > testList = ListSetting "testList" ["list1", "list2", "list3"] +-- +-- Now the configuration file looks like that: +-- +-- > testList_1="list1" +-- > testList_2="list2" +-- > testList_3="list3" +-- +-- Which is much more handy for big lists. An empty list is represented +-- like so: +-- +-- > testList= +-- +-- 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. diff --git a/Data/AppSettingsInternal.hs b/Data/AppSettingsInternal.hs new file mode 100644 --- /dev/null +++ b/Data/AppSettingsInternal.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE GADTs #-} + +module Data.AppSettingsInternal where + +import Data.Maybe (fromMaybe) +import Data.List (isPrefixOf) +import Data.Char (isDigit) +import Text.Read (readMaybe) +import qualified Data.Map as M + +import Data.Serialization + +-- I can't put the comments on the constructors: +-- http://trac.haskell.org/haddock/ticket/43 + +-- | 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 \ +-- setSetting \ \ \ +-- @ +-- +-- and so on. +-- +-- 'Setting' declares a simple setting. A value for that setting will be stored +-- in the configuration file in a single line. +-- +-- 'ListSetting' however declares a list setting. +-- While it is perfectly fine to store lists +-- using the usual Setting constructor, if you have a list +-- of more complex items, you will get very long lines and a +-- configuration file very difficult to edit or review by hand. +-- +-- The ListSetting will store settings using one line per item +-- in the list: +-- +-- > testList :: Setting [String] +-- > testList = ListSetting "testList" ["list1", "list2", "list3"] +-- +-- Now the configuration file looks like that: +-- +-- > testList_1="list1" +-- > testList_2="list2" +-- > testList_3="list3" +-- +-- Also note that an empty ListSetting is stored like so: +-- +-- > testList= +data Setting a where + Setting :: String -> a -> Setting a + + ListSetting :: (Read a, Show a) => String -> [a] -> Setting [a] + +isKeyForListSetting :: String -> String -> Bool +isKeyForListSetting settingKey key = (settingKey ++ "_") `isPrefixOf` key + && (all isDigit $ drop (length settingKey+1) key) + + +-- TODO maybe another getSetting that'll tell you +-- if the setting is invalid in the config file instead of silently +-- give you the default? + +-- | More low-level, please use the second function you get from 'readSettings', +-- wrapped in a 'GetSetting' newtype. +getSetting' :: (Read a) => Conf -> Setting a -> a +getSetting' conf (Setting key defaultV) = fromMaybe defaultV $ getSettingValueFromConf conf key +getSetting' conf (ListSetting key defaultV) = case getSettingValueFromConf conf $ key ++ "_1" of + -- an empty list for the XX list key is written as XX= in the config file. + Nothing -> case M.lookup key conf of + Nothing -> defaultV + _ -> [] + Just x -> x : decodeListSetting conf key 2 + +getSettingValueFromConf :: Read a => Conf -> String -> Maybe a +getSettingValueFromConf conf key = do + asString <- M.lookup key conf + readMaybe $ value asString + +decodeListSetting :: Read a => Conf -> String -> Int -> [a] +decodeListSetting conf key index = case getSettingValueFromConf conf fullKey of + Nothing -> [] + Just v -> v:decodeListSetting conf key (index+1) + where fullKey = key ++ "_" ++ show index diff --git a/app-settings.cabal b/app-settings.cabal --- a/app-settings.cabal +++ b/app-settings.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: app-settings -version: 0.1.0.3 +version: 0.2.0.0 synopsis: A library to manage application settings (INI file-like) description: A library to deal with application settings. @@ -32,31 +32,41 @@ > 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: + Optionally you can declare the list of all your settings, + in that case the application will also save the default + values in the configuration file, but commented out: . > fontSize=16 > # dateFormat="%x" > # backcolor=(255,0,0) . - If you did not specify the list of settings, only the + If you do not specify the list of settings, only the first line would be present in the configuration file. . + With an ordinary setting, one row in the configuration file + means one setting. That setting may of course be a list + for instance. This setup works very well for shorter lists + like [1,2,3], however if you have a list of more complex + items, you will get very long lines and a configuration + file very difficult to edit by hand. + . + For these special cases there is also the 'ListSetting' + constructor: + . + > testList :: Setting [String] + > testList = ListSetting "testList" ["list1", "list2", "list3"] + . + Now the configuration file looks like that: + . + > testList_1="list1" + > testList_2="list2" + > testList_3="list3" + . + Which is much more handy for big lists. An empty list is represented + like so: + . + > testList= + . 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): @@ -85,7 +95,8 @@ library exposed-modules: Data.AppSettings - other-modules: Data.Serialization + other-modules: Data.Serialization, + Data.AppSettingsInternal -- other-extensions: build-depends: base >=4.6 && <5, mtl == 2.1.*, diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} import Data.AppSettings +import Data.AppSettingsInternal import Test.Hspec import Test.HUnit (assertBool) @@ -17,17 +18,28 @@ textSizeFromHeight :: Setting Double textSizeFromHeight = Setting "textSizeFromHeight" 12.4 +testInlineList :: Setting [String] +testInlineList = Setting "testInlineList" ["inline1", "inline2", "inline3"] + +testList :: Setting [String] +testList = ListSetting "testList" ["list1", "list2", "list3"] + defaultConfig :: DefaultConfig defaultConfig = getDefaultConfig $ do setting textSizeFromWidth setting textSizeFromHeight setting textFill + setting testInlineList + setting testList main :: IO () main = hspec $ do + describe "unit tests" $ do + testIsKeyForListSetting describe "load config" $ do testEmptyFileDefaults testPartialFileDefaults + testPartialFileDefaults2 testFileWithComments testInvalidFile testInvalidValue @@ -35,6 +47,8 @@ describe "save config" $ do testSaveUserSetAndDefaults createBakBeforeSaving + describe "set setting" $ do + testSetListSetting testEmptyFileDefaults :: Spec testEmptyFileDefaults = it "parses correctly an empty file with defaults" $ do @@ -44,6 +58,8 @@ getSetting textSizeFromWidth `shouldBe` 0.04 getSetting textSizeFromHeight `shouldBe` 12.4 getSetting textFill `shouldBe` (1,1,0,1) + getSetting testInlineList `shouldBe` ["inline1", "inline2", "inline3"] + getSetting testList `shouldBe` ["list1", "list2", "list3"] Left (x :: SomeException) -> assertBool (show x) False testPartialFileDefaults :: Spec @@ -54,8 +70,22 @@ getSetting textSizeFromWidth `shouldBe` 1.02 getSetting textSizeFromHeight `shouldBe` 12.4 getSetting textFill `shouldBe` (1,2,3,4) + getSetting testInlineList `shouldBe` ["un", "deux"] + getSetting testList `shouldBe` ["one", "two"] Left (x :: SomeException) -> assertBool (show x) False +testPartialFileDefaults2 :: Spec +testPartialFileDefaults2 = it "parses correctly a partial2 file with defaults" $ do + readResult <- try $ readSettings (Path "tests/partial2.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) + getSetting testInlineList `shouldBe` ["un", "deux"] + getSetting testList `shouldBe` [] + 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") @@ -64,6 +94,8 @@ getSetting textSizeFromWidth `shouldBe` 1.02 getSetting textSizeFromHeight `shouldBe` 12.4 getSetting textFill `shouldBe` (1,2,3,4) + getSetting testInlineList `shouldBe` ["un", "deux"] + getSetting testList `shouldBe` ["one", "two"] Left (x :: SomeException) -> assertBool (show x) False testInvalidValue :: Spec @@ -75,6 +107,8 @@ getSetting textSizeFromWidth `shouldBe` 0.04 getSetting textSizeFromHeight `shouldBe` 12.4 getSetting textFill `shouldBe` (1,2,3,4) + getSetting testInlineList `shouldBe` ["inline1", "inline2", "inline3"] + getSetting testList `shouldBe` ["list1", "list2", "list3"] Left (x :: SomeException) -> assertBool (show x) False testNonExistingFile :: Spec @@ -85,6 +119,8 @@ getSetting textSizeFromWidth `shouldBe` 0.04 getSetting textSizeFromHeight `shouldBe` 12.4 getSetting textFill `shouldBe` (1,1,0,1) + getSetting testInlineList `shouldBe` ["inline1", "inline2", "inline3"] + getSetting testList `shouldBe` ["list1", "list2", "list3"] Left (x :: SomeException) -> assertBool (show x) False testInvalidFile :: Spec @@ -118,3 +154,28 @@ removeFile "p.config" removeFile "p.config.bak" Left (x :: SomeException) -> assertBool (show x) False + +testSetListSetting :: Spec +testSetListSetting = it "overwrites correctly a list setting" $ do + readResult <- try $ readSettings (Path "tests/empty.config") + case readResult of + Right (conf, GetSetting getSetting) -> do + getSetting testList `shouldBe` ["list1", "list2", "list3"] + getSetting testInlineList `shouldBe` ["inline1", "inline2", "inline3"] + let conf0 = setSetting conf testList ["un"] + let conf1 = setSetting conf0 testInlineList ["one"] + getSetting' conf1 testList `shouldBe` ["un"] + getSetting' conf1 testInlineList `shouldBe` ["one"] + let conf2 = setSetting conf1 testList [] + let conf3 = setSetting conf2 testInlineList [] + getSetting' conf3 testList `shouldBe` [] + getSetting' conf3 testInlineList `shouldBe` [] + Left (x :: SomeException) -> assertBool (show x) False + +testIsKeyForListSetting :: Spec +testIsKeyForListSetting = it "checks correctly whether a key is attached to a list setting" $ do + isKeyForListSetting "listTest" "listTest_1" `shouldBe` True + isKeyForListSetting "listTest" "listTest_13" `shouldBe` True + isKeyForListSetting "listTest" "listTest_unrelated" `shouldBe` False + isKeyForListSetting "listTest" "listTest_1notanumber" `shouldBe` False + isKeyForListSetting "listTest" "listTestX_1" `shouldBe` False