config-value-0.6.3/0000755000000000000000000000000013112313157012262 5ustar0000000000000000config-value-0.6.3/CHANGELOG.md0000644000000000000000000000230113112313157014067 0ustar00000000000000000.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.6.3/config-value.cabal0000644000000000000000000000323413112313157015627 0ustar0000000000000000name: config-value version: 0.6.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 Eric Mertens category: Language build-type: Simple cabal-version: >=1.10 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==7.10.3, GHC==8.0.2, GHC==8.2.1 extra-source-files: README.md CHANGELOG.md config-value.vim library exposed-modules: Config, Config.Lens other-modules: Config.Lexer, Config.LexerUtils, Config.Parser, Config.Tokens, Config.Pretty, Config.Value build-depends: base >= 4.8 && < 4.11, array >= 0.4 && < 0.6, pretty >= 1.1.1.0 && < 1.2, text >= 1.2.0.4 && < 1.3 hs-source-dirs: src build-tools: alex, happy default-language: Haskell2010 source-repository head type: git location: git://github.com/glguy/config-value.git config-value-0.6.3/config-value.vim0000644000000000000000000000330313112313157015355 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 cvStringGap contained "\\[\n\ \t]*\\" syn match cvSpecialChar contained "\\\([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=cvStringGap,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 cvAtom "\<[a-zA-Z][a-zA-Z0-9\._\-]*\>" syn match cvLineComment "--.*$" syn region cvBlockComment start="{-" end="-}" contains=cvString,cvBlockComment hi def link cvAtom Identifier hi def link cvDelimiter Delimiter hi def link cvSpecialChar SpecialChar hi def link cvStringGap 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" config-value-0.6.3/LICENSE0000644000000000000000000000204013112313157013263 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.6.3/README.md0000644000000000000000000000354313112313157013546 0ustar0000000000000000# config-value [![Hackage](https://img.shields.io/hackage/v/config-value.svg)](https://hackage.haskell.org/package/config-value) [![Build Status](https://secure.travis-ci.org/glguy/config-value.svg)](http://travis-ci.org/glguy/config-value) This package implements a simple, layout-based value definition language used for supplying configuration values to various applications. 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 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 floating : 12.34e56 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)" ``` 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.6.3/Setup.hs0000644000000000000000000000005613112313157013717 0ustar0000000000000000import Distribution.Simple main = defaultMain config-value-0.6.3/src/0000755000000000000000000000000013112313157013051 5ustar0000000000000000config-value-0.6.3/src/Config.hs0000644000000000000000000002257313112313157014623 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/ 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 == 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 -} @ -} module Config ( -- * Parsing parse , Position(..) -- * Pretty-printing , pretty -- * Types , Section(..) , Value(..) , Atom(..) , valueAnn -- * Errors , ParseError(..) ) where import Config.Value (Atom(..), Value(..), Section(..), valueAnn) import Config.Parser (parseValue) import Config.Pretty (pretty) import Config.Lexer (scanTokens) import Config.Tokens (Error(..), Position(..), Located(..), layoutPass, Token) import qualified Config.Tokens as T import Control.Exception (Exception(..)) import Numeric (showIntAtBase) import Data.Char (intToDigit) 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.Floating{} -> "parse error: unexpected floating-point literal" T.Atom atom -> "parse error: unexpected atom: `" ++ Text.unpack atom ++ "`" T.String str -> "parse error: unexpected string: " ++ show (Text.unpack str) T.Bullet -> "parse error: unexpected bullet '*'" T.Comma -> "parse error: unexpected comma ','" T.Section s -> "parse error: unexpected section: `" ++ Text.unpack s ++ "`" T.Number 2 n -> "parse error: unexpected number: " ++ showIntAtBase' "0b" 2 intToDigit n "" T.Number 8 n -> "parse error: unexpected number: " ++ showIntAtBase' "0o" 8 intToDigit n "" T.Number 16 n -> "parse error: unexpected number: " ++ showIntAtBase' "0x" 16 intToDigit n "" T.Number _ n -> "parse error: unexpected number: " ++ showIntAtBase' "" 10 intToDigit n "" 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" showIntAtBase' :: (Show a, Integral a) => String -> a -> (Int -> Char) -> a -> ShowS showIntAtBase' pfx base toDigit n | n < 0 = showChar '-' . showString pfx . showIntAtBase base toDigit (negate n) | otherwise = showString pfx . showIntAtBase base toDigit n 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.6.3/src/Config/0000755000000000000000000000000013112313157014256 5ustar0000000000000000config-value-0.6.3/src/Config/Lens.hs0000644000000000000000000000643113112313157015517 0ustar0000000000000000-- | Optics for compatibility with the lens package module Config.Lens ( key , text , number , atom , list , values , sections , ann , valuePlate ) where import Config.Value import Data.Text -- | Apply a function to the subsections of the given value when -- that value is a @Sections@ and the subsection name matches the -- given section name key :: Applicative f => Text {- ^ section name -} -> (Value a -> f (Value a)) -> Value a -> f (Value a) key i = sections . traverse . section i -- | Apply a function to the 'Value' contained inside the given -- 'Value' when it is a 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 -- | Apply a function to 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 -- | Apply a function to the 'Text' contained inside the given -- 'Value' when it is a @Text@. text :: Applicative f => (Text -> f Text) -> Value a -> f (Value a) text f (Text a t) = Text a <$> f t text _ v = pure v -- | Apply a function to the 'Text' contained inside the given -- 'Value' when it is a @Text@. This traversal is only valid -- if the output atom is a valid atom! atom :: Applicative f => (Atom -> f Atom) -> Value a -> f (Value a) atom f (Atom a t) = Atom a <$> f t atom _ v = pure v -- | Apply a function to the 'Integer' contained inside the given -- 'Value' when it is a @Number@. number :: Applicative f => (Integer -> f Integer) -> Value a -> f (Value a) number f (Number a b n) = Number a b <$> f n number _ v = pure v -- | Apply a function to 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 -- | Apply a function to any of 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 -- | Apply a function to 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 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 y -> (\a' -> Number a' x y) <$> f a Floating a x y -> (\a' -> Floating a' x y) <$> 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.6.3/src/Config/Lexer.x0000644000000000000000000000742013112313157015531 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] $octdigit = [0-7] $hexdigit = [0-9a-fA-F] $bindigit = [0-1] $white_no_nl = $white # \n $charesc = [abfnrtv\\\"'] $cntrl = [A-Z@\[\\\]\^_] $alpha = [$unilower $uniupper $asciialpha] @decimal = $digit+ @octal = $octdigit+ @binary = $bindigit+ @hexadecimal = $hexdigit+ -- 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 | @decimal | o @octal | x @hexadecimal | & @atom = $alpha [$alpha $digit $unidigit \. _ \-]* @exponent = [Ee] [\-\+]? @decimal config :- <0> { $white+ ; "--" .* ; "{" { token_ OpenMap } "}" { token_ CloseMap } "[" { token_ OpenList } "," { token_ Comma } "]" { token_ CloseList } "*" { token_ Bullet } "-"? 0 [Xx] @hexadecimal{ token (number 2 16) } "-"? 0 [Oo] @octal { token (number 2 8) } "-"? 0 [Bb] @binary { token (number 2 2) } "-"? @decimal { token (number 0 10) } "-"? @decimal ("." @decimal)? @exponent? { token floating } @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.6.3/src/Config/LexerUtils.hs0000644000000000000000000002033613112313157016716 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 where import Data.Char (GeneralCategory(..), generalCategory, digitToInt, isAscii, isSpace, ord, isDigit) import Data.Text (Text) import Data.Word (Word8) import Numeric (readInt) import qualified Data.Text as Text import Config.Tokens ------------------------------------------------------------------------ -- 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) ------------------------------------------------------------------------ -- | The initial 'Position' for the start of a file startPos :: Position startPos = Position { posIndex = 0, posLine = 1, posColumn = 1 } -- | 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 :: Int {- ^ prefix length -} -> Int {- ^ base -} -> Text {- ^ sign-prefix-digits -} -> Token number prefixLen base str = case readInt (fromIntegral base) (const True) digitToInt str2 of [(n,"")] -> Number base (s*n) _ -> error "number: Lexer failure" where str2 = drop prefixLen str1 (s,str1) = case Text.unpack str of '-':rest -> (-1, rest) rest -> ( 1, rest) -- | Construct a 'Floating' token from a lexeme. floating :: Text {- ^ sign-integer-[. decimal][e exponent] -} -> Token floating str = Floating (s * read (x1++x2)) (x3-fromIntegral (length x2)) where (s,str1) = case Text.unpack str of '-':rest -> (-1, rest) rest -> ( 1, rest) (x1,str2) = span isDigit str1 (x2,str3) = case str2 of '.':xs -> span isDigit xs _ -> ("", str2) x3 = case str3 of [] -> 0 _e:'+':xs -> read xs _e:xs -> read xs -- | 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.6.3/src/Config/Parser.y0000644000000000000000000001267113112313157015713 0ustar0000000000000000{ {-# LANGUAGE Trustworthy #-} 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{} } FLOATING { Located _ T.Floating{} } '*' { 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) } | simple { $1 } simple :: { Value Position } : NUMBER { number $1 } | FLOATING { floating $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 :: { [Value Position] } : value { [$1] } | list SEP '*' 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 two value matched from -- the constructor. number :: Located Token -> Value Position number = \(Located a (T.Number base val)) -> Number a base val -- | Convert floating token to floating value. This needs a custom -- function like this because there are two value matched from -- the constructor. floating :: Located Token -> Value Position floating = \(Located a (T.Floating coef expo)) -> Floating a coef expo 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.6.3/src/Config/Pretty.hs0000644000000000000000000000505313112313157016104 0ustar0000000000000000-- | Pretty-printing implementation for 'Value' module Config.Pretty where import Data.Char (isPrint, isDigit,intToDigit) import Data.List (mapAccumL) import qualified Data.Text as Text import Text.PrettyPrint import Numeric(showIntAtBase) import Config.Value -- | 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 _ b n -> prettyNum b n Floating _ c e-> prettyFloating c e Text _ t -> prettyText (Text.unpack t) Atom _ t -> text (Text.unpack (atomName t)) List _ [] -> text "[]" List _ xs -> vcat [ char '*' <+> pretty x | x <- xs ] prettyNum :: Int -> Integer -> Doc prettyNum b n | b == 16 = pref <> text "0x" <> num | b == 8 = pref <> text "0o" <> num | b == 2 = pref <> text "0b" <> num | otherwise = integer n where pref = if n < 0 then char '-' else empty num = text (showIntAtBase (fromIntegral b) intToDigit (abs n) "") prettyFloating :: Integer -> Integer -> Doc prettyFloating c e = text (show c ++ "e" ++ show e) prettyText :: String -> Doc prettyText = doubleQuotes . cat . 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 config-value-0.6.3/src/Config/Tokens.hs0000644000000000000000000000523213112313157016057 0ustar0000000000000000-- | 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(..) , Error(..) , layoutPass ) where import Data.Text (Text) -- | A position in a text file data Position = Position { posIndex, posLine, posColumn :: {-# UNPACK #-} !Int } deriving (Read, Show, Ord, Eq) -- | 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 | Comma | Number Int Integer | Floating Integer Integer | 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 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.6.3/src/Config/Value.hs0000644000000000000000000000503513112313157015671 0ustar0000000000000000{-# Language DeriveGeneric, DeriveTraversable, DeriveDataTypeable #-} -- | This module provides the types used in this package for configuration. -- Visit "ConfigFile.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) -- | A single section of a 'Value' -- -- Example: -- -- * @my-key: my-value@ is @'Section' ('Atom' "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. -- -- 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: -- -- * @0xff@ is @'Number' 16 255@ -- -- * @123@ is @'Number' 10 123@ -- -- * @123e10@ is @'Floating' 123 10@ -- * @123.45@ is @'Floating' 12345 (-2)@ data Value a = 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 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 Floating a _ _ -> a Text a _ -> a Atom a _ -> a List a _ -> a