Copyright | (c) Eric Mertens 2017 |
---|---|
License | ISC |
Maintainer | emertens@gmail.com |
Safe Haskell | Safe |
Language | Haskell2010 |
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
or0B
- Prefix octal (base 8) integer literals with
0o
or0O
- Prefix hexadecimal (base 16) integer literals with
0x
or0X
. 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
- parse :: Text -> Either ParseError (Value Position)
- data Position = Position {}
- pretty :: Value a -> Doc
- data Section a = Section {
- sectionAnn :: a
- sectionName :: Text
- sectionValue :: Value a
- data Value a
- newtype Atom = MkAtom {}
- valueAnn :: Value a -> a
- data Number
- numberToInteger :: Number -> Maybe Integer
- numberToRational :: Number -> Rational
- integerToNumber :: Integer -> Number
- rationalToNumber :: Rational -> Number
- data ParseError = ParseError Position String
Parsing
:: 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.
A position in a text file
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
A single section of a Value
Example:
Section | |
|
Instances
Functor Section Source # | |
Foldable Section Source # | |
Defined in Config.Value fold :: Monoid m => Section m -> m # foldMap :: Monoid m => (a -> m) -> Section a -> 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 # elem :: Eq a => a -> Section a -> Bool # maximum :: Ord a => Section a -> a # minimum :: Ord a => Section a -> a # | |
Traversable Section Source # | |
Eq a => Eq (Section a) Source # | |
Data a => Data (Section a) Source # | |
Defined in Config.Value 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 :: forall r r'. (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 # | |
Generic (Section a) Source # | |
Generic1 Section Source # | |
type Rep (Section a) Source # | |
Defined in Config.Value type Rep (Section a) = D1 ('MetaData "Section" "Config.Value" "config-value-0.7.0.0-JboFCtXlIzo1Q4jM4SfnDg" 'False) (C1 ('MetaCons "Section" 'PrefixI 'True) (S1 ('MetaSel ('Just "sectionAnn") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: (S1 ('MetaSel ('Just "sectionName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "sectionValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Value a))))) | |
type Rep1 Section Source # | |
Defined in Config.Value type Rep1 Section = D1 ('MetaData "Section" "Config.Value" "config-value-0.7.0.0-JboFCtXlIzo1Q4jM4SfnDg" 'False) (C1 ('MetaCons "Section" 'PrefixI 'True) (S1 ('MetaSel ('Just "sectionAnn") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) Par1 :*: (S1 ('MetaSel ('Just "sectionName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "sectionValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec1 Value)))) |
Sum type of the values supported by this language.
Value
is parameterized over an annotation type indented to be used for
file position or other application specific information. When no
annotations are needed, ()
is a fine choice.
Sections a [Section a] | lists of key-value pairs |
Number a Number | numbers |
Text a Text | quoted strings |
Atom a Atom | unquoted strings |
List a [Value a] | lists |
Instances
Wrapper to distinguish Atom
from Text
by
type in a configuration. Atoms can be constructed
using the OverloadedStrings
extension.
Instances
Eq Atom Source # | |
Data Atom Source # | |
Defined in Config.Value 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 # 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 :: forall r r'. (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 # | |
Read Atom Source # | |
Show Atom Source # | |
IsString Atom Source # | |
Defined in Config.Value fromString :: String -> Atom # | |
Generic Atom Source # | |
type Rep Atom Source # | |
Defined in Config.Value |
Numbers
Numbers are represented as base, coefficient, and exponent.
The most convenient way to get numbers into and out of this form
is to use one of: numberToRational
, numberToInteger
,
rationalToNumber
, or integerToNumber
.
This representation is explicit about the radix and exponent
used to facilitate better pretty-printing. By using explicit
exponents extremely large numbers can be represented compactly.
Consider that it is easy to write `1e100000000` which would use
a significant amount of memory if realized as an Integer
. This
representation allows concerned programs to check bounds before
converting to a representation like Integer
.
Instances
Eq Number Source # | |
Data Number Source # | |
Defined in Config.Number gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Number -> c Number # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Number # toConstr :: Number -> Constr # dataTypeOf :: Number -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Number) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Number) # gmapT :: (forall b. Data b => b -> b) -> Number -> Number # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Number -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Number -> r # gmapQ :: (forall d. Data d => d -> u) -> Number -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Number -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Number -> m Number # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Number -> m Number # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Number -> m Number # | |
Ord Number Source # | |
Read Number Source # | |
Show Number Source # | |
Generic Number Source # | |
type Rep Number Source # | |
Defined in Config.Number type Rep Number = D1 ('MetaData "Number" "Config.Number" "config-value-0.7.0.0-JboFCtXlIzo1Q4jM4SfnDg" 'False) (C1 ('MetaCons "MkNumber" 'PrefixI 'True) (S1 ('MetaSel ('Just "numberRadix") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Radix) :*: S1 ('MetaSel ('Just "numberCoefficient") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Rational))) |
numberToInteger :: Number -> Maybe Integer Source #
Convert a number to a Integer
. Warning: This can use a
lot of member in the case of very large exponent parts.
numberToRational :: Number -> Rational Source #
Convert a number to a Rational
. Warning: This can use a
lot of member in the case of very large exponent parts.
Errors
data ParseError Source #
Error messages that can occur during parsing annotated with a file position.