diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,34 @@ +0.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 --- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,10 +1,12 @@ # 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) +[![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 -------- @@ -19,6 +21,8 @@ configuration: {} -- empty section + inline-maps: {key1: value1, key2: value2} + sections: "glguy" @@ -28,14 +32,16 @@ so you can comment out otherwise valid portions of your config -} - atoms : yes + atoms: yes - decimal : -1234 + decimal: -1234 hexadecimal: 0x1234 - octal : 0o1234 - binary : 0b1010 - floating : 12.34e56 + octal: 0o1234 + binary: 0b1010 + floats: [1e2, 0x3p-5, 24.48] + underscores: 1_000_000 + lists: * sections: in-lists next-section: still-in-list @@ -45,7 +51,10 @@ * "lists" * 3 -unicode : "standard Haskell format strings (1 ≤ 2)\x2228(2 ≤ 3)" +unicode: "standard Haskell format strings (1 ≤ 2)x2228(2 ≤ 3)" + +multiline: "haskell style\ + \string gaps" ``` Format diff --git a/config-value.cabal b/config-value.cabal --- a/config-value.cabal +++ b/config-value.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: config-value -version: 0.7.0.1 +version: 0.8.3 synopsis: Simple, layout-based value language similar to YAML or JSON license: MIT license-file: LICENSE @@ -15,7 +15,7 @@ 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.1 +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 @@ -28,6 +28,7 @@ Config Config.Lens Config.Number + Config.Macro other-modules: Config.Lexer @@ -39,14 +40,15 @@ Config.Value build-depends: - base >= 4.8 && < 4.14, + 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 && < 1.3 + text >= 1.2.0.4 && < 2.1, build-tool-depends: alex:alex ^>= 3.2.4, - happy:happy ^>= 1.19.12, + happy:happy >= 1.19 && <1.21, hs-source-dirs: src default-language: Haskell2010 diff --git a/config-value.vim b/config-value.vim --- a/config-value.vim +++ b/config-value.vim @@ -17,11 +17,15 @@ 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 @@ -35,3 +39,7 @@ hi def link cvComment Comment let b:current_syntax = "config-value" + +setlocal commentstring=--%s +setlocal comments=:-- +let b:undo_ftplugin = "setl com< commentstring<" diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -91,8 +91,8 @@ 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/ (.), +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. @@ -128,9 +128,11 @@ 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 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 @@ -205,8 +207,9 @@ /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 (-). +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 \\. _ \\-]*@ @@ -243,6 +246,7 @@ -- * Pretty-printing , pretty + , prettyInline -- * Types , Section(..) @@ -264,14 +268,12 @@ import Config.Number (Number, numberToInteger, numberToRational, integerToNumber, rationalToNumber) import Config.Value (Atom(..), Value(..), Section(..), valueAnn) import Config.Parser (parseValue) -import Config.Pretty (pretty) +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 Numeric (showIntAtBase) -import Data.Char (intToDigit) import Data.Text (Text) import qualified Data.Text as Text @@ -306,7 +308,7 @@ 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 -> "parse error: unexpected bullet '*'" + 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" @@ -317,11 +319,6 @@ 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 = diff --git a/src/Config/Lexer.x b/src/Config/Lexer.x --- a/src/Config/Lexer.x +++ b/src/Config/Lexer.x @@ -21,19 +21,20 @@ $asciialpha = [A-Z a-z] $digit = [0-9] -$octdigit = [0-7] -$hexdigit = [0-9a-fA-F] -$bindigit = [0-1] +$octit = [0-7] +$hexit = [0-9a-fA-F] +$binit = [0-1] $white_no_nl = $white # \n -$charesc = [abfnrtv\\\"'] +$charesc = [abfnrtv\\\"'&] $cntrl = [A-Z@\[\\\]\^_] $alpha = [$unilower $uniupper $asciialpha] +@spacer = _* -@decimal = $digit+ -@octal = $octdigit+ -@binary = $bindigit+ -@hexadecimal = $hexdigit+ +@decimal = $digit (@spacer $digit)* +@octal = $octit (@spacer $octit)* +@binary = $binit (@spacer $binit)* +@hexadecimal = $hexit (@spacer $hexit)* -- Copied from Haskell 2010 @ascii = \^ $cntrl @@ -44,15 +45,14 @@ | SP | DEL @escape = $charesc | @ascii - | @decimal - | o @octal - | x @hexadecimal - | & + | $digit+ + | o $octit+ + | x $hexit+ -@atom = $alpha [$alpha $digit $unidigit \. _ \-]* +@atom = [$alpha \$ \@] [$alpha $digit $unidigit \. _ \-]* -@exponent = [Ee] [\-\+]? @decimal -@hexexponent = [Pp] [\-\+]? @decimal +@exponent = @spacer [Ee] [\-\+]? @decimal +@hexexponent = @spacer [Pp] [\-\+]? @decimal config :- @@ -65,12 +65,14 @@ "[" { token_ OpenList } "," { token_ Comma } "]" { token_ CloseList } -"*" { token_ Bullet } +"*" { token Bullet } +"-" { token Bullet } +"+" { token Bullet } -"-"? 0 [Xx] @hexadecimal ("." @hexadecimal?)? @hexexponent? { token number } -"-"? 0 [Oo] @octal ("." @octal ?)? { token number } -"-"? 0 [Bb] @binary ("." @binary ?)? { token number } -"-"? @decimal ("." @decimal ?)? @exponent? { token number } +"-"? 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 } diff --git a/src/Config/LexerUtils.hs b/src/Config/LexerUtils.hs --- a/src/Config/LexerUtils.hs +++ b/src/Config/LexerUtils.hs @@ -27,16 +27,12 @@ , errorAction ) where -import Control.Applicative -import Data.Char (GeneralCategory(..), generalCategory, digitToInt, - isAscii, isSpace, ord, isDigit, isHexDigit) +import Data.Char (GeneralCategory(..), generalCategory, isAscii, isSpace, ord) import Data.Text (Text) import Data.Word (Word8) -import Numeric (readInt, readHex) import qualified Data.Text as Text import Config.Tokens -import Config.Number import qualified Config.NumberParser ------------------------------------------------------------------------ @@ -152,7 +148,8 @@ number :: Text {- ^ sign-prefix-digits -} -> Token -number = Number . Config.NumberParser.number . Text.unpack . Text.toUpper +number = Number . Config.NumberParser.number + . Text.unpack . Text.toUpper . Text.filter ('_' /=) -- | Process a section heading token section :: Text -> Token diff --git a/src/Config/Macro.hs b/src/Config/Macro.hs new file mode 100644 --- /dev/null +++ b/src/Config/Macro.hs @@ -0,0 +1,260 @@ +{-# 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 diff --git a/src/Config/Number.hs b/src/Config/Number.hs --- a/src/Config/Number.hs +++ b/src/Config/Number.hs @@ -1,4 +1,4 @@ -{-# Language DeriveDataTypeable, DeriveGeneric #-} +{-# Language DeriveDataTypeable, DeriveGeneric, Safe #-} {-| Module : Config.Number Description : Scientific-notation numbers with explicit radix @@ -61,17 +61,17 @@ Radix16{} -> 16 -- | Convert a number to a 'Rational'. Warning: This can use a --- lot of member in the case of very large exponent parts. +-- 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 + Radix16 e -> c * 2 ^^ e -- | Convert a number to a 'Integer'. Warning: This can use a --- lot of member in the case of very large exponent parts. +-- lot of memory in the case of very large exponent parts. numberToInteger :: Number -> Maybe Integer numberToInteger n | denominator r == 1 = Just $! numerator r @@ -85,4 +85,4 @@ -- | 'Rational' to a radix 10 'Number' with no exponent rationalToNumber :: Rational -> Number -rationalToNumber r = (MkNumber (Radix10 0) r) +rationalToNumber = MkNumber (Radix10 0) diff --git a/src/Config/Parser.y b/src/Config/Parser.y --- a/src/Config/Parser.y +++ b/src/Config/Parser.y @@ -1,5 +1,5 @@ { -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Trustworthy, OverloadedStrings #-} module Config.Parser (parseValue) where @@ -15,11 +15,13 @@ STRING { Located _ T.String{} } ATOM { Located _ T.Atom{} } NUMBER { Located _ T.Number{} } -'*' { Located $$ T.Bullet } -'[' { Located $$ T.OpenList } +'*' { Located $$ (T.Bullet "*") } +'+' { Located $$ (T.Bullet "+") } +'-' { Located $$ (T.Bullet "-") } +'[' { Located $$ T.OpenList } ',' { Located _ T.Comma } ']' { Located _ T.CloseList } -'{' { Located $$ T.OpenMap } +'{' { Located $$ T.OpenMap } '}' { Located _ T.CloseMap } SEP { Located _ T.LayoutSep } END { Located _ T.LayoutEnd } @@ -37,7 +39,9 @@ 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) } + | '+' list('+') END { List $1 (reverse $2) } | simple { $1 } simple :: { Value Position } @@ -70,9 +74,9 @@ section :: { Section Position } : SECTION value { section $1 $2 } -list :: { [Value Position] } - : value { [$1] } - | list SEP '*' value { $4 : $1 } +list(blt) :: { [Value Position] } + : value { [$1] } + | list(blt) SEP blt value { $4 : $1 } inlinelist :: { [Value Position] } : { [] } diff --git a/src/Config/Pretty.hs b/src/Config/Pretty.hs --- a/src/Config/Pretty.hs +++ b/src/Config/Pretty.hs @@ -1,9 +1,10 @@ +{-# Language Safe #-} -- | Pretty-printing implementation for 'Value' -module Config.Pretty (pretty) where +module Config.Pretty (pretty, prettyInline) where import Data.Char (isPrint, isDigit,intToDigit) import Data.List (mapAccumL) -import Data.Ratio (numerator, denominator) +import Data.Ratio (denominator) import qualified Data.Text as Text import Text.PrettyPrint import Numeric(showIntAtBase) @@ -37,16 +38,17 @@ where radix = radixToInt r pref = if c < 0 then char '-' else empty - num = text (showIntAtBase (fromIntegral radix) intToDigit whole "") -- XXX - <> fracPart frac - (whole,frac) = properFraction (abs c) + num = text (showIntAtBase (fromIntegral radix) intToDigit whole "") + <> fracPart + (whole,frac) = properFraction (abs c) :: (Integer, Rational) expPart _ 0 = text "" - expPart c i = text (c : show i) - fracPart 0 = text "" - fracPart i = text ('.' : showFrac radix frac) + expPart p i = text (p : show i) + fracPart + | 0 == frac = text "" + | otherwise = text ('.' : showFrac radix frac) showFrac :: Int -> Rational -> String -showFrac radix 0 = "" +showFrac _ 0 = "" showFrac radix x = intToDigit w : rest where (w,f) = properFraction (x * fromIntegral radix) @@ -55,7 +57,7 @@ | otherwise = "" prettyText :: String -> Doc -prettyText = doubleQuotes . cat . snd . mapAccumL ppChar True +prettyText = doubleQuotes . hcat . snd . mapAccumL ppChar True where ppChar s x | isDigit x = (True, if not s then text "\\&" <> char x else char x) @@ -93,3 +95,15 @@ 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 diff --git a/src/Config/Tokens.hs b/src/Config/Tokens.hs --- a/src/Config/Tokens.hs +++ b/src/Config/Tokens.hs @@ -1,3 +1,4 @@ +{-# 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 @@ -10,7 +11,7 @@ ) where import Data.Text (Text) -import Config.Number +import Config.Number (Number) -- | A position in a text file data Position = Position @@ -36,7 +37,7 @@ = Section Text | String Text | Atom Text - | Bullet + | Bullet Text | Comma | Number Number | OpenList @@ -99,5 +100,5 @@ usesLayout :: Located Token -> Bool usesLayout t | Section{} <- locThing t = True - | Bullet <- locThing t = True + | Bullet{} <- locThing t = True | otherwise = False diff --git a/src/Config/Value.hs b/src/Config/Value.hs --- a/src/Config/Value.hs +++ b/src/Config/Value.hs @@ -1,4 +1,4 @@ -{-# Language DeriveGeneric, DeriveTraversable, DeriveDataTypeable #-} +{-# 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 @@ -21,7 +21,7 @@ -- -- Example: -- --- * @my-key: my-value@ is @'Section' _ ('Atom' _ "my-key") ('Atom' _ "my-value")@ +-- * @my-key: my-value@ is @'Section' _ "my-key" ('Atom' _ "my-value")@ data Section a = Section { sectionAnn :: a , sectionName :: Text