Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-toml-parser for openSUSE:Factory
checked in at 2023-12-05 17:03:50
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-toml-parser (Old)
and /work/SRC/openSUSE:Factory/.ghc-toml-parser.new.25432 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-toml-parser"
Tue Dec 5 17:03:50 2023 rev:2 rq:1130924 version:1.3.1.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-toml-parser/ghc-toml-parser.changes
2023-11-23 21:43:08.072986124 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-toml-parser.new.25432/ghc-toml-parser.changes
2023-12-05 17:04:13.919394105 +0100
@@ -1,0 +2,9 @@
+Tue Nov 28 18:44:21 UTC 2023 - Peter Simons <[email protected]>
+
+- Update toml-parser to version 1.3.1.0.
+ ## 1.3.1.0
+
+ * Added `Toml.Semantics.Ordered` for preserving input TOML orderings
+ * Added support for pretty-printing multi-line strings
+
+-------------------------------------------------------------------
Old:
----
toml-parser-1.3.0.0.tar.gz
New:
----
toml-parser-1.3.1.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-toml-parser.spec ++++++
--- /var/tmp/diff_new_pack.6PI80X/_old 2023-12-05 17:04:15.371447629 +0100
+++ /var/tmp/diff_new_pack.6PI80X/_new 2023-12-05 17:04:15.375447776 +0100
@@ -20,7 +20,7 @@
%global pkgver %{pkg_name}-%{version}
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.3.0.0
+Version: 1.3.1.0
Release: 0
Summary: TOML 1.0.0 parser
License: ISC
++++++ toml-parser-1.3.0.0.tar.gz -> toml-parser-1.3.1.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/ChangeLog.md
new/toml-parser-1.3.1.0/ChangeLog.md
--- old/toml-parser-1.3.0.0/ChangeLog.md 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/ChangeLog.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,5 +1,10 @@
# Revision history for toml-parser
+## 1.3.1.0
+
+* Added `Toml.Semantics.Ordered` for preserving input TOML orderings
+* Added support for pretty-printing multi-line strings
+
## 1.3.0.0 -- 2023-07-16
* Make more structured error messages available in the low-level modules.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/README.lhs
new/toml-parser-1.3.1.0/README.lhs
--- old/toml-parser-1.3.0.0/README.lhs 2001-09-09 03:46:40.000000000 +0200
+++ new/toml-parser-1.3.1.0/README.lhs 2001-09-09 03:46:40.000000000 +0200
@@ -41,18 +41,27 @@
to ensure that its code typechecks and stays in sync with the rest of the
package.
```haskell
-import Toml (parse, decode, Value(..))
-import Toml.FromValue (FromValue(fromValue), parseTableFromValue, reqKey,
optKey)
+import GHC.Generics (Generic)
+import QuoteStr (quoteStr)
+import Test.Hspec (Spec, hspec, it, shouldBe)
+import Toml (parse, decode, encode, Value(..))
+import Toml.FromValue (Result(Success), FromValue(fromValue),
parseTableFromValue, reqKey)
import Toml.FromValue.Generic (genericParseTable)
-import Toml.ToValue (ToValue(toValue), ToTable(toTable), defaultTableToValue)
+import Toml.ToValue (ToValue(toValue), ToTable(toTable), defaultTableToValue,
table, (.=))
import Toml.ToValue.Generic (genericToTable)
-import GHC.Generics (Generic)
-main = pure ()
+
+main :: IO ()
+main = hspec (parses >> decodes >> encodes)
```
### Using the raw parser
-Consider this sample TOML text from the specification.
+Consider this sample TOML text from the TOML specification.
+
+```haskell
+fruitStr :: String
+fruitStr = [quoteStr|
+```
```toml
[[fruits]]
@@ -76,52 +85,58 @@
name = "plantain"
```
+```haskell
+|]
+```
+
Parsing using this package generates the following value
-```haskell ignore
->>> parse fruitStr
-Right (fromList [
- ("fruits",Array [
- Table (fromList [
- ("name",String "apple"),
- ("physical",Table (fromList [
- ("color",String "red"),
- ("shape",String "round")])),
- ("varieties",Array [
- Table (fromList [("name",String "red delicious")]),
- Table (fromList [("name",String "granny smith")])])]),
- Table (fromList [
- ("name",String "banana"),
- ("varieties",Array [
- Table (fromList [("name",String "plantain")])])])])])
-```
-
-We can render this parsed value back to TOML text using `prettyToml fruitToml`.
-In this case the input was already sorted, so the generated text will happen
-to match almost exactly.
+```haskell
+parses :: Spec
+parses = it "parses" $
+ parse fruitStr
+ `shouldBe`
+ Right (table [
+ ("fruits", Array [
+ Table (table [
+ ("name", String "apple"),
+ ("physical", Table (table [
+ ("color", String "red"),
+ ("shape", String "round")])),
+ ("varieties", Array [
+ Table (table [("name", String "red delicious")]),
+ Table (table [("name", String "granny smith")])])]),
+ Table (table [
+ ("name", String "banana"),
+ ("varieties", Array [
+ Table (table [("name", String "plantain")])])])])])
+```
### Using decoding classes
Here's an example of defining datatypes and deserializers for the TOML above.
+The `FromValue` typeclass is used to encode each datatype into a TOML value.
+Instances can be derived for simple record types. More complex examples can
+be manually derived.
```haskell
-newtype Fruits = Fruits [Fruit]
- deriving (Eq, Show)
+newtype Fruits = Fruits { fruits :: [Fruit] }
+ deriving (Eq, Show, Generic)
-data Fruit = Fruit String (Maybe Physical) [Variety]
- deriving (Eq, Show)
+data Fruit = Fruit { name :: String, physical :: Maybe Physical, varieties ::
[Variety] }
+ deriving (Eq, Show, Generic)
-data Physical = Physical String String
- deriving (Eq, Show)
+data Physical = Physical { color :: String, shape :: String }
+ deriving (Eq, Show, Generic)
newtype Variety = Variety String
- deriving (Eq, Show)
+ deriving (Eq, Show, Generic)
instance FromValue Fruits where
- fromValue = parseTableFromValue (Fruits <$> reqKey "fruits")
+ fromValue = parseTableFromValue genericParseTable
instance FromValue Fruit where
- fromValue = parseTableFromValue (Fruit <$> reqKey "name" <*> optKey
"physical" <*> reqKey "varieties")
+ fromValue = parseTableFromValue genericParseTable
instance FromValue Physical where
fromValue = parseTableFromValue (Physical <$> reqKey "color" <*> reqKey
"shape")
@@ -132,32 +147,67 @@
We can run this example on the original value to deserialize it into
domain-specific datatypes.
-```haskell ignore
->>> decode fruitStr :: Result Fruits
-Success [] (Fruits [
- Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious",
Variety "granny smith"],
- Fruit "banana" Nothing [Variety "plantain"]])
-```
-
-### Generics
+```haskell
+decodes :: Spec
+decodes = it "decodes" $
+ decode fruitStr
+ `shouldBe`
+ Success [] (Fruits [
+ Fruit
+ "apple"
+ (Just (Physical "red" "round"))
+ [Variety "red delicious", Variety "granny smith"],
+ Fruit "banana" Nothing [Variety "plantain"]])
+```
+
+### Using encoding classes
+
+The `ToValue` class is for all datatypes that can be encoded into TOML.
+The more specialized `ToTable` class is for datatypes that encode into
+tables and are thus elligible to be top-level types (all TOML documents
+are tables at the top-level).
-Code for generating and matching tables to records can be derived
-using GHC.Generics. This will generate tables using the field names
-as table keys.
+Generics can be used to derive `ToTable` for simple record types.
+Manually defined instances are available for the more complex cases.
```haskell
-data ExampleRecord = ExampleRecord {
- exString :: String,
- exList :: [Int],
- exOpt :: Maybe Bool}
- deriving (Show, Generic, Eq)
+instance ToValue Fruits where toValue = defaultTableToValue
+instance ToValue Fruit where toValue = defaultTableToValue
+instance ToValue Physical where toValue = defaultTableToValue
+instance ToValue Variety where toValue = defaultTableToValue
+
+instance ToTable Fruits where toTable = genericToTable
+instance ToTable Fruit where toTable = genericToTable
+instance ToTable Physical where toTable x = table ["color" .= color x, "shape"
.= shape x]
+instance ToTable Variety where toTable (Variety x) = table ["name" .= x]
+
+encodes :: Spec
+encodes = it "encodes" $
+ show (encode (Fruits [Fruit
+ "apple"
+ (Just (Physical "red" "round"))
+ [Variety "red delicious", Variety "granny smith"]]))
+ `shouldBe` [quoteStr|
+ [[fruits]]
+ name = "apple"
+
+ [fruits.physical]
+ color = "red"
+ shape = "round"
-instance FromValue ExampleRecord where fromValue = parseTableFromValue
genericParseTable
-instance ToTable ExampleRecord where toTable = genericToTable
-instance ToValue ExampleRecord where toValue = defaultTableToValue
+ [[fruits.varieties]]
+ name = "red delicious"
+
+ [[fruits.varieties]]
+ name = "granny smith"|]
```
-### Larger Example
+## More Examples
A demonstration of using this package at a more realistic scale
-can be found in [HieDemoSpec](test/HieDemoSpec.hs).
+can be found in [HieDemoSpec](test/HieDemoSpec.hs). The various unit
+test files demonstrate what you can do with this library and what
+outputs you can expect.
+
+See the low-level operations used to build a TOML syntax highlighter
+in [TomlHighlighter](test-drivers/highlighter/Main.hs).
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/README.md
new/toml-parser-1.3.1.0/README.md
--- old/toml-parser-1.3.0.0/README.md 2001-09-09 03:46:40.000000000 +0200
+++ new/toml-parser-1.3.1.0/README.md 2001-09-09 03:46:40.000000000 +0200
@@ -41,18 +41,27 @@
to ensure that its code typechecks and stays in sync with the rest of the
package.
```haskell
-import Toml (parse, decode, Value(..))
-import Toml.FromValue (FromValue(fromValue), parseTableFromValue, reqKey,
optKey)
+import GHC.Generics (Generic)
+import QuoteStr (quoteStr)
+import Test.Hspec (Spec, hspec, it, shouldBe)
+import Toml (parse, decode, encode, Value(..))
+import Toml.FromValue (Result(Success), FromValue(fromValue),
parseTableFromValue, reqKey)
import Toml.FromValue.Generic (genericParseTable)
-import Toml.ToValue (ToValue(toValue), ToTable(toTable), defaultTableToValue)
+import Toml.ToValue (ToValue(toValue), ToTable(toTable), defaultTableToValue,
table, (.=))
import Toml.ToValue.Generic (genericToTable)
-import GHC.Generics (Generic)
-main = pure ()
+
+main :: IO ()
+main = hspec (parses >> decodes >> encodes)
```
### Using the raw parser
-Consider this sample TOML text from the specification.
+Consider this sample TOML text from the TOML specification.
+
+```haskell
+fruitStr :: String
+fruitStr = [quoteStr|
+```
```toml
[[fruits]]
@@ -76,52 +85,58 @@
name = "plantain"
```
+```haskell
+|]
+```
+
Parsing using this package generates the following value
-```haskell ignore
->>> parse fruitStr
-Right (fromList [
- ("fruits",Array [
- Table (fromList [
- ("name",String "apple"),
- ("physical",Table (fromList [
- ("color",String "red"),
- ("shape",String "round")])),
- ("varieties",Array [
- Table (fromList [("name",String "red delicious")]),
- Table (fromList [("name",String "granny smith")])])]),
- Table (fromList [
- ("name",String "banana"),
- ("varieties",Array [
- Table (fromList [("name",String "plantain")])])])])])
-```
-
-We can render this parsed value back to TOML text using `prettyToml fruitToml`.
-In this case the input was already sorted, so the generated text will happen
-to match almost exactly.
+```haskell
+parses :: Spec
+parses = it "parses" $
+ parse fruitStr
+ `shouldBe`
+ Right (table [
+ ("fruits", Array [
+ Table (table [
+ ("name", String "apple"),
+ ("physical", Table (table [
+ ("color", String "red"),
+ ("shape", String "round")])),
+ ("varieties", Array [
+ Table (table [("name", String "red delicious")]),
+ Table (table [("name", String "granny smith")])])]),
+ Table (table [
+ ("name", String "banana"),
+ ("varieties", Array [
+ Table (table [("name", String "plantain")])])])])])
+```
### Using decoding classes
Here's an example of defining datatypes and deserializers for the TOML above.
+The `FromValue` typeclass is used to encode each datatype into a TOML value.
+Instances can be derived for simple record types. More complex examples can
+be manually derived.
```haskell
-newtype Fruits = Fruits [Fruit]
- deriving (Eq, Show)
+newtype Fruits = Fruits { fruits :: [Fruit] }
+ deriving (Eq, Show, Generic)
-data Fruit = Fruit String (Maybe Physical) [Variety]
- deriving (Eq, Show)
+data Fruit = Fruit { name :: String, physical :: Maybe Physical, varieties ::
[Variety] }
+ deriving (Eq, Show, Generic)
-data Physical = Physical String String
- deriving (Eq, Show)
+data Physical = Physical { color :: String, shape :: String }
+ deriving (Eq, Show, Generic)
newtype Variety = Variety String
- deriving (Eq, Show)
+ deriving (Eq, Show, Generic)
instance FromValue Fruits where
- fromValue = parseTableFromValue (Fruits <$> reqKey "fruits")
+ fromValue = parseTableFromValue genericParseTable
instance FromValue Fruit where
- fromValue = parseTableFromValue (Fruit <$> reqKey "name" <*> optKey
"physical" <*> reqKey "varieties")
+ fromValue = parseTableFromValue genericParseTable
instance FromValue Physical where
fromValue = parseTableFromValue (Physical <$> reqKey "color" <*> reqKey
"shape")
@@ -132,32 +147,67 @@
We can run this example on the original value to deserialize it into
domain-specific datatypes.
-```haskell ignore
->>> decode fruitStr :: Result Fruits
-Success [] (Fruits [
- Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious",
Variety "granny smith"],
- Fruit "banana" Nothing [Variety "plantain"]])
-```
-
-### Generics
+```haskell
+decodes :: Spec
+decodes = it "decodes" $
+ decode fruitStr
+ `shouldBe`
+ Success [] (Fruits [
+ Fruit
+ "apple"
+ (Just (Physical "red" "round"))
+ [Variety "red delicious", Variety "granny smith"],
+ Fruit "banana" Nothing [Variety "plantain"]])
+```
+
+### Using encoding classes
+
+The `ToValue` class is for all datatypes that can be encoded into TOML.
+The more specialized `ToTable` class is for datatypes that encode into
+tables and are thus elligible to be top-level types (all TOML documents
+are tables at the top-level).
-Code for generating and matching tables to records can be derived
-using GHC.Generics. This will generate tables using the field names
-as table keys.
+Generics can be used to derive `ToTable` for simple record types.
+Manually defined instances are available for the more complex cases.
```haskell
-data ExampleRecord = ExampleRecord {
- exString :: String,
- exList :: [Int],
- exOpt :: Maybe Bool}
- deriving (Show, Generic, Eq)
+instance ToValue Fruits where toValue = defaultTableToValue
+instance ToValue Fruit where toValue = defaultTableToValue
+instance ToValue Physical where toValue = defaultTableToValue
+instance ToValue Variety where toValue = defaultTableToValue
+
+instance ToTable Fruits where toTable = genericToTable
+instance ToTable Fruit where toTable = genericToTable
+instance ToTable Physical where toTable x = table ["color" .= color x, "shape"
.= shape x]
+instance ToTable Variety where toTable (Variety x) = table ["name" .= x]
+
+encodes :: Spec
+encodes = it "encodes" $
+ show (encode (Fruits [Fruit
+ "apple"
+ (Just (Physical "red" "round"))
+ [Variety "red delicious", Variety "granny smith"]]))
+ `shouldBe` [quoteStr|
+ [[fruits]]
+ name = "apple"
+
+ [fruits.physical]
+ color = "red"
+ shape = "round"
-instance FromValue ExampleRecord where fromValue = parseTableFromValue
genericParseTable
-instance ToTable ExampleRecord where toTable = genericToTable
-instance ToValue ExampleRecord where toValue = defaultTableToValue
+ [[fruits.varieties]]
+ name = "red delicious"
+
+ [[fruits.varieties]]
+ name = "granny smith"|]
```
-### Larger Example
+## More Examples
A demonstration of using this package at a more realistic scale
-can be found in [HieDemoSpec](test/HieDemoSpec.hs).
+can be found in [HieDemoSpec](test/HieDemoSpec.hs). The various unit
+test files demonstrate what you can do with this library and what
+outputs you can expect.
+
+See the low-level operations used to build a TOML syntax highlighter
+in [TomlHighlighter](test-drivers/highlighter/Main.hs).
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/src/Toml/FromValue.hs
new/toml-parser-1.3.1.0/src/Toml/FromValue.hs
--- old/toml-parser-1.3.0.0/src/Toml/FromValue.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/toml-parser-1.3.1.0/src/Toml/FromValue.hs 2001-09-09
03:46:40.000000000 +0200
@@ -60,7 +60,6 @@
import Data.Ratio (Ratio)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
-import Data.String (IsString (fromString))
import Data.Text qualified
import Data.Text.Lazy qualified
import Data.Time (ZonedTime, LocalTime, Day, TimeOfDay)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/src/Toml/Lexer/Utils.hs
new/toml-parser-1.3.1.0/src/Toml/Lexer/Utils.hs
--- old/toml-parser-1.3.0.0/src/Toml/Lexer/Utils.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/toml-parser-1.3.1.0/src/Toml/Lexer/Utils.hs 2001-09-09
03:46:40.000000000 +0200
@@ -40,18 +40,19 @@
startLstr,
endStr,
unicodeEscape,
+ recommendEscape,
mkError,
) where
-import Data.Char (ord, chr, isAscii)
+import Data.Char (ord, chr, isAscii, isControl)
import Data.Foldable (asum)
import Data.Time.Format (parseTimeM, defaultTimeLocale, ParseTime)
import Numeric (readHex)
-
+import Text.Printf (printf)
+import Toml.Lexer.Token (Token(..))
import Toml.Located (Located(..))
import Toml.Position (move, Position)
-import Toml.Lexer.Token (Token(..))
-- | Type of actions associated with lexer patterns
type Action = Located String -> Context -> Outcome
@@ -115,6 +116,10 @@
| otherwise -> strFrag (Located p [chr n]) ctx
_ -> error "unicodeEscape: panic"
+recommendEscape :: Action
+recommendEscape (Located p x) _ =
+ LexerError (Located p (printf "control characters must be escaped, use:
\\u%04X" (ord (head x))))
+
-- | Emit a token ignoring the current lexeme
token_ :: Token -> Action
token_ t x _ = EmitToken (t <$ x)
@@ -167,4 +172,6 @@
mkError "" = "unexpected end-of-input"
mkError ('\n':_) = "unexpected end-of-line"
mkError ('\r':'\n':_) = "unexpected end-of-line"
-mkError (x:_) = "unexpected " ++ show x
\ No newline at end of file
+mkError (x:_)
+ | isControl x = "control characters prohibited"
+ | otherwise = "unexpected " ++ show x
\ No newline at end of file
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/src/Toml/Lexer.x
new/toml-parser-1.3.1.0/src/Toml/Lexer.x
--- old/toml-parser-1.3.0.0/src/Toml/Lexer.x 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/src/Toml/Lexer.x 2001-09-09 03:46:40.000000000
+0200
@@ -37,6 +37,7 @@
$hexdig = [ $digit A-F a-f ]
$basic_unescaped = [ $wschar \x21 \x23-\x5B \x5D-\x7E $non_ascii ]
$comment_start_symbol = \#
+$control = [\x00-\x1F \x7F]
@barekey = [0-9 A-Z a-z \- _]+
@@ -89,6 +90,7 @@
toml :-
+
<val> {
@bad_dec_int { failure "leading zero prohibited" }
@@ -170,6 +172,7 @@
\\ b { strFrag . ("\b" <$) }
\\ \\ { strFrag . ("\\" <$) }
\\ \" { strFrag . ("\"" <$) }
+ $control # [\t\r\n] { recommendEscape }
}
{
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/src/Toml/Pretty.hs
new/toml-parser-1.3.1.0/src/Toml/Pretty.hs
--- old/toml-parser-1.3.0.0/src/Toml/Pretty.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/src/Toml/Pretty.hs 2001-09-09 03:46:40.000000000
+0200
@@ -36,12 +36,13 @@
-- * Pretty errors
prettySemanticError,
prettyMatchMessage,
+ prettyLocated,
) where
import Data.Char (ord, isAsciiLower, isAsciiUpper, isDigit, isPrint)
import Data.Foldable (fold)
import Data.List (partition, sortOn)
-import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.String (fromString)
@@ -51,7 +52,9 @@
import Text.Printf (printf)
import Toml.FromValue.Matcher (MatchMessage(..), Scope (..))
import Toml.Lexer (Token(..))
+import Toml.Located (Located(..))
import Toml.Parser.Types (SectionKind(..))
+import Toml.Position (Position(..))
import Toml.Semantics (SemanticError (..), SemanticErrorKind (..))
import Toml.Value (Value(..), Table)
@@ -102,6 +105,25 @@
| x <= '\xffff' -> printf "\\u%04X%s" (ord x) (go xs)
| otherwise -> printf "\\U%08X%s" (ord x) (go xs)
+-- | Quote a string using basic string literal syntax.
+quoteMlString :: String -> String
+quoteMlString = ("\"\"\"\n"++) . go
+ where
+ go = \case
+ "" -> "\"\"\"" -- terminator
+ '"' : '"' : '"' : xs -> "\"\"\\\"" ++ go xs
+ '\\' : xs -> '\\' : '\\' : go xs
+ '\b' : xs -> '\\' : 'b' : go xs
+ '\f' : xs -> '\\' : 'f' : go xs
+ '\t' : xs -> '\\' : 't' : go xs
+ '\n' : xs -> '\n' : go xs
+ '\r' : '\n' : xs -> '\r' : '\n' : go xs
+ '\r' : xs -> '\\' : 'r' : go xs
+ x : xs
+ | isPrint x -> x : go xs
+ | x <= '\xffff' -> printf "\\u%04X%s" (ord x) (go xs)
+ | otherwise -> printf "\\U%08X%s" (ord x) (go xs)
+
-- | Pretty-print a section heading. The result is annotated as a 'TableClass'.
prettySectionKind :: SectionKind -> NonEmpty String -> TomlDoc
prettySectionKind TableKind key =
@@ -155,7 +177,7 @@
Table t -> lbrace <> concatWith (surround ", ")
[prettyAssignment k v | (k,v) <- Map.assocs t] <> rbrace
Bool True -> annotate BoolClass "true"
Bool False -> annotate BoolClass "false"
- String str -> annotate StringClass (fromString (quoteString str))
+ String str -> prettySmartString str
TimeOfDay tod -> annotate DateClass (fromString (formatTime
defaultTimeLocale "%H:%M:%S%Q" tod))
ZonedTime zt
| timeZoneMinutes (zonedTimeZone zt) == 0 ->
@@ -164,7 +186,38 @@
LocalTime lt -> annotate DateClass (fromString (formatTime
defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" lt))
Day d -> annotate DateClass (fromString (formatTime
defaultTimeLocale "%Y-%m-%d" d))
--- | Predicate for values that should be completely rendered on the
+prettySmartString :: String -> TomlDoc
+prettySmartString str
+ | '\n' `elem` str =
+ column \i ->
+ pageWidth \case
+ AvailablePerLine n _ | length str > n - i ->
+ prettyMlString str
+ _ -> prettyString str
+ | otherwise = prettyString str
+
+prettyMlString :: String -> TomlDoc
+prettyMlString str = annotate StringClass (column \i -> hang (-i) (fromString
(quoteMlString str)))
+
+prettyString :: String -> TomlDoc
+prettyString str = annotate StringClass (fromString (quoteString str))
+
+-- | Predicate for values that CAN rendered on the
+-- righthand-side of an @=@.
+isSimple :: Value -> Bool
+isSimple = \case
+ Integer _ -> True
+ Float _ -> True
+ Bool _ -> True
+ String _ -> True
+ TimeOfDay _ -> True
+ ZonedTime _ -> True
+ LocalTime _ -> True
+ Day _ -> True
+ Table x -> isSingularTable x -- differs from isAlwaysSimple
+ Array x -> null x || not (all isTable x)
+
+-- | Predicate for values that can be MUST rendered on the
-- righthand-side of an @=@.
isAlwaysSimple :: Value -> Bool
isAlwaysSimple = \case
@@ -176,7 +229,7 @@
ZonedTime _ -> True
LocalTime _ -> True
Day _ -> True
- Table x -> isSingularTable x
+ Table _ -> False -- differs from isSimple
Array x -> null x || not (all isTable x)
-- | Predicate for table values.
@@ -188,7 +241,7 @@
-- These can be collapsed using dotted-key notation on the lefthand-side
-- of a @=@.
isSingularTable :: Table -> Bool
-isSingularTable (Map.elems -> [v]) = isAlwaysSimple v
+isSingularTable (Map.elems -> [v]) = isSimple v
isSingularTable _ = False
-- | Render a complete TOML document using top-level table and array of
@@ -259,31 +312,31 @@
NoProjection -> id
KeyProjection f -> sortOn (f prefix . fst)
- (simple, sections) = partition (isAlwaysSimple . snd) (order
(Map.assocs t))
+ kvs = order (Map.assocs t)
+
+ -- this table will require no subsequent tables to be defined
+ simpleToml = all isSimple t
+
+ (simple, sections) = partition (isAlwaysSimple . snd) kvs
topLines = [fold topElts | let topElts = headers ++ assignments, not
(null topElts)]
headers =
case NonEmpty.nonEmpty prefix of
- Just key | not (null simple) || null sections || kind ==
ArrayTableKind ->
+ Just key | simpleToml || not (null simple) || null sections ||
kind == ArrayTableKind ->
[prettySectionKind kind key <> hardline]
_ -> []
- assignments = [prettyAssignment k v <> hardline | (k,v) <- simple]
+ assignments = [prettyAssignment k v <> hardline | (k,v) <- if
simpleToml then kvs else simple]
- subtables = [prettySection (prefix `snoc` k) v | (k,v) <- sections]
+ subtables = [prettySection (prefix ++ [k]) v | not simpleToml, (k,v)
<- sections]
prettySection key (Table tab) =
- prettyToml_ mbKeyProj TableKind (NonEmpty.toList key) tab
+ prettyToml_ mbKeyProj TableKind key tab
prettySection key (Array a) =
- vcat [prettyToml_ mbKeyProj ArrayTableKind (NonEmpty.toList key)
tab | Table tab <- a]
+ vcat [prettyToml_ mbKeyProj ArrayTableKind key tab | Table tab <-
a]
prettySection _ _ = error "prettySection applied to simple value"
--- | Create a 'NonEmpty' with a given prefix and last element.
-snoc :: [a] -> a -> NonEmpty a
-snoc [] y = y :| []
-snoc (x : xs) y = x :| xs ++ [y]
-
-- | Render a semantic TOML error in a human-readable string.
--
-- @since 1.3.0.0
@@ -304,3 +357,6 @@
where
f (ScopeIndex i) = ('[' :) . shows i . (']':)
f (ScopeKey key) = ('.' :) . shows (prettySimpleKey key)
+
+prettyLocated :: Located String -> String
+prettyLocated (Located p s) = printf "%d:%d: %s" (posLine p) (posColumn p) s
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/src/Toml/Semantics/Ordered.hs
new/toml-parser-1.3.1.0/src/Toml/Semantics/Ordered.hs
--- old/toml-parser-1.3.0.0/src/Toml/Semantics/Ordered.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/toml-parser-1.3.1.0/src/Toml/Semantics/Ordered.hs 2001-09-09
03:46:40.000000000 +0200
@@ -0,0 +1,113 @@
+{-|
+Module : Toml.Semantics.Ordered
+Description : Tool for extracting an ordering from an existing TOML file
+Copyright : (c) Eric Mertens, 2023
+License : ISC
+Maintainer : [email protected]
+
+This module can help build a key ordering projection given an existing
+TOML file. This could be useful for applying a transformation to a TOML
+file before pretty-printing it back in something very close to the
+original order.
+
+When using the computed order, table keys will be remembered in the order
+they appeared in the source file. Any key additional keys added to the
+tables will be ordered alphabetically after all the known keys.
+
+@
+demo =
+ do txt <- 'readFile' \"demo.toml\"
+ let Right exprs = 'Toml.Parser.parseRawToml' txt
+ to = 'extractTableOrder' exprs
+ Right toml = 'Toml.Semantics.semantics' exprs
+ projection = 'projectKey' to
+ 'print' ('Toml.Pretty.prettyTomlOrdered' projection toml)
+@
+
+@since 1.3.1.0
+
+-}
+module Toml.Semantics.Ordered (
+ TableOrder,
+ extractTableOrder,
+ projectKey,
+ ProjectedKey,
+ debugTableOrder,
+ ) where
+
+import Data.Foldable (foldl', toList)
+import Data.List (sortOn)
+import Data.Map (Map)
+import Data.Map qualified as Map
+import Toml.Located (Located(locThing))
+import Toml.Parser.Types (Expr(..), Key, Val(ValTable, ValArray))
+
+-- | Summary of the order of the keys in a TOML document.
+newtype TableOrder = TO (Map String KeyOrder)
+
+data KeyOrder = KeyOrder !Int TableOrder
+
+newtype ProjectedKey = PK (Either Int String)
+ deriving (Eq, Ord)
+
+-- | Generate a projection function for use with
'Toml.Pretty.prettyTomlOrdered'
+projectKey ::
+ TableOrder {- ^ table order -} ->
+ [String] {- ^ table path -} ->
+ String {- ^ key -} ->
+ ProjectedKey {- ^ type suitable for ordering table keys -}
+projectKey (TO to) [] = \k ->
+ case Map.lookup k to of
+ Just (KeyOrder i _) -> PK (Left i)
+ Nothing -> PK (Right k)
+projectKey (TO to) (p:ps) =
+ case Map.lookup p to of
+ Just (KeyOrder _ to') -> projectKey to' ps
+ Nothing -> PK . Right
+
+emptyOrder :: TableOrder
+emptyOrder = TO Map.empty
+
+-- | Extract a 'TableOrder' from the output of 'Toml.Parser.parseRawToml'
+-- to be later used with 'projectKey'.
+extractTableOrder :: [Expr] -> TableOrder
+extractTableOrder = snd . foldl' addExpr ([], emptyOrder)
+
+addExpr :: ([String], TableOrder) -> Expr -> ([String], TableOrder)
+addExpr (prefix, to) = \case
+ TableExpr k -> let k' = keyPath k in (k', addKey to k')
+ ArrayTableExpr k -> let k' = keyPath k in (k', addKey to k')
+ KeyValExpr k v -> (prefix, addVal prefix (addKey to (prefix ++ keyPath
k)) v)
+
+addVal :: [String] -> TableOrder -> Val -> TableOrder
+addVal prefix to = \case
+ ValArray xs -> foldl' (addVal prefix) to xs
+ ValTable kvs -> foldl' (\acc (k,v) ->
+ let k' = prefix ++ keyPath k in
+ addVal k' (addKey acc k') v) to kvs
+ _ -> to
+
+addKey :: TableOrder -> [String] -> TableOrder
+addKey to [] = to
+addKey (TO to) (x:xs) = TO (Map.alter f x to)
+ where
+ f Nothing = Just (KeyOrder (Map.size to) (addKey emptyOrder xs))
+ f (Just (KeyOrder i m)) = Just (KeyOrder i (addKey m xs))
+
+keyPath :: Key -> [String]
+keyPath = map locThing . toList
+
+-- | Render a white-space nested representation of the key ordering extracted
+-- by 'extractTableOrder'. This is provided for debugging and
understandability.
+debugTableOrder :: TableOrder -> String
+debugTableOrder to = unlines (go 0 to [])
+ where
+ go i (TO m) z =
+ foldr (go1 i) z
+ (sortOn p (Map.assocs m))
+
+ go1 i (k, KeyOrder _ v) z =
+ (replicate (4*i) ' ' ++ k) :
+ go (i+1) v z
+
+ p (_, KeyOrder i _) = i
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/src/Toml.hs
new/toml-parser-1.3.1.0/src/Toml.hs
--- old/toml-parser-1.3.0.0/src/Toml.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/toml-parser-1.3.1.0/src/Toml.hs 2001-09-09 03:46:40.000000000 +0200
@@ -32,13 +32,10 @@
Result(..),
) where
-import Text.Printf (printf)
import Toml.FromValue (FromValue (fromValue), Result(..))
import Toml.FromValue.Matcher (runMatcher)
-import Toml.Located (Located(Located))
import Toml.Parser (parseRawToml)
-import Toml.Position (Position(posColumn, posLine))
-import Toml.Pretty (TomlDoc, DocClass(..), prettyToml, prettySemanticError,
prettyMatchMessage)
+import Toml.Pretty (TomlDoc, DocClass(..), prettyToml, prettySemanticError,
prettyMatchMessage, prettyLocated)
import Toml.Semantics (semantics)
import Toml.ToValue (ToTable (toTable))
import Toml.Value (Table, Value(..))
@@ -47,11 +44,10 @@
parse :: String -> Either String Table
parse str =
case parseRawToml str of
- Left (Located p e) -> Left (printf "%d:%d: %s" (posLine p) (posColumn
p) e)
+ Left e -> Left (prettyLocated e)
Right exprs ->
case semantics exprs of
- Left (Located p e) ->
- Left (printf "%d:%d: %s" (posLine p) (posColumn p)
(prettySemanticError e))
+ Left e -> Left (prettyLocated (prettySemanticError <$> e))
Right tab -> Right tab
-- | Use the 'FromValue' instance to decode a value from a TOML string.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/test/DecodeSpec.hs
new/toml-parser-1.3.1.0/test/DecodeSpec.hs
--- old/toml-parser-1.3.0.0/test/DecodeSpec.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/test/DecodeSpec.hs 2001-09-09 03:46:40.000000000
+0200
@@ -1,13 +1,12 @@
{-# Language DuplicateRecordFields #-}
module DecodeSpec (spec) where
-import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import QuoteStr (quoteStr)
import Test.Hspec (it, shouldBe, Spec)
-import Toml (decode, Result(Success), encode)
-import Toml.FromValue (FromValue(..), runParseTable, reqKey, optKey)
+import Toml (decode, Result, encode)
+import Toml.FromValue (FromValue(..), reqKey, optKey)
import Toml.FromValue.Generic (genericParseTable)
import Toml.ToValue (ToTable(..), ToValue(toValue), table, (.=),
defaultTableToValue)
import Toml.ToValue.Generic (genericToTable)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/test/FromValueSpec.hs
new/toml-parser-1.3.1.0/test/FromValueSpec.hs
--- old/toml-parser-1.3.0.0/test/FromValueSpec.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/toml-parser-1.3.1.0/test/FromValueSpec.hs 2001-09-09
03:46:40.000000000 +0200
@@ -12,7 +12,7 @@
import Control.Monad (when)
import Test.Hspec (it, shouldBe, Spec)
import Toml (Result(..), Value(..))
-import Toml.FromValue (Result(..), FromValue(fromValue), optKey,
parseTableFromValue, reqKey, warnTable, pickKey, runParseTable)
+import Toml.FromValue (FromValue(fromValue), optKey, reqKey, warnTable,
pickKey, runParseTable)
import Toml.FromValue.Matcher (Matcher, runMatcher)
import Toml.FromValue.ParseTable (KeyAlt(..))
import Toml.Pretty (prettyMatchMessage)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/test/HieDemoSpec.hs
new/toml-parser-1.3.1.0/test/HieDemoSpec.hs
--- old/toml-parser-1.3.0.0/test/HieDemoSpec.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/test/HieDemoSpec.hs 2001-09-09 03:46:40.000000000
+0200
@@ -15,11 +15,10 @@
-}
module HieDemoSpec where
-import Control.Applicative (optional)
import GHC.Generics ( Generic )
import QuoteStr (quoteStr)
import Test.Hspec (Spec, it, shouldBe)
-import Toml (Value(Table, Array), Table, Result(..), decode)
+import Toml (Value(Table, Array), Table, decode)
import Toml.FromValue
import Toml.FromValue.Generic (genericParseTable)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/test/LexerSpec.hs
new/toml-parser-1.3.1.0/test/LexerSpec.hs
--- old/toml-parser-1.3.0.0/test/LexerSpec.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/test/LexerSpec.hs 2001-09-09 03:46:40.000000000
+0200
@@ -9,7 +9,17 @@
do it "handles special cased control character" $
parse "x = '\SOH'"
`shouldBe`
- Left "1:6: lexical error: unexpected '\\SOH'"
+ Left "1:6: lexical error: control characters prohibited"
+
+ it "recommends escapes for control characters (1)" $
+ parse "x = \"\SOH\""
+ `shouldBe`
+ Left "1:6: lexical error: control characters must be escaped, use:
\\u0001"
+
+ it "recommends escapes for control characters (2)" $
+ parse "x = \"\DEL\""
+ `shouldBe`
+ Left "1:6: lexical error: control characters must be escaped, use:
\\u007F"
-- These seem boring, but they provide test coverage of an error case in
the state machine
it "handles unexpected '}'" $
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/test/PrettySpec.hs
new/toml-parser-1.3.1.0/test/PrettySpec.hs
--- old/toml-parser-1.3.0.0/test/PrettySpec.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/test/PrettySpec.hs 2001-09-09 03:46:40.000000000
+0200
@@ -29,9 +29,10 @@
it "renders empty tables" $
fmap tomlString (parse "x.y.z={}\nz.y.w=false")
`shouldBe` Right [quoteStr|
- z.y.w = false
+ [x.y.z]
- [x.y.z]|]
+ [z]
+ y.w = false|]
it "renders empty tables in array of tables" $
fmap tomlString (parse "ex=[{},{},{a=9}]")
@@ -59,6 +60,24 @@
`shouldBe` Right [quoteStr|
a = "\\\b\t\r\n\f\"\u007F\U0001000C"|]
+ it "renders multiline strings" $
+ fmap tomlString (parse [quoteStr|
+ Everything-I-Touch = "Everything I touch\nwith tenderness,
alas,\npricks like a bramble."
+ Two-More = [
+ "The west wind whispered,\nAnd touched the eyelids of
spring:\nHer eyes, Primroses.",
+ "Plum flower temple:\nVoices rise\nFrom the foothills",
+ ]|])
+ `shouldBe` Right [quoteStr|
+ Everything-I-Touch = """
+ Everything I touch
+ with tenderness, alas,
+ pricks like a bramble."""
+ Two-More = [ """
+ The west wind whispered,
+ And touched the eyelids of spring:
+ Her eyes, Primroses."""
+ , "Plum flower temple:\nVoices rise\nFrom the
foothills" ]|]
+
it "renders floats" $
fmap tomlString (parse
"a=0.0\nb=-0.1\nc=0.1\nd=3.141592653589793\ne=4e123")
`shouldBe` Right [quoteStr|
@@ -106,3 +125,15 @@
`shouldBe` Right [quoteStr|
x = [ [ {a = "this is a longer example", b = "and it will
linewrap"}
, {c = "all on its own"} ] ]|]
+
+ it "factors out unique table prefixes in leaf tables" $
+ fmap tomlString (parse [quoteStr|
+ [x]
+ i = 1
+ p.q = "a"
+ y.z = "c"|])
+ `shouldBe` Right [quoteStr|
+ [x]
+ i = 1
+ p.q = "a"
+ y.z = "c"|]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/toml-parser-1.3.0.0/toml-parser.cabal
new/toml-parser-1.3.1.0/toml-parser.cabal
--- old/toml-parser-1.3.0.0/toml-parser.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/toml-parser-1.3.1.0/toml-parser.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: toml-parser
-version: 1.3.0.0
+version: 1.3.1.0
synopsis: TOML 1.0.0 parser
description:
TOML parser using generated lexers and parsers with
@@ -13,7 +13,7 @@
copyright: 2023 Eric Mertens
category: Text
build-type: Simple
-tested-with: GHC == {8.10.7, 9.0.2, 9.2.8, 9.4.5, 9.6.2}
+tested-with: GHC == {8.10.7, 9.0.2, 9.2.8, 9.4.7, 9.6.3}
extra-doc-files:
ChangeLog.md
@@ -60,6 +60,7 @@
Toml.Position
Toml.Pretty
Toml.Semantics
+ Toml.Semantics.Ordered
Toml.ToValue
Toml.ToValue.Generic
Toml.Value
@@ -68,8 +69,8 @@
Toml.Parser.Utils
build-depends:
array ^>= 0.5,
- base ^>= {4.14, 4.15, 4.16, 4.17, 4.18},
- containers ^>= {0.5, 0.6},
+ base ^>= {4.14, 4.15, 4.16, 4.17, 4.18, 4.19},
+ containers ^>= {0.5, 0.6, 0.7},
prettyprinter ^>= 1.7,
text >= 0.2 && < 3,
time ^>= {1.9, 1.10, 1.11, 1.12},
@@ -91,7 +92,7 @@
base,
containers,
hspec ^>= {2.10, 2.11},
- template-haskell ^>= {2.16, 2.17, 2.18, 2.19, 2.20},
+ template-haskell ^>= {2.16, 2.17, 2.18, 2.19, 2.20, 2.21},
time,
toml-parser,
other-modules:
@@ -108,9 +109,18 @@
import: extensions
type: exitcode-stdio-1.0
main-is: README.lhs
- ghc-options: -pgmL markdown-unlit
+ ghc-options: -pgmL markdown-unlit -optL "haskell toml"
+ default-extensions:
+ QuasiQuotes
+ other-modules:
+ QuoteStr
+ hs-source-dirs:
+ .
+ test
build-depends:
base,
toml-parser,
+ hspec ^>= {2.10, 2.11},
+ template-haskell ^>= {2.16, 2.17, 2.18, 2.19, 2.20, 2.21},
build-tool-depends:
markdown-unlit:markdown-unlit ^>= {0.5.1, 0.6.0},
