config-value-0.6.1: Simple, layout-based value language similar to YAML or JSON

Copyright(c) Eric Mertens 2017
LicenseISC
Maintaineremertens@gmail.com
Safe HaskellSafe
LanguageHaskell2010

Config

Contents

Description

This module parses files using the syntax demonstrated below. The full lexical syntax is available in the Alex source file. The full grammar is available in the Happy source file.

Configuration file schemas can be specified using the config-schema package. This package helps extract application-specific meaning from a Value, and can also generate documentation for the supported format.

The config-value format offers a simple, layout-based syntax for specifying configuration information. In addition configuration values can be pretty-printed back into valid concrete syntax.

Example

-- Line comments until newline
layout:
  based:
    configuration:
      {} -- empty section

    sections:
     "glguy"

    {- Block comments
       {- nested comments -}
       "O'caml style {- strings in comments"
       so you can comment out otherwise valid
       portions of your config
    -}
    atoms      : yes

    decimal    : -1234
    hexadecimal: 0x1234
    octal      : 0o1234
    binary     : 0b1010

lists:
   * sections: in-lists
     next-section: still-in-list
   * [ "inline", "lists" ]
   * * "nestable"
     * "layout"
     * "lists"
   * 3

unicode : "standard Haskell format strings (1 ≤ 2)\x2228(2 ≤ 3)"

Syntax

A configuration file should contain a single value at the top-level. Typically this value will be a list of sections (as seen in the example above).

Unicode character classes are fully supported. The alpha and digit character classes use the full Unicode range, rather than merely the ASCII ranges.

There are 5 distinct types of values possible in a configuration file:

  • Sections list (list of key-value pairs)
  • Lists
  • Text
  • Numbers
  • Atoms

Sections list

KEY: VALUE
KEY: VALUE
KEY: VALUE

Sections lists are lists of key-value pairs. Each key in the list should start on the same column in the file. The value of the pair should be indented to the right of the key.

The lexical syntax for section names is identical to the lexical syntax of atoms. Section names are nonempty sequences starting with an alpha character followed by zero or more alpha, digit, period (.), underscore (_), or dash (-).

Section lists can be nested.

Section lists can be used inline, without layout, but surrounding them with { and } and separating the sections with ,. The empty sections list is specified with {}.

Examples:

key-1 : -- spaces are allowed between the section name and the colon
  key-1.1: value-1.1
  key-1.2: [ value-1.2 ]
key-2: value-2
key-3: {} -- the value for key-3 is the empty sections list
key-4: { red: 1, blue: 2} -- inline syntax for sublist

List

* VALUE
* VALUE
* VALUE

Lists can be specified using either layout or inline syntax. There is no distinction between the two syntaxes in the abstract syntax.

Inline lists are surrounded by [ and ] with elements separated by ,. The final list element may be terminated with a trailing comma.

Example: [1, 2, 3]

Layout list entries are started with a leading *. Each leading * must occur in the some column of the file. Lists can be nested by starting the new list on a column to the right of the current list.

Layout based lists can not occur inside inline list syntax. Layout based section lists can occur inside layout based lists

Example:

-- One list element containing an atom
* item-1

-- One list element containing a two element list
* * item-2.1
  * item-2.2

-- One list element containing two key-value pairs
* key-1: value-1
  key-2: value-2

Text

"quoted string literals"

Text values are specified using the Haskell string literal syntax.

Text values are distinct from atoms described below. This allows a configuration file to make a distinction between the atom default and the text value "default", for example.

For a detailed description of Haskell string literal syntax, see Haskell 2010 2.6 Character and String Literals

Number

123.456

Numbers can be written with integer and floating-point literals.

Prefix numbers with - to construct a negative number.

Integer literals support alternate base described below.

Floating-point literals can specify a power-of-10 exponent.

Bases

  • No prefix for decimal (base 10) integer literals
  • Prefix binary (base 2) integer literals with 0b or 0B
  • Prefix octal (base 8) integer literals with 0o or 0O
  • Prefix hexadecimal (base 16) integer literals with 0x or 0X. Upper and lower-cased hex digits are supported.

List of examples:

[ 0, 42, -42, 123.45, 6E7, 1e+10, 3.4e-5, 0xfF, 0b101010, -0o77 ]

Atom

unquoted-string

Atoms are unquoted strings that are distinct from normal text values. This type is intended to represent enumerations in a configuration file.

Atoms are nonempty sequences starting with an alpha character followed by zero or more alpha, digit, period (.), underscore (_), or dash (-).

Lexical syntax: $alpha [$alpha $digit $unidigit \. _ \-]*

List of examples:

[ yes, no, default, MODE-61 ]

Comments

Comments are valid white-space.

An ordinary comment begins with -- and extends to the following newline.

-- This is a comment

Use pairs of {- and -} to create comments that can span multiple lines. These comments can be nested.

{- this {- is -}
       a comment -}

Synopsis

Parsing

parse Source #

Arguments

:: Text

source text

-> Either ParseError (Value Position)

error message or parsed value

Parse a configuration file and return the result on the right, or the position of an error on the left.

The resulting value is annotated with source file locations.

Note: Text file lines are terminated by new-lines.

Pretty-printing

pretty :: Value a -> Doc Source #

Pretty-print a Value as shown in the example. Sections will nest complex values underneath with indentation and simple values will be rendered on the same line as their section.

Types

data Section a Source #

A single section of a Value

Example:

Constructors

Section 

Instances

Functor Section Source # 

Methods

fmap :: (a -> b) -> Section a -> Section b #

(<$) :: a -> Section b -> Section a #

Foldable Section Source # 

Methods

fold :: Monoid m => Section m -> m #

foldMap :: Monoid m => (a -> m) -> Section a -> m #

foldr :: (a -> b -> b) -> b -> Section a -> b #

foldr' :: (a -> b -> b) -> b -> Section a -> b #

foldl :: (b -> a -> b) -> b -> Section a -> b #

foldl' :: (b -> a -> b) -> b -> Section a -> b #

foldr1 :: (a -> a -> a) -> Section a -> a #

foldl1 :: (a -> a -> a) -> Section a -> a #

toList :: Section a -> [a] #

null :: Section a -> Bool #

length :: Section a -> Int #

elem :: Eq a => a -> Section a -> Bool #

maximum :: Ord a => Section a -> a #

minimum :: Ord a => Section a -> a #

sum :: Num a => Section a -> a #

product :: Num a => Section a -> a #

Traversable Section Source # 

Methods

traverse :: Applicative f => (a -> f b) -> Section a -> f (Section b) #

sequenceA :: Applicative f => Section (f a) -> f (Section a) #

mapM :: Monad m => (a -> m b) -> Section a -> m (Section b) #

sequence :: Monad m => Section (m a) -> m (Section a) #

Generic1 Section Source # 

Associated Types

type Rep1 (Section :: * -> *) :: * -> * #

Methods

from1 :: Section a -> Rep1 Section a #

to1 :: Rep1 Section a -> Section a #

Eq a => Eq (Section a) Source # 

Methods

(==) :: Section a -> Section a -> Bool #

(/=) :: Section a -> Section a -> Bool #

Data a => Data (Section a) Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Section a -> c (Section a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Section a) #

toConstr :: Section a -> Constr #

dataTypeOf :: Section a -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Section a)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Section a)) #

gmapT :: (forall b. Data b => b -> b) -> Section a -> Section a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Section a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Section a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Section a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Section a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Section a -> m (Section a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Section a -> m (Section a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Section a -> m (Section a) #

Read a => Read (Section a) Source # 
Show a => Show (Section a) Source # 

Methods

showsPrec :: Int -> Section a -> ShowS #

show :: Section a -> String #

showList :: [Section a] -> ShowS #

Generic (Section a) Source # 

Associated Types

type Rep (Section a) :: * -> * #

Methods

from :: Section a -> Rep (Section a) x #

to :: Rep (Section a) x -> Section a #

type Rep1 Section Source # 
type Rep1 Section = D1 (MetaData "Section" "Config.Value" "config-value-0.6.1-7oW3b9CFGAfGQJSHPDYHSr" False) (C1 (MetaCons "Section" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "sectionAnn") NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1) ((:*:) (S1 (MetaSel (Just Symbol "sectionName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)) (S1 (MetaSel (Just Symbol "sectionValue") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec1 Value)))))
type Rep (Section a) Source # 
type Rep (Section a) = D1 (MetaData "Section" "Config.Value" "config-value-0.6.1-7oW3b9CFGAfGQJSHPDYHSr" False) (C1 (MetaCons "Section" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "sectionAnn") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) ((:*:) (S1 (MetaSel (Just Symbol "sectionName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)) (S1 (MetaSel (Just Symbol "sectionValue") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Value a))))))

data Value a Source #

Sum type of the values supported by this language.

The first field of the Number constructor is the based used in the concrete syntax of the configuration value.

The Floating constructor stores the coefficient and power-of-10 exponent used in the concrete syntax. This allows representing numbers that would otherwise overflow a Double.

Value is parameterized over an annotation type indented to be used for file position or other application specific information.

Examples:

Constructors

Sections a [Section a]

lists of key-value pairs

Number a Int Integer

integer literal base (2, 8, 10, or 16) and integer value

Floating a Integer Integer

coef exponent: coef * 10 ^ exponent

Text a Text

quoted strings

Atom a Atom

unquoted strings

List a [Value a]

lists

Instances

Functor Value Source # 

Methods

fmap :: (a -> b) -> Value a -> Value b #

(<$) :: a -> Value b -> Value a #

Foldable Value Source # 

Methods

fold :: Monoid m => Value m -> m #

foldMap :: Monoid m => (a -> m) -> Value a -> m #

foldr :: (a -> b -> b) -> b -> Value a -> b #

foldr' :: (a -> b -> b) -> b -> Value a -> b #

foldl :: (b -> a -> b) -> b -> Value a -> b #

foldl' :: (b -> a -> b) -> b -> Value a -> b #

foldr1 :: (a -> a -> a) -> Value a -> a #

foldl1 :: (a -> a -> a) -> Value a -> a #

toList :: Value a -> [a] #

null :: Value a -> Bool #

length :: Value a -> Int #

elem :: Eq a => a -> Value a -> Bool #

maximum :: Ord a => Value a -> a #

minimum :: Ord a => Value a -> a #

sum :: Num a => Value a -> a #

product :: Num a => Value a -> a #

Traversable Value Source # 

Methods

traverse :: Applicative f => (a -> f b) -> Value a -> f (Value b) #

sequenceA :: Applicative f => Value (f a) -> f (Value a) #

mapM :: Monad m => (a -> m b) -> Value a -> m (Value b) #

sequence :: Monad m => Value (m a) -> m (Value a) #

Generic1 Value Source # 

Associated Types

type Rep1 (Value :: * -> *) :: * -> * #

Methods

from1 :: Value a -> Rep1 Value a #

to1 :: Rep1 Value a -> Value a #

Eq a => Eq (Value a) Source # 

Methods

(==) :: Value a -> Value a -> Bool #

(/=) :: Value a -> Value a -> Bool #

Data a => Data (Value a) Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Value a -> c (Value a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Value a) #

toConstr :: Value a -> Constr #

dataTypeOf :: Value a -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Value a)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Value a)) #

gmapT :: (forall b. Data b => b -> b) -> Value a -> Value a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Value a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Value a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Value a -> m (Value a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Value a -> m (Value a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Value a -> m (Value a) #

Read a => Read (Value a) Source # 
Show a => Show (Value a) Source # 

Methods

showsPrec :: Int -> Value a -> ShowS #

show :: Value a -> String #

showList :: [Value a] -> ShowS #

Generic (Value a) Source # 

Associated Types

type Rep (Value a) :: * -> * #

Methods

from :: Value a -> Rep (Value a) x #

to :: Rep (Value a) x -> Value a #

type Rep1 Value Source # 
type Rep1 Value = D1 (MetaData "Value" "Config.Value" "config-value-0.6.1-7oW3b9CFGAfGQJSHPDYHSr" False) ((:+:) ((:+:) (C1 (MetaCons "Sections" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) ((:.:) [] (Rec1 Section))))) ((:+:) (C1 (MetaCons "Number" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer))))) (C1 (MetaCons "Floating" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer))))))) ((:+:) (C1 (MetaCons "Text" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)))) ((:+:) (C1 (MetaCons "Atom" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Atom)))) (C1 (MetaCons "List" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) Par1) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) ((:.:) [] (Rec1 Value))))))))
type Rep (Value a) Source # 
type Rep (Value a) = D1 (MetaData "Value" "Config.Value" "config-value-0.6.1-7oW3b9CFGAfGQJSHPDYHSr" False) ((:+:) ((:+:) (C1 (MetaCons "Sections" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Section a])))) ((:+:) (C1 (MetaCons "Number" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer))))) (C1 (MetaCons "Floating" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Integer))))))) ((:+:) (C1 (MetaCons "Text" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)))) ((:+:) (C1 (MetaCons "Atom" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Atom)))) (C1 (MetaCons "List" PrefixI False) ((:*:) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Value a])))))))

newtype Atom Source #

Wrapper to distinguish Atom from Text by type in a configuration. Atoms can be constructed using the OverloadedStrings extension.

Constructors

MkAtom 

Fields

Instances

Eq Atom Source # 

Methods

(==) :: Atom -> Atom -> Bool #

(/=) :: Atom -> Atom -> Bool #

Data Atom Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Atom -> c Atom #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Atom #

toConstr :: Atom -> Constr #

dataTypeOf :: Atom -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Atom) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Atom) #

gmapT :: (forall b. Data b => b -> b) -> Atom -> Atom #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Atom -> r #

gmapQ :: (forall d. Data d => d -> u) -> Atom -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Atom -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Atom -> m Atom #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Atom -> m Atom #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Atom -> m Atom #

Ord Atom Source # 

Methods

compare :: Atom -> Atom -> Ordering #

(<) :: Atom -> Atom -> Bool #

(<=) :: Atom -> Atom -> Bool #

(>) :: Atom -> Atom -> Bool #

(>=) :: Atom -> Atom -> Bool #

max :: Atom -> Atom -> Atom #

min :: Atom -> Atom -> Atom #

Read Atom Source # 
Show Atom Source # 

Methods

showsPrec :: Int -> Atom -> ShowS #

show :: Atom -> String #

showList :: [Atom] -> ShowS #

IsString Atom Source # 

Methods

fromString :: String -> Atom #

Generic Atom Source # 

Associated Types

type Rep Atom :: * -> * #

Methods

from :: Atom -> Rep Atom x #

to :: Rep Atom x -> Atom #

type Rep Atom Source # 
type Rep Atom = D1 (MetaData "Atom" "Config.Value" "config-value-0.6.1-7oW3b9CFGAfGQJSHPDYHSr" True) (C1 (MetaCons "MkAtom" PrefixI True) (S1 (MetaSel (Just Symbol "atomName") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Text)))

valueAnn :: Value a -> a Source #

Returns the annotation for a value.

Errors