libconfig-0.3.0.0: Haskell bindings to libconfig

Copyright(c) Matthew Peddie 2014
LicenseBSD3
Maintainermpeddie@gmail.com
Stabilityexperimental
PortabilityGHC
Safe HaskellNone
LanguageHaskell2010

Language.Libconfig.Bindings

Contents

Description

Low-level FFI bindings to the libconfig configuration file library. Please see the libconfig manual for documentation on what the various functions actually do and the underlying model of the libconfig API. The documentation in this module contains many usage examples which double as tests, but the focus is only on FFI details and C-vs.-Haskell impedance mismatches. As a result, there is no explanation of the behavior of many of the functions.

Synopsis

Doctest example setup

All the examples run on the included test file test/test.conf, which is reproduced here from the libconfig manual.

     # Example application configuration file

     version = "1.0";

     application:
     {
       window:
       {
         title = "My Application";
         size = { w = 640; h = 480; };
         pos = { x = 350; y = 250; };
       };

       list = ( ( "abc", 123, true ), 1.234, ( * an empty list *) );

       books = ( { title  = "Treasure Island";
                   author = "Robert Louis Stevenson";
                   price  = 29.95;
                   qty    = 5; },
                 { title  = "Snow Crash";
                   author = "Neal Stephenson";
                   price  = 9.99;
                   qty    = 8; } );

       misc:
       {
         pi = 3.141592654;
         bigint = 9223372036854775807L;
         columns = [ "Last Name", "First Name", MI ];
         bitmask = 0x1FC3;
       };
     };

The following setup actions are assumed for many of the usage examples below.

>>> Just conf <- configNew "test/test.conf"
>>> Just app <- configLookup conf "application"
>>> Just misc <- configLookupFrom app "misc"
>>> Just winsize <- configLookupFrom app "window.size"

conf' is used for modifying values.

>>> Just conf' <- configNew "test/test.conf"

data Configuration Source

Top-level configuration value, corresponding to the libconfig config_t. Wrapped opaquely for pointer-safety.

Instances

data Setting Source

Corresponds to a libconfig config_setting_t value; wrapped opaquely for pointer safety.

Instances

data ConfigErr Source

This is a set of possible errors that can occur when libconfig tries to read in a config file.

Instances

Enum ConfigErr

This is a set of possible libconfig types. Many functions will return Nothing if you attempt to use a value as the incorrect type. See the libconfig manual for more details.

Eq ConfigErr 
Show ConfigErr 

isCollectionType :: ConfigType -> Bool Source

Tells whether a ConfigType value is a collection (ListType, ArrayType or GroupType).

>>> isCollectionType GroupType
True
>>> isCollectionType BoolType
False

isScalarType :: ConfigType -> Bool Source

Tells whether a ConfigType value is a scalar (i.e. not a collection).

>>> isScalarType FloatType
True
>>> isScalarType ListType
False

Note:

>>> isScalarType NoneType
True

data ConfigFormat Source

This is used for fine-grained configuration of how integers are output when a config file is written. See configGetDefaultFormat and the libconfig manual.

Constructors

DefaultFormat 
HexFormat 

Resource management

configInit :: IO Configuration Source

This function allocates a new Configuration and initializes it.

configNew :: String -> IO (Maybe Configuration) Source

Create a new Configuration and read in the data from the specified configuration file.

> configNew s = configInit >>= \c -> configReadFile c s

touchConfiguration :: Configuration -> IO () Source

libconfig manages storage for all Setting objects via the Configuration, so if a Configuration goes out of scope, GHC may get rid of it, and any Setting objects may become invalid. This function can be used to ensure that a Configuration doesn't get automatically garbage-collected too early.

Config I/O

configReadFile :: Configuration -> String -> IO (Maybe ()) Source

Read in a Configuration from the specified configuration file. The Configuration should already be initialized with configInit.

configWriteFile :: Configuration -> String -> IO (Maybe ()) Source

Write out a Configuration to the specified configuration file.

configReadString :: Configuration -> String -> IO (Maybe ()) Source

Read configuration data from a string.

Safe (capable of returning an error) getting of primitive

These Haskell functions return Nothing if the lookup fails, there is a type mismatch, etc.

configSettingLookupInt :: Setting -> String -> IO (Maybe Int) Source

>>> configSettingLookupInt winsize "w"
Just 640

configSettingLookupInt64 :: Setting -> String -> IO (Maybe Int64) Source

>>> configSettingLookupInt64 misc "bigint"
Just 9223372036854775807

configSettingLookupFloat :: Setting -> String -> IO (Maybe Double) Source

>>> configSettingLookupFloat misc "pi"
Just 3.141592654

configSettingLookupBool :: Setting -> String -> IO (Maybe Bool) Source

(The example configuration file does not contain any boolean values that are direct children of a config_setting_t.)

configSettingLookupString :: Setting -> String -> IO (Maybe String) Source

>>> Just win <- configLookupFrom app "window"
>>> configSettingLookupString win "title"
Just "My Application"

Unsafe getting of primitives

These functions are sketchy if used directly, because there is no way to distinguish between a successful result and a failure (at the libconfig level). Take care to only ever use these once you've already checked the ConfigType of the Setting using configSettingType.

configSettingGetInt :: Setting -> IO Int Source

>>> Just appwinwidth <- configLookup conf "application.window.size.w"
>>> configSettingGetInt appwinwidth
640

configSettingGetInt64 :: Setting -> IO Int64 Source

>>> Just miscbigint <- configLookup conf "application.misc.bigint"
>>> configSettingGetInt64 miscbigint
9223372036854775807

configSettingGetFloat :: Setting -> IO Double Source

>>> Just miscpi <- configLookup conf "application.misc.pi"
>>> configSettingGetFloat miscpi
3.141592654

configSettingGetBool :: Setting -> IO Bool Source

>>> Just listbool <- configLookup conf "application.list.[0].[2]"
>>> configSettingGetBool listbool
True

configSettingGetString :: Setting -> IO String Source

>>> Just wintitle <- configLookup conf "application.window.title"
>>> configSettingGetString wintitle
"My Application"

Setting of primitives

These functions return a value of type Maybe (), indicating whether the action was successful. (It may fail if, for example, there is a setting type mismatch.)

configSettingSetInt :: Setting -> Int -> IO (Maybe ()) Source

>>> Just treasureqty <- configLookup conf' "application.books.[0].qty"
>>> configSettingSetInt treasureqty 222
Just ()
>>> configSettingGetInt treasureqty
222

configSettingSetInt64 :: Setting -> Int64 -> IO (Maybe ()) Source

>>> Just miscbigint <- configLookup conf' "application.misc.bigint"
>>> configSettingSetInt64 miscbigint 92233720368547758
Just ()
>>> configSettingGetInt64 miscbigint
92233720368547758

configSettingSetFloat :: Setting -> Double -> IO (Maybe ()) Source

>>> Just treasureprice <- configLookup conf' "application.books.[0].price"
>>> configSettingSetFloat treasureprice 22.22
Just ()
>>> configSettingGetFloat treasureprice
22.22

configSettingSetBool :: Setting -> Bool -> IO (Maybe ()) Source

>>> Just listbool <- configLookup conf' "application.list.[0].[2]"
>>> configSettingSetBool listbool False
Just ()
>>> configSettingGetBool listbool
False

configSettingSetString :: Setting -> String -> IO (Maybe ()) Source

>>> Just treasureauthor <- configLookup conf' "application.books.[0].author"
>>> configSettingSetString treasureauthor "Robert L. Stevenson"
Just ()
>>> configSettingGetString treasureauthor
"Robert L. Stevenson"

Unsafe getting of primitives from a collection

These functions are sketchy if used directly, because there is no way to distinguish between a successful result and a failure (at the libconfig level). Take care to only ever use these once you've already checked the ConfigType of the element using configSettingType or verified it for other elements of an array.

These functions may be used on collections with type GroupType, ArrayType or ListType.

configSettingGetIntElem :: Setting -> Int -> IO Int Source

>>> Just treasure <- configLookup conf "application.books.[0]"
>>> configSettingGetIntElem treasure 3
5

configSettingGetInt64Elem :: Setting -> Int -> IO Int64 Source

>>> Just misc <- configLookup conf "application.misc"
>>> configSettingGetInt64Elem misc 1
9223372036854775807

configSettingGetFloatElem :: Setting -> Int -> IO Double Source

>>> Just list <- configLookup conf "application.list"
>>> configSettingGetFloatElem list 1
1.234

configSettingGetBoolElem :: Setting -> Int -> IO Bool Source

(The example configuration does not contain any boolean values that are direct children of collections of type config_setting_t).

configSettingGetStringElem :: Setting -> Int -> IO String Source

>>> Just win <- configLookup conf "application.window"
>>> configSettingGetStringElem win 0
"My Application"

Setting of primitives within a collection

In the event of an out-of-bounds index or a type mismatch, these functions return Nothing. If the function succeeds, the Setting that is returned will be either the same Setting that previously existed at that spot or a newly allocated one.

These functions may be used on collections with type ArrayType or ListType (but not GroupType).

configSettingSetIntElem :: Setting -> Int -> Int -> IO (Maybe Setting) Source

(This example appends a new value of type IntType to application.list, because the example file contains no suitable example values for us to modify.)

>>> Just list <- configLookup conf' "application.list"
>>> Just new3 <- configSettingSetIntElem list (-1) 22
>>> configSettingGetIntElem list 3
22
>>> configSettingGetInt new3
22

configSettingSetInt64Elem :: Setting -> Int -> Int64 -> IO (Maybe Setting) Source

(This example appends a new value of type Int64Type to application.list, because the example file contains no suitable example values for us to modify.)

>>> Just list <- configLookup conf' "application.list"
>>> Just new3 <- configSettingSetInt64Elem list (-1) 92233720368547758
>>> configSettingGetInt64Elem list 3
92233720368547758
>>> configSettingGetInt64 new3
92233720368547758

configSettingSetFloatElem :: Setting -> Int -> Double -> IO (Maybe Setting) Source

>>> Just list <- configLookup conf' "application.list"
>>> Just new1 <- configSettingSetFloatElem list 1 0.2222
>>> configSettingGetFloatElem list 1
0.2222
>>> configSettingGetFloat new1
0.2222

configSettingSetBoolElem :: Setting -> Int -> Bool -> IO (Maybe Setting) Source

(This example appends a new value of type BoolType to application.list, because the example file contains no suitable example values for us to modify.)

>>> Just list <- configLookup conf' "application.list"
>>> Just new3 <- configSettingSetBoolElem list (-1) False
>>> configSettingGetBoolElem list 3
False
>>> configSettingGetBool new3
False

configSettingSetStringElem :: Setting -> Int -> String -> IO (Maybe Setting) Source

>>> Just misccols <- configLookup conf' "application.misc.columns"
>>> Just new0 <- configSettingSetStringElem misccols 0 "butts"
>>> configSettingGetStringElem misccols 0
"butts"
>>> configSettingGetString new0
"butts"

Direct lookup by path

In the event of a name lookup failure or type mismatch, these functions return Nothing.

configLookup :: Configuration -> String -> IO (Maybe Setting) Source

>>> Just app <- configLookup conf "application"
>>> configSettingName app
Just "application"

configLookupFrom :: Setting -> String -> IO (Maybe Setting) Source

>>> Just list <- configLookupFrom app "list"
>>> configSettingName list
Just "list"

configLookupInt :: Configuration -> String -> IO (Maybe Int) Source

>>> configLookupInt conf "application.window.size.w"
Just 640

configLookupInt64 :: Configuration -> String -> IO (Maybe Int64) Source

>>> configLookupInt64 conf "application.misc.bigint"
Just 9223372036854775807

configLookupFloat :: Configuration -> String -> IO (Maybe Double) Source

>>> configLookupFloat conf "application.misc.pi"
Just 3.141592654

configLookupBool :: Configuration -> String -> IO (Maybe Bool) Source

>>> configLookupBool conf "application.list.[0].[2]"
Just True

configLookupString :: Configuration -> String -> IO (Maybe String) Source

>>> configLookupString conf "application.window.title"
Just "My Application"

Collection management

configSettingIndex :: Setting -> IO Int Source

>>> Just col0 <- configLookup conf "application.misc.columns.[0]"
>>> configSettingIndex col0
0

configSettingLength :: Setting -> IO Int Source

>>> Just cols <- configLookup conf "application.misc.columns"
>>> configSettingLength cols
3

configSettingGetElem :: Setting -> Int -> IO (Maybe Setting) Source

>>> Just cols <- configLookup conf "application.misc.columns"
>>> Just col0 <- configSettingGetElem cols 0
>>> configSettingGetString col0
"Last Name"

configSettingGetMember :: Setting -> String -> IO (Maybe Setting) Source

>>> Just miscpi <- configSettingGetMember misc "pi"
>>> configSettingGetFloat miscpi
3.141592654

configSettingAdd :: Setting -> String -> ConfigType -> IO (Maybe Setting) Source

>>> Just misc' <- configLookup conf' "application.misc"
>>> Just randSeed <- configSettingAdd misc' "random_seed" IntType
>>> configSettingSetInt randSeed 55
Just ()
>>> configSettingGetInt randSeed
55
>>> configSettingLookupInt misc' "random_seed"
Just 55
>>> configSettingGetIntElem misc' 4
55

configSettingRemove :: Setting -> String -> IO (Maybe ()) Source

>>> Just misc' <- configLookup conf' "application.misc"
>>> configSettingLength misc'
4
>>> configSettingRemove misc' "bitmask"
Just ()
>>> configSettingLength misc'
3

configSettingRemoveElem :: Setting -> Int -> IO (Maybe ()) Source

>>> Just misc' <- configLookup conf' "application.misc"
>>> configSettingLength misc'
4
>>> configSettingRemoveElem misc' 2
Just ()
>>> configSettingLength misc'
3
>>> Just new2 <- configSettingGetElem misc' 2
>>> configSettingType new2
IntType
>>> configSettingGetInt new2
8131

Miscellaneous

configSettingName :: Setting -> IO (Maybe String) Source

>>> Just list <- configLookup conf "application.list"
>>> configSettingName list
Just "list"
>>> Just list1 <- configLookup conf "application.list.[0]"
>>> configSettingName list1
Nothing

configSettingParent :: Setting -> IO (Maybe Setting) Source

>>> Just list <- configLookup conf "application.list"
>>> Just app <- configSettingParent list
>>> configSettingName app
Just "application"

configSettingIsRoot :: Setting -> IO Bool Source

>>> configSettingIsRoot app
False
>>> Just root <- configRootSetting conf
>>> configSettingIsRoot root
True

configRootSetting :: Configuration -> IO (Maybe Setting) Source

>>> Just root <- configRootSetting conf
>>> Just version <- configSettingGetMember root "version"
>>> configSettingGetString version
"1.0"

configSettingSourceLine :: Setting -> IO Int Source

>>> configSettingSourceLine app
5

configSettingSourceFile :: Setting -> IO String Source

>>> configSettingSourceFile app
"test/test.conf"

Formatting

configGetDefaultFormat :: Configuration -> IO ConfigFormat Source

>>> configGetDefaultFormat conf
DefaultFormat

configSetDefaultFormat :: Configuration -> ConfigFormat -> IO () Source

>>> configGetDefaultFormat conf'
DefaultFormat
>>> configSetDefaultFormat conf' HexFormat
>>> configGetDefaultFormat conf'
HexFormat

configSettingGetFormat :: Setting -> IO ConfigFormat Source

>>> Just appwinwidth <- configLookup conf "application.window.size.w"
>>> configSettingGetFormat appwinwidth
DefaultFormat

configSettingSetFormat :: Setting -> ConfigFormat -> IO (Maybe ()) Source

>>> Just appwinwidth' <- configLookup conf' "application.window.size.w"
>>> configSettingGetFormat appwinwidth'
DefaultFormat
>>> configSettingSetFormat appwinwidth' HexFormat
Just ()
>>> configSettingGetFormat appwinwidth'
HexFormat

configGetTabWidth :: Configuration -> IO Int Source

>>> configGetTabWidth conf
2

configSetTabWidth :: Configuration -> Int -> IO () Source

>>> configGetTabWidth conf'
2
>>> configSetTabWidth conf' 8
>>> configGetTabWidth conf'
8

Error reporting

Config file type system

configSettingType :: Setting -> IO ConfigType Source

>>> Just list <- configLookup conf "application.list"
>>> configSettingType list
ListType

configSettingIsGroup :: Setting -> IO Bool Source

>>> Just grp <- configLookup conf "application.window"
>>> configSettingIsGroup grp
True

configSettingIsList :: Setting -> IO Bool Source

>>> Just list <- configLookup conf "application.list"
>>> configSettingIsList list
True

configSettingIsArray :: Setting -> IO Bool Source

>>> Just arr <- configLookup conf "application.misc.columns"
>>> configSettingIsArray arr
True

configSettingIsAggregate :: Setting -> IO Bool Source

>>> Just grp <- configLookup conf "application.window"
>>> Just arr <- configLookup conf "application.misc.columns"
>>> Just list <- configLookup conf "application.list"
>>> Just width <- configLookup conf "application.window.size.w"
>>> mapM configSettingIsAggregate [grp, arr, list, width]
[True,True,True,False]

configSettingIsNumber :: Setting -> IO Bool Source

>>> Just int <- configLookup conf "application.window.pos.x"
>>> Just bigint <- configLookup conf "application.misc.bigint"
>>> Just float <- configLookup conf "application.misc.pi"
>>> Just grp <- configLookup conf "application.window"
>>> mapM configSettingIsNumber [int, bigint, float, grp]
[True,True,True,False]

configSettingIsScalar :: Setting -> IO Bool Source

>>> Just int <- configLookup conf "application.window.pos.x"
>>> Just bigint <- configLookup conf "application.misc.bigint"
>>> Just float <- configLookup conf "application.misc.pi"
>>> Just bool <- configLookup conf "application.list.[0].[2]"
>>> Just str <- configLookup conf "application.window.title"
>>> Just grp <- configLookup conf "application.window"
>>> mapM configSettingIsScalar [int, bigint, float, bool, str, grp]
[True,True,True,True,True,False]