config-value-0.8.3/0000755000000000000000000000000007346545000012272 5ustar0000000000000000config-value-0.8.3/CHANGELOG.md0000644000000000000000000000450307346545000014105 0ustar00000000000000000.8.3 --- * Add `prettyInline` for layout-free pretty-printing 0.8.2.1 --- * Fix pretty-printing bug with long string literals 0.8.2 --- * Add `+` and `-` to the set of layout-based list syntax bullets. All elements of the list are checked to see that a consistent bullet is used. Different bullets might be used to help make nested lists more understandable. `-` might be used to make things look more like YAML 0.8.1 --- * Allow underscores in number literals Copied from Underscores are allowed and ignored - in the *middle* of integer-parts of the literal syntax - between base-markers (0x, 0o, 0b) and number part - before the `eEpP` part of an exponent 0.8 --- * Allow atoms and section names to start with `@` or `$` * Add `Config.Macro` module 0.7.0.1 --- * Fix pretty-printing of fractional, hexadecimal numbers 0.7.0.0 --- * Updated number representation to preserve fractional part and added new `Config.Number` module with operations on this new type. 0.6.3.1 --- * Build on GHC 8.4.1 0.6.3 --- * Add `valuePlate` 0.6.2.1 --- * Fixed error output for unexpected floating point literal 0.6.2 --- * Nicer errors on unterminated inline lists and sections. * Stop enforcing well-formed text files 0.6.1 --- * Add vim syntax highlighting file * Fix string gaps, they shouldn't require a newline 0.6 --- * Annotate `Value` with file positions * Derive `Generic1` instances for `Value` 0.5.1 --- * Allow trailing commas in lists and section lists * Support inline section lists using `{}` * Add more documentation 0.5 ---- * Add support for floating-point numbers 0.4.0.2 ---- * Internal lexer and parser improvements * Added support for `\&` escape sequence 0.4.0.1 ---- * Loosen version constraints to build back to GHC 7.4.2 * Remove unused bytestring dependency 0.4 ---- * Make `Atom` a newtype to help distinguish it from `Text` * Add `values` traversal for traversing individual elements of a list 0.3 ----- * Replace `yes` and `no` with generalized atoms * Add character index to error position * Add human readable error messages 0.2 ----- * Take `Text` as the input to `parse` 0.1.1 ----- * Added `Config.Lens` module * Added aligned fields to pretty printer 0.1 ----- * Initial release config-value-0.8.3/LICENSE0000644000000000000000000000204007346545000013273 0ustar0000000000000000Copyright (c) 2015 Eric Mertens Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. config-value-0.8.3/README.md0000644000000000000000000000425307346545000013555 0ustar0000000000000000# config-value [![Hackage](https://img.shields.io/hackage/v/config-value.svg)](https://hackage.haskell.org/package/config-value) [![Build Status](https://api.travis-ci.com/glguy/config-value.svg)](http://travis-ci.com/glguy/config-value) This package implements a simple, layout-based value definition language used for supplying configuration values to various applications. Before starting to use config-value, you probably want to read the documentation for [config-schema](https://github.com/glguy/config-schema) to see the user-friendly way to wrap this library. Live Demo -------- The config-value and config-schema packages are available in a [live demo](https://glguy.net/config-demo/). Example ------- ``` -- Line comments until newline layout: based: configuration: {} -- empty section inline-maps: {key1: value1, key2: value2} 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 floats: [1e2, 0x3p-5, 24.48] underscores: 1_000_000 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)" multiline: "haskell style\ \string gaps" ``` Format ------ The language supports: Strings, Atoms, Integers, Lists, Nested Sections. Sections are layout based. The contents of a section must be indented further than the section heading. The whitespace between a section heading and its colon is not significant. Section names must start with a letter and may contain letters, numbers, dashes (`-`), underscores (`_`), and periods (`.`). Lists are either layout based with `*` prefixes or inline surrounded by `[` and `]` delimited by `,` Strings are surrounded by `"` and use Haskell-style escapes. Numbers support decimal, hexadecimal (`0x`), octal (`0o`), and binary (`0b`). Atoms follow the same lexical rule as section heading. config-value-0.8.3/Setup.hs0000644000000000000000000000005607346545000013727 0ustar0000000000000000import Distribution.Simple main = defaultMain config-value-0.8.3/config-value.cabal0000644000000000000000000000356107346545000015642 0ustar0000000000000000cabal-version: 2.2 name: config-value version: 0.8.3 synopsis: Simple, layout-based value language similar to YAML or JSON license: MIT license-file: LICENSE author: Eric Mertens maintainer: emertens@gmail.com copyright: 2015-2016,2019 Eric Mertens category: Language build-type: Simple homepage: https://github.com/glguy/config-value bug-reports: https://github.com/glguy/config-value/issues description: This package implements a language similar to YAML or JSON but with fewer special cases and fewer dependencies. It emphasizes layout structure for sections and lists, and requires quotes around strings. tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.2, GHC==9.0.1 extra-source-files: README.md CHANGELOG.md config-value.vim library exposed-modules: Config Config.Lens Config.Number Config.Macro other-modules: Config.Lexer Config.LexerUtils Config.Parser Config.NumberParser Config.Tokens Config.Pretty Config.Value build-depends: base >= 4.8 && < 4.18, array >= 0.4 && < 0.6, containers >= 0.5 && < 0.7, pretty >= 1.1.1.0 && < 1.2, text >= 1.2.0.4 && < 2.1, build-tool-depends: alex:alex ^>= 3.2.4, happy:happy >= 1.19 && <1.21, hs-source-dirs: src default-language: Haskell2010 source-repository head type: git location: git://github.com/glguy/config-value.git test-suite unit-tests type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test build-depends: base, config-value, text default-language: Haskell2010 ghc-options: -Wall config-value-0.8.3/config-value.vim0000644000000000000000000000360507346545000015372 0ustar0000000000000000" Config-value syntax file " Language: config-value " Author: Eric Mertens if exists("b:current_syntax") finish endif " Reserved symbols syn match cvDelimiter "*\|:\|\[\|\]\|,\|{\|}\|=" " Strings and constants -- copied from haskell.vim syn match cvSpecialChar contained "\\\([\n\t ]*\\\|[0-9]\+\|o[0-7]\+\|x[0-9a-fA-F]\+\|[\"'&\\abfnrtv]\|\^[@A-Z^_\[\\\]]\)" syn match cvSpecialChar contained "\\\(NUL\|SOH\|STX\|ETX\|EOT\|ENQ\|ACK\|BEL\|BS\|HT\|LF\|VT\|FF\|CR\|SO\|SI\|DLE\|DC1\|DC2\|DC3\|DC4\|NAK\|SYN\|ETB\|CAN\|EM\|SUB\|ESC\|FS\|GS\|RS\|US\|SP\|DEL\)" syn region cvString start=+"+ skip=+\\\\\|\\"+ end=+"\|\n+ contains=cvSpecialChar syn match cvNumber "-\=\([0-9]\+\|0[xX][0-9a-fA-F]\+\|0[oO][0-7]\+\|0[bB][0-1]\+\)\>" syn match cvFloat "-\=[0-9]\+\.[0-9]\+\([eE][-+]\=[0-9]\+\)\=\>" syn match cvFloat "-\=[0-9]\+[eE][-+]\=[0-9]\+\>" syn match cvVariable "$[a-zA-Z0-9\._\-]*\>" syn match cvDirective "@[a-zA-Z0-9\._\-]*\>" syn match cvAtom "\<[a-zA-Z][a-zA-Z0-9\._\-]*\>" syn match cvLineComment "--.*$" syn region cvBlockComment start="{-" end="-}" contains=cvString,cvBlockComment hi def link cvVariable Macro hi def link cvDirective Include hi def link cvAtom Identifier hi def link cvDelimiter Delimiter hi def link cvSpecialChar SpecialChar hi def link cvString String hi def link cvNumber Number hi def link cvFloat Float hi def link cvBlockComment cvComment hi def link cvLineComment cvComment hi def link cvComment Comment let b:current_syntax = "config-value" setlocal commentstring=--%s setlocal comments=:-- let b:undo_ftplugin = "setl com< commentstring<" config-value-0.8.3/src/0000755000000000000000000000000007346545000013061 5ustar0000000000000000config-value-0.8.3/src/Config.hs0000644000000000000000000002213307346545000014623 0ustar0000000000000000{-# LANGUAGE Safe #-} {-| Module : Config Description : Configuration file parser and abstract syntax Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com 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 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/, @$@ or @\@@ 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 @*@, @+@, or @-@. Each leading bullet 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. A single list must use the same bullet token for every element of the list. Nested lists can choose a different bullet. This can help visually distinguish nested lists. 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 == 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/, @$@, or @\@@ 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 -} @ -} module Config ( -- * Parsing parse , Position(..) -- * Pretty-printing , pretty , prettyInline -- * Types , Section(..) , Value(..) , Atom(..) , valueAnn -- * Numbers , Number , numberToInteger , numberToRational , integerToNumber , rationalToNumber -- * Errors , ParseError(..) ) where import Config.Number (Number, numberToInteger, numberToRational, integerToNumber, rationalToNumber) import Config.Value (Atom(..), Value(..), Section(..), valueAnn) import Config.Parser (parseValue) import Config.Pretty (pretty, prettyInline) import Config.Lexer (scanTokens) import Config.Tokens (Error(..), Position(..), Located(..), layoutPass, Token) import qualified Config.Tokens as T import Control.Exception (Exception(..)) import Data.Text (Text) import qualified Data.Text as Text -- | 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. parse :: Text {- ^ source text -} -> Either ParseError (Value Position) {- ^ error message or parsed value -} parse txt = case parseValue (layoutPass (scanTokens txt)) of Right x -> Right x Left (Located posn token) -> Left (ParseError posn (explainToken token)) -- | Error messages that can occur during parsing annotated with a file position. data ParseError = ParseError Position String deriving (Read, Show, Eq, Ord) -- | 'displayException' implements a pretty format instance Exception ParseError where displayException (ParseError posn msg) = "line " ++ show (posLine posn) ++ " column " ++ show (posColumn posn) ++ ": " ++ msg explainToken :: Token -> String explainToken token = case token of T.Error e -> explainError e T.Atom atom -> "parse error: unexpected atom: `" ++ Text.unpack atom ++ "`" T.String str -> "parse error: unexpected string: " ++ show (Text.unpack str) T.Bullet s -> "parse error: unexpected bullet '" ++ Text.unpack s ++ "'" T.Comma -> "parse error: unexpected comma ','" T.Section s -> "parse error: unexpected section: `" ++ Text.unpack s ++ "`" T.Number{} -> "parse error: unexpected number" T.OpenList -> "parse error: unexpected start of list '['" T.CloseList -> "parse error: unexpected end of list ']'" T.OpenMap -> "parse error: unexpected start of section '{'" T.CloseMap -> "parse error: unexpected end of section '}'" T.LayoutSep -> "parse error: unexpected end of block" T.LayoutEnd -> "parse error: unexpected end of block" T.EOF -> "parse error: unexpected end of file" explainError :: Error -> String explainError e = case e of T.UntermComment -> "lexical error: unterminated comment" T.UntermString -> "lexical error: unterminated string literal" T.UntermSections -> "lexical error: unterminated sections" T.UntermList -> "lexical error: unterminated list" T.BadEscape c -> "lexical error: bad escape sequence: " ++ Text.unpack c T.NoMatch c -> "lexical error at character " ++ show c config-value-0.8.3/src/Config/0000755000000000000000000000000007346545000014266 5ustar0000000000000000config-value-0.8.3/src/Config/Lens.hs0000644000000000000000000000642707346545000015534 0ustar0000000000000000{-| Module : Config.Lens Description : Lenses and traversals for manipulating 'Value' values. Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com Lenses and traversals for compatibility with the lens package -} module Config.Lens ( key , text , atom , number , list , values , sections , ann , valuePlate ) where import Config.Number import Config.Value import Data.Text -- | Traversal for the subsections of the given 'Value' when -- that value is a 'Sections' and the section name matches the -- given name. key :: Applicative f => Text {- ^ section name -} -> (Value a -> f (Value a)) -> Value a -> f (Value a) key i = sections . traverse . section i -- | Traversal for the 'Value' contained inside the given -- 'Section' when its section name matches the given name. section :: Applicative f => Text {- ^ section name -} -> (Value a -> f (Value a)) -> Section a -> f (Section a) section i f s@(Section a j v) | i == j = Section a j <$> f v | otherwise = pure s -- | Traversal for the ['Section'] contained inside the given -- 'Value' when it is a 'Sections'. sections :: Applicative f => ([Section a] -> f [Section a]) -> Value a -> f (Value a) sections f (Sections a xs) = Sections a <$> f xs sections _ v = pure v -- | Traversal for the 'Text' contained inside the given 'Value'. text :: Applicative f => (Text -> f Text) -> Value a -> f (Value a) text f (Text a t) = Text a <$> f t text _ v = pure v -- | Traversal for the 'Atom' contained inside the given 'Value'. atom :: Applicative f => (Atom -> f Atom) -> Value a -> f (Value a) atom f (Atom a t) = Atom a <$> f t atom _ v = pure v -- | Traversal for the 'Number' contained inside the given 'Value'. number :: Applicative f => (Number -> f Number) -> Value a -> f (Value a) number f (Number a n) = Number a <$> f n number _ v = pure v -- | Traversal for the ['Value'] contained inside the given -- 'Value' when it is a 'List'. list :: Applicative f => ([Value a] -> f [Value a]) -> Value a -> f (Value a) list f (List a xs) = List a <$> f xs list _ v = pure v -- | Traversal for the immediate values in a list or a sections list. -- -- This is intended to be used with "Control.Lens.Plated". valuePlate :: Applicative f => (Value a -> f (Value a)) -> Value a -> f (Value a) valuePlate f (List a xs) = List a <$> traverse f xs valuePlate f (Sections a xs) = Sections a <$> traverse (sectionVal f) xs valuePlate _ v = pure v sectionVal :: Functor f => (Value a -> f (Value a)) -> Section a -> f (Section a) sectionVal f (Section a k v) = Section a k <$> f v -- | Traversal for the 'Value' elements inside the given -- 'Value' when it is a 'List'. -- -- @ -- 'values' = 'list' . 'traverse' -- @ values :: Applicative f => (Value a -> f (Value a)) -> Value a -> f (Value a) values = list . traverse -- | Lens for the annotation component of a 'Value' ann :: Functor f => (a -> f a) -> Value a -> f (Value a) ann f v = case v of Sections a x -> (\a' -> Sections a' x) <$> f a Number a x -> (\a' -> Number a' x) <$> f a Text a x -> (\a' -> Text a' x) <$> f a Atom a x -> (\a' -> Atom a' x) <$> f a List a x -> (\a' -> List a' x) <$> f a config-value-0.8.3/src/Config/Lexer.x0000644000000000000000000001005507346545000015537 0ustar0000000000000000{ {-# OPTIONS_GHC -Wnot #-} {-# LANGUAGE Trustworthy #-} module Config.Lexer ( scanTokens ) where import Config.LexerUtils import Config.Tokens import Data.Text (Text) import qualified Data.Text as Text } $uniupper = \x1 $unilower = \x2 $unidigit = \x3 $unisymbol = \x4 $unispace = \x5 $uniother = \x6 $asciialpha = [A-Z a-z] $digit = [0-9] $octit = [0-7] $hexit = [0-9a-fA-F] $binit = [0-1] $white_no_nl = $white # \n $charesc = [abfnrtv\\\"'&] $cntrl = [A-Z@\[\\\]\^_] $alpha = [$unilower $uniupper $asciialpha] @spacer = _* @decimal = $digit (@spacer $digit)* @octal = $octit (@spacer $octit)* @binary = $binit (@spacer $binit)* @hexadecimal = $hexit (@spacer $hexit)* -- Copied from Haskell 2010 @ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM | SUB | ESC | FS | GS | RS | US | SP | DEL @escape = $charesc | @ascii | $digit+ | o $octit+ | x $hexit+ @atom = [$alpha \$ \@] [$alpha $digit $unidigit \. _ \-]* @exponent = @spacer [Ee] [\-\+]? @decimal @hexexponent = @spacer [Pp] [\-\+]? @decimal config :- <0> { $white+ ; "--" .* ; "{" { token_ OpenMap } "}" { token_ CloseMap } "[" { token_ OpenList } "," { token_ Comma } "]" { token_ CloseList } "*" { token Bullet } "-" { token Bullet } "+" { token Bullet } "-"? 0 [Xx] @spacer @hexadecimal ("." @hexadecimal?)? @hexexponent? { token number } "-"? 0 [Oo] @spacer @octal ("." @octal ?)? { token number } "-"? 0 [Bb] @spacer @binary ("." @binary ?)? { token number } "-"? @decimal ("." @decimal ?)? @exponent? { token number } @atom { token Atom } @atom $white_no_nl* : { token section } \" { startString } } { \" { endMode } "\" @escape ; "\" $white+ "\" ; "\" . { token (Error . BadEscape) } . ; \n { untermString } } <0,comment> "{-" { nestMode InComment } { "-}" { endMode } \" { nestMode InCommentString } . ; \n ; } { \" { endMode } \n { endMode } \\ \" ; . ; } { -- | Attempt to produce a token stream from an input file. -- In the case of an error the line and column of the error -- are returned instead. scanTokens :: Text {- ^ Source text -} -> [Located Token] {- ^ Tokens with position -} scanTokens str = go (Located startPos str) InNormal where go inp st = case alexScan inp (stateToInt st) of AlexEOF -> eofAction (locPosition inp) st AlexError inp' -> errorAction inp' AlexSkip inp' _ -> go inp' st AlexToken inp' len act -> case act len inp st of (st', xs) -> xs ++ go inp' st' -- | Compute the Alex state corresponding to a particular 'LexerMode' stateToInt :: LexerMode -> Int stateToInt InNormal{} = 0 stateToInt InComment{} = comment stateToInt InCommentString{} = commentstring stateToInt InString{} = stringlit } config-value-0.8.3/src/Config/LexerUtils.hs0000644000000000000000000001667507346545000016741 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | This module is separate from the Lexer.x input to Alex -- to segregate the automatically generated code from the -- hand written code. The automatically generated code -- causes lots of warnings which mask the interesting warnings. module Config.LexerUtils ( -- * Alex wrapper AlexInput , alexGetByte -- * Lexer modes , LexerMode(..) , startString , nestMode , endMode -- * Token builders , token , token_ , section , number -- * Final actions , untermString , eofAction , errorAction ) where import Data.Char (GeneralCategory(..), generalCategory, isAscii, isSpace, ord) import Data.Text (Text) import Data.Word (Word8) import qualified Data.Text as Text import Config.Tokens import qualified Config.NumberParser ------------------------------------------------------------------------ -- Custom Alex wrapper - these functions are used by generated code ------------------------------------------------------------------------ -- | The generated code expects the lexer input type to be named 'AlexInput' type AlexInput = Located Text -- | Get the next characteristic byte from the input source. alexGetByte :: AlexInput -> Maybe (Word8,AlexInput) alexGetByte (Located p cs) = do (c,cs') <- Text.uncons cs let !b = byteForChar c !inp = Located (move p c) cs' return (b, inp) ------------------------------------------------------------------------ -- | Advance the position according to the kind of character lexed. move :: Position -> Char -> Position move (Position ix line column) c = case c of '\t' -> Position (ix + 1) line (((column + 7) `div` 8) * 8 + 1) '\n' -> Position (ix + 1) (line + 1) 1 _ -> Position (ix + 1) line (column + 1) -- | Action to perform upon end of file. Produce errors if EOF was unexpected. eofAction :: Position -> LexerMode -> [Located Token] eofAction eofPosn st = case st of InComment posn _ -> [Located posn (Error UntermComment)] InCommentString posn _ -> [Located posn (Error UntermComment)] InString posn _ -> [Located posn (Error UntermString)] InNormal -> [Located (park eofPosn) EOF] -- | Terminate the line if needed and move the cursor to column 0 to ensure -- that it terminates any top-level block. park :: Position -> Position park pos | posColumn pos == 1 = pos { posColumn = 0 } | otherwise = pos { posColumn = 0, posLine = posLine pos + 1 } -- | Action to perform when lexer gets stuck. Emits an error. errorAction :: AlexInput -> [Located Token] errorAction inp = [fmap (Error . NoMatch . Text.head) inp] ------------------------------------------------------------------------ -- Lexer Modes ------------------------------------------------------------------------ -- | The lexer can be in any of four modes which determine which rules -- are active. data LexerMode = InNormal | InComment !Position !LexerMode -- ^ Start of comment and return mode | InCommentString !Position !LexerMode -- ^ Start of string and return mode | InString !Position !Text -- ^ Start of string and input text -- | Type of actions used by lexer upon matching a rule type Action = Int {- ^ match length -} -> Located Text {- ^ current input -} -> LexerMode {- ^ lexer mode -} -> (LexerMode, [Located Token]) {- ^ updated lexer mode, emitted tokens -} -- | Helper function for building an 'Action' using the lexeme token :: (Text -> Token) -> Action token f len match st = (st, [fmap (f . Text.take len) match]) -- | Helper function for building an 'Action' where the lexeme is unused. token_ :: Token -> Action token_ = token . const ------------------------------------------------------------------------ -- Alternative modes ------------------------------------------------------------------------ -- | Used to enter one of the nested modes nestMode :: (Position -> LexerMode -> LexerMode) -> Action nestMode f _ match st = (f (locPosition match) st, []) -- | Enter the string literal lexer startString :: Action startString _ (Located posn text) _ = (InString posn text, []) -- | Successfully terminate the current mode and emit tokens as needed endMode :: Action endMode len (Located endPosn _) mode = case mode of InNormal -> (InNormal, []) InCommentString _ st -> (st, []) InComment _ st -> (st, []) InString startPosn input -> let n = posIndex endPosn - posIndex startPosn + len badEscape = BadEscape (Text.pack "out of range") in case reads (Text.unpack (Text.take n input)) of [(s,"")] -> (InNormal, [Located startPosn (String (Text.pack s))]) _ -> (InNormal, [Located startPosn (Error badEscape)]) -- | Action for unterminated string constant untermString :: Action untermString _ _ = \(InString posn _) -> (InNormal, [Located posn (Error UntermString)]) ------------------------------------------------------------------------ -- Token builders ------------------------------------------------------------------------ -- | Construct a 'Number' token from a token using a -- given base. This function expect the token to be -- legal for the given base. This is checked by Alex. number :: Text {- ^ sign-prefix-digits -} -> Token number = Number . Config.NumberParser.number . Text.unpack . Text.toUpper . Text.filter ('_' /=) -- | Process a section heading token section :: Text -> Token section = Section . Text.dropWhileEnd isSpace . Text.init ------------------------------------------------------------------------ -- Embed all of unicode, kind of, in a single byte! ------------------------------------------------------------------------ -- | Alex is driven by looking up elements in a 128 element array. -- This function maps each ASCII character to its ASCII encoding -- and it maps non-ASCII code-points to a character class (0-6) byteForChar :: Char -> Word8 byteForChar c | c <= '\6' = non_graphic | isAscii c = fromIntegral (ord c) | otherwise = case generalCategory c of LowercaseLetter -> lower OtherLetter -> lower UppercaseLetter -> upper TitlecaseLetter -> upper DecimalNumber -> digit OtherNumber -> digit ConnectorPunctuation -> symbol DashPunctuation -> symbol OtherPunctuation -> symbol MathSymbol -> symbol CurrencySymbol -> symbol ModifierSymbol -> symbol OtherSymbol -> symbol Space -> space ModifierLetter -> other NonSpacingMark -> other SpacingCombiningMark -> other EnclosingMark -> other LetterNumber -> other OpenPunctuation -> other ClosePunctuation -> other InitialQuote -> other FinalQuote -> other _ -> non_graphic where non_graphic = 0 upper = 1 lower = 2 digit = 3 symbol = 4 space = 5 other = 6 config-value-0.8.3/src/Config/Macro.hs0000644000000000000000000001641207346545000015667 0ustar0000000000000000{-# LANGUAGE Safe, OverloadedStrings, DeriveTraversable, RankNTypes #-} {-| Module : Config.Macro Description : Configuration pre-processor adding support for aliases and common sections Copyright : (c) Eric Mertens, 2020 License : ISC Maintainer : emertens@gmail.com This module provides assigns meaning to atoms and section names that start with @\@@ and @$@. It provides processing pass for configuration to use local variables and inclusion to better structure configuration. = Sigils * @$@ starts a variable. * @\@@ starts a directive. Merge key-value mappings using @\@splice@. Load external configuration with @\@load@. = Variables Variables are atoms that start with a @$@ sigil. Variables are defined by setting a variable as a section name. This variable will remain in scope for the remainder of the sections being defined. Variables used in a value position will be replaced with their previously defined values. @ $example: 42 field1: $example field2: [0, $example] @ expands to @ field1: 42 field2: [0, 42] @ Later variable definitions will shadow earlier definitions. @ { $x: 1, $x: 2, k: $x } @ expands to @ { k: 2 } @ Scoping examples: @ top1: a: $x -- BAD: $x not defined yet $x: 42 -- $x is now defined to be 42 b: $x -- OK: $x was defined above c: {sub1: $x, sub2: [$x]} -- OK: $x in scope in subsections -- note: $x now goes out of scope top2: $x -- BAD: $x no longer in scope @ Macros are expanded at their definition site. All variables are resolved before adding the new variable into the environment. Variables are lexically scoped rather than dynamically scoped. Allowed: @ $x: 1 $y: $x -- OK, y is now 1 @ Not allowed: @ $y: $x -- BAD: $x was not in scope $x: 1 z: $y @ = Sections splicing One sections value can be spliced into another sections value using the @\@splice@ directive. It is an error to splice a value that is not a key-value sections. @ $xy: { x: 0, y: 1 } example: \@splice: $xy z: 2 @ expands to @ example: x: 0 y: 1 z: 2 @ = File loading The @\@load@ directive is intended including configuration from other sources. 'loadFileWithMacros' provides an interpretation of this directive that loads other files. An arbitrary interpretation can be defined with 'expandMacros'' To load a value define a key-value mapping with a single @\@load@ key with a value specifying the location to load from. @ x: @load: "fourty-two.cfg" @ could expand to @ x: 42 @ -} module Config.Macro ( -- * Macro expansion primitives MacroError(..), expandMacros, expandMacros', -- * File loader with inclusion LoadFileError(..), FilePosition(..), loadFileWithMacros ) where import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Control.Exception import Config import Data.Map (Map) import Data.Typeable (Typeable) import qualified Data.Map as Map -- | Errors from macro expansion annotated with the 'valueAnn' from -- the 'Value' nearest to the problem (typically a file position). data MacroError a = UndeclaredVariable a Text -- ^ Variable used before its defintion | UnknownDirective a Text -- ^ Unknown directive | BadSplice a -- ^ Incorrect use of @\@splice@ | BadLoad a -- ^ Incorrect use of @\@load@ deriving (Eq, Read, Show, Functor, Foldable, Traversable) instance (Typeable a, Show a) => Exception (MacroError a) data Special = Plain | Variable Text | Splice | Load processAtom :: a -> Text -> Either (MacroError a) Special processAtom a txt = case Text.uncons txt of Just ('@',"splice") -> Right Splice Just ('@',"load" ) -> Right Load Just ('@',t ) -> Left (UnknownDirective a t) Just ('$',t ) -> Right (Variable t) _ -> Right Plain -- | Expand macros in a configuration value. -- -- @\@load@ not supported and results in a 'BadLoad' error. expandMacros :: Value a -> Either (MacroError a) (Value a) expandMacros = expandMacros' Left (Left . BadLoad . valueAnn) Map.empty -- | Expand macros in a configuration value using a pre-populated environment. expandMacros' :: Monad m => (forall b. MacroError a -> m b) {- ^ failure -} -> (Value a -> m (Value a)) {- ^ @\@load@ implementation -} -> Map Text (Value a) {- ^ variable environment -} -> Value a {- ^ value to expand -} -> m (Value a) {- ^ expanded value -} expandMacros' failure load = go where proc a txt = either failure pure (processAtom a txt) go env v = case v of Number a x -> pure (Number a x) Text a x -> pure (Text a x) List a x -> List a <$> traverse (go env) x Sections _ [Section _ "@load" arg] -> load =<< go env arg Sections a x -> Sections a <$> elaborateSections env x Atom a x -> do x' <- proc a (atomName x) case x' of Plain -> pure (Atom a x) Splice -> failure (BadSplice a) Load -> failure (BadLoad a) Variable var -> case Map.lookup var env of Nothing -> failure (UndeclaredVariable a var) Just y -> pure y elaborateSections _ [] = pure [] elaborateSections env (Section a k v : xs) = do special <- proc a k v' <- go env v case special of Load -> failure (BadLoad a) Variable var -> elaborateSections (Map.insert var v' env) xs Plain -> (Section a k v' :) <$> elaborateSections env xs Splice -> case v' of Sections _ ys -> (ys++) <$> elaborateSections env xs _ -> failure (BadSplice a) -- | A pair of filepath and position data FilePosition = FilePosition FilePath Position deriving (Read, Show, Ord, Eq) -- | Errors thrown by 'loadFileWithMacros' data LoadFileError = LoadFileParseError FilePath ParseError -- ^ failure to parse a file | LoadFileMacroError (MacroError FilePosition) -- ^ failure to expand macros deriving (Eq, Read, Show) instance Exception LoadFileError -- | Load a configuration value from a given file path. -- -- @\@load@ will compute included file path from the given function given the -- load argument and current configuration file path. -- -- Valid @\@load@ arguments are string literals use as arguments to -- the path resolution function. -- -- Throws `IOError` from file loads and `LoadFileError` loadFileWithMacros :: (Text -> FilePath -> IO FilePath) {- ^ inclusion path resolution -} -> FilePath {- ^ starting file path -} -> IO (Value FilePosition) {- ^ macro-expanded config value -} loadFileWithMacros findPath = go where go path = do txt <- Text.readFile path v1 <- case parse txt of Left e -> throwIO (LoadFileParseError path e) Right v -> pure v let v2 = FilePosition path <$> v1 let loadImpl pathVal = case pathVal of Text _ str -> go =<< findPath str path _ -> throwIO (LoadFileMacroError (BadLoad (valueAnn pathVal))) expandMacros' (throwIO . LoadFileMacroError) loadImpl Map.empty v2 config-value-0.8.3/src/Config/Number.hs0000644000000000000000000000537607346545000016065 0ustar0000000000000000{-# Language DeriveDataTypeable, DeriveGeneric, Safe #-} {-| Module : Config.Number Description : Scientific-notation numbers with explicit radix Copyright : (c) Eric Mertens, 2019 License : ISC Maintainer : emertens@gmail.com This module provides a representation of numbers in scientific notation. -} module Config.Number ( Number(..) , Radix(..) , radixToInt , numberToRational , numberToInteger , integerToNumber , rationalToNumber ) where import Data.Ratio (numerator, denominator) import Data.Data (Data) import GHC.Generics (Generic) -- | 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'. data Number = MkNumber { numberRadix :: !Radix , numberCoefficient :: !Rational } deriving (Eq, Ord, Read, Show, Data, Generic) -- | Radix used for a number. Some radix modes support an -- exponent. data Radix = Radix2 -- ^ binary, base 2 | Radix8 -- ^ octal, base 8 | Radix10 !Integer -- ^ decimal, base 10, exponent base 10 | Radix16 !Integer -- ^ hexdecimal, base 16, exponent base 2 deriving (Eq, Ord, Read, Show, Data, Generic) -- | Returns the radix as an integer ignoring any exponent. radixToInt :: Radix -> Int radixToInt r = case r of Radix2 {} -> 2 Radix8 {} -> 8 Radix10{} -> 10 Radix16{} -> 16 -- | Convert a number to a 'Rational'. Warning: This can use a -- lot of memory in the case of very large exponent parts. numberToRational :: Number -> Rational numberToRational (MkNumber r c) = case r of Radix2 -> c Radix8 -> c Radix10 e -> c * 10 ^^ e Radix16 e -> c * 2 ^^ e -- | Convert a number to a 'Integer'. Warning: This can use a -- lot of memory in the case of very large exponent parts. numberToInteger :: Number -> Maybe Integer numberToInteger n | denominator r == 1 = Just $! numerator r | otherwise = Nothing where r = numberToRational n -- | 'Integer' to a radix 10 'Number' with no exponent integerToNumber :: Integer -> Number integerToNumber = rationalToNumber . fromInteger -- | 'Rational' to a radix 10 'Number' with no exponent rationalToNumber :: Rational -> Number rationalToNumber = MkNumber (Radix10 0) config-value-0.8.3/src/Config/NumberParser.y0000644000000000000000000000673407346545000017077 0ustar0000000000000000{ {-# LANGUAGE Trustworthy #-} module Config.NumberParser where import Data.List (foldl') import Config.Number } %tokentype { Char} %token '+' { '+' } '-' { '-' } '.' { '.' } '0' { '0' } '1' { '1' } '2' { '2' } '3' { '3' } '4' { '4' } '5' { '5' } '6' { '6' } '7' { '7' } '8' { '8' } '9' { '9' } 'A' { 'A' } 'B' { 'B' } 'C' { 'C' } 'D' { 'D' } 'E' { 'E' } 'F' { 'F' } 'O' { 'O' } 'P' { 'P' } 'X' { 'X' } %name number %% number :: { Number } : '-' unsigned_number { negNum $2 } | unsigned_number { $1 } unsigned_number : '0' 'X' hexadecimal fracpart(hexadecimal) exppart('P') { mkNum (Radix16 $5) $3 $4 } | decimal fracpart(decimal ) exppart('E') { mkNum (Radix10 $3) $1 $2 } | '0' 'O' octal fracpart(octal ) { mkNum Radix8 $3 $4 } | '0' 'B' binary fracpart(binary ) { mkNum Radix2 $3 $4 } fracpart(p) :: { [Int] } : { [] } | '.' { [] } | '.' p { $2 } exppart(p) :: { Integer } : { 0 } | p expnum { $2 } expnum :: { Integer } : '+' decimal { toInt 10 $2 } | '-' decimal { - toInt 10 $2 } | decimal { toInt 10 $1 } hexadecimal :: { [Int] } : hexdigit { [$1] } | hexadecimal hexdigit { $2 : $1 } decimal :: { [Int] } : decdigit { [$1] } | decimal decdigit { $2 : $1 } octal :: { [Int] } : octdigit { [$1] } | octal octdigit { $2 : $1 } binary :: { [Int] } : bindigit { [$1] } | binary bindigit { $2 : $1 } hexdigit :: { Int } : '0' { 0} | '1' { 1} | '2' { 2} | '3' { 3} | '4' { 4} | '5' { 5} | '6' { 6} | '7' { 7} | '8' { 8} | '9' { 9} | 'A' {10} | 'B' {11} | 'C' {12} | 'D' {13} | 'E' {14} | 'F' {15} decdigit : '0' { 0} | '1' { 1} | '2' { 2} | '3' { 3} | '4' { 4} | '5' { 5} | '6' { 6} | '7' { 7} | '8' { 8} | '9' { 9} octdigit :: { Int } : '0' { 0} | '1' { 1} | '2' { 2} | '3' { 3} | '4' { 4} | '5' { 5} | '6' { 6} | '7' { 7} bindigit :: { Int } : '0' { 0} | '1' { 1} { mkNum :: Radix -> [Int] -> [Int] -> Number mkNum radix coef frac = MkNumber radix (fromInteger (toInt base coef) + toFrac base frac) where base = radixToInt radix negNum :: Number -> Number negNum n = n { numberCoefficient = - numberCoefficient n } toInt :: Int -> [Int] -> Integer toInt base = foldl' (\acc i -> acc*base' + fromIntegral i) 0 . reverse where base' = fromIntegral base toFrac :: Int -> [Int] -> Rational toFrac base = foldl' (\acc i -> (fromIntegral i+acc)/base') 0 where base' = fromIntegral base happyError [] = error "Unexpected EOF" happyError (c:_) = error ("Unexpected: "++[c]) } config-value-0.8.3/src/Config/Parser.y0000644000000000000000000001247307346545000015723 0ustar0000000000000000{ {-# LANGUAGE Trustworthy, OverloadedStrings #-} module Config.Parser (parseValue) where import Config.Value (Section(..), Value(..), Atom(..)) import Config.Tokens (Located(..), Token, Position) import qualified Config.Tokens as T } %tokentype { Located Token } %token SECTION { Located _ T.Section{} } STRING { Located _ T.String{} } ATOM { Located _ T.Atom{} } NUMBER { Located _ T.Number{} } '*' { Located $$ (T.Bullet "*") } '+' { Located $$ (T.Bullet "+") } '-' { Located $$ (T.Bullet "-") } '[' { Located $$ T.OpenList } ',' { Located _ T.Comma } ']' { Located _ T.CloseList } '{' { Located $$ T.OpenMap } '}' { Located _ T.CloseMap } SEP { Located _ T.LayoutSep } END { Located _ T.LayoutEnd } EOF { Located _ T.EOF } %monad { Either (Located Token) } %error { errorP } %name config %% config :: { Value Position } : value EOF { $1 } value :: { Value Position } : sections END { sections $1 } | '*' list('*') END { List $1 (reverse $2) } | '-' list('-') END { List $1 (reverse $2) } | '+' list('+') END { List $1 (reverse $2) } | simple { $1 } simple :: { Value Position } : NUMBER { number $1 } | STRING { text $1 } | ATOM { atom $1 } | '{' inlinesections '}' { Sections $1 (reverse $2) } | '[' inlinelist ']' { List $1 (reverse $2) } | '{' inlinesections term {% untermSections $1 } | '[' inlinelist term {% untermList $1 } term :: { () } term : EOF { () } | END { () } | SEP { () } sections :: { [Section Position] } : section { [$1] } | sections SEP section { $3 : $1 } inlinesections :: { [Section Position] } : { [] } | inlinesections1 { $1 } | inlinesections1 ',' { $1 } inlinesections1 :: { [Section Position] } : section { [$1] } | inlinesections1 ',' section { $3 : $1 } section :: { Section Position } : SECTION value { section $1 $2 } list(blt) :: { [Value Position] } : value { [$1] } | list(blt) SEP blt value { $4 : $1 } inlinelist :: { [Value Position] } : { [] } | inlinelist1 { $1 } | inlinelist1 ',' { $1 } inlinelist1 :: { [Value Position] } : simple { [$1] } | inlinelist1 ',' simple { $3 : $1 } { -- | Convert number token to number value. This needs a custom -- function like this because there are multiple values matched from -- the constructor. number :: Located Token -> Value Position number = \(Located a (T.Number n)) -> Number a n section :: Located Token -> Value Position -> Section Position section = \(Located a (T.Section k)) v -> Section a k v sections :: [Section Position] -> Value Position sections xxs = Sections (sectionAnn x) (x:xs) where x:xs = reverse xxs text :: Located Token -> Value Position text = \(Located a (T.String x)) -> Text a x atom :: Located Token -> Value Position atom = \(Located a (T.Atom x)) -> Atom a (MkAtom x) errorP :: [Located Token] -> Either (Located Token) a errorP xs = Left (head xs) untermSections :: Position -> Either (Located Token) a untermSections p = Left (Located p (T.Error T.UntermSections)) untermList :: Position -> Either (Located Token) a untermList p = Left (Located p (T.Error T.UntermList)) -- | Attempt to parse a layout annotated token stream or -- the token that caused the parse to fail. parseValue :: [Located Token] {- ^ layout annotated token stream -} -> Either (Located Token) (Value Position) {- ^ token at failure or result -} parseValue = config } config-value-0.8.3/src/Config/Pretty.hs0000644000000000000000000000717007346545000016116 0ustar0000000000000000{-# Language Safe #-} -- | Pretty-printing implementation for 'Value' module Config.Pretty (pretty, prettyInline) where import Data.Char (isPrint, isDigit,intToDigit) import Data.List (mapAccumL) import Data.Ratio (denominator) import qualified Data.Text as Text import Text.PrettyPrint import Numeric(showIntAtBase) import Prelude hiding ((<>)) import Config.Value import Config.Number -- | 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. pretty :: Value a -> Doc pretty value = case value of Sections _ [] -> text "{}" Sections _ xs -> prettySections xs Number _ n -> prettyNumber n Text _ t -> prettyText (Text.unpack t) Atom _ t -> text (Text.unpack (atomName t)) List _ [] -> text "[]" List _ xs -> vcat [ char '*' <+> pretty x | x <- xs ] prettyNumber :: Number -> Doc prettyNumber (MkNumber r c) = case r of Radix16 e -> pref <> text "0x" <> num <> expPart 'p' e Radix10 e -> pref <> num <> expPart 'e' e Radix8 -> pref <> text "0o" <> num Radix2 -> pref <> text "0b" <> num where radix = radixToInt r pref = if c < 0 then char '-' else empty num = text (showIntAtBase (fromIntegral radix) intToDigit whole "") <> fracPart (whole,frac) = properFraction (abs c) :: (Integer, Rational) expPart _ 0 = text "" expPart p i = text (p : show i) fracPart | 0 == frac = text "" | otherwise = text ('.' : showFrac radix frac) showFrac :: Int -> Rational -> String showFrac _ 0 = "" showFrac radix x = intToDigit w : rest where (w,f) = properFraction (x * fromIntegral radix) rest | denominator f < denominator x = showFrac radix f | otherwise = "" prettyText :: String -> Doc prettyText = doubleQuotes . hcat . snd . mapAccumL ppChar True where ppChar s x | isDigit x = (True, if not s then text "\\&" <> char x else char x) | isPrint x = (True, char x) | otherwise = (False, char '\\' <> int (fromEnum x)) prettySections :: [Section a] -> Doc prettySections ss = prettySmallSections small $$ rest where (small,big) = break (isBig . sectionValue) ss rest = case big of [] -> empty b : bs -> prettyBigSection b $$ prettySections bs prettyBigSection :: Section a -> Doc prettyBigSection s = text (Text.unpack (sectionName s)) <> colon $$ nest 2 (pretty (sectionValue s)) prettySmallSections :: [Section a] -> Doc prettySmallSections ss = vcat (map pp annotated) where annotate s = (Text.length (sectionName s), s) annotated = map annotate ss indent = 1 + maximum (0 : map fst annotated) pp (l,s) = prettySmallSection (indent - l) s prettySmallSection :: Int -> Section a -> Doc prettySmallSection n s = text (Text.unpack (sectionName s)) <> colon <> text (replicate n ' ') <> pretty (sectionValue s) isBig :: Value a -> Bool isBig (Sections _ (_:_)) = True isBig (List _ (_:_)) = True isBig _ = False -- | Pretty-printer that uses no layout for sections or lists. prettyInline :: Value a -> Doc prettyInline value = case value of Number _ n -> prettyNumber n Text _ t -> prettyText (Text.unpack t) Atom _ t -> text (Text.unpack (atomName t)) List _ xs -> brackets (list (map prettyInline xs)) Sections _ xs -> braces (list [text (Text.unpack k) <> colon <> prettyInline v | Section _ k v <- xs]) where list = hcat . punctuate comma config-value-0.8.3/src/Config/Tokens.hs0000644000000000000000000000561207346545000016071 0ustar0000000000000000{-# Language Safe #-} -- | This module provides the token type used in the lexer and -- parser and provides the extra pass to insert layout tokens. module Config.Tokens ( Token(..) , Located(..) , Position(..) , startPos , Error(..) , layoutPass ) where import Data.Text (Text) import Config.Number (Number) -- | A position in a text file data Position = Position { posIndex, posLine, posColumn :: {-# UNPACK #-} !Int } deriving (Read, Show, Ord, Eq) -- | The initial 'Position' for the start of a file startPos :: Position startPos = Position { posIndex = 0, posLine = 1, posColumn = 1 } -- | A value annotated with its text file position data Located a = Located { locPosition :: {-# UNPACK #-} !Position , locThing :: !a } deriving (Read, Show) instance Functor Located where fmap f (Located p x) = Located p (f x) -- | The token type used by "Config.Lexer" and "Config.Parser" data Token = Section Text | String Text | Atom Text | Bullet Text | Comma | Number Number | OpenList | CloseList | OpenMap | CloseMap | Error Error -- "Virtual" tokens used by the subsequent layout processor | LayoutSep | LayoutEnd | EOF deriving (Show) -- | Types of lexical errors data Error = UntermComment | UntermString | UntermList | UntermSections | BadEscape Text | NoMatch Char deriving (Show) -- | Process a list of position-annotated tokens inserting -- layout end tokens as appropriate. layoutPass :: [Located Token] {- ^ tokens without layout markers -} -> [Located Token] {- ^ tokens with layout markers -} layoutPass toks = foldr step (\_ -> []) toks [Layout (-1)] data Layout = NoLayout | Layout Int -- | Single step of the layout pass step :: Located Token {- ^ current token -} -> ([Layout] -> [Located Token]) {- ^ continuation -} -> [Layout] {- ^ stack of layout scopes -} -> [Located Token] {- ^ token stream with layout -} -- start blocks must be indented -- tokens before the current layout end the current layout -- note that EOF occurs on column 1 for properly formatted text files step t next cols = case cols of NoLayout:cols' | CloseMap <- locThing t -> t : next cols' _ | OpenMap <- locThing t -> t : next (NoLayout : cols) Layout col:_ | toCol t == col -> t{locThing=LayoutSep} : t : next cols Layout col:cols' | toCol t < col -> t{locThing=LayoutEnd} : step t next cols' Layout{}:_ | usesLayout t -> t : next (Layout (toCol t) : cols) _ -> t : next cols -- | Extract the column number from a located thing. toCol :: Located a -> Int toCol = posColumn . locPosition -- | Return True when a token starts a layout scope. usesLayout :: Located Token -> Bool usesLayout t | Section{} <- locThing t = True | Bullet{} <- locThing t = True | otherwise = False config-value-0.8.3/src/Config/Value.hs0000644000000000000000000000377207346545000015707 0ustar0000000000000000{-# Language DeriveGeneric, DeriveTraversable, DeriveDataTypeable, Safe #-} -- | This module provides the types used in this package for configuration. -- Visit "Config.Parser" to parse values of this type in a convenient -- layout based notation. module Config.Value ( Section(..) , Value(..) , Atom(..) , valueAnn ) where import Data.Text (Text) import Data.Data (Data, Typeable) import Data.String (IsString(..)) import GHC.Generics (Generic, Generic1) import Config.Number (Number) -- | A single section of a 'Value' -- -- Example: -- -- * @my-key: my-value@ is @'Section' _ "my-key" ('Atom' _ "my-value")@ data Section a = Section { sectionAnn :: a , sectionName :: Text , sectionValue :: Value a } deriving ( Eq, Read, Show, Typeable, Data , Functor, Foldable, Traversable , Generic, Generic1 ) -- | Wrapper to distinguish 'Atom' from 'Text' by -- type in a configuration. Atoms can be constructed -- using the @OverloadedStrings@ extension. newtype Atom = MkAtom { atomName :: Text } deriving ( Eq, Ord, Show, Read, Typeable, Data , Generic ) instance IsString Atom where fromString = MkAtom . fromString -- | 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. data Value a = 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 deriving ( Eq, Read, Show, Typeable, Data , Functor, Foldable, Traversable , Generic, Generic1 ) -- | Returns the annotation for a value. valueAnn :: Value a -> a valueAnn v = case v of Sections a _ -> a Number a _ -> a Text a _ -> a Atom a _ -> a List a _ -> a config-value-0.8.3/test/0000755000000000000000000000000007346545000013251 5ustar0000000000000000config-value-0.8.3/test/Main.hs0000644000000000000000000000723507346545000014500 0ustar0000000000000000{-# Language OverloadedStrings #-} {-| Module : Main Description : Unit tests for config-schema Copyright : (c) Eric Mertens, 2017 License : ISC Maintainer : emertens@gmail.com -} module Main (main) where import Config import Config.Number import Control.Monad (unless) import Data.Foldable import Data.Text (Text) import qualified Data.Text as Text parseTest :: Value () {- ^ expected value -} -> [Text] {- ^ input lines -} -> IO () parseTest expected txts = case parse (Text.unlines txts) of Left e -> fail (show e) Right v -> unless ((() <$ v) == expected) (fail (show (expected, () <$ v))) number :: Number -> Value () number = Number () atom :: Atom -> Value () atom = Atom () list :: [Value ()] -> Value () list = List () text :: Text -> Value () text = Text () sections :: [(Text, Value ())] -> Value () sections xs = Sections () [Section () k v | (k,v) <- xs] main :: IO () main = sequenceA_ [ parseTest (number (MkNumber (Radix10 0) 42)) ["42"] , parseTest (number (MkNumber (Radix10 56) 42)) ["42e56"] , parseTest (number (MkNumber (Radix10 56) 42.34)) ["42.34e56"] , parseTest (number (MkNumber (Radix10 0) 42.34)) ["42.34"] , parseTest (number (MkNumber (Radix10 0) 42)) ["42."] , parseTest (number (MkNumber (Radix10 0) 42)) ["042"] , parseTest (number (MkNumber (Radix16 0) 42)) ["0x2a"] , parseTest (number (MkNumber (Radix16 56) 42)) ["0x2ap56"] , parseTest (number (MkNumber (Radix16 56) (0x2a + (0x34 / 16^(2::Int))))) ["0x2a.34p56"] , parseTest (number (MkNumber (Radix16 0) (0x2a + (0x3f / 16^(2::Int))))) ["0x2a.3f"] , parseTest (number (MkNumber (Radix16 0) 42)) ["0x2a."] , parseTest (number (MkNumber (Radix16 0) 42)) ["0x02a"] , parseTest (number (MkNumber Radix2 42)) ["0b101010"] , parseTest (number (MkNumber Radix2 4)) ["0b0100"] , parseTest (number (MkNumber Radix2 4)) ["0b0100."] , parseTest (number (MkNumber Radix2 (4 + (22 / 2^(6::Int))))) ["0b100.010110"] , parseTest (number (MkNumber Radix8 55)) ["0o67"] , parseTest (number (MkNumber Radix8 55)) ["0o67."] , parseTest (number (MkNumber Radix8 55)) ["0o067"] , parseTest (number (MkNumber Radix8 (55 + (10 / 64)))) ["0o67.12"] , parseTest (atom "example") ["example"] , parseTest (atom "one-two") ["one-two"] , parseTest (atom "one-1") ["one-1"] , parseTest (list []) ["[ ]"] , parseTest (list []) ["[]"] , parseTest (list [atom "x"]) ["[x]"] , parseTest (list [atom "x"]) ["* x"] , parseTest (list [atom "x", atom "y", atom "z"]) ["[x, y, z]"] , parseTest (list [atom "x", atom "y", atom "z"]) ["* x", "* y", "* z"] , parseTest (list [atom "x", list [atom "y", atom "z"]]) ["[x,[y,z]]"] , parseTest (list [atom "x", list [atom "y", atom "z"]]) ["* x", "* [y,z]"] , parseTest (list [atom "x", list [atom "y", atom "z"]]) ["* x", "* * y", " * z"] , parseTest (text "string") ["\"string\""] , parseTest (text "\10string\1\2") ["\"\\x0ast\\&r\\ \\ing\\SOH\\^B\""] , parseTest (text "string") ["\"str\\", " \\ing\""] , parseTest (sections []) ["{}"] , parseTest (sections [("x", atom "y")]) ["{x:y}"] , parseTest (sections [("x", atom "y")]) ["x:y"] , parseTest (sections [("x", atom "y"), ("z", atom "w")]) ["{x:y,z:w}"] , parseTest (sections [("x", sections [("y", atom "z")])]) ["x:y:z"] , parseTest (sections [("x", sections [("y", atom "z")])]) ["x:" ," y:" ," z"] , parseTest (sections [("x", list [atom "y", atom "z"])]) ["x: * y" ," * z"] , parseTest (list [sections [("x", atom "y")], sections [("z", atom "w")]]) ["* x: y" ,"* z: w"] ]