diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +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 @@ -5,6 +5,8 @@ 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 -------- 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 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 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.15, array >= 0.4 && < 0.6, + containers >= 0.5 && < 0.7, pretty >= 1.1.1.0 && < 1.2, text >= 1.2.0.4 && < 1.3 build-tool-depends: alex:alex ^>= 3.2.4, - happy:happy ^>= 1.19.12, + happy:happy ^>= 1.19, 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 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. @@ -205,8 +205,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 \\. _ \\-]*@ @@ -270,8 +271,6 @@ 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 @@ -317,11 +316,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 @@ -25,7 +25,7 @@ $hexdigit = [0-9a-fA-F] $bindigit = [0-1] $white_no_nl = $white # \n -$charesc = [abfnrtv\\\"'] +$charesc = [abfnrtv\\\"'&] $cntrl = [A-Z@\[\\\]\^_] $alpha = [$unilower $uniupper $asciialpha] @@ -47,9 +47,8 @@ | @decimal | o @octal | x @hexadecimal - | & -@atom = $alpha [$alpha $digit $unidigit \. _ \-]* +@atom = [$alpha \$ \@] [$alpha $digit $unidigit \. _ \-]* @exponent = [Ee] [\-\+]? @decimal @hexexponent = [Pp] [\-\+]? @decimal 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 ------------------------------------------------------------------------ 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 there 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 @\@spilce@ +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/Pretty.hs b/src/Config/Pretty.hs --- a/src/Config/Pretty.hs +++ b/src/Config/Pretty.hs @@ -3,7 +3,7 @@ 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 +37,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)