tomland 1.0.1.0 → 1.1.0.0

raw patch · 17 files changed

+804/−297 lines, 17 filesdep ~basedep ~gaugedep ~hspec-megaparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, gauge, hspec-megaparsec, megaparsec, parser-combinators

API changes (from Hackage documentation)

Files

• CHANGELOG.md +41/−0
• README.lhs +4/−4
• README.md +4/−4
• examples/Playground.hs +7/−0
• src/Toml.hs +2/−0
• src/Toml/Bi/Combinators.hs +15/−4
• src/Toml/Bi/Map.hs +36/−3
• src/Toml/Generic.hs +393/−0
• src/Toml/Parser/Core.hs +2/−1
• src/Toml/Parser/TOML.hs +66/−86
• src/Toml/Printer.hs +29/−14
• test/Test/Toml/BiCode/Property.hs +24/−24
• test/Test/Toml/Gen.hs +2/−2
• test/Test/Toml/Parsing/Unit.hs +127/−141
• test/Test/Toml/Printer/Golden.hs +19/−7
• test/golden/pretty_custom_sorted.golden +26/−0
• tomland.cabal +7/−7

@@ -3,6 +3,47 @@ tomland uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 1.1.0.0 — Jul 8, 2019++* [#154](https://github.com/kowainik/tomland/issues/154):+  Implement `Generic` bidirectional codecs+  (by [@chshersh](https://github.com/chshersh)).+* [#145](https://github.com/kowainik/tomland/issues/145):+  Add support for inline table arrays+  (by [@jiegillet](https://github.com/jiegillet)).+* [#195](https://github.com/kowainik/tomland/issues/195):+  Fix an exponential parser behavior for parsing table of arrays+  (by [@jiegillet](https://github.com/jiegillet)).+* [#190](https://github.com/kowainik/tomland/issues/190):+  Add `enumBounded` codec for nullary sum types+  (by [@mxxo](https://github.com/mxxo)).+* [#189](https://github.com/kowainik/tomland/issues/189):+  **Breaking change:** Implement custom table sorting by keys. Also fields of+  the `PrintOptions` data type were renamed according to style guide+  (by [@ramanshah](https://github.com/ramanshah)).++  __Before:__++  ```haskell+  data PrintOptions = PrintOptions+      { shouldSort :: Bool+      , indent     :: Int+      } deriving (Show)+  ```++  __Now:__++  ```haskell+  data PrintOptions = PrintOptions+      { printOptionsSorting :: !(Maybe (Key -> Key -> Ordering))+      , printOptionsIndent  :: !Int+      }+  ```++  __Migration guide:__ If you used `indent` field, use `printOptionsIndent`+  instead. If you used `shouldSort`, use `printOptionsSorting` instead and pass+  `Nothing` instead of `False` or `Just compare` instead of `True`.+ ## 1.0.1.0 — May 17, 2019  * [#177](https://github.com/kowainik/tomland/issues/177):

@@ -152,10 +152,10 @@  | Library            | parse :: Text -> AST | transform :: AST -> Haskell | |--------------------|----------------------|-----------------------------|-| `tomland`          | `387.5 μs`           | `1.313 μs`                  |-| `htoml`            | `801.2 μs`           | `32.54 μs`                  |-| `htoml-megaparsec` | `318.7 μs`           | `34.74 μs`                  |-| `toml-parser`      | `157.2 μs`           | `1.156 μs`                  |+| `tomland`          | `305.5 μs`           | `1.280 μs`                  |+| `htoml`            | `852.8 μs`           | `33.37 μs`                  |+| `htoml-megaparsec` | `295.0 μs`           | `33.62 μs`                  |+| `toml-parser`      | `164.6 μs`           | `1.101 μs`                  |  You may see that `tomland` is not the fastest one (though still very fast). But performance hasn’t been optimized so far and:

@@ -152,10 +152,10 @@  | Library            | parse :: Text -> AST | transform :: AST -> Haskell | |--------------------|----------------------|-----------------------------|-| `tomland`          | `387.5 μs`           | `1.313 μs`                  |-| `htoml`            | `801.2 μs`           | `32.54 μs`                  |-| `htoml-megaparsec` | `318.7 μs`           | `34.74 μs`                  |-| `toml-parser`      | `157.2 μs`           | `1.156 μs`                  |+| `tomland`          | `305.5 μs`           | `1.280 μs`                  |+| `htoml`            | `852.8 μs`           | `33.37 μs`                  |+| `htoml-megaparsec` | `295.0 μs`           | `33.62 μs`                  |+| `toml-parser`      | `164.6 μs`           | `1.101 μs`                  |  You may see that `tomland` is not the fastest one (though still very fast). But performance hasn’t been optimized so far and:

@@ -31,6 +31,11 @@  newtype N = N Text +data ColorScheme = Light+                 | Dark+                 | HighContrast+                 deriving (Show, Enum, Bounded)+ data Test = Test     { testB  :: Bool     , testI  :: Int@@ -41,6 +46,7 @@     , testX  :: TestInside     , testY  :: Maybe TestInside     , testN  :: N+    , testC  :: ColorScheme     , testE1 :: Either Integer String     , testE2 :: Either String Double     , users  :: [User]@@ -58,6 +64,7 @@     <*> Toml.table insideCodec "testX" .= testX     <*> Toml.dioptional ((Toml.table insideCodec) "testY") .= testY     <*> Toml.diwrap (Toml.text "testN") .= testN+    <*> Toml.enumBounded "testC" .= testC     <*> eitherT1 .= testE1     <*> eitherT2 .= testE2     <*> Toml.list userCodec "user" .= users

@@ -32,6 +32,7 @@  module Toml     ( module Toml.Bi+    , module Toml.Generic     , module Toml.Parser     , module Toml.PrefixTree     , module Toml.Printer@@ -39,6 +40,7 @@     ) where  import Toml.Bi+import Toml.Generic import Toml.Parser import Toml.PrefixTree import Toml.Printer

@@ -38,6 +38,7 @@          -- * Additional codecs for custom types        , textBy        , read+       , enumBounded           -- * Combinators for tables        , table@@ -69,17 +70,18 @@ import Numeric.Natural (Natural)  import Toml.Bi.Code (DecodeException (..), Env, St, TomlCodec, execTomlCodec)-import Toml.Bi.Map (BiMap (..), TomlBiMap, _Array, _Bool, _ByteString, _Day, _Double, _Float,-                    _HashSet, _Int, _IntSet, _Integer, _LByteString, _LText, _LocalTime, _Natural,-                    _NonEmpty, _Read, _Set, _String, _Text, _TextBy, _TimeOfDay, _Word, _ZonedTime)+import Toml.Bi.Map (BiMap (..), TomlBiMap, _Array, _Bool, _ByteString, _Day, _Double, _EnumBounded,+                    _Float, _HashSet, _Int, _IntSet, _Integer, _LByteString, _LText, _LocalTime,+                    _Natural, _NonEmpty, _Read, _Set, _String, _Text, _TextBy, _TimeOfDay, _Word,+                    _ZonedTime) import Toml.Bi.Monad (Codec (..)) import Toml.PrefixTree (Key) import Toml.Type (AnyValue (..), TOML (..), insertKeyAnyVal, insertTable, insertTableArrays)  import qualified Data.ByteString.Lazy as BL import qualified Data.HashMap.Strict as HashMap-import qualified Toml.PrefixTree as Prefix import qualified Data.Text.Lazy as L+import qualified Toml.PrefixTree as Prefix   {- | General function to create bidirectional converters for key-value pairs. In@@ -161,6 +163,15 @@ -- | Codec for values with a 'Read' and 'Show' instance. read :: (Show a, Read a) => Key -> TomlCodec a read = match _Read++{- | Codec for general nullary sum data types with a 'Bounded', 'Enum', and+'Show' instance. This codec provides much better error messages than 'read' for+nullary sum types.++@since 1.1.1.0+-}+enumBounded :: (Bounded a, Enum a, Show a) => Key -> TomlCodec a+enumBounded = match _EnumBounded  -- | Codec for text values as 'ByteString'. byteString :: Key -> TomlCodec ByteString

@@ -29,6 +29,7 @@        , _StringText        , _ReadString        , _BoundedInteger+       , _EnumBoundedText        , _ByteStringText        , _LByteStringText @@ -58,6 +59,7 @@         , _Left        , _Right+       , _EnumBounded        , _Just           -- * Useful utility functions@@ -65,12 +67,12 @@        ) where  import Control.Arrow ((>>>))-import Control.Monad ((>=>))- import Control.DeepSeq (NFData)+import Control.Monad ((>=>)) import Data.Bifunctor (bimap, first) import Data.ByteString (ByteString) import Data.Hashable (Hashable)+import Data.Map (Map) import Data.Semigroup (Semigroup (..)) import Data.Text (Text) import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)@@ -88,6 +90,7 @@ import qualified Data.HashSet as HS import qualified Data.IntSet as IS import qualified Data.List.NonEmpty as NE+import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -381,6 +384,36 @@          in Left $ ArbitraryError msg       | otherwise = Right (fromIntegral n) +{- | Helper bimap for 'EnumBounded' and 'Data.Text.Text'.++@since 1.1.1.0+-}+_EnumBoundedText :: forall a. (Show a, Enum a, Bounded a) => TomlBiMap a Text+_EnumBoundedText = BiMap+    { forward  = Right . tShow+    , backward = toEnumBounded+    }+  where+    toEnumBounded :: Text -> Either TomlBiMapError a+    toEnumBounded value = case M.lookup value enumOptions of+        Just a  -> Right a+        Nothing ->+            let msg = "Value is '" <> value <> "' but expected one of: " <> T.intercalate ", " options+            in Left (ArbitraryError msg)+      where+        enumOptions :: Map Text a+        enumOptions = M.fromList $ zip options enums+        options  = fmap tShow enums+        enums = [minBound @a .. maxBound @a]++{- | Bimap for nullary sum data types with 'Show', 'Enum' and 'Bounded'+instances.  Usually used as 'Toml.Bi.Combinators.enumBounded' combinator.++@since 1.1.1.0+-}+_EnumBounded :: (Show a, Enum a, Bounded a) => TomlBiMap a AnyValue+_EnumBounded = _EnumBoundedText >>> _Text+ {- | 'Word' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.word' combinator. -}@@ -462,7 +495,7 @@ _HashSet bi = iso HS.toList HS.fromList >>> _Array bi  {- | 'IS.IntSet' bimap for 'AnyValue'. Usually used as-'Toml.Bi.Combinators.arrayIntSetOf' combinator.+'Toml.Bi.Combinators.arrayIntSet' combinator. -} _IntSet :: TomlBiMap IS.IntSet AnyValue _IntSet = iso IS.toList IS.fromList >>> _Array _Int

@@ -0,0 +1,393 @@+{-# LANGUAGE AllowAmbiguousTypes  #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE GADTs                #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE Rank2Types           #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}++{- | This module contains implementation of the 'Generic' TOML codec. If your+data types are big and nested, and you want to have codecs for them without writing a lot of+boilerplate code, you can find this module helpful. Below you can find the detailed+explanation on how the 'Generic' codecs work.++Consider the following Haskell data types:++@+__data__ User = User+    { age     :: Int+    , address :: Address+    , socials :: [Social]+    } __deriving__ ('Generic')++__data__ Address = Address+    { street :: Text+    , house  :: Int+    } __deriving__ ('Generic')++__data__ Social = Social+    { name :: Text+    , link :: Text+    } __deriving__ ('Generic')+@++Value of the @User@ type represents the following TOML:++@+age = 27++[address]+  street = "Miami Beach"+  house  = 42++[[socials]]+  name = \"Twitter\"+  link = "https://twitter.com/foo"++[[socials]]+  name = \"GitHub\"+  link = "https://github.com/bar"+@++Normally you would write 'TomlCodec' for this data type like this:++@+userCodec :: 'TomlCodec' User+userCodec = User+    \<$\> Toml.int "age" .= age+    \<*\> Toml.table addressCodec "address" .= address+    \<*\> Toml.list  socialCodec  "socials" .= socials++addressCodec :: 'TomlCodec' Address+addressCodec = Address+    \<$\> Toml.text "street" .= street+    \<*\> Toml.int  "house"  .= house++socialCodec :: 'TomlCodec' Social+socialCodec = Social+    \<$\> Toml.text "name" .= name+    \<*\> Toml.text "link" .= link+@++However, if you derive 'Generic' instance for your data types (as we do in the+example), you can write your codecs in a simpler way.++@+userCodec :: 'TomlCodec' User+userCodec = 'genericCodec'++__instance__ 'HasCodec' Address __where__+    hasCodec = Toml.table 'genericCodec'++__instance__ 'HasItemCodec' Social __where__+    hasItemCodec = Right 'genericCodec'+@++Several notes about the interface:++1. Your top-level data types are always implemented as 'genericCodec' (or other+generic codecs).+2. If you have a custom data type as a field of another type, you need to implement+the instance of the 'HasCodec' typeclass.+3. If the data type appears as an element of a list, you need to implement the instance+of the 'HasItemCodec' typeclass.++@since 1.1.1.0+-}++module Toml.Generic+       ( genericCodec+       , genericCodecWithOptions+       , stripTypeNameCodec++         -- * Options+       , TomlOptions (..)+       , GenericOptions (..)+       , stripTypeNameOptions+       , stripTypeNamePrefix++         -- * Core generic typeclass+       , HasCodec (..)+       , HasItemCodec (..)+       , GenericCodec (..)+       ) where++import Data.Char (isLower, toLower)+import Data.IntSet (IntSet)+import Data.Kind (Type)+import Data.List (stripPrefix)+import Data.List.NonEmpty (NonEmpty)+import Data.Proxy (Proxy (..))+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)+import Data.Typeable (Typeable, typeRep)+import Data.Word (Word)+import GHC.Generics ((:*:) (..), (:+:), C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1,+                     Selector (..))+import GHC.TypeLits (ErrorMessage (..), TypeError)+import Numeric.Natural (Natural)++import Toml.Bi (TomlBiMap, TomlCodec, (.=))+import Toml.PrefixTree (Key)+import Toml.Type (AnyValue)++import qualified Data.Text.Lazy as L+import qualified Toml.Bi as Toml+++{- | Generic codec for arbitrary data types. Uses field names as keys.+-}+genericCodec :: (Generic a, GenericCodec (Rep a)) => TomlCodec a+genericCodec = Toml.dimap from to $ genericTomlCodec (GenericOptions id)+{-# INLINE genericCodec #-}++{- | Generic codec with options for arbitrary data types.+-}+genericCodecWithOptions+    :: forall a+     . (Generic a, GenericCodec (Rep a), Typeable a)+    => TomlOptions a+    -> TomlCodec a+genericCodecWithOptions = Toml.dimap from to . genericTomlCodec . toGenericOptions @a+{-# INLINE genericCodecWithOptions #-}++{- | Generic codec that uses 'stripTypeNameOptions'.+-}+stripTypeNameCodec+    :: forall a+     . (Generic a, GenericCodec (Rep a), Typeable a)+    => TomlCodec a+stripTypeNameCodec = genericCodecWithOptions $ stripTypeNameOptions @a+{-# INLINE stripTypeNameCodec #-}++----------------------------------------------------------------------------+-- Generic typeclasses+----------------------------------------------------------------------------++{- | Options to configure various parameters of generic encoding. Specifically:++*  __'tomlOptionsFieldModifier'__: how to translate field names to TOML keys?+-}+data TomlOptions a = TomlOptions+    { tomlOptionsFieldModifier :: Typeable a => Proxy a -> String -> String+    }++{- | Same as 'TomlOptions' but with all data type information erased. This data+type is used internally. Define your options using 'TomlOptions' data type.+-}+newtype GenericOptions = GenericOptions+    { genericOptionsFieldModifier :: String -> String+    }++toGenericOptions :: forall a . Typeable a => TomlOptions a -> GenericOptions+toGenericOptions TomlOptions{..} = GenericOptions+    { genericOptionsFieldModifier = tomlOptionsFieldModifier (Proxy @a)+    }++-- | Options that use 'stripTypeNamePrefix' as 'tomlOptionsFieldModifier'.+stripTypeNameOptions :: Typeable a => TomlOptions a+stripTypeNameOptions = TomlOptions+    { tomlOptionsFieldModifier = stripTypeNamePrefix+    }++{- | Strips name of the type name from field name prefix.++>>> data UserData = UserData { userDataId :: Int, userDataShortInfo :: Text }+>>> stripTypeNamePrefix (Proxy @UserData) "userDataId"+"id"+>>> stripTypeNamePrefix (Proxy @UserData) "userDataShortInfo"+"shortInfo"+>>> stripTypeNamePrefix (Proxy @UserData) "udStats"+"stats"+>>> stripTypeNamePrefix (Proxy @UserData) "fooBar"+"bar"+>>> stripTypeNamePrefix (Proxy @UserData) "name"+"name"+-}+stripTypeNamePrefix :: forall a . Typeable a => Proxy a -> String -> String+stripTypeNamePrefix _ fieldName =+    case stripPrefix (headToLower $ typeName @a) fieldName of+        Just rest -> leaveIfEmpty rest+        Nothing   -> leaveIfEmpty (dropWhile isLower fieldName)+  where+    headToLower :: String -> String+    headToLower = \case+        []   -> error "Cannot use 'headToLower' on empty Text"+        x:xs -> toLower x : xs++    -- if all lower case then leave field as it is+    leaveIfEmpty :: String -> String+    leaveIfEmpty rest = if null rest then fieldName else headToLower rest++typeName :: forall a . Typeable a => String+typeName = show $ typeRep (Proxy @a)++----------------------------------------------------------------------------+-- Generic typeclasses+----------------------------------------------------------------------------++class GenericCodec (f :: k -> Type) where+    genericTomlCodec :: GenericOptions -> TomlCodec (f p)++instance GenericCodec f => GenericCodec (D1 d f) where+    genericTomlCodec = Toml.dimap unM1 M1 . genericTomlCodec+    {-# INLINE genericTomlCodec #-}++type GenericSumTomlNotSupported =+    'Text "Generic TOML deriving for arbitrary sum types is not supported currently."++instance (TypeError GenericSumTomlNotSupported) => GenericCodec (f :+: g) where+    genericTomlCodec = error "Not supported"++instance GenericCodec f => GenericCodec (C1 c f) where+    genericTomlCodec = Toml.dimap unM1 M1 . genericTomlCodec+    {-# INLINE genericTomlCodec #-}++instance (GenericCodec f, GenericCodec g) => GenericCodec (f :*: g) where+    genericTomlCodec options = (:*:)+        <$> genericTomlCodec options .= fstG+        <*> genericTomlCodec options .= sndG+      where+        fstG :: (f :*: g) p -> f p+        fstG (f :*: _) = f++        sndG :: (f :*: g) p -> g p+        sndG (_ :*: g) = g+    {-# INLINE genericTomlCodec #-}++instance (Selector s, HasCodec a) => GenericCodec (S1 s (Rec0 a)) where+    genericTomlCodec GenericOptions{..} = genericWrap $ hasCodec @a fieldName+      where+        genericWrap :: TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)+        genericWrap = Toml.dimap (unK1 . unM1) (M1 . K1)++        fieldName :: Key+        fieldName =+            fromString+            $ genericOptionsFieldModifier+            $ selName (error "S1" :: S1 s Proxy ())+    {-# INLINE genericTomlCodec #-}++----------------------------------------------------------------------------+-- Helper typeclasses+----------------------------------------------------------------------------++{- | This typeclass tells how the data type should be coded as an item of a+list. Lists in TOML can have two types: __primitive__ and __table of arrays__.++* If 'hasItemCodec' returns 'Left': __primitive__ arrays codec is used.+* If 'hasItemCodec' returns 'Right:' __table of arrays__ codec is used.+-}+class HasItemCodec a where+    hasItemCodec :: Either (TomlBiMap a AnyValue) (TomlCodec a)++instance HasItemCodec Bool      where hasItemCodec = Left Toml._Bool+instance HasItemCodec Int       where hasItemCodec = Left Toml._Int+instance HasItemCodec Word      where hasItemCodec = Left Toml._Word+instance HasItemCodec Integer   where hasItemCodec = Left Toml._Integer+instance HasItemCodec Natural   where hasItemCodec = Left Toml._Natural+instance HasItemCodec Double    where hasItemCodec = Left Toml._Double+instance HasItemCodec Float     where hasItemCodec = Left Toml._Float+instance HasItemCodec Text      where hasItemCodec = Left Toml._Text+instance HasItemCodec L.Text    where hasItemCodec = Left Toml._LText+instance HasItemCodec ZonedTime where hasItemCodec = Left Toml._ZonedTime+instance HasItemCodec LocalTime where hasItemCodec = Left Toml._LocalTime+instance HasItemCodec Day       where hasItemCodec = Left Toml._Day+instance HasItemCodec TimeOfDay where hasItemCodec = Left Toml._TimeOfDay+instance HasItemCodec IntSet    where hasItemCodec = Left Toml._IntSet++{- | If data type @a@ is not primitive then this instance returns codec for list+under key equal to @a@ type name.+-}+instance (HasItemCodec a, Typeable a) => HasItemCodec [a] where+    hasItemCodec = case hasItemCodec @a of+        Left prim   -> Left $ Toml._Array prim+        Right codec -> Right $ Toml.list codec (fromString $ typeName @a)++{- | Helper typeclass for generic deriving. This instance tells how the data+type should be coded if it's a field of another data type.++__NOTE:__ If you implement TOML codecs for your data types manually, prefer more+explicit @Toml.int@ or @Toml.text@ instead of implicit @Toml.hasCodec@.+Implement instances of this typeclass only when using 'genericCodec' and when+your custom data types are not covered here.+-}+class HasCodec a where+    hasCodec :: Key -> TomlCodec a++instance HasCodec Bool      where hasCodec = Toml.bool+instance HasCodec Int       where hasCodec = Toml.int+instance HasCodec Word      where hasCodec = Toml.word+instance HasCodec Integer   where hasCodec = Toml.integer+instance HasCodec Natural   where hasCodec = Toml.natural+instance HasCodec Double    where hasCodec = Toml.double+instance HasCodec Float     where hasCodec = Toml.float+instance HasCodec Text      where hasCodec = Toml.text+instance HasCodec L.Text    where hasCodec = Toml.lazyText+instance HasCodec ZonedTime where hasCodec = Toml.zonedTime+instance HasCodec LocalTime where hasCodec = Toml.localTime+instance HasCodec Day       where hasCodec = Toml.day+instance HasCodec TimeOfDay where hasCodec = Toml.timeOfDay+instance HasCodec IntSet    where hasCodec = Toml.arrayIntSet++instance HasCodec a => HasCodec (Maybe a) where+    hasCodec = Toml.dioptional . hasCodec @a++instance HasItemCodec a => HasCodec [a] where+    hasCodec = case hasItemCodec @a of+        Left prim   -> Toml.arrayOf prim+        Right codec -> Toml.list codec++instance HasItemCodec a => HasCodec (NonEmpty a) where+    hasCodec = case hasItemCodec @a of+        Left prim   -> Toml.arrayNonEmptyOf prim+        Right codec -> Toml.nonEmpty codec++{-+TODO: uncomment when higher-kinded roles will be implemented+* https://github.com/ghc-proposals/ghc-proposals/pull/233++{- | @newtype@ for generic deriving of 'HasCodec' typeclass for custom data+types that should we wrapped into separate table. Use it only for data types+that are fields of another data types.++@+data Person = Person+    { personName    :: Text+    , personAddress :: Address+    } deriving (Generic)++data Address = Address+    { addressStreet :: Text+    , addressHouse  :: Int+    } deriving (Generic)+      deriving HasCodec via TomlTable Address++personCodec :: TomlCodec Person+personCodec = genericCodec+@++@personCodec@ corresponds to the TOML of the following structure:++@+name = "foo"+[address]+    street = \"Bar\"+    house = 42+@+-}+newtype TomlTable a = TomlTable+    { unTomlTable :: a+    }++instance (Generic a, GenericCodec (Rep a)) => HasCodec (TomlTable a) where+    hasCodec :: Key -> TomlCodec (TomlTable a)+    hasCodec = Toml.diwrap . Toml.table (genericCodec @a)++instance (Generic a, GenericCodec (Rep a)) => HasItemCodec (TomlTable a) where+    hasItemCodec = Right $ Toml.diwrap $ genericCodec @a+-}

@@ -16,7 +16,8 @@ import Data.Text (Text) import Data.Void (Void) -import Text.Megaparsec (Parsec, anySingle, errorBundlePretty, match, parse, satisfy, try, (<?>))+import Text.Megaparsec (Parsec, anySingle, eof, errorBundlePretty, match, parse, satisfy, try,+                        (<?>)) import Text.Megaparsec.Char (alphaNumChar, char, digitChar, eol, hexDigitChar, space, space1,                              string, tab) import Text.Megaparsec.Char.Lexer (binary, float, hexadecimal, octal, signed, skipLineComment,

@@ -4,23 +4,19 @@  module Toml.Parser.TOML        ( keyP-       , hasKeyP-       , tableP-       , tableArrayP-       , inlineTableP        , tomlP        ) where  import Control.Applicative (Alternative (..))-import Control.Monad.Combinators (between, eitherP, optional, sepEndBy)-import Data.List.NonEmpty (NonEmpty (..), (<|))+import Control.Monad.Combinators (between, sepEndBy)+import Data.List.NonEmpty (NonEmpty (..)) import Data.Semigroup ((<>)) import Data.Text (Text) -import Toml.Parser.Core (Parser, alphaNumChar, char, lexeme, sc, text, try)+import Toml.Parser.Core (Parser, alphaNumChar, char, eof, lexeme, sc, text, try) import Toml.Parser.String (basicStringP, literalStringP) import Toml.Parser.Value (anyValueP)-import Toml.PrefixTree (Key (..), KeysDiff (..), Piece (..), fromList, keysDiff)+import Toml.PrefixTree (Key (..), KeysDiff (..), Piece (..), keysDiff, single) import Toml.Type (AnyValue, TOML (..))  import qualified Control.Applicative.Combinators.NonEmpty as NC@@ -46,7 +42,7 @@  -- | Parser for 'Key': dot-separated list of 'Piece'. keyP :: Parser Key-keyP = Key <$> NC.sepBy1 keyComponentP (char '.')+keyP = Key <$> keyComponentP `NC.sepBy1` char '.'  -- | Parser for table name: 'Key' inside @[]@. tableNameP :: Parser Key@@ -56,99 +52,83 @@ tableArrayNameP :: Parser Key tableArrayNameP = between (text "[[") (text "]]") keyP --- Tables+-- Helper functions for building TOML+tomlKV :: Key -> AnyValue -> TOML+tomlKV k v = mempty { tomlPairs = HashMap.singleton k v } --- | Parser for lines starting with 'key =', either values or inline tables.-hasKeyP :: Parser (Key, Either AnyValue TOML)-hasKeyP = (,) <$> keyP <* text "=" <*> eitherP anyValueP inlineTableP+tomlT :: Key -> TOML -> TOML+tomlT k t = mempty { tomlTables = single k t } +tomlA :: Key -> NonEmpty TOML -> TOML+tomlA k a = mempty { tomlTableArrays = HashMap.singleton k a }++-- | Parser for lines starting with 'key =', either values, inline tables or+-- inline arrays of tables.+hasKeyP :: Maybe Key -> Parser TOML+hasKeyP key = do+    k <- keyP <* text "="+    table k <|> try (tableArray k) <|> (tomlKV k <$> anyValueP)+  where+    table :: Key -> Parser TOML+    table k = do+        (kDiff, _) <- childKeyP key (pure k)+        tomlT kDiff <$> inlineTableP++    tableArray :: Key -> Parser TOML+    tableArray k = do+        (kDiff, _) <- childKeyP key (pure k)+        tomlA kDiff <$> inlineTableArrayP+ -- | Parser for inline tables. inlineTableP :: Parser TOML-inlineTableP = between-    (text "{") (text "}")-    (tomlFromInline <$> hasKeyP `sepEndBy` text ",")+inlineTableP = between (text "{") (text "}") $+    mconcat <$>+    (tomlKV <$> (keyP <* text "=") <*> anyValueP ) `sepEndBy` text "," --- | Parser for a table.-tableP :: Parser (Key, TOML)-tableP = do-    key  <- tableNameP-    toml <- subTableContent key-    pure (key, toml)+-- | Parser for inline arrays of tables.+inlineTableArrayP :: Parser (NonEmpty TOML)+inlineTableArrayP = between (text "[") (text "]") $+    inlineTableP `NC.sepEndBy1` text "," --- | Parser for an array of tables.-tableArrayP :: Parser (Key, NonEmpty TOML)-tableArrayP = do-    key       <- tableArrayNameP-    localToml <- subTableContent key-    more      <- optional $ sameKeyP key tableArrayP-    case more of-        Nothing         -> pure (key, localToml :| [])-        Just (_, tomls) -> pure (key, localToml <| tomls)+-- | Parser for an array of tables under a certain key.+tableArrayP :: Key -> Parser (NonEmpty TOML)+tableArrayP key =+    localTomlP (Just key) `NC.sepBy1` sameKeyP key tableArrayNameP  -- | Parser for a '.toml' file tomlP :: Parser TOML-tomlP = do-    sc-    (val, inline)  <- distributeEithers <$> many hasKeyP-    (table, array) <- fmap distributeEithers-        $ many-        $ eitherPairP (try tableP) tableArrayP--    pure TOML-        { tomlPairs       = HashMap.fromList val-        , tomlTables      = fromList $ inline ++ table-        , tomlTableArrays = HashMap.fromList array-        }+tomlP = sc *> localTomlP Nothing <* eof --- | Parser for full 'TOML' under a certain key-subTableContent :: Key -> Parser TOML-subTableContent key = do-    (val, inline)  <- distributeEithers <$> many hasKeyP-    (table, array) <- fmap distributeEithers-        $ many-        $ childKeyP key-        $ eitherPairP (try tableP) tableArrayP+-- | Parser for a toml under a certain key+localTomlP :: Maybe Key -> Parser TOML+localTomlP key = mconcat <$> many (subArray <|> subTable <|> hasKeyP key)+  where+    subTable :: Parser TOML+    subTable = do+        (kDiff, k) <- try $ childKeyP key tableNameP+        tomlT kDiff <$> localTomlP (Just k) -    pure TOML-        { tomlPairs       = HashMap.fromList val-        , tomlTables      = fromList $ inline ++ table-        , tomlTableArrays = HashMap.fromList array-        }+    subArray :: Parser TOML+    subArray = do+        (kDiff, k) <- try $ childKeyP key tableArrayNameP+        tomlA kDiff <$> tableArrayP k --- | @childKeyP key p@ returns the result of @p@ if the key returned by @p@ is--- a child key of the @key@, and fails otherwise.-childKeyP :: Key -> Parser (Key, a) -> Parser (Key, a)-childKeyP key p = try $ do-    (k, x) <- p+-- | @childKeyP (Just key) p@ checks if the result of @p@ if a child key of+-- @key@ and returns the difference of the keys and the child key.+-- @childKeyP Nothing p@ is only called from @tomlP@ (no parent key).+childKeyP :: Maybe Key -> Parser Key -> Parser (Key, Key)+childKeyP Nothing parser = (\k -> (k, k)) <$> parser+childKeyP (Just key) parser = do+    k <- parser     case keysDiff key k of-        FstIsPref k' -> pure (k', x)-        _            -> fail $ show k ++ " is not a child key of " ++ show key+        FstIsPref d -> pure (d, k)+        _           -> fail $ show k ++ " is not a child key of " ++ show key  -- | @sameKeyP key p@ returns the result of @p@ if the key returned by @p@ is -- the same as @key@, and fails otherwise.-sameKeyP :: Key -> Parser (Key, a) -> Parser (Key, a)+sameKeyP :: Key -> Parser Key -> Parser Key sameKeyP key parser = try $ do-    (k, x) <- parser+    k <- parser     case keysDiff key k of-        Equal -> pure (k, x)+        Equal -> pure k         _     -> fail $ show k ++ " is not the same as " ++ show key---- Helper functions---- | Helper function to create a 'TOML' from a list of key/values or inline tables.-tomlFromInline :: [(Key, Either AnyValue TOML)] -> TOML-tomlFromInline kvs =-    let (lefts, rights) = distributeEithers kvs-    in TOML (HashMap.fromList lefts) (fromList rights) mempty---- | Helper function to seperate the 'Either'.-distributeEithers :: [(c, Either a b)] -> ([(c, a)], [(c, b)])-distributeEithers = foldr distribute ([], [])-  where-    distribute :: (c, Either a b) -> ([(c, a)], [(c, b)]) -> ([(c, a)], [(c, b)])-    distribute (k, Left a) (ls, rs)  = ((k, a) : ls, rs)-    distribute (k, Right b) (ls, rs) = (ls, (k, b) : rs)---- | Helper function to make an 'Either' parser.-eitherPairP :: Alternative m => m (c, a) -> m (c, b) -> m (c, Either a b)-eitherPairP a b = (fmap Left <$> a) <|> (fmap Right <$> b)

@@ -10,8 +10,10 @@        , prettyKey        ) where +import Data.Bifunctor (first)+import Data.Function (on) import Data.HashMap.Strict (HashMap)-import Data.List (sortOn, splitAt)+import Data.List (sortBy, splitAt) import Data.List.NonEmpty (NonEmpty) import Data.Monoid ((<>)) import Data.Text (Text)@@ -26,17 +28,24 @@  {- | Configures the pretty printer. -} data PrintOptions = PrintOptions-    { shouldSort :: Bool  -- ^ should table keys be sorted or not-    , indent     :: Int   -- ^ indentation size-    } deriving (Show)+    { {- | How table keys should be sorted, if at all. +      @since 1.1.1.0+      -}+      printOptionsSorting :: !(Maybe (Key -> Key -> Ordering))++      {- | Number of spaces by which to indent.+      -}+    , printOptionsIndent  :: !Int+    }+ {- | Default printing options.  1. Sorts all keys and tables by name. 2. Indents with 2 spaces. -} defaultOptions :: PrintOptions-defaultOptions = PrintOptions True 2+defaultOptions = PrintOptions (Just compare) 2  {- | Converts 'TOML' type into 'Data.Text.Text' (using 'defaultOptions'). @@ -78,7 +87,7 @@               -> Int          -- ^ Current indentation               -> Text         -- ^ Accumulator for table names               -> TOML         -- ^ Given 'TOML'-              -> [Text]         -- ^ Pretty result+              -> [Text]       -- ^ Pretty result prettyTomlInd options i prefix TOML{..} = concat     [ prettyKeyValue    options i tomlPairs     , prettyTables      options i prefix tomlTables@@ -91,7 +100,7 @@  -- | Returns pretty formatted  key-value pairs of the 'TOML'. prettyKeyValue :: PrintOptions -> Int -> HashMap Key AnyValue -> [Text]-prettyKeyValue options i = mapOrdered (\kv -> [kvText kv]) options+prettyKeyValue options i = mapOrdered (\kv -> [kvText kv]) options . HashMap.toList   where     kvText :: (Key, AnyValue) -> Text     kvText (k, AnyValue v) =@@ -128,8 +137,14 @@  -- | Returns pretty formatted tables section of the 'TOML'. prettyTables :: PrintOptions -> Int -> Text -> PrefixMap TOML -> [Text]-prettyTables options i pref = mapOrdered (prettyTable . snd) options+prettyTables options i pref asPieces = mapOrdered (prettyTable . snd) options asKeys   where+    asKeys :: [(Key, PrefixTree TOML)]+    asKeys = map (first pieceToKey) $ HashMap.toList asPieces++    pieceToKey :: Piece -> Key+    pieceToKey = Key . pure+     prettyTable :: PrefixTree TOML -> [Text]     prettyTable (Leaf k toml) =         let name = addPrefix k pref@@ -153,7 +168,7 @@     prettyTableName n = "[" <> n <> "]"  prettyTableArrays :: PrintOptions -> Int -> Text -> HashMap Key (NonEmpty TOML) -> [Text]-prettyTableArrays options i pref = mapOrdered arrText options+prettyTableArrays options i pref = mapOrdered arrText options . HashMap.toList   where     arrText :: (Key, NonEmpty TOML) -> [Text]     arrText (k, ne) =@@ -171,13 +186,13 @@  -- Returns an indentation prefix tabWith :: PrintOptions -> Int -> Text-tabWith options n = Text.replicate (n * indent options) " "+tabWith PrintOptions{..} n = Text.replicate (n * printOptionsIndent) " "  -- Returns a proper sorting function-mapOrdered :: Ord k => ((k, v) -> [t]) -> PrintOptions -> HashMap k v -> [t]-mapOrdered f options-    | shouldSort options = concatMap f . sortOn fst . HashMap.toList-    | otherwise          = concatMap f . HashMap.toList+mapOrdered :: ((Key, v) -> [t]) -> PrintOptions -> [(Key, v)] -> [t]+mapOrdered f options = case printOptionsSorting options of+    Just sorter -> concatMap f . sortBy (sorter `on` fst)+    Nothing     -> concatMap f  -- Adds next part of the table name to the accumulator. addPrefix :: Key -> Text -> Text

@@ -31,30 +31,30 @@     tripping bigType (encode bigTypeCodec) (decode bigTypeCodec)  data BigType = BigType-    { btBool          :: Bool-    , btInteger       :: Integer-    , btNatural       :: Natural-    , btInt           :: Int-    , btWord          :: Word-    , btDouble        :: Batman Double-    , btFloat         :: Batman Float-    , btText          :: Text-    , btString        :: String-    , btBS            :: ByteString-    , btLazyBS        :: L.ByteString-    , btLocalTime     :: LocalTime-    , btDay           :: Day-    , btTimeOfDay     :: TimeOfDay-    , btArray         :: [Int]-    , btArraySet      :: Set Word-    , btArrayIntSet   :: IntSet-    , btArrayHashSet  :: HashSet Natural-    , btArrayNonEmpty :: NonEmpty Text-    , btNonEmpty      :: NonEmpty ByteString-    , btList          :: [Bool]-    , btNewtype       :: BigTypeNewtype-    , btSum           :: BigTypeSum-    , btRecord        :: BigTypeRecord+    { btBool          :: !Bool+    , btInteger       :: !Integer+    , btNatural       :: !Natural+    , btInt           :: !Int+    , btWord          :: !Word+    , btDouble        :: !(Batman Double)+    , btFloat         :: !(Batman Float)+    , btText          :: !Text+    , btString        :: !String+    , btBS            :: !ByteString+    , btLazyBS        :: !L.ByteString+    , btLocalTime     :: !LocalTime+    , btDay           :: !Day+    , btTimeOfDay     :: !TimeOfDay+    , btArray         :: ![Int]+    , btArraySet      :: !(Set Word)+    , btArrayIntSet   :: !IntSet+    , btArrayHashSet  :: !(HashSet Natural)+    , btArrayNonEmpty :: !(NonEmpty Text)+    , btNonEmpty      :: !(NonEmpty ByteString)+    , btList          :: ![Bool]+    , btNewtype       :: !BigTypeNewtype+    , btSum           :: !BigTypeSum+    , btRecord        :: !BigTypeRecord     } deriving (Show, Eq)  -- | Wrapper over 'Double' and 'Float' to be equal on @NaN@ values.

@@ -179,9 +179,9 @@              $ Gen.list (Range.linear 0 5)              $ (,) <$> genKey <*> genToml     arrays = fmap fromList $-             Gen.list (Range.linear 0 5) $ do+             Gen.list (Range.linear 0 10) $ do                key <- genKey-               arr <- Gen.list (Range.linear 1 5) genToml+               arr <- Gen.list (Range.linear 1 10) genToml                return (key, NE.fromList arr)  -- Date generators

@@ -13,7 +13,7 @@  import Toml.Edsl (mkToml, table, tableArray, (=:)) import Toml.Parser.String (textP)-import Toml.Parser.TOML (hasKeyP, tableArrayP, tableP, tomlP, keyP)+import Toml.Parser.TOML (keyP, tomlP) import Toml.Parser.Value (arrayP, boolP, dateTimeP, doubleP, integerP) import Toml.PrefixTree (Key (..), Piece (..), fromList) import Toml.Type (AnyValue (..), TOML (..), UValue (..), Value (..))@@ -192,69 +192,31 @@             parseInteger "0xaBcDeF" 0xaBcDeF  keySpecs :: Spec-keySpecs = do-    describe "keyP" $ do-        context "when the key is a bare key" $ do-            it "can parse keys which contain ASCII letters, digits, underscores, and dashes" $ do-                parseKey "key"       (makeKey ["key"])-                parseKey "bare_key1" (makeKey ["bare_key1"])-                parseKey "bare-key2" (makeKey ["bare-key2"])-            it "can parse keys which contain only digits" $-                parseKey "1234" (makeKey ["1234"])-        context "when the key is a quoted key" $ do-            it "can parse keys that follow the exact same rules as basic strings" $ do-                parseKey (dquote "127.0.0.1") (makeKey [dquote "127.0.0.1"])-                parseKey (dquote "character encoding") (makeKey [dquote "character encoding"])-                parseKey (dquote "ʎǝʞ") (makeKey [dquote "ʎǝʞ"])-            it "can parse keys that follow the exact same rules as literal strings" $ do-                parseKey (squote "key2") (makeKey [squote "key2"])-                parseKey (squote "quoted \"value\"") (makeKey [squote "quoted \"value\""])-        context "when the key is a dotted key" $-            it "can parse a sequence of bare or quoted keys joined with a dot" $ do-                parseKey "name"           (makeKey ["name"])-                parseKey "physical.color" (makeKey ["physical", "color"])-                parseKey "physical.shape" (makeKey ["physical", "shape"])-                parseKey "site.\"google.com\"" (makeKey ["site", dquote "google.com"])-        -- it "ignores whitespaces around dot-separated parts" $+keySpecs = describe "keyP" $ do+    context "when the key is a bare key" $ do+        it "can parse keys which contain ASCII letters, digits, underscores, and dashes" $ do+            parseKey "key"       (makeKey ["key"])+            parseKey "bare_key1" (makeKey ["bare_key1"])+            parseKey "bare-key2" (makeKey ["bare-key2"])+        it "can parse keys which contain only digits" $+            parseKey "1234" (makeKey ["1234"])+    context "when the key is a quoted key" $ do+        it "can parse keys that follow the exact same rules as basic strings" $ do+            parseKey (dquote "127.0.0.1") (makeKey [dquote "127.0.0.1"])+            parseKey (dquote "character encoding") (makeKey [dquote "character encoding"])+            parseKey (dquote "ʎǝʞ") (makeKey [dquote "ʎǝʞ"])+        it "can parse keys that follow the exact same rules as literal strings" $ do+            parseKey (squote "key2") (makeKey [squote "key2"])+            parseKey (squote "quoted \"value\"") (makeKey [squote "quoted \"value\""])+    context "when the key is a dotted key" $ do+        it "can parse a sequence of bare or quoted keys joined with a dot" $ do+            parseKey "name"           (makeKey ["name"])+            parseKey "physical.color" (makeKey ["physical", "color"])+            parseKey "physical.shape" (makeKey ["physical", "shape"])+            parseKey "site.\"google.com\"" (makeKey ["site", dquote "google.com"])+        -- it "ignores whitespaces around dot-separated parts" $ do         --     parseKey "a . b . c. d" (makeKey ["a", "b", "c", "d"]) -    describe "hasKeyP" $ do-        it "can parse key/value pairs" $ do-            parseHasKey "x='abcdef'" (makeKey ["x"], Left $ AnyValue (Text "abcdef"))-            parseHasKey "x=1"        (makeKey ["x"], Left $ AnyValue (Integer 1))-            parseHasKey "x=5.2"      (makeKey ["x"], Left $ AnyValue (Double 5.2))-            parseHasKey "x=true"     (makeKey ["x"], Left $ AnyValue (Bool True))-            parseHasKey "x=[1, 2, 3]" (makeKey ["x"] , Left $ AnyValue (Array [Integer 1, Integer 2, Integer 3]))-            parseHasKey "x = 1920-12-10"-                (makeKey ["x"], Left $ AnyValue (Day day2))-        --xit "can parse a key/value pair when the value is an inline table" $ do-        --  pending-        it "ignores white spaces around key names and values" $ do-            parseHasKey "x=1    "   (makeKey ["x"]       , Left $ AnyValue (Integer 1))-            parseHasKey "x=    1"   (makeKey ["x"]       , Left $ AnyValue (Integer 1))-            parseHasKey "x    =1"   (makeKey ["x"]       , Left $ AnyValue (Integer 1))-            parseHasKey "x\t= 1 "   (makeKey ["x"]       , Left $ AnyValue (Integer 1))-            parseHasKey "\"x\" = 1" (makeKey [dquote "x"], Left $ AnyValue (Integer 1))-        --xit "fails if the key, equals sign, and value are not on the same line" $ do-        --  keyValFailOn "x\n=\n1"-        --  keyValFailOn "x=\n1"-        --  keyValFailOn "\"x\"\n=\n1"-        it "works if the value is broken over multiple lines" $-            parseHasKey "x=[1, \n2\n]" (makeKey ["x"], Left $ AnyValue (Array [Integer 1, Integer 2]))-        it "fails if the value is not specified" $-            hasKeyFailOn "x="--        it "can parse a TOML inline table" $-            parseHasKey "table-1={key1 = \"some string\", key2 = 123}"-                (makeKey ["table-1"], Right $ tomlFromKeyVal [str, int])-        it "can parse an empty TOML table" $-            parseHasKey "table = {}" (makeKey ["table"], Right $ tomlFromKeyVal [])-        it "allows the name of the table to be any valid TOML key" $ do-            parseHasKey "dog.\"tater.man\"={}"-                (makeKey ["dog", dquote "tater.man"], Right $ tomlFromKeyVal [])-            parseHasKey "j.\"ʞ\".'l'={}"-                (makeKey ["j", dquote "ʞ", squote "l"], Right $ tomlFromKeyVal [])- textSpecs :: Spec textSpecs = describe "textP" $ do     context "when the string is a basic string" $ do@@ -392,91 +354,120 @@         parseDateTime "1979-05-27T00:32:0007:00"             (ULocal $ LocalTime day1 (TimeOfDay 0 32 0)) -tableSpecs :: Spec-tableSpecs = do-    describe "tableP" $ do+tomlSpecs :: Spec+tomlSpecs = do+    describe "Key/values" $ do+        it "can parse key/value pairs" $ do+            parseToml "x='abcdef'" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Text "abcdef"))])+            parseToml "x=1"        (tomlFromKeyVal [(makeKey ["x"], AnyValue (Integer 1))])+            parseToml "x=5.2"      (tomlFromKeyVal [(makeKey ["x"], AnyValue (Double 5.2))])+            parseToml "x=true"     (tomlFromKeyVal [(makeKey ["x"], AnyValue (Bool True))])+            parseToml "x=[1, 2, 3]" (tomlFromKeyVal [(makeKey ["x"] , AnyValue (Array [Integer 1, Integer 2, Integer 3]))])+            parseToml "x = 1920-12-10" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Day day2))])+        it "ignores white spaces around key names and values" $ do+            let toml = tomlFromKeyVal [(makeKey ["x"], AnyValue (Integer 1))]+            parseToml "x=1    "   toml+            parseToml "x=    1"   toml+            parseToml "x    =1"   toml+            parseToml "x\t= 1 "   toml+            parseToml "\"x\" = 1" (tomlFromKeyVal [(makeKey [dquote "x"], AnyValue (Integer 1))])+        --xit "fails if the key, equals sign, and value are not on the same line" $ do+        --  keyValFailOn "x\n=\n1"+        --  keyValFailOn "x=\n1"+        --  keyValFailOn "\"x\"\n=\n1"+        it "works if the value is broken over multiple lines" $+            parseToml "x=[1, \n2\n]" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Array [Integer 1, Integer 2]))])+        it "fails if the value is not specified" $+            tomlFailOn "x="++    describe "tables" $ do         it "can parse a TOML table" $-          parseTable "[table-1]\nkey1 = \"some string\"\nkey2 = 123"-                (makeKey ["table-1"], tomlFromKeyVal [str, int])+          parseToml "[table] \n key1 = \"some string\"\nkey2 = 123"+                $ tomlFromTable [(makeKey ["table"], tomlFromKeyVal [str, int])]         it "can parse an empty TOML table" $-            parseTable "[table]" (makeKey ["table"], tomlFromKeyVal [])-        it "allows the name of the table to be any valid TOML key" $ do-            parseTable "[dog.\"tater.man\"]"-                (makeKey ["dog", dquote "tater.man"], tomlFromKeyVal [])-            parseTable "[j.\"ʞ\".'l']"-                (makeKey ["j", dquote "ʞ", squote "l"], tomlFromKeyVal [])+            parseToml "[table]" (tomlFromTable [(makeKey ["table"], mempty)])         it "can parse a table with subarrays" $ do-            let arr1 = tomlFromArray [(makeKey ["array"], strT :| [intT])]-            parseTable "[table]\n[[table.array]] \nkey1 = \"some string\"\n \-                              \ [[table.array]] \nkey2 = 123" (makeKey ["table"], arr1)+            let t = tomlFromTable [(makeKey ["table"], tomlFromArray [(makeKey ["array"], strT :| [intT])])]+            parseToml "[table] \n [[table.array]] \nkey1 = \"some string\"\n \+                                  \[[table.array]] \nkey2 = 123" t+        it "can parse a TOML inline table" $+            parseToml "table={key1 = \"some string\", key2 = 123}"+                (tomlFromTable [(makeKey ["table"], tomlFromKeyVal [str, int])])+        it "can parse an empty inline TOML table" $+            parseToml "table = {}" (tomlFromTable [(makeKey ["table"], mempty)])+        it "allows the name of the table to be any valid TOML key" $ do+            parseToml "dog.\"tater.man\"={}"+                (tomlFromTable [(makeKey ["dog", dquote "tater.man"], mempty)])+            parseToml "j.\"ʞ\".'l'={}"+                (tomlFromTable [(makeKey ["j", dquote "ʞ", squote "l"], mempty)]) -    describe "tableArrayP" $ do+    describe "array of tables" $ do         it "can parse an empty array" $-            parseTableArray "[[tArray]]" (makeKey ["tArray"], mempty :| [])-        it "allows the name of the table array to be any valid TOML key" $ do-            parseTableArray "[[dog.\"tater.man\"]]"-                (makeKey ["dog", dquote "tater.man"], mempty :| [])-            parseTableArray "[[j.\"ʞ\".'l']]"-                (makeKey ["j", dquote "ʞ", squote "l"], mempty :| [])+            parseToml "[[array]]" (tomlFromArray [(makeKey ["array"], mempty :| [])])         it "can parse an array of key/values" $ do-            let array  = (makeKey ["tArray"], NE.fromList [strT, intT])-            parseTableArray "[[tArray]]\nkey1 = \"some string\"\n \-                           \ [[tArray]]\nkey2 = 123" array+            let array = tomlFromArray [(makeKey ["array"], NE.fromList [strT, intT])]+            parseToml "[[array]]\n key1 = \"some string\"\n \+                      \[[array]]\n key2 = 123" array         it "can parse an array of tables" $ do             let table1 = tomlFromTable [(makeKey ["table1"], strT)]                 table2 = tomlFromTable [(makeKey ["table2"], intT)]-                array  = (makeKey ["tArray"], NE.fromList [table1, table2])-            parseTableArray "[[tArray]]\n[tArray.table1] \n key1 = \"some string\"\n \-                           \ [[tArray]]\n[tArray.table2] \n key2 = 123" array+                array  = tomlFromArray [(makeKey ["array"], NE.fromList [table1, table2])]+            parseToml "[[array]]\n[array.table1] \n key1 = \"some string\"\n \+                      \[[array]]\n[array.table2] \n key2 = 123" array         it "can parse an array of array" $ do-            let arr = tomlFromArray [(makeKey ["table-1-1"], NE.fromList [strT, intT])]-                array = (makeKey ["table-1"], arr :| [])-            parseTableArray "[[table-1]]\n[[table-1.table-1-1]] \nkey1 = \"some string\"\n \-                                         \ [[table-1.table-1-1]] \nkey2 = 123" array+            let arr = tomlFromArray [(makeKey ["subarray"], NE.fromList [strT, intT])]+                array = tomlFromArray [(makeKey ["array"], arr :| [])]+            parseToml "[[array]] \n [[array.subarray]] \nkey1 = \"some string\"\n \+                      \[[array.subarray]] \nkey2 = 123" array         it "can parse an array of arrays" $ do-            let arr1 = (makeKey ["table-1-1"], strT :| [])-                arr2 = (makeKey ["table-1-2"], intT :| [])-                array = (makeKey ["table-1"], tomlFromArray [arr1, arr2] :| [])-            parseTableArray "[[table-1]]\n[[table-1.table-1-1]] \nkey1 = \"some string\"\n \-                                         \ [[table-1.table-1-2]] \nkey2 = 123" array+            let arr1 = (makeKey ["table-1"], strT :| [])+                arr2 = (makeKey ["table-2"], intT :| [])+                array = tomlFromArray [(makeKey ["array"], tomlFromArray [arr1, arr2] :| [])]+            parseToml "[[array]]\n [[array.table-1]] \nkey1 = \"some string\"\n \+                                  \[[array.table-2]] \nkey2 = 123" array+        it "can parse very large arrays" $ do+            let array = tomlFromArray [(makeKey ["array"], NE.fromList $ replicate 1000 mempty)]+            parseToml (mconcat $ replicate 1000 "[[array]]\n") array+        it "can parse an inline array of tables" $ do+            let array  = tomlFromArray [(makeKey ["table"], NE.fromList [strT, intT])]+            parseToml "table = [{key1 = \"some string\"}, {key2 = 123}]" array -tomlSpecs :: Spec-tomlSpecs = describe "tomlP" $ do-    it "can parse TOML files" $-       parseToml tomlStr1 toml1-    it "can parse mix of tables and arrays" $-       parseToml tomlStr2 toml2-  where-    tomlStr1, tomlStr2 :: Text-    tomlStr1 = T.unlines-        [ " # This is a TOML document.\n\n"-        , "title = \"TOML Example\" # Comment \n\n"-        , "[owner]\n"-        , "  name = \"Tom Preston-Werner\" "-        , "  enabled = true # First class dates"-        ]-    tomlStr2 = T.unlines-        [ "[[array1]]\n key1 = \"some string\" \n"-        , ""-        , "[table1]  \n key2 = 123 \n"-        , "[[array2]]\n key3 = 3.14 \n"-        , "  [table2]  \n key4 = true"-        ]+    describe "TOML" $ do+        it "can parse TOML files" $+           parseToml tomlStr1 toml1+        it "can parse mix of tables and arrays" $+           parseToml tomlStr2 toml2+      where+        tomlStr1, tomlStr2 :: Text+        tomlStr1 = T.unlines+            [ " # This is a TOML document.\n\n"+            , "title = \"TOML Example\" # Comment \n\n"+            , "[owner]\n"+            , "  name = \"Tom Preston-Werner\" "+            , "  enabled = true # First class dates"+            ]+        tomlStr2 = T.unlines+            [ "[[array1]]\n key1 = \"some string\" \n"+            , ""+            , "[table1]  \n key2 = 123 \n"+            , "[[array2]]\n key3 = 3.14 \n"+            , "  [table2]  \n key4 = true"+            ] -    toml1, toml2 :: TOML-    toml1 = mkToml $ do-        "title" =: "TOML Example"-        table "owner" $ do-            "name" =: "Tom Preston-Werner"-            "enabled" =: Bool True+        toml1, toml2 :: TOML+        toml1 = mkToml $ do+            "title" =: "TOML Example"+            table "owner" $ do+                "name" =: "Tom Preston-Werner"+                "enabled" =: Bool True -    toml2 = mkToml $ do-        tableArray "array1" $-            "key1" =: "some string" :| []-        table "table1" $ "key2" =: 123-        tableArray "array2" $-            "key3" =: Double 3.14 :| []-        table "table2" $ "key4" =: Bool True+        toml2 = mkToml $ do+            tableArray "array1" $+                "key1" =: "some string" :| []+            table "table1" $ "key2" =: 123+            tableArray "array2" $+                "key3" =: Double 3.14 :| []+            table "table2" $ "key4" =: Bool True  ---------------------------------------------------------------------------- -- Utilities@@ -501,25 +492,20 @@ parseInteger = parseX integerP parseKey :: Text -> Key -> Expectation parseKey = parseX keyP-parseHasKey :: Text -> (Key, Either AnyValue TOML) -> Expectation-parseHasKey = parseX hasKeyP parseText :: Text -> Text -> Expectation parseText = parseX textP-parseTable :: Text -> (Key, TOML) -> Expectation-parseTable = parseX tableP-parseTableArray :: Text -> (Key, NonEmpty TOML) -> Expectation-parseTableArray = parseX tableArrayP+ parseToml :: Text -> TOML -> Expectation parseToml = parseX tomlP -arrayFailOn, boolFailOn, dateTimeFailOn, doubleFailOn, hasKeyFailOn, integerFailOn, textFailOn :: Text -> Expectation+arrayFailOn, boolFailOn, dateTimeFailOn, doubleFailOn, integerFailOn, textFailOn, tomlFailOn :: Text -> Expectation arrayFailOn     = failOn arrayP boolFailOn      = failOn boolP dateTimeFailOn  = failOn dateTimeP doubleFailOn    = failOn doubleP-hasKeyFailOn    = failOn hasKeyP integerFailOn   = failOn integerP textFailOn      = failOn textP+tomlFailOn      = failOn tomlP  -- UValue Util 

@@ -4,13 +4,14 @@        ( test_prettyGolden        ) where +import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Ord (comparing) import Test.Tasty (TestTree, testGroup) import Test.Tasty.Silver (goldenVsAction)-import Data.List.NonEmpty (NonEmpty ((:|)))  import Toml (TOML, Value (..))-import Toml.Edsl ((=:), mkToml, table, tableArray, empty)-import Toml.PrefixTree ((<|))+import Toml.Edsl (empty, mkToml, table, tableArray, (=:))+import Toml.PrefixTree (Key (..), (<|)) import Toml.Printer (PrintOptions (..), defaultOptions, prettyOptions)  example :: TOML@@ -34,17 +35,28 @@  noFormatting :: PrintOptions noFormatting = PrintOptions-    { shouldSort = False-    , indent     = 0+    { printOptionsSorting = Nothing+    , printOptionsIndent  = 0     } +-- | Decorate keys as tuples so spam comes before egg+spamEggDecorate :: Key -> (Int, Key)+spamEggDecorate k+    | k == "spam" = (0, "spam")+    | k == "egg" = (1, "egg")+    | otherwise = (2, k)++spamEgg :: Key -> Key -> Ordering+spamEgg = comparing spamEggDecorate+ test_prettyGolden :: TestTree test_prettyGolden =     testGroup "Toml.Printer"         [ test "pretty_default" defaultOptions-        , test "pretty_sorted_only" noFormatting{ shouldSort = True}-        , test "pretty_indented_only" noFormatting{ indent = 4 }+        , test "pretty_sorted_only" noFormatting { printOptionsSorting = Just compare }+        , test "pretty_indented_only" noFormatting { printOptionsIndent = 4 }         , test "pretty_unformatted" noFormatting+        , test "pretty_custom_sorted" noFormatting { printOptionsSorting = Just spamEgg }         ]   where     test name options =

@@ -0,0 +1,26 @@+a = "a"+b = "bb"+c = "cccc"+d = "ddd"++[baz]++[doo]++[foo]++[qux.doo]+spam = "!"+egg = "?"++[[deeper]]+green = true++[[deeper]]+[deeper.blue]+red = 255++[[deepest]]+ping = "pong"++[[deepest]]

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                tomland-version:             1.0.1.0+version:             1.1.0.0 synopsis:            Bidirectional TOML serialization description:     Implementation of bidirectional TOML serialization. Simple codecs look like this:@@ -74,6 +74,7 @@                            Toml.Bi.Monad                            Toml.Bi.Map                          Toml.Edsl+                         Toml.Generic                          Toml.Parser                            Toml.Parser.Core                            Toml.Parser.String@@ -91,9 +92,9 @@                      , containers >= 0.5.7 && < 0.7                      , deepseq ^>= 1.4                      , hashable ^>= 1.2-                     , megaparsec ^>= 7.0.1+                     , megaparsec ^>= 7.0.5                      , mtl ^>= 2.2-                     , parser-combinators+                     , parser-combinators ^>= 1.1.0                      , text ^>= 1.2                      , time >= 1.8 && < 1.10                      , transformers ^>= 0.5@@ -141,7 +142,7 @@                      , containers >= 0.5.7 && < 0.7                      , hashable                      , hedgehog ^>= 1.0-                     , hspec-megaparsec+                     , hspec-megaparsec ^>= 2.0.0                      , megaparsec                      , tasty ^>= 1.2                      , tasty-hedgehog ^>= 1.0.0.0@@ -171,10 +172,9 @@                       -with-rtsopts=-N                       -O2 -  build-depends:      base-                    , aeson+  build-depends:      aeson                     , deepseq ^>= 1.4-                    , gauge+                    , gauge ^>= 0.2.4                     , htoml ^>= 1.0.0.3                     , htoml-megaparsec ^>= 2.1.0.3                     , parsec