packages feed

htoml-megaparsec (empty) → 1.0.0.4

raw patch · 130 files changed

+2395/−0 lines, 130 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, composition-prelude, containers, criterion, file-embed, htoml, megaparsec, mtl, old-locale, parsec, tasty, tasty-hspec, tasty-hunit, text, time, unordered-containers, vector

Files

+ CHANGES.md view
@@ -0,0 +1,44 @@+Change log+==========++#### dev+* ...++### 1.0.0.3++Switched to megaparsec, resulting in double the speed of the old parser.++### 1.0.0.1+* Improve docs++### 1.0.0.0+* Use `Vector` over `List` internally, as per discussion in [issue 13](https://github.com/cies/htoml/issues/13)++### 0.2.0.1+* Expose `ToJSON` implementation+* Remove unused .cabal dependency (thanks @tmcgilchrist)++#### 0.2.0.0+* Compatible with TOML 0.4.0+* Improve test suite (all test now pass -- thanks @HuwCampbell)+* Slight API breakage (therefore major version bump)+* Use Parsec's parser state to track explicitness of table definitions (thanks @HuwCampbell)+* Clean up docs and code++#### 0.1.0.3+* GHC 7.10 compatibility fix (thanks @erebe)+* Allow time >= 1.5.0, by using some CPP trickery+* Improve README based on+  [feedback on Reddit](http://www.reddit.com/r/haskell/comments/2s376c/show_rhaskell_htoml_a_parser_for_toml_files)++#### 0.1.0.2+* Update the REAMDE+* Add/relax dependency version contraints where applicable+* Fix all warnings+* Add `CHANGES.md`++#### 0.1.0.1+* Fix `cabal configure` error in cabal file++#### 0.1.0.0+* Initial upload to Hackage
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013-2014, Spiros Eliopoulos++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,246 @@+htoml+=====++[![Build Status](https://travis-ci.org/cies/htoml.svg?branch=master)](https://travis-ci.org/cies/htoml)+[![Latest version on Hackage](https://img.shields.io/hackage/v/htoml.svg)](https://hackage.haskell.org/package/htoml)+[![Dependencies of latest version on Hackage](https://img.shields.io/hackage-deps/v/htoml.svg)](https://hackage.haskell.org/package/htoml)++[![htoml on Stackage LTS 5](http://stackage.org/package/htoml/badge/lts-5)](http://stackage.org/lts-5/package/htoml)+[![htoml on Stackage LTS 6](http://stackage.org/package/htoml/badge/lts-6)](http://stackage.org/lts-6/package/htoml)+[![htoml on Stackage Nightly](http://stackage.org/package/htoml/badge/nightly)](http://stackage.org/nightly/package/htoml)+++A [TOML](https://github.com/mojombo/toml) parser library in+[Haskell](http://haskell-lang.org).++TOML is the obvious, minimal configuration language by+[Tom Preston-Werner](https://github.com/mojombo).+It is an alternative to the [XML](http://www.w3.org/TR/REC-xml/),+[YAML](http://www.yaml.org/spec/1.2/spec.html) and+[INI](http://en.wikipedia.org/wiki/INI_file) formats mainly for the purpose of+configuration files. Many will find that XML and YAML are too heavy for+the purpose of configuration files prupose while INI is underspecified.+TOML is to configuration files, like what Markdown is for rich-text.++This library aims to be compatible with the latest version of the+[TOML spec](https://github.com/mojombo/toml).+Compatibility between `htoml` version and TOML (as proven by+[BurntSushi's language agnostic TOML test suite](https://github.com/BurntSushi/toml-test))+is as follows:++* [TOML v0.4.0](https://github.com/toml-lang/toml/releases/tag/v0.4.0)+is implemented by  `htoml >= 1.0.0.0`+* *(currently only one item in this mapping, more will follow)*+++### Documentation++Apart from this README, documentation for this package may+(or may not) be found on [Hackage](https://hackage.haskell.org/package/htoml).+++### Quick start++Installing `htoml` is easy. Either by using+[Stack](http://haskellstack.org) (recommended):++    stack install htoml++Or by using Cabal:++    cabal install htoml++In order to make your project depend on it you can add it as a+dependency in your project's `.cabal` file, and since it is not+yet on [Stackage](https://www.stackage.org/) you will also have+to add it to the `extra-deps` section of your `stack.yaml` file+when using Stack.++To quickly show some features of `htoml` we use Stack to start a+GHCi-based REPL. It picks up configuration from the `.ghci` file+in the root of the repository.++    git clone https://github.com/cies/htoml.git+    cd htoml+    stack init+    stack --install-ghc ghci++Add a `--resolver` flag to the `stack init` command to specify+a specific package snapshot, e.g.: `--resolver lts-4.1`.++In case you have missing dependencies (possibly `file-embed`),+they can be added to the `extra-deps` in `stack.yaml`+automatically with:++    stack solver --update-config++We can now start exploring `htoml` from a GHCi REPL. From the+root of this repository run:++    stack ghci++Now read a `.toml` file from the benchmark suite, with:++```haskell+txt <- readFile "benchmarks/example.toml"+let r = parseTomlDoc "" txt+r+```++...which prints:++    Right (fromList [("database",VTable (fromList [("enabled",VBoolean True),("po [...]++Then convert it to [Aeson](https://hackage.haskell.org/package/aeson) (JSON), with:++```haskell+let Right toml = r+toJSON toml+```++...which prints:++    Object (fromList [("database",Object (fromList [("enabled",Bool True),("po [...]++Finally trigger a parse error, with:++```haskell+let Left err = parseTomlDoc "" "== invalid toml =="+err+```++...it errors out (as it should), showing:++    (line 1, column 1):+    unexpected '='+    expecting "#", "\n", "\r\n", letter or digit, "_", "-", "\"", "'", "[" or end of input++**Note:** Some of the above outputs are truncated, indicated by `[...]`.+++### How to pull data from a TOML file after parsing it++Once you have sucessfully parsed a TOML file you most likely want to pull+some piecces of data out of the resulting data structure.++To do so you have two main options. The first is to use pattern matching.+For example let's consider the following `parseResult`:++```haskell+Right (fromList [("server",VTable (fromList [("enabled",VBoolean True)] ) )] )+```++Which could be pattern matched with:++```haskell+case parseResult of+  Left  _ -> "Could not parse file"+  Right m -> case m ! "server" of+    VTable mm -> case mm ! "enabled" of+      VBoolean b -> "Server is " ++ (if b then "enabled" else "disabled")+      _ -> "Could not parse server status (Boolean)"+    _ -> "TOML file does not contain the 'server' key"+```++The second main option is to use the `toJSON` function to transform the data+to an [Aeson](https://hackage.haskell.org/package/aeson) data structure,+after which you can use your Aeson toolbelt to tackle the problem. Since+TOML is intended to be a close cousin of JSON this is a very practical+approach.++Other ways to pull data from a parsed TOML document will most likely+exist; possible using the `lens` library as+[documented here](https://github.com/cies/htoml/issues/8).+++### Compatibility++Currently we are testing against several versions of GHC with+[Travis CI](https://travis-ci.org/cies/htoml) as defined in the `env` section of our+[`.travis.yml`](https://github.com/cies/htoml/blob/master/.travis.yml).+`lts-2` implies GHC 7.8.4, `lts-3` implies GHC 7.10.2, `lts-4`/`lts-5`+imply GHC 7.10.3, and `nightly` is build with a regularly updated version of GHC.+++### Version contraints of `htoml`'s dependencies++If you encounter any problems because `htoml`'s dependecies are+constrained either too much or too little, please+[file a issue](https://github.com/cies/htoml/issues) for that.+Or off even better submit a PR.+++### Tests and benchmarks++Tests are build and run with:++    stack test++[BurntSushi's language agnostic test suite](https://github.com/BurntSushi/toml-test)+is embedded in the test suite executable.  Using a shell script (that+lives in `test/BurntSushi`) the latest tests can be fetched from+its Github repository.++The benchmarks, that use the amazing [`criterion`](http://www.serpentine.com/criterion)+library, are build and run with:++    stack build :benchmarks+++### Contributions++Most welcome! Please raise issues, start discussions, give comments or+submit pull-requests.+This is one of the first Haskell libraries I wrote, feedback is+much appreciated.+++### Features++* Compatibility to the TOML spec is proven by an extensive test suite+* Incorporates [BurntSushi's language agnostic test suite](https://github.com/BurntSushi/toml-test)+* Has an internal representation that easily maps to JSON+* Provides an [Aeson](https://hackage.haskell.org/package/aeson)-style JSON interface (suggested by Greg Weber)+* Useful error messages (thanks to using Parsec over Attoparsec)+* Understands arrays as described in [this issue](https://github.com/toml-lang/toml/issues/254)+* Fails on mix-type arrays (as per spec)+* Comes with a benchmark suite to make performance gains/regressions measurable+* Tries to be well documented (please raise an issue if you find documentation lacking)+* Available on [Stackage](http://stackage.org) (see top of this README for badges+  indicating TOMLs *inclusion in Stackage status*)+++### Todo++* More documentation and start to use the proper Haddock idioms+* Add property tests with QuickCheck (the internet says it's possible for parsers)+* Extensively test error cases (probably improving error reporting along the way)+* See how lenses may (or may not) fit into this package, or an additional package+* Consider moving to [one of the more modern parser combinators](https://www.reddit.com/r/haskell/comments/46u45o/what_is_the_current_state_of_parser_libraries_in)+  in Haskell (`megaparsec` maybe?) -- possibly wait until a clear winner shows++Do you see todo that looks like fun thing to implement and you can spare the time?+Please knoe that PRs are welcome :)+++### Acknowledgements++Originally this project started off by improving the `toml` package by+Spiros Eliopoulos.++[HuwCampbell](https://github.com/HuwCampbell) helped a lot by making tests+pass and implementing "explicitness tracking" in Parsec's parser state.+++### Copyright and licensing++This package includes BurntSushi's language agnostic+[TOML tests](https://github.com/BurntSushi/toml-test), which are WTFPL+licensed.++The TOML examples that are used as part of the benchmarks are copied+from Tom Preston-Werner's TOML spec which is MIT licensed.++For all other files in this project the copyrights are specified in the+`htoml.cabal` file, they are distributed under the BSD3 license as found+in the `LICENSE` file.
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/env runghc++> module Main where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ benchmarks/Benchmarks.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++import           Prelude        hiding (readFile)++import           Criterion.Main+import           Data.Text.IO   (readFile)++import           Text.Toml+++main :: IO ()+main = do+    exampleToml  <- readFile "./benchmarks/example.toml"+    repeatedToml <- readFile "./benchmarks/repeated.toml"+    defaultMain++      [ bgroup "string"+        [ bench "assignment"  $ whnf (parseTomlDoc "") "q=42\nqa=[4,2,]\nqb=true\nqf=23.23\n\+                                                       \qd=1979-05-27T07:32:00Z\nqs='forty-two'"+        , bench "headers"     $ whnf (parseTomlDoc "") "[Q]\n[A]\n[[QA]]\n[[QA]]\n[[QA]]\n[[QA]]"+        , bench "mixed"       $ whnf (parseTomlDoc "") "q=42\nqa=[4,2,]\n[Q]qq=42\n[[QA]]\n[[QA]]"+        ]++      , bgroup "file"+        [ bench "example"     $ whnf (parseTomlDoc "") exampleToml+        , bench "repeated-4x" $ whnf (parseTomlDoc "") repeatedToml+        ]++      ]
+ benchmarks/example.toml view
@@ -0,0 +1,48 @@+# This is a TOML document. Boom.++title = "TOML Example"++[owner]+name = "Tom Preston-Werner"+organization = "GitHub"+bio = "GitHub Cofounder & CEO\nLikes tater tots and beer."+dob = 1979-05-27T07:32:00Z # First class dates? Why not?++[database]+server = "192.168.1.1"+ports = [ 8001, 8001, 8002 ]+connection_max = 5000+enabled = true++[servers1]++  # You can indent as you please. Tabs or spaces. TOML don't care.+  [servers.alpha]+  ip = "10.0.0.1"+  dc = "eqdc10"++  [servers.beta]+  ip = "10.0.0.2"+  dc = "eqdc10"+  country = "中国" # This should be parsed as UTF-8++[clients]+data = [ ["gamma", "delta"], [1, 2] ] # just an update to make sure parsers support it+++# Line breaks are OK when inside arrays+hosts = [+  "alpha",+  "omega"+]++# Products++  [[products]]+  name = "Hammer"+  sku = 738594937++  [[products]]+  name = "Nail"+  sku = 284758393+  color = "gray"
+ benchmarks/repeated.toml view
@@ -0,0 +1,194 @@+# This is a TOML document. Boom.++title = "TOML Example"++[owner]+name = "Tom Preston-Werner"+organization = "GitHub"+bio = "GitHub Cofounder & CEO\nLikes tater tots and beer."+dob = 1979-05-27T07:32:00Z # First class dates? Why not?++[database]+server = "192.168.1.1"+ports = [ 8001, 8001, 8002 ]+connection_max = 5000+enabled = true++[servers1]++  # You can indent as you please. Tabs or spaces. TOML don't care.+  [servers.alpha]+  ip = "10.0.0.1"+  dc = "eqdc10"++  [servers.beta]+  ip = "10.0.0.2"+  dc = "eqdc10"+  country = "中国" # This should be parsed as UTF-8++[clients]+data = [ ["gamma", "delta"], [1, 2] ] # just an update to make sure parsers support it+++# Line breaks are OK when inside arrays+hosts = [+  "alpha",+  "omega"+]++# Products++  [[products]]+  name = "Hammer"+  sku = 738594937++  [[products]]+  name = "Nail"+  sku = 284758393+  color = "gray"+++# This is a TOML document. Boom.++[owner2]+name = "Tom Preston-Werner"+organization = "GitHub"+bio = "GitHub Cofounder & CEO\nLikes tater tots and beer."+dob = 1979-05-27T07:32:00Z # First class dates? Why not?++[database2]+server = "192.168.1.1"+ports = [ 8001, 8001, 8002 ]+connection_max = 5000+enabled = true++[servers2]++  # You can indent as you please. Tabs or spaces. TOML don't care.+  [servers.alpha2]+  ip = "10.0.0.1"+  dc = "eqdc10"++  [servers.beta2]+  ip = "10.0.0.2"+  dc = "eqdc10"+  country = "中国" # This should be parsed as UTF-8++[clients2]+data = [ ["gamma", "delta"], [1, 2] ] # just an update to make sure parsers support it+++# Line breaks are OK when inside arrays+hosts = [+  "alpha",+  "omega"+]++# Products++  [[products2]]+  name = "Hammer"+  sku = 738594937++  [[products2]]+  name = "Nail"+  sku = 284758393+  color = "gray"++++# This is a TOML document. Boom.++[owner3]+name = "Tom Preston-Werner"+organization = "GitHub"+bio = "GitHub Cofounder & CEO\nLikes tater tots and beer."+dob = 1979-05-27T07:32:00Z # First class dates? Why not?++[database3]+server = "192.168.1.1"+ports = [ 8001, 8001, 8002 ]+connection_max = 5000+enabled = true++[servers3]++  # You can indent as you please. Tabs or spaces. TOML don't care.+  [servers.alpha3]+  ip = "10.0.0.1"+  dc = "eqdc10"++  [servers.beta3]+  ip = "10.0.0.2"+  dc = "eqdc10"+  country = "中国" # This should be parsed as UTF-8++[clients3]+data = [ ["gamma", "delta"], [1, 3] ] # just an update to make sure parsers support it+++# Line breaks are OK when inside arrays+hosts = [+  "alpha",+  "omega"+]++# Products++  [[products3]]+  name = "Hammer"+  sku = 738594937++  [[products3]]+  name = "Nail"+  sku = 284758393+  color = "gray"++++# This is a TOML document. Boom.++[owner4]+name = "Tom Preston-Werner"+organization = "GitHub"+bio = "GitHub Cofounder & CEO\nLikes tater tots and beer."+dob = 1979-05-27T07:32:00Z # First class dates? Why not?++[database4]+server = "192.168.1.1"+ports = [ 8001, 8001, 8002 ]+connection_max = 5000+enabled = true++[servers4]++  # You can indent as you please. Tabs or spaces. TOML don't care.+  [servers.alpha4]+  ip = "10.0.0.1"+  dc = "eqdc10"++  [servers.beta4]+  ip = "10.0.0.2"+  dc = "eqdc10"+  country = "中国" # This should be parsed as UTF-8++[clients4]+data = [ ["gamma", "delta"], [1, 4] ] # just an update to make sure parsers support it+++# Line breaks are OK when inside arrays+hosts = [+  "alpha",+  "omega"+]++# Products++  [[products4]]+  name = "Hammer"+  sku = 738594937++  [[products4]]+  name = "Nail"+  sku = 284758393+  color = "gray"
+ htoml-megaparsec.cabal view
@@ -0,0 +1,93 @@+name:                     htoml-megaparsec+version:                  1.0.0.4+synopsis:                 Parser for TOML files+description:              TOML is an obvious and minimal format for config files.+                          This package provides a TOML parser+                          built with the Megaparsec. It exposes a JSON+                          interface using Aeson.+homepage:                 https://github.com/vmchale/htoml-megaparsec+bug-reports:              https://github.com/vmchale/htoml-megaparsec/issues+license:                  BSD3+license-file:             LICENSE+copyright:                (c) 2013-2016 Cies Breijs, 2017 Vanessa McHale+author:                   Cies Breijs, Vanessa McHale+maintainer:               Vanessa McHale <vanessa.mchale@reconfigure.io>+category:                 Data, Text, Configuration, Language, TOML+build-type:               Simple+cabal-version:            >= 1.18+extra-source-files:       test/BurntSushi/fetch-toml-tests.sh+                        , test/BurntSushi/valid/*.toml+                        , test/BurntSushi/valid/*.json+                        , test/BurntSushi/invalid/*.toml+                        , benchmarks/example.toml+                        , benchmarks/repeated.toml++Extra-doc-files:          README.md+                        , CHANGES.md++source-repository head+  type:                   git+  location:               https://github.com/cies/htoml.git++library+  exposed-modules:        Text.Toml+                        , Text.Toml.Parser+                        , Text.Toml.Types+  hs-source-dirs:         src+  default-language:       Haskell2010+  build-depends:          base                   >= 4.3    && < 5+                        , containers             >= 0.5+                        , megaparsec             >= 6.0.0+                        , unordered-containers   >= 0.2+                        , vector                 >= 0.10+                        , aeson                  >= 0.8+                        , text                   >= 1.0    && < 2+                        , mtl                    >= 2.2+                        , composition-prelude    >= 0.1.1.0+                        , time                   -any+                        , old-locale             -any+  if impl(ghc >= 8.0)+    ghc-options:          -Wincomplete-uni-patterns -Wincomplete-record-updates+  ghc-options:            -Wall++test-suite htoml-test+  hs-source-dirs:         test+  ghc-options:            -Wall -threaded -rtsopts -with-rtsopts=-N+  main-is:                Test.hs+  other-modules:          BurntSushi+                        , Text.Toml.Parser.Spec+  type:                   exitcode-stdio-1.0+  default-language:       Haskell2010+  build-depends:          base+                        , megaparsec+                        , containers+                        , unordered-containers+                        , vector+                        , aeson+                        , text+                        , time+			  -- from here non-lib deps+                        , htoml+                        , bytestring+                        , file-embed+                        , tasty+                        , tasty-hspec+                        , tasty-hunit++benchmark benchmarks+  hs-source-dirs:         benchmarks .+  ghc-options:            -O2 -Wall -threaded -rtsopts -with-rtsopts=-N+  main-is:                Benchmarks.hs+  type:                   exitcode-stdio-1.0+  default-language:       Haskell2010+  build-depends:          base+                        , parsec+                        , containers+                        , unordered-containers+                        , vector+                        , aeson+                        , text+                        , time+			  -- from here non-lib deps+                        , htoml+                        , criterion
+ src/Text/Toml.hs view
@@ -0,0 +1,14 @@+module Text.Toml where++import           Control.Composition+import           Control.Monad.State (evalState)+import           Data.Text           (Text)+import           Text.Megaparsec+import           Text.Toml.Parser+++-- | Parse a 'Text' that results in 'Either' a 'String'+-- containing the error message, or an internal representation+-- of the document as a 'Table'.+parseTomlDoc :: String -> Text -> Either TomlError Table+parseTomlDoc = flip evalState mempty .* runParserT tomlDoc
+ src/Text/Toml/Parser.hs view
@@ -0,0 +1,290 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE MonoLocalBinds    #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++module Text.Toml.Parser+  ( module Text.Toml.Parser+  , module Text.Toml.Types+  ) where++import           Control.Applicative  hiding (many, optional, (<|>))+import           Control.Monad+import           Control.Monad.State  (evalState)+import qualified Data.HashMap.Strict  as M+import qualified Data.Set             as S+import           Data.Text            (Text, pack, unpack)+import qualified Data.Text            as T+import qualified Data.Vector          as V+import           Data.Void+import           Text.Megaparsec.Char++#if MIN_VERSION_time(1,5,0)+import           Data.Time.Format     (defaultTimeLocale, iso8601DateFormat,+                                       parseTimeM)+#else+import           Data.Time.Format     (parseTime)+import           System.Locale        (defaultTimeLocale, iso8601DateFormat)+#endif++import           Numeric              (readHex)+import           Text.Megaparsec      hiding (runParser)++import           Text.Toml.Types++-- Imported as last to fix redundancy warning+import           Prelude              hiding (concat, takeWhile)+++type TomlError = ParseError (Token Text) Void++-- | Convenience function for the test suite and GHCI.+parseOnly :: Parser Toml a -> Text -> Either TomlError a+parseOnly parser = flip evalState mempty . runParserT parser "noneSrc"++-- | Parses a complete document formatted according to the TOML spec.+tomlDoc :: (TomlM m) => Parser m Table+tomlDoc = do+    skipBlanks+    topTable <- table+    namedSections <- many namedSection+    -- Ensure the input is completely consumed+    eof+    -- Load each named section into the top table+    foldM (flip (insert Explicit)) topTable namedSections++-- | Parses a table of key-value pairs.+table :: (TomlM m) => Parser m Table+table = do+    pairs <- try (many (assignment <* skipBlanks)) <|> (try skipBlanks >> return [])+    case maybeDupe (map fst pairs) of+      Just k  -> fail $ "Cannot redefine key " ++ (unpack k)+      Nothing -> return $ M.fromList pairs++-- | Parses an inline table of key-value pairs.+inlineTable :: (TomlM m) => Parser m Node+inlineTable = do+    pairs <- between (char '{') (char '}') (skipSpaces *> separatedValues <* skipSpaces)+    case maybeDupe (map fst pairs) of+      Just k  -> fail $ "Cannot redefine key " ++ (unpack k)+      Nothing -> return $ VTable $ M.fromList pairs+  where+    skipSpaces      = many (satisfy isSpc)+    separatedValues = sepBy (skipSpaces *> assignment <* skipSpaces) comma+    comma           = skipSpaces >> char ',' >> skipSpaces++-- | Find dupes, if any.+maybeDupe :: Ord a => [a] -> Maybe a+maybeDupe xx = dup xx S.empty+  where+    dup []     _ = Nothing+    dup (x:xs) s = if S.member x s then Just x else dup xs (S.insert x s)+++-- | Parses a 'Table' or 'TableArray' with its header.+-- The resulting tuple has the header's value in the first position, and the+-- 'NTable' or 'NTArray' in the second.+namedSection :: (TomlM m) => Parser m ([Text], Node)+namedSection = do+    eitherHdr <- try (Left <$> tableHeader) <|> try (Right <$> tableArrayHeader)+    skipBlanks+    tbl <- table+    skipBlanks+    return $ case eitherHdr of Left  ns -> (ns, VTable tbl )+                               Right ns -> (ns, VTArray $ V.singleton tbl)+++-- | Parses a table header.+tableHeader :: (TomlM m) => Parser m [Text]+tableHeader = between (char '[') (char ']') headerValue+++-- | Parses a table array header.+tableArrayHeader :: (TomlM m) => Parser m [Text]+tableArrayHeader = between (twoChar '[') (twoChar ']') headerValue+  where+    twoChar c = count 2 (char c)+++-- | Parses the value of any header (names separated by dots), into a list of 'Text'.+headerValue :: (TomlM m) => Parser m [Text]+headerValue = ((pack <$> some keyChar) <|> anyStr') `sepBy1` (char '.')+  where+    keyChar = alphaNumChar <|> char '_' <|> char '-'++-- | Parses a key-value assignment.+assignment :: (TomlM m) => Parser m (Text, Node)+assignment = do+    k <- (pack <$> some keyChar) <|> anyStr'+    many (satisfy isSpc) >> char '=' >> skipBlanks+    v <- value+    return (k, v)+  where+    -- TODO: Follow the spec, e.g.: only first char cannot be '['.+    keyChar = alphaNumChar <|> char '_' <|> char '-'+++-- | Parses a value.+value :: (TomlM m) => Parser m Node+value = (try array       <?> "array")+    <|> (try boolean     <?> "boolean")+    <|> (try anyStr      <?> "string")+    <|> (try datetime    <?> "datetime")+    <|> (try float       <?> "float")+    <|> (try integer     <?> "integer")+    <|> (try inlineTable <?> "inline table")+++--+-- | * Toml value parsers+--++array :: (TomlM m) => Parser m Node+array = (try (arrayOf array)    <?> "array of arrays")+    <|> (try (arrayOf boolean)  <?> "array of booleans")+    <|> (try (arrayOf anyStr)   <?> "array of strings")+    <|> (try (arrayOf datetime) <?> "array of datetimes")+    <|> (try (arrayOf float)    <?> "array of floats")+    <|> (try (arrayOf integer)  <?> "array of integers")+++boolean :: (TomlM m) => Parser m Node+boolean = VBoolean <$> ( (try . string $ "true")  *> return True  <|>+                         (try . string $ "false") *> return False )+++anyStr :: (TomlM m) => Parser m Node+anyStr = VString <$> anyStr'++anyStr' :: (TomlM m) => Parser m Text+anyStr' = try multiBasicStr <|> try basicStr <|> try multiLiteralStr <|> try literalStr+++basicStr :: (TomlM m) => Parser m Text+basicStr = between dQuote dQuote (fmap pack $ many strChar)+  where+    strChar = try escSeq <|> try (satisfy (\c -> c /= '"' && c /= '\\'))+    dQuote  = char '\"'+++multiBasicStr :: (TomlM m) => Parser m Text+multiBasicStr = (openDQuote3 *> escWhiteSpc *> (pack <$> manyTill strChar (try dQuote3)))+  where+    -- | Parse the a tripple-double quote, with possibly a newline attached+    openDQuote3 = try (dQuote3 <* char '\n') <|> try dQuote3+    -- | Parse tripple-double quotes+    dQuote3     = count 3 $ char '"'+    -- | Parse a string char, accepting escaped codes, ignoring escaped white space+    strChar     = (escSeq <|> (satisfy (/= '\\'))) <* escWhiteSpc+    -- | Parse escaped white space, if any+    escWhiteSpc = many $ char '\\' >> char '\n' >> (many $ satisfy (\c -> isSpc c || c == '\n'))+++literalStr :: (TomlM m) => Parser m Text+literalStr = between sQuote sQuote (pack <$> many (satisfy (/= '\'')))+  where+    sQuote = char '\''+++multiLiteralStr :: (TomlM m) => Parser m Text+multiLiteralStr = (openSQuote3 *> (fmap pack $ manyTill anyChar sQuote3))+  where+    -- | Parse the a tripple-single quote, with possibly a newline attached+    openSQuote3 = try (sQuote3 <* char '\n') <|> try sQuote3+    -- | Parse tripple-single quotes+    sQuote3     = try . count 3 . char $ '\''+++datetime :: (TomlM m) => Parser m Node+datetime = do+    d <- try $ manyTill anyChar (char 'Z')+#if MIN_VERSION_time(1,5,0)+    let  mt = parseTimeM True defaultTimeLocale (iso8601DateFormat $ Just "%X") d+#else+    let  mt = parseTime defaultTimeLocale (iso8601DateFormat $ Just "%X") d+#endif+    case mt of Just t  -> return $ VDatetime t+               Nothing -> fail "parsing datetime failed"+++-- | Attoparsec 'double' parses scientific "e" notation; reimplement according to Toml spec.+float :: (TomlM m) => Parser m Node+float = VFloat <$> do+    n <- intStr <* lookAhead (satisfy (\c -> c == '.' || c == 'e' || c == 'E'))+    d <- (satisfy (== '.') *> uintStr) <|> return "0"+    e <- (satisfy (\c -> c == 'e' || c == 'E') *> intStr) <|> return "0"+    return . read . join $ [n, ".", d, "e", e]+  where+    sign    = try (string "-") <|> (try (char '+') >> return "") <|> return ""+    uintStr = (:) <$> digitChar <*> many (optional (char '_') *> digitChar)+    intStr  = do s <- T.unpack <$> sign+                 u <- uintStr+                 return . join $ [s, u]+++integer :: (TomlM m) => Parser m Node+integer = VInteger <$> (signed $ read <$> uintStr)+  where+    uintStr :: (TomlM m) => Parser m [Char]+    uintStr = (:) <$> digitChar <*> many (optional (char '_') *> digitChar)++--+-- * Utility functions+--++-- | Parses the elements of an array, while restricting them to a certain type.+arrayOf :: (TomlM m) => Parser m Node -> Parser m Node+arrayOf p = (VArray . V.fromList) <$>+                between (char '[') (char ']') (skipBlanks *> separatedValues)+  where+    separatedValues = sepEndBy (skipBlanks *> try p <* skipBlanks) comma <* skipBlanks+    comma           = skipBlanks >> char ',' >> skipBlanks+++-- | Parser for escape sequences.+escSeq :: (TomlM m) => Parser m Char+escSeq = char '\\' *> escSeqChar+  where+    escSeqChar =  try (char '"')  *> return '"'+              <|> try (char '\\') *> return '\\'+              <|> try (char '/')  *> return '/'+              <|> try (char 'b')  *> return '\b'+              <|> try (char 't')  *> return '\t'+              <|> try (char 'n')  *> return '\n'+              <|> try (char 'f')  *> return '\f'+              <|> try (char 'r')  *> return '\r'+              <|> try (char 'u')  *> unicodeHex 4+              <|> try (char 'U')  *> unicodeHex 8+              <?> "escape character"+++-- | Parser for unicode hexadecimal values of representation length 'n'.+unicodeHex :: (TomlM m) => Int -> Parser m Char+unicodeHex n = do+    h <- count n (satisfy isHex)+    let v = fst . head . readHex $ h+    return $ if v <= maxChar then toEnum v else '_'+  where+    isHex c = (c >= '0' && c <= '9') || (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')+    maxChar = fromEnum (maxBound :: Char)+++-- | Parser for signs (a plus or a minus).+signed :: (Num a, TomlM m) => Parser m a -> Parser m a+signed p =  try (negate <$> (char '-' *> p))+        <|> try (char '+' *> p)+        <|> try p+++-- | Parses the (rest of the) line including an EOF, whitespace and comments.+skipBlanks :: (TomlM m) => Parser m ()+skipBlanks = skipMany blank+  where+    blank   = try ((some $ satisfy isSpc) >> return ()) <|> try comment <|> try (void eol)+    comment = char '#' >> (many $ satisfy (/= '\n')) >> return ()+++-- | Results in 'True' for whitespace chars, tab or space, according to spec.+isSpc :: Char -> Bool+isSpc c = c == ' ' || c == '\t'
+ src/Text/Toml/Types.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE ConstraintKinds   #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++module Text.Toml.Types+  ( Table+  , emptyTable+  , VTArray+  , VArray+  , Node (..)+  , Explicitness (..)+  , isExplicit+  , insert+  , ToJSON (..)+  , ToBsJSON (..)+  , Toml+  , TomlM+  , Parser+  ) where++import           Control.Applicative       (Alternative)+import           Control.Monad             (MonadPlus, join, when)+import           Control.Monad.State       (State)+import           Control.Monad.State.Class (MonadState, get, modify)+import           Control.Monad.Trans       (lift)+import           Data.Aeson.Types          hiding (Parser)+import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as M+import           Data.Int                  (Int64)+import           Data.List                 (intersect)+import           Data.Set                  (Set)+import qualified Data.Set                  as S+import           Data.Text                 (Text)+import qualified Data.Text                 as T+import           Data.Time.Clock           (UTCTime)+import           Data.Time.Format          ()+import           Data.Vector               (Vector)+import qualified Data.Vector               as V+import           Data.Void                 (Void)+import           Text.Megaparsec           hiding (State)++type Parser m a = (MonadState (Set [Text]) m) => ParsecT Void Text m a++type TomlM m = (MonadState (S.Set [Text]) m)++type Toml = State (S.Set [Text])++-- | The TOML 'Table' is a mapping ('HashMap') of 'Text' keys to 'Node' values.+type Table = HashMap Text Node++-- | Contruct an empty 'Table'.+emptyTable :: Table+emptyTable = M.empty++-- | An array of 'Table's, implemented using a 'Vector'.+type VTArray = Vector Table++-- | A \"value\" array that may contain zero or more 'Node's, implemented using a 'Vector'.+type VArray = Vector Node++-- | A 'Node' may contain any type of value that may be put in a 'VArray'.+data Node = VTable    !Table+          | VTArray   !VTArray+          | VString   !Text+          | VInteger  !Int64+          | VFloat    !Double+          | VBoolean  !Bool+          | VDatetime !UTCTime+          | VArray    !VArray+  deriving (Eq, Show)++-- | To mark whether or not a 'Table' has been explicitly defined.+-- See: https://github.com/toml-lang/toml/issues/376+data Explicitness = Explicit | Implicit+  deriving (Eq, Show)++-- | Convenience function to get a boolean value.+isExplicit :: Explicitness -> Bool+isExplicit Explicit = True+isExplicit Implicit = False++throwParser :: (MonadPlus m, Alternative m, Ord e, MonadParsec e s m) => String -> m a+throwParser x = fancyFailure $ S.fromList [ErrorFail x]++-- | Inserts a table, 'Table', with the namespaced name, '[Text]', (which+-- may be part of a table array) into a 'Table'.+-- It may result in an error in the 'ParsecT' monad for redefinitions.+insert :: (TomlM m) => Explicitness -> ([Text], Node) -> Table -> Parser m Table+insert _ ([], _) _ = throwParser "FATAL: Cannot call 'insert' without a name."+insert ex ([name], node) ttbl =+    -- In case 'name' is final (a top-level name)+    case M.lookup name ttbl of+      Nothing -> do when (isExplicit ex) $ updateExState [name] node+                    return $ M.insert name node ttbl+      Just (VTable t) -> case node of+          (VTable nt) -> case merge t nt of+                  Left ds -> nameInsertError ds name+                  Right r -> do when (isExplicit ex) $+                                  updateExStateOrError [name] node+                                return $ M.insert name (VTable r) ttbl+          _ -> commonInsertError node [name]+      Just (VTArray a) -> case node of+          (VTArray na) -> return $ M.insert name (VTArray $ a V.++ na) ttbl+          _            -> commonInsertError node [name]+      Just _ -> commonInsertError node [name]+insert ex (fullName@(name:ns), node) ttbl =+    -- In case 'name' is not final (not a top-level name)+    case M.lookup name ttbl of+      Nothing -> do+          r <- insert Implicit (ns, node) emptyTable+          when (isExplicit ex) $ updateExState fullName node+          return $ M.insert name (VTable r) ttbl+      Just (VTable t) -> do+          r <- insert Implicit (ns, node) t+          when (isExplicit ex) $ updateExStateOrError fullName node+          return $ M.insert name (VTable r) ttbl+      Just (VTArray a) ->+          if V.null a+          then throwParser "FATAL: Call to 'insert' found impossibly empty VArray."+          else do r <- insert Implicit (ns, node) (V.last a)+                  return $ M.insert name (VTArray $ V.init a `V.snoc` r) ttbl+      Just _ -> commonInsertError node fullName+++-- | Merge two tables, resulting in an error when overlapping keys are+-- found ('Left' will contain those keys).  When no overlapping keys are+-- found the result will contain the union of both tables in a 'Right'.+merge :: Table -> Table -> Either [Text] Table+merge existing new = case M.keys existing `intersect` M.keys new of+                       [] -> Right $ M.union existing new+                       ds -> Left ds++-- TOML tables maybe redefined when first definition was implicit.+-- For instance a top-level table `a` can implicitly defined by defining a non top-level+-- table `b` under it (namely with `[a.b]`). Once the table `a` is subsequently defined+-- explicitly (namely with `[a]`), it is then not possible to (re-)define it again.+-- A parser state of all explicitly defined tables is maintained, which allows+-- raising errors for illegal redefinitions of such.+updateExStateOrError :: (TomlM m) => [Text] -> Node -> Parser m ()+updateExStateOrError name node@(VTable _) = do+    explicitlyDefinedNames <- lift get+    let ns = explicitlyDefinedNames+    when (S.member name ns) $ tableClashError name+    updateExState name node+updateExStateOrError _ _ = return ()++-- | Like 'updateExStateOrError' but does not raise errors. Only use this when sure+-- that redefinitions cannot occur.+updateExState :: (TomlM m) => [Text] -> Node -> Parser m ()+updateExState name (VTable _) = lift $ modify (S.insert name)+updateExState _ _             = return ()+++-- * Parse errors resulting from invalid TOML++-- | Key(s) redefintion error.+nameInsertError :: (TomlM m) => [Text] -> Text -> Parser m a+nameInsertError ns name = throwParser . T.unpack $ T.concat+    [ "Cannot redefine key(s) (", T.intercalate ", " ns+    , "), from table named '", name, "'." ]++-- | Table redefinition error.+tableClashError :: (TomlM m) => [Text] -> Parser m a+tableClashError name = throwParser . T.unpack $ T.concat+    [ "Cannot redefine table named: '", T.intercalate "." name, "'." ]++-- | Common redefinition error.+commonInsertError :: (TomlM m) => Node -> [Text] -> Parser m a+commonInsertError what name = throwParser . join $+    [ "Cannot insert ", w, " as '", n, "' since key already exists." ]+  where+    n = T.unpack $ T.intercalate "." name+    w = case what of (VTable _) -> "tables"+                     _          -> "array of tables"+++-- * Regular ToJSON instances++-- | 'ToJSON' instances for the 'Node' type that produce Aeson (JSON)+-- in line with the TOML specification.+instance ToJSON Node where+  toJSON (VTable v)    = toJSON v+  toJSON (VTArray v)   = toJSON v+  toJSON (VString v)   = toJSON v+  toJSON (VInteger v)  = toJSON v+  toJSON (VFloat v)    = toJSON v+  toJSON (VBoolean v)  = toJSON v+  toJSON (VDatetime v) = toJSON v+  toJSON (VArray v)    = toJSON v++++-- * Special BurntSushi ToJSON type class and instances++-- | Type class for conversion to BurntSushi-style JSON.+--+-- BurntSushi has made a language agnostic test suite available that+-- this library uses. This test suit expects that values are encoded+-- as JSON objects with a 'type' and a 'value' member.+class ToBsJSON a where+  toBsJSON :: a -> Value++-- | Provide a 'toBsJSON' instance to the 'VTArray'.+instance (ToBsJSON a) => ToBsJSON (Vector a) where+  toBsJSON = Array . V.map toBsJSON+  {-# INLINE toBsJSON #-}++-- | Provide a 'toBsJSON' instance to the 'NTable'.+instance (ToBsJSON v) => ToBsJSON (M.HashMap Text v) where+  toBsJSON = Object . M.map toBsJSON+  {-# INLINE toBsJSON #-}++-- | 'ToBsJSON' instances for the 'TValue' type that produce Aeson (JSON)+-- in line with BurntSushi's language agnostic TOML test suite.+--+-- As seen in this function, BurntSushi's JSON encoding explicitly+-- specifies the types of the values.+instance ToBsJSON Node where+  toBsJSON (VTable v)    = toBsJSON v+  toBsJSON (VTArray v)   = toBsJSON v+  toBsJSON (VString v)   = object [ "type"  .= toJSON ("string" :: String)+                                  , "value" .= toJSON v ]+  toBsJSON (VInteger v)  = object [ "type"  .= toJSON ("integer" :: String)+                                  , "value" .= toJSON (show v) ]+  toBsJSON (VFloat v)    = object [ "type"  .= toJSON ("float" :: String)+                                  , "value" .= toJSON (show v) ]+  toBsJSON (VBoolean v)  = object [ "type"  .= toJSON ("bool" :: String)+                                  , "value" .= toJSON (if v then "true" else "false" :: String) ]+  toBsJSON (VDatetime v) = object [ "type"  .= toJSON ("datetime" :: String)+                                  , "value" .= toJSON (let s = show v+                                                           z = take (length s - 4)  s ++ "Z"+                                                           d = take (length z - 10) z+                                                           t = drop (length z - 9)  z+                                                       in  d ++ "T" ++ t) ]+  toBsJSON (VArray v)    = object [ "type"  .= toJSON ("array" :: String)+                                  , "value" .= toBsJSON v ]
+ test/BurntSushi.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module BurntSushi (tests) where++import           Test.Tasty           (TestTree, testGroup)+import           Test.Tasty.HUnit++import           Data.Aeson+import qualified Data.ByteString      as B+import           Data.ByteString.Lazy (fromStrict)+import           Data.FileEmbed+import           Data.List            (isPrefixOf, isSuffixOf)+import           Data.Text.Encoding   (decodeUtf8)++import           Text.Toml+import           Text.Toml.Types+++allFiles :: [(FilePath, B.ByteString)]+allFiles = $(makeRelativeToProject "test/BurntSushi" >>= embedDir)+++validPairs :: [(String, (B.ByteString, B.ByteString))]+validPairs =+    map (\(tFP, tBS) -> (stripExt tFP, (tBS, jsonCounterpart tFP))) tomlFiles+  where+    validFiles = filter (\(f, _) -> "valid" `isPrefixOf` f) allFiles+    filterOnSuffix sfx = filter (\(f, _) -> sfx `isSuffixOf` f)+    tomlFiles = filterOnSuffix ".toml" validFiles+    jsonFiles = filterOnSuffix ".json" validFiles+    stripExt fp = take (length fp - 5) fp+    jsonCounterpart tFP =+      case filter (\(f, _) -> f == stripExt tFP ++ ".json") jsonFiles of+        []       -> error $ "Could not find a JSON counterpart for: " ++ tFP+        [(_, j)] -> j+        _        -> error $ "Expected one, but found several \+                            \JSON counterparts for: " ++ tFP+++invalidTomlFiles :: [(FilePath, B.ByteString)]+invalidTomlFiles = filter (\(f, _) -> "invalid" `isPrefixOf` f) allFiles+++tests :: IO TestTree+tests = return $ testGroup "BurntSushi's test suite"+          [ testGroup "test equality of resulting JSON (valid)" $+              map (\(fp, (tBS, jBS)) -> testCase fp $ assertIsValid fp tBS jBS) validPairs+          , testGroup "test parse failures of malformed TOML files (invalid)" $+              map (\(fp, tBS) -> testCase fp $ assertParseFailure fp tBS) invalidTomlFiles+          ]+  where+    assertIsValid f tomlBS jsonBS =+      case parseTomlDoc "test" (decodeUtf8 tomlBS) of+        Left e -> assertFailure $ "Could not parse TOML file: " ++ f ++ ".toml\n" ++ (show e)+        Right tomlTry -> case eitherDecode (fromStrict jsonBS) of+          Left _ -> assertFailure $ "Could not parse JSON file: " ++ f ++ ".json"+          Right jsonCorrect -> assertEqual "" jsonCorrect (toBsJSON tomlTry)+    assertParseFailure f tomlBS =+      case parseTomlDoc "test" (decodeUtf8 tomlBS) of+        Left _ -> return ()+        Right _ -> assertFailure $ "Parser accepted invalid TOML file: " ++ f
+ test/BurntSushi/fetch-toml-tests.sh view
@@ -0,0 +1,13 @@+#!/bin/sh++rm valid/*+rmdir valid+rm invalid/*+rmdir invalid++git clone https://github.com/BurntSushi/toml-test++mv toml-test/tests/valid .+mv toml-test/tests/invalid .++rm -rf toml-test
+ test/BurntSushi/invalid/array-mixed-types-arrays-and-ints.toml view
@@ -0,0 +1,1 @@+arrays-and-ints =  [1, ["Arrays are not integers."]]
+ test/BurntSushi/invalid/array-mixed-types-ints-and-floats.toml view
@@ -0,0 +1,1 @@+ints-and-floats = [1, 1.1]
+ test/BurntSushi/invalid/array-mixed-types-strings-and-ints.toml view
@@ -0,0 +1,1 @@+strings-and-ints = ["hi", 42]
+ test/BurntSushi/invalid/datetime-malformed-no-leads.toml view
@@ -0,0 +1,1 @@+no-leads = 1987-7-05T17:45:00Z
+ test/BurntSushi/invalid/datetime-malformed-no-secs.toml view
@@ -0,0 +1,1 @@+no-secs = 1987-07-05T17:45Z
+ test/BurntSushi/invalid/datetime-malformed-no-t.toml view
@@ -0,0 +1,1 @@+no-t = 1987-07-0517:45:00Z
+ test/BurntSushi/invalid/datetime-malformed-no-z.toml view
@@ -0,0 +1,1 @@+no-z = 1987-07-05T17:45:00
+ test/BurntSushi/invalid/datetime-malformed-with-milli.toml view
@@ -0,0 +1,1 @@+with-milli = 1987-07-5T17:45:00.12Z
+ test/BurntSushi/invalid/duplicate-key-table.toml view
@@ -0,0 +1,5 @@+[fruit]+type = "apple"++[fruit.type]+apple = "yes"
+ test/BurntSushi/invalid/duplicate-keys.toml view
@@ -0,0 +1,2 @@+dupe = false+dupe = true
+ test/BurntSushi/invalid/duplicate-tables.toml view
@@ -0,0 +1,2 @@+[a]+[a]
+ test/BurntSushi/invalid/empty-implicit-table.toml view
@@ -0,0 +1,1 @@+[naughty..naughty]
+ test/BurntSushi/invalid/empty-table.toml view
@@ -0,0 +1,1 @@+[]
+ test/BurntSushi/invalid/float-no-leading-zero.toml view
@@ -0,0 +1,2 @@+answer = .12345+neganswer = -.12345
+ test/BurntSushi/invalid/float-no-trailing-digits.toml view
@@ -0,0 +1,2 @@+answer = 1.+neganswer = -1.
+ test/BurntSushi/invalid/key-empty.toml view
@@ -0,0 +1,1 @@+ = 1
+ test/BurntSushi/invalid/key-hash.toml view
@@ -0,0 +1,1 @@+a# = 1
+ test/BurntSushi/invalid/key-newline.toml view
@@ -0,0 +1,2 @@+a+= 1
+ test/BurntSushi/invalid/key-open-bracket.toml view
@@ -0,0 +1,1 @@+[abc = 1
+ test/BurntSushi/invalid/key-single-open-bracket.toml view
@@ -0,0 +1,1 @@+[
+ test/BurntSushi/invalid/key-space.toml view
@@ -0,0 +1,1 @@+a b = 1
+ test/BurntSushi/invalid/key-start-bracket.toml view
@@ -0,0 +1,3 @@+[a]+[xyz = 5+[b]
+ test/BurntSushi/invalid/key-two-equals.toml view
@@ -0,0 +1,1 @@+key= = 1
+ test/BurntSushi/invalid/string-bad-byte-escape.toml view
@@ -0,0 +1,1 @@+naughty = "\xAg"
+ test/BurntSushi/invalid/string-bad-escape.toml view
@@ -0,0 +1,1 @@+invalid-escape = "This string has a bad \a escape character."
+ test/BurntSushi/invalid/string-byte-escapes.toml view
@@ -0,0 +1,1 @@+answer = "\x33"
+ test/BurntSushi/invalid/string-no-close.toml view
@@ -0,0 +1,1 @@+no-ending-quote = "One time, at band camp
+ test/BurntSushi/invalid/table-array-implicit.toml view
@@ -0,0 +1,14 @@+# This test is a bit tricky. It should fail because the first use of+# `[[albums.songs]]` without first declaring `albums` implies that `albums`+# must be a table. The alternative would be quite weird. Namely, it wouldn't+# comply with the TOML spec: "Each double-bracketed sub-table will belong to +# the most *recently* defined table element *above* it."+#+# This is in contrast to the *valid* test, table-array-implicit where+# `[[albums.songs]]` works by itself, so long as `[[albums]]` isn't declared+# later. (Although, `[albums]` could be.)+[[albums.songs]]+name = "Glory Days"++[[albums]]+name = "Born in the USA"
+ test/BurntSushi/invalid/table-array-malformed-bracket.toml view
@@ -0,0 +1,2 @@+[[albums]+name = "Born to Run"
+ test/BurntSushi/invalid/table-array-malformed-empty.toml view
@@ -0,0 +1,2 @@+[[]]+name = "Born to Run"
+ test/BurntSushi/invalid/table-empty.toml view
@@ -0,0 +1,1 @@+[]
+ test/BurntSushi/invalid/table-nested-brackets-close.toml view
@@ -0,0 +1,2 @@+[a]b]+zyx = 42
+ test/BurntSushi/invalid/table-nested-brackets-open.toml view
@@ -0,0 +1,2 @@+[a[b]+zyx = 42
+ test/BurntSushi/invalid/table-whitespace.toml view
@@ -0,0 +1,1 @@+[invalid key]
+ test/BurntSushi/invalid/table-with-pound.toml view
@@ -0,0 +1,2 @@+[key#group]+answer = 42
+ test/BurntSushi/invalid/text-after-array-entries.toml view
@@ -0,0 +1,4 @@+array = [+  "Is there life after an array separator?", No+  "Entry"+]
+ test/BurntSushi/invalid/text-after-integer.toml view
@@ -0,0 +1,1 @@+answer = 42 the ultimate answer?
+ test/BurntSushi/invalid/text-after-string.toml view
@@ -0,0 +1,1 @@+string = "Is there life after strings?" No.
+ test/BurntSushi/invalid/text-after-table.toml view
@@ -0,0 +1,1 @@+[error] this shouldn't be here
+ test/BurntSushi/invalid/text-before-array-separator.toml view
@@ -0,0 +1,4 @@+array = [+  "Is there life before an array separator?" No,+  "Entry"+]
+ test/BurntSushi/invalid/text-in-array.toml view
@@ -0,0 +1,5 @@+array = [+  "Entry 1",+  I don't belong,+  "Entry 2",+]
+ test/BurntSushi/valid/array-empty.json view
@@ -0,0 +1,11 @@+{+    "thevoid": { "type": "array", "value": [+        {"type": "array", "value": [+            {"type": "array", "value": [+                {"type": "array", "value": [+                    {"type": "array", "value": []}+                ]}+            ]}+        ]}+    ]}+}
+ test/BurntSushi/valid/array-empty.toml view
@@ -0,0 +1,1 @@+thevoid = [[[[[]]]]]
+ test/BurntSushi/valid/array-nospaces.json view
@@ -0,0 +1,10 @@+{+    "ints": {+        "type": "array",+        "value": [+            {"type": "integer", "value": "1"},+            {"type": "integer", "value": "2"},+            {"type": "integer", "value": "3"}+        ]+    }+}
+ test/BurntSushi/valid/array-nospaces.toml view
@@ -0,0 +1,1 @@+ints = [1,2,3]
+ test/BurntSushi/valid/arrays-hetergeneous.json view
@@ -0,0 +1,19 @@+{+    "mixed": {+        "type": "array",+        "value": [+            {"type": "array", "value": [+                {"type": "integer", "value": "1"},+                {"type": "integer", "value": "2"}+            ]},+            {"type": "array", "value": [+                {"type": "string", "value": "a"},+                {"type": "string", "value": "b"}+            ]},+            {"type": "array", "value": [+                {"type": "float", "value": "1.1"},+                {"type": "float", "value": "2.1"}+            ]}+        ]+    }+}
+ test/BurntSushi/valid/arrays-hetergeneous.toml view
@@ -0,0 +1,1 @@+mixed = [[1, 2], ["a", "b"], [1.1, 2.1]]
+ test/BurntSushi/valid/arrays-nested.json view
@@ -0,0 +1,13 @@+{+    "nest": {+        "type": "array",+        "value": [+            {"type": "array", "value": [+                {"type": "string", "value": "a"}+            ]},+            {"type": "array", "value": [+                {"type": "string", "value": "b"}+            ]}+        ]+    }+}
+ test/BurntSushi/valid/arrays-nested.toml view
@@ -0,0 +1,1 @@+nest = [["a"], ["b"]]
+ test/BurntSushi/valid/arrays.json view
@@ -0,0 +1,34 @@+{+    "ints": {+        "type": "array",+        "value": [+            {"type": "integer", "value": "1"},+            {"type": "integer", "value": "2"},+            {"type": "integer", "value": "3"}+        ]+    },+    "floats": {+        "type": "array",+        "value": [+            {"type": "float", "value": "1.1"},+            {"type": "float", "value": "2.1"},+            {"type": "float", "value": "3.1"}+        ]+    },+    "strings": {+        "type": "array",+        "value": [+            {"type": "string", "value": "a"},+            {"type": "string", "value": "b"},+            {"type": "string", "value": "c"}+        ]+    },+    "dates": {+        "type": "array",+        "value": [+            {"type": "datetime", "value": "1987-07-05T17:45:00Z"},+            {"type": "datetime", "value": "1979-05-27T07:32:00Z"},+            {"type": "datetime", "value": "2006-06-01T11:00:00Z"}+        ]+    }+}
+ test/BurntSushi/valid/arrays.toml view
@@ -0,0 +1,8 @@+ints = [1, 2, 3]+floats = [1.1, 2.1, 3.1]+strings = ["a", "b", "c"]+dates = [+  1987-07-05T17:45:00Z,+  1979-05-27T07:32:00Z,+  2006-06-01T11:00:00Z,+]
+ test/BurntSushi/valid/bool.json view
@@ -0,0 +1,4 @@+{+    "f": {"type": "bool", "value": "false"},+    "t": {"type": "bool", "value": "true"}+}
+ test/BurntSushi/valid/bool.toml view
@@ -0,0 +1,2 @@+t = true+f = false
+ test/BurntSushi/valid/comments-everywhere.json view
@@ -0,0 +1,12 @@+{+    "group": {+        "answer": {"type": "integer", "value": "42"},+        "more": {+            "type": "array",+            "value": [+                {"type": "integer", "value": "42"},+                {"type": "integer", "value": "42"}+            ]+        }+    }+}
+ test/BurntSushi/valid/comments-everywhere.toml view
@@ -0,0 +1,24 @@+# Top comment.+  # Top comment.+# Top comment.++# [no-extraneous-groups-please]++[group] # Comment+answer = 42 # Comment+# no-extraneous-keys-please = 999+# Inbetween comment.+more = [ # Comment+  # What about multiple # comments?+  # Can you handle it?+  #+          # Evil.+# Evil.+  42, 42, # Comments within arrays are fun.+  # What about multiple # comments?+  # Can you handle it?+  #+          # Evil.+# Evil.+# ] Did I fool you?+] # Hopefully not.
+ test/BurntSushi/valid/datetime.json view
@@ -0,0 +1,3 @@+{+    "bestdayever": {"type": "datetime", "value": "1987-07-05T17:45:00Z"}+}
+ test/BurntSushi/valid/datetime.toml view
@@ -0,0 +1,1 @@+bestdayever = 1987-07-05T17:45:00Z
+ test/BurntSushi/valid/empty.json view
@@ -0,0 +1,1 @@+{}
+ test/BurntSushi/valid/empty.toml view
+ test/BurntSushi/valid/example.json view
@@ -0,0 +1,14 @@+{+  "best-day-ever": {"type": "datetime", "value": "1987-07-05T17:45:00Z"},+  "numtheory": {+    "boring": {"type": "bool", "value": "false"},+    "perfection": {+      "type": "array",+      "value": [+        {"type": "integer", "value": "6"},+        {"type": "integer", "value": "28"},+        {"type": "integer", "value": "496"}+      ]+    }+  }+}
+ test/BurntSushi/valid/example.toml view
@@ -0,0 +1,5 @@+best-day-ever = 1987-07-05T17:45:00Z++[numtheory]+boring = false+perfection = [6, 28, 496]
+ test/BurntSushi/valid/float.json view
@@ -0,0 +1,4 @@+{+    "pi": {"type": "float", "value": "3.14"},+    "negpi": {"type": "float", "value": "-3.14"}+}
+ test/BurntSushi/valid/float.toml view
@@ -0,0 +1,2 @@+pi = 3.14+negpi = -3.14
+ test/BurntSushi/valid/implicit-and-explicit-after.json view
@@ -0,0 +1,10 @@+{+    "a": {+        "better": {"type": "integer", "value": "43"},+        "b": {+            "c": {+                "answer": {"type": "integer", "value": "42"}+            }+        }+    }+}
+ test/BurntSushi/valid/implicit-and-explicit-after.toml view
@@ -0,0 +1,5 @@+[a.b.c]+answer = 42++[a]+better = 43
+ test/BurntSushi/valid/implicit-and-explicit-before.json view
@@ -0,0 +1,10 @@+{+    "a": {+        "better": {"type": "integer", "value": "43"},+        "b": {+            "c": {+                "answer": {"type": "integer", "value": "42"}+            }+        }+    }+}
+ test/BurntSushi/valid/implicit-and-explicit-before.toml view
@@ -0,0 +1,5 @@+[a]+better = 43++[a.b.c]+answer = 42
+ test/BurntSushi/valid/implicit-groups.json view
@@ -0,0 +1,9 @@+{+    "a": {+        "b": {+            "c": {+                "answer": {"type": "integer", "value": "42"}+            }+        }+    }+}
+ test/BurntSushi/valid/implicit-groups.toml view
@@ -0,0 +1,2 @@+[a.b.c]+answer = 42
+ test/BurntSushi/valid/integer.json view
@@ -0,0 +1,4 @@+{+    "answer": {"type": "integer", "value": "42"},+    "neganswer": {"type": "integer", "value": "-42"}+}
+ test/BurntSushi/valid/integer.toml view
@@ -0,0 +1,2 @@+answer = 42+neganswer = -42
+ test/BurntSushi/valid/key-equals-nospace.json view
@@ -0,0 +1,3 @@+{+    "answer": {"type": "integer", "value": "42"}+}
+ test/BurntSushi/valid/key-equals-nospace.toml view
@@ -0,0 +1,1 @@+answer=42
+ test/BurntSushi/valid/key-space.json view
@@ -0,0 +1,3 @@+{+    "a b": {"type": "integer", "value": "1"}+}
+ test/BurntSushi/valid/key-space.toml view
@@ -0,0 +1,1 @@+"a b" = 1
+ test/BurntSushi/valid/key-special-chars.json view
@@ -0,0 +1,5 @@+{+    "~!@$^&*()_+-`1234567890[]|/?><.,;:'": {+        "type": "integer", "value": "1"+    }+}
+ test/BurntSushi/valid/key-special-chars.toml view
@@ -0,0 +1,1 @@+"~!@$^&*()_+-`1234567890[]|/?><.,;:'" = 1
+ test/BurntSushi/valid/long-float.json view
@@ -0,0 +1,4 @@+{+    "longpi": {"type": "float", "value": "3.141592653589793"},+    "neglongpi": {"type": "float", "value": "-3.141592653589793"}+}
+ test/BurntSushi/valid/long-float.toml view
@@ -0,0 +1,2 @@+longpi = 3.141592653589793+neglongpi = -3.141592653589793
+ test/BurntSushi/valid/long-integer.json view
@@ -0,0 +1,4 @@+{+    "answer": {"type": "integer", "value": "9223372036854775807"},+    "neganswer": {"type": "integer", "value": "-9223372036854775808"}+}
+ test/BurntSushi/valid/long-integer.toml view
@@ -0,0 +1,2 @@+answer = 9223372036854775807+neganswer = -9223372036854775808
+ test/BurntSushi/valid/multiline-string.json view
@@ -0,0 +1,30 @@+{+    "multiline_empty_one": {+        "type": "string",+        "value": ""+    },+    "multiline_empty_two": {+        "type": "string",+        "value": ""+    },+    "multiline_empty_three": {+        "type": "string",+        "value": ""+    },+    "multiline_empty_four": {+        "type": "string",+        "value": ""+    },+    "equivalent_one": {+        "type": "string",+        "value": "The quick brown fox jumps over the lazy dog."+    },+    "equivalent_two": {+        "type": "string",+        "value": "The quick brown fox jumps over the lazy dog."+    },+    "equivalent_three": {+        "type": "string",+        "value": "The quick brown fox jumps over the lazy dog."+    }+}
+ test/BurntSushi/valid/multiline-string.toml view
@@ -0,0 +1,23 @@+multiline_empty_one = """"""+multiline_empty_two = """+"""+multiline_empty_three = """\+    """+multiline_empty_four = """\+   \+   \+   """++equivalent_one = "The quick brown fox jumps over the lazy dog."+equivalent_two = """+The quick brown \+++  fox jumps over \+    the lazy dog."""++equivalent_three = """\+       The quick brown \+       fox jumps over \+       the lazy dog.\+       """
+ test/BurntSushi/valid/raw-multiline-string.json view
@@ -0,0 +1,14 @@+{+    "oneline": {+        "type": "string",+        "value": "This string has a ' quote character."+    },+    "firstnl": {+        "type": "string",+        "value": "This string has a ' quote character."+    },+    "multiline": {+        "type": "string",+        "value": "This string\nhas ' a quote character\nand more than\none newline\nin it."+    }+}
+ test/BurntSushi/valid/raw-multiline-string.toml view
@@ -0,0 +1,9 @@+oneline = '''This string has a ' quote character.'''+firstnl = '''+This string has a ' quote character.'''+multiline = '''+This string+has ' a quote character+and more than+one newline+in it.'''
+ test/BurntSushi/valid/raw-string.json view
@@ -0,0 +1,30 @@+{+    "backspace": {+        "type": "string",+        "value": "This string has a \\b backspace character."+    },+    "tab": {+        "type": "string",+        "value": "This string has a \\t tab character."+    },+    "newline": {+        "type": "string",+        "value": "This string has a \\n new line character."+    },+    "formfeed": {+        "type": "string",+        "value": "This string has a \\f form feed character."+    },+    "carriage": {+        "type": "string",+        "value": "This string has a \\r carriage return character."+    },+    "slash": {+        "type": "string",+        "value": "This string has a \\/ slash character."+    },+    "backslash": {+        "type": "string",+        "value": "This string has a \\\\ backslash character."+    }+}
+ test/BurntSushi/valid/raw-string.toml view
@@ -0,0 +1,7 @@+backspace = 'This string has a \b backspace character.'+tab = 'This string has a \t tab character.'+newline = 'This string has a \n new line character.'+formfeed = 'This string has a \f form feed character.'+carriage = 'This string has a \r carriage return character.'+slash = 'This string has a \/ slash character.'+backslash = 'This string has a \\ backslash character.'
+ test/BurntSushi/valid/string-empty.json view
@@ -0,0 +1,6 @@+{+    "answer": {+        "type": "string",+        "value": ""+    }+}
+ test/BurntSushi/valid/string-empty.toml view
@@ -0,0 +1,1 @@+answer = ""
+ test/BurntSushi/valid/string-escapes.json view
@@ -0,0 +1,46 @@+{+    "backspace": {+        "type": "string",+        "value": "This string has a \u0008 backspace character."+    },+    "tab": {+        "type": "string",+        "value": "This string has a \u0009 tab character."+    },+    "newline": {+        "type": "string",+        "value": "This string has a \u000A new line character."+    },+    "formfeed": {+        "type": "string",+        "value": "This string has a \u000C form feed character."+    },+    "carriage": {+        "type": "string",+        "value": "This string has a \u000D carriage return character."+    },+    "quote": {+        "type": "string",+        "value": "This string has a \u0022 quote character."+    },+    "backslash": {+        "type": "string",+        "value": "This string has a \u005C backslash character."+    },+    "notunicode1": {+        "type": "string",+        "value": "This string does not have a unicode \\u escape."+    },+    "notunicode2": {+        "type": "string",+        "value": "This string does not have a unicode \u005Cu escape."+    },+    "notunicode3": {+        "type": "string",+        "value": "This string does not have a unicode \\u0075 escape."+    },+    "notunicode4": {+        "type": "string",+        "value": "This string does not have a unicode \\\u0075 escape."+    }+}
+ test/BurntSushi/valid/string-escapes.toml view
@@ -0,0 +1,11 @@+backspace = "This string has a \b backspace character."+tab = "This string has a \t tab character."+newline = "This string has a \n new line character."+formfeed = "This string has a \f form feed character."+carriage = "This string has a \r carriage return character."+quote = "This string has a \" quote character."+backslash = "This string has a \\ backslash character."+notunicode1 = "This string does not have a unicode \\u escape."+notunicode2 = "This string does not have a unicode \u005Cu escape."+notunicode3 = "This string does not have a unicode \\u0075 escape."+notunicode4 = "This string does not have a unicode \\\u0075 escape."
+ test/BurntSushi/valid/string-simple.json view
@@ -0,0 +1,6 @@+{+    "answer": {+        "type": "string",+        "value": "You are not drinking enough whisky."+    }+}
+ test/BurntSushi/valid/string-simple.toml view
@@ -0,0 +1,1 @@+answer = "You are not drinking enough whisky."
+ test/BurntSushi/valid/string-with-pound.json view
@@ -0,0 +1,7 @@+{+    "pound": {"type": "string", "value": "We see no # comments here."},+    "poundcomment": {+        "type": "string",+        "value": "But there are # some comments here."+    }+}
+ test/BurntSushi/valid/string-with-pound.toml view
@@ -0,0 +1,2 @@+pound = "We see no # comments here."+poundcomment = "But there are # some comments here." # Did I # mess you up?
+ test/BurntSushi/valid/table-array-implicit.json view
@@ -0,0 +1,7 @@+{+    "albums": {+       "songs": [+           {"name": {"type": "string", "value": "Glory Days"}}+       ]+    }+}
+ test/BurntSushi/valid/table-array-implicit.toml view
@@ -0,0 +1,2 @@+[[albums.songs]]+name = "Glory Days"
+ test/BurntSushi/valid/table-array-many.json view
@@ -0,0 +1,16 @@+{+    "people": [+        {+            "first_name": {"type": "string", "value": "Bruce"},+            "last_name": {"type": "string", "value": "Springsteen"}+        },+        {+            "first_name": {"type": "string", "value": "Eric"},+            "last_name": {"type": "string", "value": "Clapton"}+        },+        {+            "first_name": {"type": "string", "value": "Bob"},+            "last_name": {"type": "string", "value": "Seger"}+        }+    ]+}
+ test/BurntSushi/valid/table-array-many.toml view
@@ -0,0 +1,11 @@+[[people]]+first_name = "Bruce"+last_name = "Springsteen"++[[people]]+first_name = "Eric"+last_name = "Clapton"++[[people]]+first_name = "Bob"+last_name = "Seger"
+ test/BurntSushi/valid/table-array-nest.json view
@@ -0,0 +1,18 @@+{+    "albums": [+        {+            "name": {"type": "string", "value": "Born to Run"},+            "songs": [+                {"name": {"type": "string", "value": "Jungleland"}},+                {"name": {"type": "string", "value": "Meeting Across the River"}}+            ]+        },+        {+            "name": {"type": "string", "value": "Born in the USA"},+            "songs": [+                {"name": {"type": "string", "value": "Glory Days"}},+                {"name": {"type": "string", "value": "Dancing in the Dark"}}+            ]+        }+    ]+}
+ test/BurntSushi/valid/table-array-nest.toml view
@@ -0,0 +1,17 @@+[[albums]]+name = "Born to Run"++  [[albums.songs]]+  name = "Jungleland"++  [[albums.songs]]+  name = "Meeting Across the River"++[[albums]]+name = "Born in the USA"+  +  [[albums.songs]]+  name = "Glory Days"++  [[albums.songs]]+  name = "Dancing in the Dark"
+ test/BurntSushi/valid/table-array-one.json view
@@ -0,0 +1,8 @@+{+    "people": [+        {+            "first_name": {"type": "string", "value": "Bruce"},+            "last_name": {"type": "string", "value": "Springsteen"}+        }+    ]+}
+ test/BurntSushi/valid/table-array-one.toml view
@@ -0,0 +1,3 @@+[[people]]+first_name = "Bruce"+last_name = "Springsteen"
+ test/BurntSushi/valid/table-empty.json view
@@ -0,0 +1,3 @@+{+    "a": {}+}
+ test/BurntSushi/valid/table-empty.toml view
@@ -0,0 +1,1 @@+[a]
+ test/BurntSushi/valid/table-sub-empty.json view
@@ -0,0 +1,3 @@+{+    "a": { "b": {} }+}
+ test/BurntSushi/valid/table-sub-empty.toml view
@@ -0,0 +1,2 @@+[a]+[a.b]
+ test/BurntSushi/valid/table-whitespace.json view
@@ -0,0 +1,3 @@+{+    "valid key": {}+}
+ test/BurntSushi/valid/table-whitespace.toml view
@@ -0,0 +1,1 @@+["valid key"]
+ test/BurntSushi/valid/table-with-pound.json view
@@ -0,0 +1,5 @@+{+    "key#group": {+        "answer": {"type": "integer", "value": "42"}+    }+}
+ test/BurntSushi/valid/table-with-pound.toml view
@@ -0,0 +1,2 @@+["key#group"]+answer = 42
+ test/BurntSushi/valid/unicode-escape.json view
@@ -0,0 +1,4 @@+{+    "answer4": {"type": "string", "value": "\u03B4"},+    "answer8": {"type": "string", "value": "\u03B4"}+}
+ test/BurntSushi/valid/unicode-escape.toml view
@@ -0,0 +1,2 @@+answer4 = "\u03B4"+answer8 = "\U000003B4"
+ test/BurntSushi/valid/unicode-literal.json view
@@ -0,0 +1,3 @@+{+    "answer": {"type": "string", "value": "δ"}+}
+ test/BurntSushi/valid/unicode-literal.toml view
@@ -0,0 +1,1 @@+answer = "δ"
+ test/Test.hs view
@@ -0,0 +1,20 @@+module Main where++import           Prelude               hiding (readFile)  -- needed for GHCi, see `.ghci`+import           Test.Tasty            (defaultMain, testGroup)++import qualified BurntSushi+import           Text.Toml.Parser.Spec+++main :: IO ()+main = do+  parserSpec <- tomlParserSpec+  bsTests <- BurntSushi.tests++  defaultMain $ testGroup "" $+    [ parserSpec+    , bsTests+      --, quickCheckSuite+      -- A QuickCheck suite for a parser is possible. The internet knows.+    ]
+ test/Text/Toml/Parser/Spec.hs view
@@ -0,0 +1,437 @@+{-# LANGUAGE OverloadedStrings #-}++module Text.Toml.Parser.Spec where++import           Test.Tasty          (TestTree)+import           Test.Tasty.Hspec++import           Data.HashMap.Strict (fromList)+import           Data.Time.Calendar  (Day (..))+import           Data.Time.Clock     (UTCTime (..))+import qualified Data.Vector         as V++import           Text.Toml.Parser+++mkVTArray :: [Table] -> Node+mkVTArray = VTArray . V.fromList++mkVArray :: [Node] -> Node+mkVArray  = VArray . V.fromList+++tomlParserSpec :: IO TestTree+tomlParserSpec = testSpec "Parser Hspec suite" $ do++  describe "Parser.tomlDoc generic" $ do++    it "should parse empty input" $+      testParser tomlDoc "" $ fromList []++    it "should parse non-empty tomlDocs that do not end with a newline" $+      testParser tomlDoc "number = 123" $+        fromList [("number", VInteger 123)]++    it "should parse when tomlDoc ends in a comment" $+      testParser tomlDoc "q = 42  # understood?" $+        fromList [("q", VInteger 42)]++    it "should not parse re-assignment of key" $+      testParserFails tomlDoc "q=42\nq=42"++    it "should not parse rubbish" $+      testParserFails tomlDoc "{"+++  describe "Parser.tomlDoc (named tables)" $ do++    it "should parse simple named table" $+      testParser tomlDoc "[a]\naa = 108" $+        fromList [("a", VTable (fromList [("aa", VInteger 108)] ))]++    it "should not parse redefined table header (key already exists at scope)" $+      testParserFails tomlDoc "[a]\n[a]"++    it "should parse redefinition of implicit key" $+      testParser tomlDoc "[a.b]\n[a]" $+        fromList [("a", VTable (fromList [("b", VTable emptyTable)] ))]++    it "should parse redefinition of implicit key, with table contents" $+      testParser tomlDoc "[a.b]\nb=3\n[a]\na=4" $+        fromList [("a", VTable (fromList [("b", VTable (fromList [("b", VInteger 3)])),+                                          ("a", VInteger 4)]))]++    it "should parse redefinition by implicit table header" $+      testParser tomlDoc "[a]\n[a.b]" $+        fromList [("a", VTable (fromList [("b", VTable emptyTable)] ))]++    it "should parse inline tables the same as normal tables" $+      testParser tomlDoc "[a]\nb={}" $+        fromList [("a", VTable (fromList [("b", VTable emptyTable)] ))]++    it "should not parse redefinition key" $+      testParserFails tomlDoc "[a]\nb=1\n[a.b]"+++  describe "Parser.tomlDoc (tables arrays)" $ do++    it "should parse a simple empty table array" $+      testParser tomlDoc "[[a]]\n[[a]]" $+        fromList [("a", mkVTArray [ fromList []+                                  , fromList [] ] )]++    it "should parse a simple table array with content" $+      testParser tomlDoc "[[a]]\na1=1\n[[a]]\na2=2" $+        fromList [("a", mkVTArray [ fromList [("a1", VInteger 1)]+                                  , fromList [("a2", VInteger 2)] ] )]++    it "should not allow a simple table array to be inserted into a non table array" $+      testParserFails tomlDoc "a = [1,2,3]\n[[a]]"++    it "should parse a simple empty nested table array" $+      testParser tomlDoc "[[a.b]]\n[[a.b]]" $+        fromList [("a", VTable (fromList [("b", mkVTArray [ emptyTable+                                                          , emptyTable ] )] ) ) ]++    it "should parse a simple non empty table array" $+      testParser tomlDoc "[[a.b]]\na1=1\n[[a.b]]\na2=2" $+        fromList [("a", VTable (fromList [("b", mkVTArray [ fromList [("a1", VInteger 1)]+                                                          , fromList [("a2", VInteger 2)]+                                                          ] )] ) )]++    it "should parse redefined implicit table header" $+      testParserFails tomlDoc "[[a.b]]\n[[a]]"++    it "should parse redefinition by implicit table header" $+      testParser tomlDoc "[[a]]\n[[a.b]]" $+        fromList [("a", mkVTArray [ fromList [("b", mkVTArray [ fromList [] ])] ] )]+++  describe "Parser.tomlDoc (mixed named tables and tables arrays)" $ do++    it "should not parse redefinition of key by table header (table array by table)" $+      testParserFails tomlDoc "[[a]]\n[a]"++    it "should not parse redefinition of key by table header (table by table array)" $+      testParserFails tomlDoc "[a]\n[[a]]"++    it "should not parse redefinition implicit table header (table by array)" $+      testParserFails tomlDoc "[a.b]\n[[a]]"++    it "should parse redefined implicit table header (array by table)" $+      testParser tomlDoc "[[a.b]]\n[a]" $+        fromList [("a", VTable (fromList [("b", mkVTArray [ fromList [] ])] ) )]++    it "should not parse redefined implicit table header (array by table), when keys collide" $+      testParserFails tomlDoc "[[a.b]]\n[a]\nb=1"++    it "should insert sub-key of regular table in most recently defined table array" $+      testParser tomlDoc "[[a]]\ni=0\n[[a]]\ni=1\n[a.b]" $+        fromList [("a", mkVTArray [ fromList [ ("i", VInteger 0) ]+                                  , fromList [ ("b", VTable  $ fromList [] )+                                             , ("i", VInteger 1) ]+                                  ] )]++    it "should insert sub-key of table array" $+      testParser tomlDoc "[a]\n[[a.b]]" $+        fromList [("a", VTable (fromList [("b", mkVTArray [fromList []])] ) )]++    it "should insert sub-key (with content) of table array" $+      testParser tomlDoc "[a]\nq=42\n[[a.b]]\ni=0" $+        fromList [("a", VTable (fromList [ ("q", VInteger 42),+                                           ("b", mkVTArray [+                                                   fromList [("i", VInteger 0)]+                                                   ]) ]) )]++  describe "Parser.headerValue" $ do++    it "should parse simple table header" $+      testParser headerValue "table" ["table"]++    it "should parse simple nested table header" $+      testParser headerValue "main.sub" ["main", "sub"]++    it "should not parse just a dot (separator)" $+      testParserFails headerValue "."++    it "should not parse an empty most right name" $+      testParserFails headerValue  "first."++    it "should not parse an empty most left name" $+      testParserFails headerValue  ".second"++    it "should not parse an empty middle name" $+      testParserFails headerValue  "first..second"+++  describe "Parser.tableHeader" $ do++    it "should not parse an empty table header" $+      testParserFails tableHeader "[]"++    it "should parse simple table header" $+      testParser tableHeader "[item]" ["item"]++    it "should parse simple nested table header" $+      testParser tableHeader "[main.sub]" ["main", "sub"]+++  describe "Parser.tableArrayHeader" $ do++    it "should not parse an empty table header" $+      testParserFails tableArrayHeader "[[]]"++    it "should parse simple table array header" $+      testParser tableArrayHeader "[[item]]" ["item"]++    it "should parse simple nested table array header" $+      testParser tableArrayHeader "[[main.sub]]" ["main", "sub"]+++  describe "Parser.assignment" $ do++    it "should parse simple example" $+      testParser assignment "country = \"\"" ("country", VString "")++    it "should parse without spacing around the assignment operator" $+      testParser assignment "a=108" ("a", VInteger 108)++    it "should parse when value on next line" $+      testParser assignment "a =\n108" ("a", VInteger 108)+++  describe "Parser.boolean" $ do++    it "should parse true" $+      testParser boolean "true" $ VBoolean True++    it "should parse false" $+      testParser boolean "false" $ VBoolean False++    it "should not parse capitalized variant" $+      testParserFails boolean "False"+++  describe "Parser.basicStr" $ do++    it "should parse the common escape sequences in basic strings" $+      testParser basicStr "\"123\\b\\t\\n\\f\\r\\\"\\/\\\\\"" $ "123\b\t\n\f\r\"/\\"++    it "should parse the simple unicode value from the example" $+      testParser basicStr "\"中国\"" $ "中国"++    it "should parse escaped 4 digit unicode values" $+      testParser assignment "special_k = \"\\u0416\"" ("special_k", VString "Ж")++    it "should parse escaped 8 digit unicode values" $+      testParser assignment "g_clef = \"\\U0001D11e\"" ("g_clef", VString "𝄞")++    it "should not parse escaped unicode values with missing digits" $+      testParserFails assignment "g_clef = \"\\U1D11e\""+++  describe "Parser.multiBasicStr" $ do++    it "should parse simple example" $+      testParser multiBasicStr "\"\"\"thorrough\"\"\"" $  "thorrough"++    it "should parse text containing a quote" $+      testParser multiBasicStr "\"\"\"is \"it\" complete\"\"\"" $ "is \"it\" complete"++    it "should parse with newlines" $+      testParser multiBasicStr "\"\"\"One\nTwo\"\"\"" $  "One\nTwo"++    it "should parse with escaped newlines" $+      testParser multiBasicStr "\"\"\"One\\\nTwo\"\"\"" $  "OneTwo"++    it "should parse newlines, ignoring 1 leading newline" $+      testParser multiBasicStr "\"\"\"\nOne\\\nTwo\"\"\"" $  "OneTwo"++    it "should parse with espaced whitespace" $+      testParser multiBasicStr "\"\"\"\\\n\+                               \Quick \\\n\+                               \\\\n\+                               \Jumped \\\n\+                               \Lazy\\\n\+                               \ \"\"\"" $  "Quick Jumped Lazy"++    it "should parse espaced on first" $+      testParser multiBasicStr "\"\"\"\\\nQuick \\\n\\\nJumped \\\nLazy\\\n\"\"\"" $  "Quick Jumped Lazy"+++  describe "Parser.literalStr" $ do++    it "should parse literally" $+      testParser literalStr "'\"Your\" folder: \\\\User\\new\\tmp\\'" $+                             "\"Your\" folder: \\\\User\\new\\tmp\\"++    it "has no notion of 'escaped single quotes'" $+      testParserFails tomlDoc "q = 'I don\\'t know.'"  -- string terminates before the "t"+++  describe "Parser.multiLiteralStr" $ do++    it "should parse literally" $+      testParser multiLiteralStr+        "'''\nFirst newline is dropped.\n   Other whitespace,\n  is preserved -- isn't it?'''"+        $  "First newline is dropped.\n   Other whitespace,\n  is preserved -- isn't it?"+++  describe "Parser.datetime" $ do++    it "should parse a JSON formatted datetime string in zulu timezone" $+      testParser datetime "1979-05-27T07:32:00Z" $+        VDatetime $ UTCTime (ModifiedJulianDay 44020) 27120++    it "should not parse only dates" $+      testParserFails datetime "1979-05-27"++    it "should not parse without the Z" $+      testParserFails datetime "1979-05-27T07:32:00"+++  describe "Parser.float" $ do++    it "should parse positive floats" $+      testParser float "3.14" $ VFloat 3.14++    it "should parse positive floats with plus sign" $+      testParser float "+3.14" $ VFloat 3.14++    it "should parse negative floats" $+      testParser float "-0.1" $ VFloat (-0.1)++    it "should parse more or less zero float" $+      testParser float "0.0" $ VFloat 0.0++    it "should parse 'scientific notation' ('e'-notation)" $+      testParser float "1.5e6" $ VFloat 1500000.0++    it "should parse 'scientific notation' ('e'-notation) with upper case E" $+      testParser float "1E0" $ VFloat 1.0++    it "should not accept floats starting with a dot" $+      testParserFails float ".5"++    it "should not accept floats without any decimals" $+      testParserFails float "5."++    it "should accept floats which contain underscores" $+      testParser float "5_3.4_5" $ VFloat 53.45++    it "should not accept floats which end with underscores" $+      testParserFails float "5_3.4_5_"++    it "should not accept floats which start with underscores" $+      testParserFails float "_5_3.4_5"++    it "should not accept floats which have two consecutive underscores" $+      testParserFails float "5__3.4__5"++  describe "Parser.integer" $ do++    it "should parse positive integers" $+      testParser integer "108" $ VInteger 108++    it "should parse negative integers" $+      testParser integer "-1" $ VInteger (-1)++    it "should parse zero" $+      testParser integer "0" $ VInteger 0++    it "should parse integers prefixed with a plus" $+      testParser integer "+42" $ VInteger 42++    it "should accept integers which contain underscores" $+      testParser integer "4_2" $ VInteger 42++    it "should not accept integers which end with underscores" $+      testParserFails integer "4_2_"++    it "should not accept integers which start with underscores" $+      testParserFails integer "_4_2"++    it "should not accept integers which have two consecutive underscores" $+      testParserFails integer "4__2"++  describe "Parser.tomlDoc arrays" $ do++    it "should parse an empty array" $+      testParser array "[]" $ mkVArray []++    it "should parse an empty array with whitespace" $+      testParser array "[ ]" $ mkVArray []++    it "should not parse an empty array with only a terminating comma" $+      testParserFails array "[,]"++    it "should parse an empty array of empty arrays" $+      testParser array "[[],[]]" $ mkVArray [ mkVArray [], mkVArray [] ]++    it "should parse an empty array of empty arrays with whitespace" $+      testParser array "[ \n[ ]\n ,\n [ \n ] ,\n ]" $ mkVArray [ mkVArray [], mkVArray [] ]++    it "should parse nested arrays" $+      testParser assignment "d = [ ['gamma', 'delta'], [1, 2] ]"+              $ ("d", mkVArray [ mkVArray [ VString "gamma"+                                          , VString "delta" ]+                               , mkVArray [ VInteger 1+                                          , VInteger 2 ] ])++    it "should allow linebreaks in an array" $+      testParser assignment "hosts = [\n'alpha',\n'omega'\n]"+        $ ("hosts", mkVArray [VString "alpha", VString "omega"])++    it "should allow some linebreaks in an array" $+      testParser assignment "hosts = ['alpha' ,\n'omega']"+        $ ("hosts", mkVArray [VString "alpha", VString "omega"])++    it "should allow linebreaks in an array, with comments" $+      testParser assignment "hosts = [\n\+                            \'alpha',  # the first\n\+                            \'omega'   # the last\n\+                            \]"+        $ ("hosts", mkVArray [VString "alpha", VString "omega"])++    it "should allow linebreaks in an array, with comments, and terminating comma" $+      testParser assignment "hosts = [\n\+                            \'alpha',  # the first\n\+                            \'omega',  # the last\n\+                            \]"+        $ ("hosts", mkVArray [VString "alpha", VString "omega"])++    it "inside an array, all element should be of the same type" $+      testParserFails array "[1, 2.0]"++    it "inside an array of arrays, this inner arrays may contain values of different types" $+      testParser array "[[1], [2.0], ['a']]" $+        mkVArray [ mkVArray [VInteger 1], mkVArray [VFloat 2.0], mkVArray [VString "a"] ]++    it "all string variants are of the same type of the same type" $+      testParser assignment "data = [\"a\", \"\"\"b\"\"\", 'c', '''d''']" $+                            ("data", mkVArray [ VString "a", VString "b",+                                                VString "c", VString "d" ])++    it "should parse terminating commas in arrays" $+      testParser array "[1, 2, ]" $ mkVArray [ VInteger 1, VInteger 2 ]++    it "should parse terminating commas in arrays(2)" $+      testParser array "[1,2,]" $ mkVArray [ VInteger 1, VInteger 2 ]++  describe "Parser.tomlDoc inline tables" $ do++    it "should parse an empty inline table" $+      testParser inlineTable "{}" $ VTable (fromList [])++    it "should parse simple inline tables" $+      testParser inlineTable "{ a = 8 , b = \"things\" }" $+        VTable (fromList [ ("a" , VInteger 8) , ("b", VString "things") ])++    it "should not parse simple inline tables with newline " $+      testParserFails inlineTable "{ a = 8 , \n b = \"things\" }"++  where+    testParser p str success = case parseOnly p str of Left  _ -> False+                                                       Right x -> x == success+    testParserFails p str    = case parseOnly p str of Left  _ -> True+                                                       Right _ -> False