tomland 1.1.0.1 → 1.2.0.0

raw patch · 33 files changed

+985/−712 lines, 33 filesdep −aesondep −gaugedep −htomldep ~basedep ~containersdep ~hashablePVP ok

version bump matches the API change (PVP)

Dependencies removed: aeson, gauge, htoml, htoml-megaparsec, parsec, toml-parser

Dependency ranges changed: base, containers, hashable, hedgehog, text, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +33/−0
• README.lhs +12/−6
• README.md +12/−6
• benchmark/Benchmark/Htoml.hs +0/−45
• benchmark/Benchmark/HtomlMegaparsec.hs +0/−43
• benchmark/Benchmark/TomlParser.hs +0/−91
• benchmark/Benchmark/Tomland.hs +0/−39
• benchmark/Benchmark/Type.hs +0/−57
• benchmark/Main.hs +0/−41
• examples/Main.hs +153/−0
• examples/Playground.hs +0/−116
• src/Toml/Bi/Code.hs +9/−7
• src/Toml/Bi/Combinators.hs +78/−7
• src/Toml/Bi/Map.hs +89/−21
• src/Toml/Bi/Monad.hs +61/−0
• src/Toml/Edsl.hs +5/−0
• src/Toml/Generic.hs +22/−1
• src/Toml/Parser.hs +12/−6
• src/Toml/Parser/Item.hs +104/−0
• src/Toml/Parser/Key.hs +51/−0
• src/Toml/Parser/TOML.hs +0/−134
• src/Toml/Parser/Validate.hs +181/−0
• src/Toml/PrefixTree.hs +15/−12
• src/Toml/Printer.hs +2/−1
• src/Toml/Type/AnyValue.hs +13/−3
• src/Toml/Type/TOML.hs +19/−7
• src/Toml/Type/UValue.hs +2/−1
• src/Toml/Type/Value.hs +18/−6
• test/Test/Toml/BiCode/Property.hs +15/−10
• test/Test/Toml/BiMap/Property.hs +3/−0
• test/Test/Toml/Gen.hs +19/−4
• test/Test/Toml/Parsing/Unit.hs +33/−9
• tomland.cabal +24/−39

@@ -3,6 +3,39 @@ tomland uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 1.2.0.0 — Oct 12, 2019++* [#216](https://github.com/kowainik/tomland/issues/216):+  Refactor TOML parser significantly. Check for some validation errors.+  (by [@chshersh](https://github.com/chshersh))+* [#213](https://github.com/kowainik/tomland/issues/213):+  Support GHC-8.8.1.+  (by [@vrom911](https://github.com/vrom911))+* [#226](https://github.com/kowainik/tomland/issues/226):+  Add `dimatch` combinator for better support of sum types.+  (by [@Nimor111](https://github.com/Nimor111))+* [#219](https://github.com/kowainik/tomland/issues/219):+  Add INLINE pragmas to code.+  (by [@willbasky](https://github.com/willbasky))+* [#204](https://github.com/kowainik/tomland/issues/204):+  Implement bidirectional codecs to work with `ByteString` as array of bytes.+  (by [@crtschin](https://github.com/crtschin))+* [#201](https://github.com/kowainik/tomland/issues/201):+  Implement `set` and `hashSet` combinators for array of tables.+  (by [@SanchayanMaity](https://github.com/SanchayanMaity))+* [#215](https://github.com/kowainik/tomland/issues/215):+  Move benchmarks to separate repository+  [toml-benchmarks](https://github.com/kowainik/toml-benchmarks).+  (by [@kutyel](https://github.com/kutyel))+* [#209](https://github.com/kowainik/tomland/issues/209):+  Bump up `parser-combinators` to `1.2.0`.+  (by [@vrom911](https://github.com/vrom911))+* [#198](https://github.com/kowainik/tomland/issues/198):+  Improve test generators.+  (by [@gabrielelana](https://github.com/gabrielelana)+  , [@chshersh](https://github.com/chshersh)+  )+ ## 1.1.0.1 — Jul 10, 2019  * [#206](https://github.com/kowainik/tomland/issues/206):

@@ -1,7 +1,9 @@ # tomland  ![palm](https://user-images.githubusercontent.com/4276606/51088259-7a777000-176e-11e9-9d76-6be4023c0ac3.png)-[![Build status](https://img.shields.io/travis/kowainik/tomland.svg?logo=travis)](https://travis-ci.org/kowainik/tomland)+[![GitHub CI](https://github.com/kowainik/tomland/workflows/CI/badge.svg)](https://github.com/kowainik/tomland/actions)+[![Travis CI](https://img.shields.io/travis/kowainik/tomland.svg?logo=travis)](https://travis-ci.org/kowainik/tomland)+[![AppVeyor CI](https://ci.appveyor.com/api/projects/status/github/kowainik/tomland?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/tomland) [![Hackage](https://img.shields.io/hackage/v/tomland.svg?logo=haskell)](https://hackage.haskell.org/package/tomland) [![Stackage LTS](http://stackage.org/package/tomland/badge/lts)](http://stackage.org/lts/package/tomland) [![Stackage Nightly](http://stackage.org/package/tomland/badge/nightly)](http://stackage.org/nightly/package/tomland)@@ -74,9 +76,9 @@     }  data User-    = Admin  Integer  -- id of admin-    | Client Text     -- name of the client-    deriving (Show)+    = Admin  !Integer  -- id of admin+    | Client !Text     -- name of the client+    deriving stock (Show)  newtype Port = Port Int newtype Host = Host Text@@ -95,7 +97,11 @@    represented as array of tables in TOML. If you have lists of primitive types    like `Int`, `Bool`, `Double`, `Text` or time types, that you can use    `Toml.arrayOf` and parse arrays of values.-5. `tomland` separates conversion between Haskell types and TOML values from+5. If you have sets of custom data types, use `Toml.set` or `Toml.HashSet`. Such+   sets are represented as array of tables in TOML.+6. For parsing sum types, use `Toml.dimatch`. This requires writing matching functions+   for the constructors of the sum type.+7. `tomland` separates conversion between Haskell types and TOML values from    matching values by keys. Converters between types and values have type    `TomlBiMap` and are named with capital letter started with underscore. Main    type for TOML codecs is called `TomlCodec`. To lift `TomlBiMap` to@@ -146,7 +152,7 @@  ## Benchmarks and comparison with other libraries -`tomland` is compared with other libraries. Since it uses 2-step approach with+`tomland` is [compared](https://github.com/kowainik/toml-benchmarks) with other libraries. Since it uses 2-step approach with converting text to intermediate AST and only then decoding Haskell type from this AST, benchmarks are also implemented in a way to reflect this difference. 

@@ -1,7 +1,9 @@ # tomland  ![palm](https://user-images.githubusercontent.com/4276606/51088259-7a777000-176e-11e9-9d76-6be4023c0ac3.png)-[![Build status](https://img.shields.io/travis/kowainik/tomland.svg?logo=travis)](https://travis-ci.org/kowainik/tomland)+[![GitHub CI](https://github.com/kowainik/tomland/workflows/CI/badge.svg)](https://github.com/kowainik/tomland/actions)+[![Travis CI](https://img.shields.io/travis/kowainik/tomland.svg?logo=travis)](https://travis-ci.org/kowainik/tomland)+[![AppVeyor CI](https://ci.appveyor.com/api/projects/status/github/kowainik/tomland?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/tomland) [![Hackage](https://img.shields.io/hackage/v/tomland.svg?logo=haskell)](https://hackage.haskell.org/package/tomland) [![Stackage LTS](http://stackage.org/package/tomland/badge/lts)](http://stackage.org/lts/package/tomland) [![Stackage Nightly](http://stackage.org/package/tomland/badge/nightly)](http://stackage.org/nightly/package/tomland)@@ -74,9 +76,9 @@     }  data User-    = Admin  Integer  -- id of admin-    | Client Text     -- name of the client-    deriving (Show)+    = Admin  !Integer  -- id of admin+    | Client !Text     -- name of the client+    deriving stock (Show)  newtype Port = Port Int newtype Host = Host Text@@ -95,7 +97,11 @@    represented as array of tables in TOML. If you have lists of primitive types    like `Int`, `Bool`, `Double`, `Text` or time types, that you can use    `Toml.arrayOf` and parse arrays of values.-5. `tomland` separates conversion between Haskell types and TOML values from+5. If you have sets of custom data types, use `Toml.set` or `Toml.HashSet`. Such+   sets are represented as array of tables in TOML.+6. For parsing sum types, use `Toml.dimatch`. This requires writing matching functions+   for the constructors of the sum type.+7. `tomland` separates conversion between Haskell types and TOML values from    matching values by keys. Converters between types and values have type    `TomlBiMap` and are named with capital letter started with underscore. Main    type for TOML codecs is called `TomlCodec`. To lift `TomlBiMap` to@@ -146,7 +152,7 @@  ## Benchmarks and comparison with other libraries -`tomland` is compared with other libraries. Since it uses 2-step approach with+`tomland` is [compared](https://github.com/kowainik/toml-benchmarks) with other libraries. Since it uses 2-step approach with converting text to intermediate AST and only then decoding Haskell type from this AST, benchmarks are also implemented in a way to reflect this difference. 

@@ -1,45 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE DeriveAnyClass     #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE PackageImports     #-}-{-# LANGUAGE StandaloneDeriving #-}--module Benchmark.Htoml-       ( decode-       , parse-       , convert-       ) where--import Control.DeepSeq (NFData, rnf, rwhnf)-import Data.Aeson.Types (parseEither, parseJSON)-import Data.Semigroup ((<>))-import Data.Text (Text)-import GHC.Generics (Generic)-import Text.Parsec.Error (ParseError)--import "htoml" Text.Toml (parseTomlDoc)-import "htoml" Text.Toml.Types (Node (..), Table, toJSON)--import Benchmark.Type (HaskellType)----- | Decode toml file to Haskell type.-decode :: Text -> Either String HaskellType-decode txt = case parseTomlDoc "" txt of-    Left err   -> error $ "'htoml' parsing failed: " <> show err-    Right toml -> convert toml---- | Wrapper on htoml's 'parseTomlDoc'-parse :: Text -> Either ParseError Table-parse = parseTomlDoc ""---- | Convert from already parsed toml to Haskell type.-convert :: Table -> Either String HaskellType-convert = parseEither parseJSON . toJSON--deriving instance NFData Node-deriving instance Generic Node--instance NFData ParseError where-    rnf = rwhnf

@@ -1,43 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE PackageImports #-}--module Benchmark.HtomlMegaparsec-       ( decode-       , parse-       , convert-       ) where--import Data.Aeson.Types (ToJSON, parseEither, parseJSON, toJSON)-import Data.Semigroup ((<>))-import Data.Text (Text)--import "htoml-megaparsec" Text.Toml (Node (..), Table, TomlError, parseTomlDoc)--import Benchmark.Type (HaskellType)---- | Decode toml file to Haskell type.-decode :: Text -> Either String HaskellType-decode txt = case parseTomlDoc "log" txt of-    Left err   -> error $ "'htoml-megaparsec' parsing failed: " <> show err-    Right toml -> convert toml---- | Wrapper on htoml-megaparsec's parseTomlDoc-parse :: Text -> Either TomlError Table-parse = parseTomlDoc "log"---- | Convert from already parsed toml to Haskell type.-convert :: Table -> Either String HaskellType-convert = parseEither parseJSON . toJSON---- | '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

@@ -1,91 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE DeriveAnyClass      #-}-{-# LANGUAGE DeriveGeneric       #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving  #-}--module Benchmark.TomlParser-       ( decode-       , parse-       , convert-       ) where--import Control.DeepSeq (NFData, rnf, rwhnf)-import Data.Semigroup ((<>))-import Data.Text (Text)-import GHC.Generics (Generic)--import Benchmark.Type (FruitInside (..), HaskellType (..), SizeInside (..))--import qualified TOML----- | Decode toml file to Haskell type.-decode :: Text -> Either String HaskellType-decode txt = case parse txt of-    Left err   -> error $ "'toml-parser' parsing failed: " <> show err-    Right toml -> maybe (Left "Some error during conversion") Right $ convert toml---- | Wrapper over 'TOML.parseTOML'-parse :: Text -> Either TOML.TOMLError [(Text, TOML.Value)]-parse = TOML.parseTOML---- | Convert from already parsed toml to Haskell type.-convert :: [(Text, TOML.Value)] -> Maybe HaskellType-convert toml = do-    TOML.String htTitle <- lookup "title" toml-    TOML.Double htAtom <- lookup "atom" toml-    TOML.Bool htCash <- lookup "cash" toml--    TOML.List tomlWords <- lookup "words" toml-    htWords <- mapM matchText tomlWords--    TOML.List tomlBools <- lookup "bool" toml-    htBool <- mapM matchBool tomlBools--    TOML.ZonedTimeV htToday <- lookup "today" toml--    TOML.List tomlInts <- lookup "ints" toml-    htInteger <- mapM matchInteger tomlInts--    TOML.Table fruit <- lookup "fruit" toml-    htFruit <- do-        TOML.String fiName <- lookup "name" fruit-        TOML.String fiDescription <- lookup "description" fruit-        pure FruitInside{..}--    TOML.Table size <- lookup "size" toml-    htSize <- do-        TOML.List dimensions <- lookup "dimensions" size-        arrays :: [[TOML.Value]] <- mapM matchArray dimensions-        unSize <- mapM (mapM matchDouble) arrays-        pure SizeInside{..}--    pure HaskellType{..}--matchText :: TOML.Value -> Maybe Text-matchText (TOML.String t) = Just t-matchText _               = Nothing--matchBool :: TOML.Value -> Maybe Bool-matchBool (TOML.Bool b) = Just b-matchBool _             = Nothing--matchInteger :: TOML.Value -> Maybe Integer-matchInteger (TOML.Integer i) = Just i-matchInteger _                = Nothing--matchArray :: TOML.Value -> Maybe [TOML.Value]-matchArray (TOML.List a) = Just a-matchArray _             = Nothing--matchDouble :: TOML.Value -> Maybe Double-matchDouble (TOML.Double d) = Just d-matchDouble _               = Nothing--deriving instance Generic TOML.Value-deriving instance NFData  TOML.Value--instance NFData TOML.TOMLError where-  rnf = rwhnf

@@ -1,39 +0,0 @@-module Benchmark.Tomland-       ( decode-       , parse-       , convert-       ) where--import Data.Text (Text)--import Benchmark.Type (FruitInside (..), HaskellType (..), SizeInside (..))-import Toml (DecodeException, TOML, TomlCodec, parse, (.=))--import qualified Toml--decode :: Text -> Either DecodeException HaskellType-decode = Toml.decode codec--convert :: TOML -> Either DecodeException HaskellType-convert = Toml.runTomlCodec codec---- | Codec to use in tomland decode and convert functions.-codec :: TomlCodec HaskellType-codec = HaskellType-    <$> Toml.text "title" .= htTitle-    <*> Toml.double "atom" .= htAtom-    <*> Toml.bool "cash" .= htCash-    <*> Toml.arrayOf Toml._Text "words" .= htWords-    <*> Toml.arrayOf Toml._Bool "bool" .= htBool-    <*> Toml.zonedTime "today" .= htToday-    <*> Toml.arrayOf Toml._Integer "ints" .= htInteger-    <*> Toml.table insideF "fruit" .= htFruit-    <*> Toml.table insideS "size" .= htSize--insideF :: TomlCodec FruitInside-insideF = FruitInside-    <$> Toml.text "name" .= fiName-    <*> Toml.text "description" .= fiDescription--insideS :: TomlCodec SizeInside-insideS = Toml.diwrap $ Toml.arrayOf (Toml._Array Toml._Double) "dimensions"

@@ -1,57 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric  #-}--module Benchmark.Type-       ( HaskellType (..)-       , FruitInside (..)-       , SizeInside (..)-       ) where--import Control.DeepSeq (NFData)-import Data.Aeson.Types (FromJSON, parseJSON, withObject, (.:))-import Data.Text (Text)-import Data.Time (ZonedTime)-import GHC.Generics (Generic)----- | Haskell type to convert to.-data HaskellType = HaskellType-    { htTitle   :: Text-    , htAtom    :: Double-    , htCash    :: Bool-    , htWords   :: [Text]-    , htBool    :: [Bool]-    , htToday   :: ZonedTime-    , htInteger :: [Integer]-    , htFruit   :: FruitInside-    , htSize    :: SizeInside-    } deriving (Show, NFData, Generic)--instance FromJSON HaskellType where-    parseJSON = withObject "HaskellType" $ \o -> HaskellType-        <$> o .: "title"-        <*> o .: "atom"-        <*> o .: "cash"-        <*> o .: "words"-        <*> o .: "bool"-        <*> o .: "today"-        <*> o .: "ints"-        <*> o .: "fruit"-        <*> o .: "size"--data FruitInside = FruitInside-    { fiName        :: Text-    , fiDescription :: Text-    } deriving (Show, NFData, Generic)--instance FromJSON FruitInside where-    parseJSON = withObject "FruitInside" $ \o -> FruitInside-        <$> o .: "name"-        <*> o .: "description"--newtype SizeInside = SizeInside-    { unSize :: [[Double]]-    } deriving (Show, NFData, Generic)--instance FromJSON SizeInside where-    parseJSON = withObject "SizeInside" $ \o -> SizeInside <$> o .: "dimensions"

@@ -1,41 +0,0 @@-module Main-       ( main-       ) where--import Gauge.Main (bench, bgroup, defaultMain, nf)--import qualified Benchmark.Htoml as Htoml-import qualified Benchmark.HtomlMegaparsec as HtomlM-import qualified Benchmark.Tomland as Tomland-import qualified Benchmark.TomlParser as TomlParser-import qualified Data.Text.IO as TIO----- | Benchmark.-main :: IO ()-main = do-    txt <- TIO.readFile "./benchmark/benchmark.toml"-    Right tomlandVal <- pure $ Tomland.parse txt-    Right htomlVal <- pure $ Htoml.parse txt-    Right htomlMegaVal <- pure $ HtomlM.parse txt-    Right tomlParserVal <- pure $ TomlParser.parse txt-    defaultMain-        [ bgroup "Parse"-            [ bench "tomland"          $ nf Tomland.parse txt-            , bench "htoml"            $ nf Htoml.parse txt-            , bench "htoml-megaparsec" $ nf HtomlM.parse txt-            , bench "toml-parser"      $ nf TomlParser.parse txt-            ]-        , bgroup "Convert"-            [ bench "tomland"          $ nf Tomland.convert tomlandVal-            , bench "htoml"            $ nf Htoml.convert htomlVal-            , bench "htoml-megaparsec" $ nf HtomlM.convert htomlMegaVal-            , bench "toml-parser"      $ nf TomlParser.convert tomlParserVal-            ]-        , bgroup "Decode"-            [ bench "tomland"          $ nf Tomland.decode txt-            , bench "htoml"            $ nf Htoml.decode txt-            , bench "htoml-megaparsec" $ nf HtomlM.decode txt-            , bench "toml-parser"      $ nf TomlParser.decode txt-            ]-        ]

@@ -0,0 +1,153 @@+{-# OPTIONS -Wno-unused-top-binds #-}+{-# LANGUAGE DeriveAnyClass #-}++module Main (main) where++import Control.Applicative ((<|>))+import Control.Arrow ((>>>))+import Data.Hashable (Hashable)+import Data.HashSet (HashSet)+import Data.Set (Set)+import Data.Text (Text)+import Data.Time (fromGregorian)+import GHC.Generics (Generic)++import Toml (ParseException (..), TomlCodec, pretty, (.=), (<!>))+import Toml.Edsl (mkToml, table, (=:))+import Toml.Type (TOML (..), Value (..))++import qualified Data.Text.IO as TIO+import qualified Toml++newtype TestInside = TestInside { unInside :: Text }++insideCodec :: TomlCodec TestInside+insideCodec = Toml.dimap unInside TestInside $ Toml.text "inside"++data User = User+    { userName :: !Text+    , userAge  :: !Int+    } deriving stock (Eq, Ord, Generic)+      deriving anyclass (Hashable)++userCodec :: TomlCodec User+userCodec = User+    <$> Toml.text "name" .= userName+    <*> Toml.int  "age"  .= userAge++newtype N = N+    { unN :: Text+    }++data ColorScheme+    = Light+    | Dark+    | HighContrast+    deriving stock (Show, Enum, Bounded)++data UserStatus+    = Registered Text Text+    | Anonymous Text++matchRegistered :: UserStatus -> Maybe (Text, Text)+matchRegistered (Registered username password) = Just (username, password)+matchRegistered _                              = Nothing++matchAnonymous :: UserStatus -> Maybe Text+matchAnonymous (Anonymous username) = Just username+matchAnonymous _                    = Nothing++userPassCodec :: TomlCodec (Text, Text)+userPassCodec = (,)+    <$> Toml.text "username" .= fst+    <*> Toml.text "password" .= snd++userStatusCodec :: TomlCodec UserStatus+userStatusCodec =+    Toml.dimatch matchRegistered (uncurry Registered) (Toml.table userPassCodec "testStatus")+    <|> Toml.dimatch matchAnonymous Anonymous (Toml.text "testStatus")++data Test = Test+    { testB      :: !Bool+    , testI      :: !Int+    , testF      :: !Double+    , testS      :: !Text+    , testA      :: ![Text]+    , testM      :: !(Maybe Bool)+    , testX      :: !TestInside+    , testY      :: !(Maybe TestInside)+    , testN      :: !N+    , testC      :: !ColorScheme+    , testE1     :: !(Either Integer String)+    , testE2     :: !(Either String Double)+    , testStatus :: !UserStatus+    , users      :: ![User]+    , susers     :: !(Set User)+    , husers     :: !(HashSet User)+    }+++testT :: TomlCodec Test+testT = Test+    <$> Toml.bool "testB" .= testB+    <*> Toml.int "testI" .= testI+    <*> Toml.double "testF" .= testF+    <*> Toml.text "testS" .= testS+    <*> Toml.arrayOf Toml._Text "testA" .= testA+    <*> Toml.dioptional (Toml.bool "testM") .= testM+    <*> 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+    <*> userStatusCodec .= testStatus+    <*> Toml.list userCodec "user" .= users+    <*> Toml.set userCodec "suser" .= susers+    <*> Toml.hashSet userCodec "huser" .= husers+  where+    -- different keys for sum type+    eitherT1 :: TomlCodec (Either Integer String)+    eitherT1 = Toml.match (Toml._Left >>> Toml._Integer)  "either.Left"+           <|> Toml.match (Toml._Right >>> Toml._String) "either.Right"++    -- same key for sum type;+    -- doesn't work if you have something like `Either String String`,+    -- you should distinguish these cases by different keys like in `eitherT1` example+    eitherT2 :: TomlCodec (Either String Double)+    eitherT2 = ( Toml.match (Toml._Left >>> Toml._String)+             <!> Toml.match (Toml._Right >>> Toml._Double)+               ) "either"++main :: IO ()+main = do+    TIO.putStrLn "=== Printing manually specified TOML ==="+    TIO.putStrLn $ pretty myToml++    TIO.putStrLn "=== Trying to print invalid TOML ==="+    content <- TIO.readFile "examples/invalid.toml"+    TIO.putStrLn $ case Toml.parse content of+        Left (ParseException e) -> e+        Right toml              -> pretty toml++    TIO.putStrLn "=== Testing bidirectional conversion ==="+    biFile <- TIO.readFile "examples/biTest.toml"+    TIO.putStrLn $ case Toml.decode testT biFile of+        Left msg   -> Toml.prettyException msg+        Right test -> Toml.encode testT test++myToml :: TOML+myToml = mkToml $ do+    "a" =: Bool True+    "list" =: Array ["one", "two"]+    "time" =: Array [Day (fromGregorian 2018 3 29)]+    table "table.name.1" $ do+        "aInner" =: 1+        "listInner" =: Array [Bool True, Bool False]+        table "1" $ do+            "aInner11" =: 11+            "listInner11" =: Array [0, 1]+        table "2" $+            "Inner12" =: "12"+    table "table.name.2" $+        "Inner2" =: 42

@@ -1,116 +0,0 @@-{-# OPTIONS -Wno-unused-top-binds #-}--module Main (main) where--import Control.Applicative ((<|>))-import Control.Arrow ((>>>))-import Data.Text (Text)-import Data.Time (fromGregorian)--import Toml (ParseException (..), TomlCodec, pretty, (.=), (<!>))-import Toml.Edsl (mkToml, table, (=:))-import Toml.Type (TOML (..), Value (..))--import qualified Data.Text.IO as TIO-import qualified Toml--newtype TestInside = TestInside { unInside :: Text }--insideCodec :: TomlCodec TestInside-insideCodec = Toml.dimap unInside TestInside $ Toml.text "inside"--data User = User-    { userName :: Text-    , userAge  :: Int-    }--userCodec :: TomlCodec User-userCodec = User-    <$> Toml.text "name" .= userName-    <*> Toml.int  "age"  .= userAge--newtype N = N Text--data ColorScheme = Light-                 | Dark-                 | HighContrast-                 deriving (Show, Enum, Bounded)--data Test = Test-    { testB  :: Bool-    , testI  :: Int-    , testF  :: Double-    , testS  :: Text-    , testA  :: [Text]-    , testM  :: Maybe Bool-    , testX  :: TestInside-    , testY  :: Maybe TestInside-    , testN  :: N-    , testC  :: ColorScheme-    , testE1 :: Either Integer String-    , testE2 :: Either String Double-    , users  :: [User]-    }---testT :: TomlCodec Test-testT = Test-    <$> Toml.bool "testB" .= testB-    <*> Toml.int "testI" .= testI-    <*> Toml.double "testF" .= testF-    <*> Toml.text "testS" .= testS-    <*> Toml.arrayOf Toml._Text "testA" .= testA-    <*> Toml.dioptional (Toml.bool "testM") .= testM-    <*> 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-  where-    -- different keys for sum type-    eitherT1 :: TomlCodec (Either Integer String)-    eitherT1 = Toml.match (Toml._Left >>> Toml._Integer)  "either.Left"-           <|> Toml.match (Toml._Right >>> Toml._String) "either.Right"--    -- same key for sum type;-    -- doesn't work if you have something like `Either String String`,-    -- you should distinguish these cases by different keys like in `eitherT1` example-    eitherT2 :: TomlCodec (Either String Double)-    eitherT2 = ( Toml.match (Toml._Left >>> Toml._String)-             <!> Toml.match (Toml._Right >>> Toml._Double)-               ) "either"--main :: IO ()-main = do-    TIO.putStrLn "=== Printing manually specified TOML ==="-    TIO.putStrLn $ pretty myToml--    TIO.putStrLn "=== Trying to print invalid TOML ==="-    content <- TIO.readFile "examples/invalid.toml"-    TIO.putStrLn $ case Toml.parse content of-        Left (ParseException e) -> e-        Right toml              -> pretty toml--    TIO.putStrLn "=== Testing bidirectional conversion ==="-    biFile <- TIO.readFile "examples/biTest.toml"-    TIO.putStrLn $ case Toml.decode testT biFile of-        Left msg   -> Toml.prettyException msg-        Right test -> Toml.encode testT test--myToml :: TOML-myToml = mkToml $ do-    "a" =: Bool True-    "list" =: Array ["one", "two"]-    "time" =: Array [Day (fromGregorian 2018 3 29)]-    table "table.name.1" $ do-        "aInner" =: 1-        "listInner" =: Array [Bool True, Bool False]-        table "1" $ do-            "aInner11" =: 11-            "listInner11" =: Array [0, 1]-        table "2" $-            "Inner12" =: "12"-    table "table.name.2" $-        "Inner2" =: 42

@@ -45,15 +45,17 @@ import qualified Data.Text as Text import qualified Data.Text.IO as TIO + -- | Type of exception for converting from TOML to user custom data type. data DecodeException     = TrivialError-    | BiMapError TomlBiMapError-    | KeyNotFound Key  -- ^ No such key-    | TableNotFound Key  -- ^ No such table-    | TypeMismatch Key Text TValue  -- ^ Expected type vs actual type-    | ParseError ParseException  -- ^ Exception during parsing-    deriving (Eq, Generic, NFData)+    | BiMapError !TomlBiMapError+    | KeyNotFound !Key  -- ^ No such key+    | TableNotFound !Key  -- ^ No such table+    | TypeMismatch !Key !Text !TValue  -- ^ Expected type vs actual type+    | ParseError !ParseException  -- ^ Exception during parsing+    deriving stock (Eq, Generic)+    deriving anyclass (NFData)  instance Show DecodeException where     show = Text.unpack . prettyException@@ -120,7 +122,7 @@ execTomlCodec codec obj = execState (runMaybeT $ codecWrite codec obj) mempty  -- | File loading error data type.-data LoadTomlException = LoadTomlException FilePath Text+data LoadTomlException = LoadTomlException !FilePath !Text  instance Show LoadTomlException where     show (LoadTomlException filePath msg) = "Couldnt parse file " ++ filePath ++ ": " ++ show msg

@@ -13,6 +13,7 @@        , natural        , int        , word+       , word8          -- ** Floating point numbers        , double        , float@@ -21,6 +22,8 @@        , lazyText        , byteString        , lazyByteString+       , byteStringArray+       , lazyByteStringArray        , string          -- ** Time types        , zonedTime@@ -44,6 +47,8 @@        , table        , nonEmpty        , list+       , set+       , hashSet           -- * General construction of codecs        , match@@ -66,24 +71,25 @@ import Data.Set (Set) import Data.Text (Text) import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)-import Data.Word (Word)+import Data.Word (Word8) import Numeric.Natural (Natural)  import Toml.Bi.Code (DecodeException (..), Env, St, TomlCodec, execTomlCodec)-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.Bi.Map (BiMap (..), TomlBiMap, _Array, _Bool, _ByteString, _ByteStringArray, _Day,+                    _Double, _EnumBounded, _Float, _HashSet, _Int, _IntSet, _Integer, _LByteString,+                    _LByteStringArray, _LText, _LocalTime, _Natural, _NonEmpty, _Read, _Set,+                    _String, _Text, _TextBy, _TimeOfDay, _Word, _Word8, _ZonedTime)+import Toml.Bi.Monad (Codec (..), dimap) 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 Data.HashSet as HS+import qualified Data.Set as S import qualified Data.Text.Lazy as L import qualified Toml.PrefixTree as Prefix - {- | General function to create bidirectional converters for key-value pairs. In order to use this function you need to create 'TomlBiMap' for your type and 'AnyValue':@@ -119,50 +125,70 @@ -- | Codec for boolean values. bool :: Key -> TomlCodec Bool bool = match _Bool+{-# INLINE bool #-}  -- | Codec for integer values. integer :: Key -> TomlCodec Integer integer = match _Integer+{-# INLINE integer #-}  -- | Codec for integer values. int :: Key -> TomlCodec Int int = match _Int+{-# INLINE int #-}  -- | Codec for natural values. natural :: Key -> TomlCodec Natural natural = match _Natural+{-# INLINE natural #-}  -- | Codec for word values. word :: Key -> TomlCodec Word word = match _Word+{-# INLINE word #-} +{- | Codec for word8 values.++@since 1.2.0.0+-}+word8 :: Key -> TomlCodec Word8+word8 = match _Word8+{-# INLINE word8 #-}+ -- | Codec for floating point values with double precision. double :: Key -> TomlCodec Double double = match _Double+{-# INLINE double #-}  -- | Codec for floating point values. float :: Key -> TomlCodec Float float = match _Float+{-# INLINE float #-}  -- | Codec for text values. text :: Key -> TomlCodec Text text = match _Text+{-# INLINE text #-}  -- | Codec for lazy text values. lazyText :: Key -> TomlCodec L.Text lazyText = match _LText+{-# INLINE lazyText #-}  -- | Codec for text values with custom error messages for parsing. textBy :: (a -> Text) -> (Text -> Either Text a) -> Key -> TomlCodec a textBy to from = match (_TextBy to from)+{-# INLINE textBy #-}  -- | Codec for string values. string :: Key -> TomlCodec String string = match _String+{-# INLINE string #-}  -- | Codec for values with a 'Read' and 'Show' instance. read :: (Show a, Read a) => Key -> TomlCodec a read = match _Read+{-# INLINE 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@@ -172,45 +198,71 @@ -} enumBounded :: (Bounded a, Enum a, Show a) => Key -> TomlCodec a enumBounded = match _EnumBounded+{-# INLINE enumBounded #-}  -- | Codec for text values as 'ByteString'. byteString :: Key -> TomlCodec ByteString byteString = match _ByteString+{-# INLINE byteString #-}  -- | Codec for text values as 'BL.ByteString'. lazyByteString :: Key -> TomlCodec BL.ByteString lazyByteString = match _LByteString+{-# INLINE lazyByteString #-} +{- | Codec for positive integer array values as 'ByteString'.++@since 1.2.0.0+-}+byteStringArray :: Key -> TomlCodec ByteString+byteStringArray = match _ByteStringArray+{-# INLINE byteStringArray #-}++{- | Codec for positive integer array values as lazy 'ByteString'.++@since 1.2.0.0+-}+lazyByteStringArray :: Key -> TomlCodec BL.ByteString+lazyByteStringArray = match _LByteStringArray+{-# INLINE lazyByteStringArray #-}+ -- | Codec for zoned time values. zonedTime :: Key -> TomlCodec ZonedTime zonedTime = match _ZonedTime+{-# INLINE zonedTime #-}  -- | Codec for local time values. localTime :: Key -> TomlCodec LocalTime localTime = match _LocalTime+{-# INLINE localTime #-}  -- | Codec for day values. day :: Key -> TomlCodec Day day = match _Day+{-# INLINE day #-}  -- | Codec for time of day values. timeOfDay :: Key -> TomlCodec TimeOfDay timeOfDay = match _TimeOfDay+{-# INLINE timeOfDay #-}  -- | Codec for list of values. Takes converter for single value and -- returns a list of values. arrayOf :: TomlBiMap a AnyValue -> Key -> TomlCodec [a] arrayOf = match . _Array+{-# INLINE arrayOf #-}  -- | Codec for sets. Takes converter for single value and -- returns a set of values. arraySetOf :: Ord a => TomlBiMap a AnyValue -> Key -> TomlCodec (Set a) arraySetOf = match . _Set+{-# INLINE arraySetOf #-}  -- | Codec for sets of ints. Takes converter for single value and -- returns a set of ints. arrayIntSet :: Key -> TomlCodec IntSet arrayIntSet = match _IntSet+{-# INLINE arrayIntSet #-}  -- | Codec for hash sets. Takes converter for single hashable value and -- returns a set of hashable values.@@ -220,11 +272,13 @@     -> Key     -> TomlCodec (HashSet a) arrayHashSetOf = match . _HashSet+{-# INLINE arrayHashSetOf #-}  -- | Codec for non- empty lists of values. Takes converter for single value and -- returns a non-empty list of values. arrayNonEmptyOf :: TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a) arrayNonEmptyOf = match . _NonEmpty+{-# INLINE arrayNonEmptyOf #-}  {- | Prepends given key to all errors that contain key. This function is used to give better error messages. So when error happens we know all pieces of table@@ -298,3 +352,20 @@   where     nonEmptyCodec :: TomlCodec (NonEmpty a)     nonEmptyCodec = nonEmpty codec key++{- | 'Codec' for set of values. Represented in TOML as array of tables.++@since 1.2.0.0+-}+set :: forall a . Ord a => TomlCodec a -> Key -> TomlCodec (Set a)+set codec key = dimap S.toList S.fromList (list codec key)+{-# INLINE set #-}++{- | 'Codec' for HashSet of values. Represented in TOML as array of tables.++@since 1.2.0.0+-}++hashSet :: forall a . (Hashable a, Eq a) => TomlCodec a -> Key -> TomlCodec (HashSet a)+hashSet codec key = dimap HS.toList HS.fromList (list codec key)+{-# INLINE hashSet #-}

@@ -21,18 +21,6 @@        , wrongConstructor        , prettyBiMapError -         -- * Helpers for BiMap and AnyValue-       , mkAnyValueBiMap-       , _TextBy-       , _LTextText-       , _NaturalInteger-       , _StringText-       , _ReadString-       , _BoundedInteger-       , _EnumBoundedText-       , _ByteStringText-       , _LByteStringText-          -- * Some predefined bi mappings        , _Array        , _Bool@@ -48,15 +36,29 @@        , _Read        , _Natural        , _Word+       , _Word8        , _Int        , _Float        , _ByteString        , _LByteString+       , _ByteStringArray+       , _LByteStringArray+       , _NonEmpty        , _Set        , _IntSet        , _HashSet-       , _NonEmpty +         -- * Helpers for BiMap and AnyValue+       , mkAnyValueBiMap+       , _TextBy+       , _LTextText+       , _NaturalInteger+       , _StringText+       , _ReadString+       , _BoundedInteger+       , _EnumBoundedText+       , _ByteStringText+       , _LByteStringText        , _Left        , _Right        , _EnumBounded@@ -76,7 +78,7 @@ import Data.Semigroup (Semigroup (..)) import Data.Text (Text) import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)-import Data.Word (Word)+import Data.Word (Word8) import GHC.Generics (Generic) import Numeric.Natural (Natural) import Text.Read (readEither)@@ -86,6 +88,7 @@                   matchZoned, mkMatchError, toMArray)  import qualified Control.Category as Cat+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import qualified Data.HashSet as HS import qualified Data.IntSet as IS@@ -125,16 +128,19 @@ instance Cat.Category (BiMap e) where     id :: BiMap e a a     id = BiMap Right Right+    {-# INLINE id #-}      (.) :: BiMap e b c -> BiMap e a b -> BiMap e a c     bc . ab = BiMap         { forward  =  forward ab >=>  forward bc         , backward = backward bc >=> backward ab         }+    {-# INLINE (.) #-}  -- | Inverts bidirectional mapping. invert :: BiMap e a b -> BiMap e b a invert (BiMap f g) = BiMap g f+{-# INLINE invert #-}  {- | Creates 'BiMap' from isomorphism. Can be used in the following way: @@ -154,6 +160,7 @@ -} iso :: (a -> b) -> (b -> a) -> BiMap e a b iso f g = BiMap (Right . f) (Right . g)+{-# INLINE iso #-}  {- | Creates 'BiMap' from prism-like pair of functions. This combinator can be used to create 'BiMap' for custom data types like this:@@ -175,8 +182,12 @@     other    -> Toml.'wrongConstructor' \"Client\" other @ -}-prism :: (field -> object) -> (object -> Either error field) -> BiMap error object field+prism+    :: (field -> object)+    -> (object -> Either error field)+    -> BiMap error object field prism review preview = BiMap preview (Right . review)+{-# INLINE prism #-}  ---------------------------------------------------------------------------- -- BiMap error types@@ -190,13 +201,14 @@     = WrongConstructor -- ^ Error for cases with wrong constructors. For                        -- example, you're trying to convert 'Left' but                        -- bidirectional converter expects 'Right'.-        Text           -- ^ Expected constructor name-        Text           -- ^ Actual value+        !Text          -- ^ Expected constructor name+        !Text          -- ^ Actual value     | WrongValue       -- ^ Error for cases with wrong values-        MatchError     -- ^ Information about failed matching+        !MatchError    -- ^ Information about failed matching     | ArbitraryError   -- ^ Arbitrary textual error-        Text           -- ^ Error message-    deriving (Eq, Show, Generic, NFData)+        !Text          -- ^ Error message+    deriving stock (Eq, Show, Generic)+    deriving anyclass (NFData)  -- | Converts 'TomlBiMapError' into pretty human-readable text. prettyBiMapError :: TomlBiMapError -> Text@@ -283,77 +295,91 @@ -} _Bool :: TomlBiMap Bool AnyValue _Bool = mkAnyValueBiMap matchBool Bool+{-# INLINE _Bool #-}  {- | 'Prelude.Integer' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.integer' combinator. -} _Integer :: TomlBiMap Integer AnyValue _Integer = mkAnyValueBiMap matchInteger Integer+{-# INLINE _Integer #-}  {- | 'Prelude.Double' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.double' combinator. -} _Double :: TomlBiMap Double AnyValue _Double = mkAnyValueBiMap matchDouble Double+{-# INLINE _Double #-}  {- | 'Data.Text.Text' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.text' combinator. -} _Text :: TomlBiMap Text AnyValue _Text = mkAnyValueBiMap matchText Text+{-# INLINE _Text #-}  -- | Helper bimap for 'Data.Text.Lazy.Text' and 'Data.Text.Text'. _LTextText :: BiMap e TL.Text Text _LTextText = iso TL.toStrict TL.fromStrict+{-# INLINE _LTextText #-}  {- | 'Data.Text.Lazy.Text' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.lazyText' combinator. -} _LText :: TomlBiMap TL.Text AnyValue _LText = _LTextText >>> _Text+{-# INLINE _LText #-}  {- | 'Data.Time.ZonedTime' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.zonedTime' combinator. -} _ZonedTime :: TomlBiMap ZonedTime AnyValue _ZonedTime = mkAnyValueBiMap matchZoned Zoned+{-# INLINE _ZonedTime #-}  {- | 'Data.Time.LocalTime' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.localTime' combinator. -} _LocalTime :: TomlBiMap LocalTime AnyValue _LocalTime = mkAnyValueBiMap matchLocal Local+{-# INLINE _LocalTime #-}  {- | 'Data.Time.Day' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.day' combinator. -} _Day :: TomlBiMap Day AnyValue _Day = mkAnyValueBiMap matchDay Day+{-# INLINE _Day #-}  {- | 'Data.Time.TimeOfDay' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.timeOfDay' combinator. -} _TimeOfDay :: TomlBiMap TimeOfDay AnyValue _TimeOfDay = mkAnyValueBiMap matchHours Hours+{-# INLINE _TimeOfDay #-}  -- | Helper bimap for 'String' and 'Data.Text.Text'. _StringText :: BiMap e String Text _StringText = iso T.pack T.unpack+{-# INLINE _StringText #-}  {- | 'String' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.string' combinator. -} _String :: TomlBiMap String AnyValue _String = _StringText >>> _Text+{-# INLINE _String #-}  -- | Helper bimap for 'String' and types with 'Read' and 'Show' instances. _ReadString :: (Show a, Read a) => TomlBiMap a String _ReadString = BiMap (Right . show) (first (ArbitraryError . T.pack) . readEither)+{-# INLINE _ReadString #-}  -- | Bimap for 'AnyValue' and values with a 'Read' and 'Show' instance. -- Usually used as 'Toml.Bi.Combinators.read' combinator. _Read :: (Show a, Read a) => TomlBiMap a AnyValue _Read = _ReadString >>> _String+{-# INLINE _Read #-}  -- | Helper bimap for 'Natural' and 'Prelude.Integer'. _NaturalInteger :: TomlBiMap Natural Integer@@ -369,6 +395,7 @@ -} _Natural :: TomlBiMap Natural AnyValue _Natural = _NaturalInteger >>> _Integer+{-# INLINE _Natural #-}  -- | Helper bimap for 'Prelude.Integer' and integral, bounded values. _BoundedInteger :: (Integral a, Bounded a, Show a) => TomlBiMap a Integer@@ -384,7 +411,7 @@          in Left $ ArbitraryError msg       | otherwise = Right (fromIntegral n) -{- | Helper bimap for 'EnumBounded' and 'Data.Text.Text'.+{- | Helper bimap for '_EnumBounded' and 'Data.Text.Text'.  @since 1.1.1.0 -}@@ -413,24 +440,37 @@ -} _EnumBounded :: (Show a, Enum a, Bounded a) => TomlBiMap a AnyValue _EnumBounded = _EnumBoundedText >>> _Text+{-# INLINE _EnumBounded #-}  {- | 'Word' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.word' combinator. -} _Word :: TomlBiMap Word AnyValue _Word = _BoundedInteger >>> _Integer+{-# INLINE _Word #-} +{- | 'Word8' bimap for 'AnyValue'. Usually used as+'Toml.Bi.Combinators.word8' combinator.++@since 1.2.0.0+-}+_Word8 :: TomlBiMap Word8 AnyValue+_Word8 = _BoundedInteger >>> _Integer+{-# INLINE _Word8 #-}+ {- | 'Int' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.int' combinator. -} _Int :: TomlBiMap Int AnyValue _Int = _BoundedInteger >>> _Integer+{-# INLINE _Int #-}  {- | 'Float' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.float' combinator. -} _Float :: TomlBiMap Float AnyValue _Float = iso realToFrac realToFrac >>> _Double+{-# INLINE _Float #-}  -- | Helper bimap for 'Data.Text.Text' and strict 'ByteString' _ByteStringText :: TomlBiMap ByteString Text@@ -438,11 +478,13 @@   where     eitherText :: ByteString -> Either TomlBiMapError Text     eitherText = either (\err -> Left $ ArbitraryError $ tShow err) Right . T.decodeUtf8'+{-# INLINE _ByteStringText #-}  -- | UTF8 encoded 'ByteString' bimap for 'AnyValue'. -- Usually used as 'Toml.Bi.Combinators.byteString' combinator. _ByteString :: TomlBiMap ByteString AnyValue _ByteString = _ByteStringText >>> _Text+{-# INLINE _ByteString #-}  -- | Helper bimap for 'Data.Text.Text' and lazy 'BL.ByteString'. _LByteStringText :: TomlBiMap BL.ByteString Text@@ -450,12 +492,32 @@   where     eitherText :: BL.ByteString -> Either TomlBiMapError Text     eitherText = bimap (ArbitraryError . tShow) TL.toStrict . TL.decodeUtf8'+{-# INLINE _LByteStringText #-}  -- | UTF8 encoded lazy 'BL.ByteString' bimap for 'AnyValue'. -- Usually used as 'Toml.Bi.Combinators.lazyByteString' combinator. _LByteString :: TomlBiMap BL.ByteString AnyValue _LByteString = _LByteStringText >>> _Text+{-# INLINE _LByteString #-} +{- | 'ByteString' bimap for 'AnyValue' encoded as a list of non-negative integers.+Usually used as 'Toml.Bi.Combinators.byteStringArray' combinator.++@since 1.2.0.0+-}+_ByteStringArray :: TomlBiMap ByteString AnyValue+_ByteStringArray = iso BS.unpack BS.pack >>> _Array _Word8+{-# INLINE _ByteStringArray #-}++{- | Lazy 'ByteString' bimap for 'AnyValue' encoded as a list of non-negative integers.+Usually used as 'Toml.Bi.Combinators.lazyByteStringArray' combinator.++@since 1.2.0.0+-}+_LByteStringArray :: TomlBiMap BL.ByteString AnyValue+_LByteStringArray = iso BL.unpack BL.pack >>>  _Array _Word8+{-# INLINE _LByteStringArray #-}+ -- | Takes a bimap of a value and returns a bimap between a list of values and 'AnyValue' -- as an array. Usually used as 'Toml.Bi.Combinators.arrayOf' combinator. _Array :: forall a . TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue@@ -477,28 +539,34 @@ -- as an array. Usually used as 'Toml.Bi.Combinators.nonEmpty' combinator. _NonEmpty :: TomlBiMap a AnyValue -> TomlBiMap (NE.NonEmpty a) AnyValue _NonEmpty bi = _NonEmptyArray >>> _Array bi+{-# INLINE _NonEmpty #-}  _NonEmptyArray :: TomlBiMap (NE.NonEmpty a) [a] _NonEmptyArray = BiMap     { forward  = Right . NE.toList     , backward = maybe (Left $ ArbitraryError "Empty array list, but expected NonEmpty") Right . NE.nonEmpty     }+{-# INLINE _NonEmptyArray #-}  -- | Takes a bimap of a value and returns a bimap between a set of values and 'AnyValue' -- as an array. Usually used as 'Toml.Bi.Combinators.arraySetOf' combinator. _Set :: (Ord a) => TomlBiMap a AnyValue -> TomlBiMap (S.Set a) AnyValue _Set bi = iso S.toList S.fromList >>> _Array bi+{-# INLINE _Set #-}  -- | Takes a bimap of a value and returns a bimap between a hash set of values and 'AnyValue' -- as an array. Usually used as 'Toml.Bi.Combinators.arrayHashSetOf' combinator. _HashSet :: (Eq a, Hashable a) => TomlBiMap a AnyValue -> TomlBiMap (HS.HashSet a) AnyValue _HashSet bi = iso HS.toList HS.fromList >>> _Array bi+{-# INLINE _HashSet #-}  {- | 'IS.IntSet' bimap for 'AnyValue'. Usually used as 'Toml.Bi.Combinators.arrayIntSet' combinator. -} _IntSet :: TomlBiMap IS.IntSet AnyValue _IntSet = iso IS.toList IS.fromList >>> _Array _Int+{-# INLINE _IntSet #-}  tShow :: Show a => a -> Text tShow = T.pack . show+{-# INLINE tShow #-}

@@ -6,6 +6,7 @@        , dimap        , dioptional        , diwrap+       , dimatch        , (<!>)        , (.=)        ) where@@ -54,6 +55,7 @@         { codecRead  = f <$> codecRead codec         , codecWrite = fmap f . codecWrite codec         }+    {-# INLINE fmap #-}  instance (Applicative r, Applicative w) => Applicative (Codec r w c) where     pure :: a -> Codec r w c a@@ -61,12 +63,14 @@         { codecRead  = pure a         , codecWrite = \_ -> pure a         }+    {-# INLINE pure #-}      (<*>) :: Codec r w c (a -> b) -> Codec r w c a -> Codec r w c b     codecf <*> codeca = Codec         { codecRead  = codecRead codecf <*> codecRead codeca         , codecWrite = \c -> codecWrite codecf c <*> codecWrite codeca c         }+    {-# INLINE (<*>) #-}  instance (Monad r, Monad w) => Monad (Codec r w c) where     (>>=) :: Codec r w c a -> (a -> Codec r w c b) -> Codec r w c b@@ -74,6 +78,7 @@         { codecRead  = codecRead codec >>= \a -> codecRead (f a)         , codecWrite = \c -> codecWrite codec c >>= \a -> codecWrite (f a) c         }+    {-# INLINE (>>=) #-}  instance (Alternative r, Alternative w) => Alternative (Codec r w c) where     empty :: Codec r w c a@@ -81,21 +86,26 @@         { codecRead  = empty         , codecWrite = \_ -> empty         }+    {-# INLINE empty #-}      (<|>) :: Codec r w c a -> Codec r w c a -> Codec r w c a     codec1 <|> codec2 = Codec         { codecRead  = codecRead codec1 <|> codecRead codec2         , codecWrite = \c -> codecWrite codec1 c <|> codecWrite codec2 c         }+    {-# INLINE (<|>) #-}  instance (MonadPlus r, MonadPlus w) => MonadPlus (Codec r w c) where     mzero = empty+    {-# INLINE mzero #-}     mplus = (<|>)+    {-# INLINE mplus #-}  -- | Alternative instance for function arrow but without 'empty'. infixl 3 <!> (<!>) :: Alternative f => (a -> f x) -> (a -> f x) -> (a -> f x) f <!> g = \a -> f a <|> g a+{-# INLINE (<!>) #-}  {- | This is an instance of @Profunctor@ for 'Codec'. But since there's no @Profunctor@ type class in @base@ or package with no dependencies (and we don't@@ -151,6 +161,7 @@     { codecRead  = g <$> codecRead codec     , codecWrite = fmap g . codecWrite codec . f     }+{-# INLINE dimap #-}  {- | Bidirectional converter for @Maybe a@ values. For example, given the data type:@@ -179,6 +190,7 @@     { codecRead  = optional codecRead     , codecWrite = traverse codecWrite     }+{-# INLINE dioptional #-}  {- | Combinator used for @newtype@ wrappers. For example, given the data types: @@ -206,7 +218,55 @@     => BiCodec r w a     -> BiCodec r w b diwrap = dimap coerce coerce+{-# INLINE diwrap #-} +{- | Bidirectional converter for @sum types@. For example, given the data+type:++@+__data__ Example+    = Foo Int+    | Bar Bool Int+@++the TOML codec will look like++@+matchFoo :: Example -> Maybe Int+matchFoo (Foo num) = Just num+matchFoo _         = Nothing++matchBar :: Example -> Maybe (Bool, Int)+matchBar (Bar b num) = Just (b, num)+matchBar _           = Nothing++barCodec :: TomlCodec (Bool, Int)+barCodec = (,)+    \<$\> Toml.bool "a" '.=' fst+    \<*\> Toml.int "b" '.=' snd++exampleCodec :: TomlCodec Example+exampleCodec =+    dimatch matchFoo Foo (Toml.int "foo")+    \<|\> dimatch matchBar (uncurry Bar) (Toml.table barCodec "bar")+@++@since 1.2.0.0+-}+dimatch+    :: (Functor r, Alternative w)+    => (c -> Maybe d) -- ^ Mapper for consumer+    -> (a -> b)       -- ^ Mapper for producer+    -> Codec r w d a  -- ^ Source 'Codec' object+    -> Codec r w c b  -- ^ Target 'Codec' object+dimatch match ctor codec = Codec+    { codecRead = ctor <$> codecRead codec+    , codecWrite = \c -> case match c of+        Nothing -> empty+        Just d  -> ctor <$> codecWrite codec d+    }+{-# INLINE dimatch #-}+ {- | Operator to connect two operations:  1. How to get field from object?@@ -229,3 +289,4 @@ infixl 5 .= (.=) :: Codec r w field a -> (object -> field) -> Codec r w object a codec .= getter = codec { codecWrite = codecWrite codec . getter }+{-# INLINE (.=) #-}

@@ -58,19 +58,24 @@ -- | Creates 'TOML' from the 'TDSL'. mkToml :: TDSL -> TOML mkToml env = execState env mempty+{-# INLINE mkToml #-}  -- | Creates an empty 'TDSL'. empty :: TDSL empty = put mempty+{-# INLINE empty #-}  -- | Adds key-value pair to the 'TDSL'. (=:) :: Key -> Value a -> TDSL (=:) k v = modify $ insertKeyVal k v+{-# INLINE (=:) #-}  -- | Adds table to the 'TDSL'. table :: Key -> TDSL -> TDSL table k = modify . insertTable k . mkToml+{-# INLINE table #-}  -- | Adds array of tables to the 'TDSL'. tableArray :: Key -> NonEmpty TDSL -> TDSL tableArray k = modify . insertTableArrays k . fmap mkToml+{-# INLINE tableArray #-}

@@ -116,16 +116,19 @@        ) where  import Data.Char (isLower, toLower)+import Data.Hashable (Hashable)+import Data.HashSet (HashSet) import Data.IntSet (IntSet) import Data.Kind (Type) import Data.List (stripPrefix) import Data.List.NonEmpty (NonEmpty) import Data.Proxy (Proxy (..))+import Data.Set (Set) 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 Data.Word (Word8) import GHC.Generics ((:*:) (..), (:+:), C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1,                      Selector (..)) import GHC.TypeLits (ErrorMessage (..), TypeError)@@ -230,6 +233,8 @@ -- Generic typeclasses ---------------------------------------------------------------------------- +{- | Helper class to derive TOML codecs generically.+-} class GenericCodec (f :: k -> Type) where     genericTomlCodec :: GenericOptions -> TomlCodec (f p) @@ -288,6 +293,8 @@ instance HasItemCodec Bool      where hasItemCodec = Left Toml._Bool instance HasItemCodec Int       where hasItemCodec = Left Toml._Int instance HasItemCodec Word      where hasItemCodec = Left Toml._Word+-- | @since 1.2.0.0+instance HasItemCodec Word8     where hasItemCodec = Left Toml._Word8 instance HasItemCodec Integer   where hasItemCodec = Left Toml._Integer instance HasItemCodec Natural   where hasItemCodec = Left Toml._Natural instance HasItemCodec Double    where hasItemCodec = Left Toml._Double@@ -322,6 +329,8 @@ instance HasCodec Bool      where hasCodec = Toml.bool instance HasCodec Int       where hasCodec = Toml.int instance HasCodec Word      where hasCodec = Toml.word+-- | @since 1.2.0.0+instance HasCodec Word8     where hasCodec = Toml.word8 instance HasCodec Integer   where hasCodec = Toml.integer instance HasCodec Natural   where hasCodec = Toml.natural instance HasCodec Double    where hasCodec = Toml.double@@ -346,6 +355,18 @@     hasCodec = case hasItemCodec @a of         Left prim   -> Toml.arrayNonEmptyOf prim         Right codec -> Toml.nonEmpty codec++-- | @since 1.2.0.0+instance (Ord a, HasItemCodec a) => HasCodec (Set a) where+    hasCodec = case hasItemCodec @a of+        Left prim   -> Toml.arraySetOf prim+        Right codec -> Toml.set codec++-- | @since 1.2.0.0+instance (Hashable a, Eq a, HasItemCodec a) => HasCodec (HashSet a) where+    hasCodec = case hasItemCodec @a of+        Left prim   -> Toml.arrayHashSetOf prim+        Right codec -> Toml.hashSet codec  {- TODO: uncomment when higher-kinded roles will be implemented

@@ -8,18 +8,22 @@        ) where  import Control.DeepSeq (NFData)-import Data.Text (Text, pack)+import Data.Text (Text) import GHC.Generics (Generic) -import Toml.Parser.TOML (tomlP)+import Toml.Parser.Item (tomlP)+import Toml.Parser.Validate (validateItems) import Toml.Type (TOML) +import qualified Data.Text as T import qualified Toml.Parser.Core as P (errorBundlePretty, parse)   -- | Pretty parse exception for parsing toml.-newtype ParseException = ParseException Text-    deriving (Show, Eq, Generic, NFData)+newtype ParseException = ParseException+    { unParseException :: Text+    } deriving stock (Show, Generic)+      deriving newtype (Eq, NFData)  {- | Parses 'Text' as 'TOML' AST object. If you want to convert 'Text' to your custom haskell data type, use 'Toml.Bi.Code.decode' or 'Toml.Bi.Code.decodeFile'@@ -27,5 +31,7 @@ -} parse :: Text -> Either ParseException TOML parse t = case P.parse tomlP "" t of-    Left err   -> Left $ ParseException $ pack $ P.errorBundlePretty err-    Right toml -> Right toml+    Left err    -> Left $ ParseException $ T.pack $ P.errorBundlePretty err+    Right items -> case validateItems items of+        Left err   -> Left $ ParseException $ T.pack $ show err+        Right toml -> Right toml

@@ -0,0 +1,104 @@+{-| This module contains the definition of the 'TomlItem' data type which+represents either key-value pair or table name. This data type serves the+purpose to be the intermediate representation of parsing a TOML file which will+be assembled to TOML AST later.++@since 1.2.0.0+-}++module Toml.Parser.Item+       ( TomlItem (..)+       , Table (..)+       , setTableName++       , tomlP+       ) where++import Control.Applicative (liftA2, many)+import Control.Applicative.Combinators.NonEmpty (sepEndBy1)+import Control.Monad.Combinators (between, sepEndBy)+import Data.Foldable (asum)+import Data.List.NonEmpty (NonEmpty)++import Toml.Parser.Core (Parser, eof, sc, text, try, (<?>))+import Toml.Parser.Key (keyP, tableArrayNameP, tableNameP)+import Toml.Parser.Value (anyValueP)+import Toml.PrefixTree (Key)+import Toml.Type (AnyValue)+++{- | One item of a TOML file. It could be either:++* A name of a table+* A name of a table array+* Key-value pair+* Inline table+* Inline array of tables++Knowing a list of 'TomlItem's, it's possible to construct 'Toml.Type.TOML.TOML'+from this information.+-}+data TomlItem+    = TableName !Key+    | TableArrayName !Key+    | KeyVal !Key !AnyValue+    | InlineTable !Key !Table+    | InlineTableArray !Key !(NonEmpty Table)+    deriving stock (Show, Eq)++{- | Changes name of table to a new one. Works only for 'TableName' and+'TableArrayName' constructors.+-}+setTableName :: Key -> TomlItem -> TomlItem+setTableName new = \case+    TableName _ -> TableName new+    TableArrayName _ -> TableArrayName new+    item -> item++{- | Table that contains only @key = val@ pairs.+-}+newtype Table = Table+    { unTable :: [(Key, AnyValue)]+    } deriving stock (Show)+      deriving newtype (Eq)++----------------------------------------------------------------------------+-- Parser+----------------------------------------------------------------------------++-- | Parser for inline tables.+inlineTableP :: Parser Table+inlineTableP =+    fmap Table+    $ between (text "{") (text "}")+    $ (liftA2 (,) (keyP <* text "=") anyValueP) `sepEndBy` text ","++-- | Parser for inline arrays of tables.+inlineTableArrayP :: Parser (NonEmpty Table)+inlineTableArrayP = between (text "[") (text "]")+    $ inlineTableP `sepEndBy1` text ","++-- | Parser for a single item in the TOML file.+tomlItemP :: Parser TomlItem+tomlItemP = asum+    [ TableName <$> try tableNameP <?> "table name"+    , TableArrayName <$> tableArrayNameP <?> "array of tables name"+    , keyValP+    ]+  where+    -- parser for "key = val" pairs; can be one of three forms:+    -- 1. key = { ... }+    -- 2. key = [ {...}, {...}, ... ]+    -- 3. key = ...+    keyValP :: Parser TomlItem+    keyValP = do+        key <- keyP <* text "="+        asum+            [ InlineTable key <$> inlineTableP <?> "inline table"+            , InlineTableArray key <$> try inlineTableArrayP <?> "inline array of tables"+            , KeyVal key <$> anyValueP <?> "key-value pair"+            ]++-- | Parser for the full content of the .toml file.+tomlP :: Parser [TomlItem]+tomlP = sc *> many tomlItemP <* eof

@@ -0,0 +1,51 @@+{- | Parsers for keys and table names.++@since 1.2.0.0+-}++module Toml.Parser.Key+       ( keyP+       , tableNameP+       , tableArrayNameP+       ) where++import Control.Applicative (Alternative (..))+import Control.Applicative.Combinators.NonEmpty (sepBy1)+import Control.Monad.Combinators (between)+import Data.Semigroup ((<>))+import Data.Text (Text)++import Toml.Parser.Core (Parser, alphaNumChar, char, lexeme, text)+import Toml.Parser.String (basicStringP, literalStringP)+import Toml.PrefixTree (Key (..), Piece (..))++import qualified Data.Text as Text+++-- | Parser for bare key piece, like @foo@.+bareKeyPieceP :: Parser Text+bareKeyPieceP = lexeme $ Text.pack <$> bareStrP+  where+    bareStrP :: Parser String+    bareStrP = some $ alphaNumChar <|> char '_' <|> char '-'++-- | Parser for 'Piece'.+keyComponentP :: Parser Piece+keyComponentP = Piece <$>+    (bareKeyPieceP <|> (quote "\"" <$> basicStringP) <|> (quote "'" <$> literalStringP))+  where+    -- adds " or ' to both sides+    quote :: Text -> Text -> Text+    quote q t = q <> t <> q++-- | Parser for 'Key': dot-separated list of 'Piece'.+keyP :: Parser Key+keyP = Key <$> keyComponentP `sepBy1` char '.'++-- | Parser for table name: 'Key' inside @[]@.+tableNameP :: Parser Key+tableNameP = between (text "[") (text "]") keyP++-- | Parser for array of tables name: 'Key' inside @[[]]@.+tableArrayNameP :: Parser Key+tableArrayNameP = between (text "[[") (text "]]") keyP

@@ -1,134 +0,0 @@-{- | Parser for 'TOML' data type: keys, tables, array of tables. Uses value-parsers from "Toml.Parser.Value".--}--module Toml.Parser.TOML-       ( keyP-       , tomlP-       ) where--import Control.Applicative (Alternative (..))-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, eof, lexeme, sc, text, try)-import Toml.Parser.String (basicStringP, literalStringP)-import Toml.Parser.Value (anyValueP)-import Toml.PrefixTree (Key (..), KeysDiff (..), Piece (..), keysDiff, single)-import Toml.Type (AnyValue, TOML (..))--import qualified Control.Applicative.Combinators.NonEmpty as NC-import qualified Data.HashMap.Lazy as HashMap-import qualified Data.Text as Text----- | Parser for bare key piece, like @foo@.-bareKeyPieceP :: Parser Text-bareKeyPieceP = lexeme $ Text.pack <$> bareStrP-  where-    bareStrP :: Parser String-    bareStrP = some $ alphaNumChar <|> char '_' <|> char '-'---- | Parser for 'Piece'.-keyComponentP :: Parser Piece-keyComponentP = Piece <$>-    (bareKeyPieceP <|> (quote "\"" <$> basicStringP) <|> (quote "'" <$> literalStringP))-  where-    -- adds " or ' to both sides-    quote :: Text -> Text -> Text-    quote q t = q <> t <> q---- | Parser for 'Key': dot-separated list of 'Piece'.-keyP :: Parser Key-keyP = Key <$> keyComponentP `NC.sepBy1` char '.'---- | Parser for table name: 'Key' inside @[]@.-tableNameP :: Parser Key-tableNameP = between (text "[") (text "]") keyP---- | Parser for array of tables name: 'Key' inside @[[]]@.-tableArrayNameP :: Parser Key-tableArrayNameP = between (text "[[") (text "]]") keyP---- Helper functions for building TOML-tomlKV :: Key -> AnyValue -> TOML-tomlKV k v = mempty { tomlPairs = HashMap.singleton k v }--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 "}") $-    mconcat <$>-    (tomlKV <$> (keyP <* text "=") <*> anyValueP ) `sepEndBy` text ","---- | Parser for inline arrays of tables.-inlineTableArrayP :: Parser (NonEmpty TOML)-inlineTableArrayP = between (text "[") (text "]") $-    inlineTableP `NC.sepEndBy1` text ","---- | 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 = sc *> localTomlP Nothing <* eof---- | Parser for a toml under a certain key-localTomlP :: Maybe Key -> Parser TOML-localTomlP key = mconcat <$> many (subArray <|> subTable <|> (try $ hasKeyP key))-  where-    subTable :: Parser TOML-    subTable = do-        (kDiff, k) <- try $ childKeyP key tableNameP-        tomlT kDiff <$> localTomlP (Just k)--    subArray :: Parser TOML-    subArray = do-        (kDiff, k) <- try $ childKeyP key tableArrayNameP-        tomlA kDiff <$> tableArrayP k---- | @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 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 -> Parser Key-sameKeyP key parser = try $ do-    k <- parser-    case keysDiff key k of-        Equal -> pure k-        _     -> fail $ show k ++ " is not the same as " ++ show key

@@ -0,0 +1,181 @@+{- | This module contains functions that aggregate the result of+'Toml.Parser.Item.tomlP' parser into 'TOML'. This approach allows to keep parser+fast and simple and delegate the process of creating tree structure to a+separate function.++@since 1.2.0.0+-}++module Toml.Parser.Validate+       ( -- * Decoding+         validateItems+       , ValidationError (..)++         -- * Internal helpers+       , groupItems+       , groupWithParent+       , validateItemForest+       ) where++import Data.Bifunctor (first)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Semigroup ((<>))+import Data.Tree (Forest, Tree (..))++import Toml.Parser.Item (Table (..), TomlItem (..), setTableName)+import Toml.PrefixTree (Key, KeysDiff (FstIsPref), keysDiff)+import Toml.Type (TOML (..), insertKeyAnyVal, insertTable, insertTableArrays)++import qualified Data.HashMap.Strict as HashMap+import qualified Toml.PrefixTree as PrefixMap+++{- | Validate list of 'TomlItem's and convert to 'TOML' if not validation+errors are found.+-}+validateItems :: [TomlItem] -> Either ValidationError TOML+validateItems = validateItemForest . groupItems++----------------------------------------------------------------------------+-- Grouping+----------------------------------------------------------------------------++{- | This function takes flat list of 'TomlItem's and groups it into list of+'Tree's by putting all corresponding items inside tables and table arrays.  It+doesn't perform any validation, just groups items according to prefixes of their+keys. So, for example, if you have the following keys as flat list:++@+aaa              # ordinary key+aaa.bbb          # ordinary key+[foo]            # table nam+foo.bar+foo.baz+[xxx]            # table name+[xxx.yyy]        # table name+zzz+@++the following tree structure will be created:++@+aaa+aaa.bbb+[foo]+├──── foo.bar+└──── foo.baz+[xxx]+└──── [yyy]+      └──── zzz+@+-}+groupItems :: [TomlItem] -> Forest TomlItem+groupItems = fst . groupWithParent Nothing++{- | This function groups list of TOML items into 'Forest' and returns list of+items that are not children of specified parent.++__Invariant:__ When this function is called with 'Nothing', second element in+the result tuple should be empty list.+-}+groupWithParent+    :: Maybe Key   -- ^ Parent name+    -> [TomlItem]  -- ^ List of items+    -> (Forest TomlItem, [TomlItem])  -- ^ Forest of times and remaining items+groupWithParent _ [] = ([], [])+groupWithParent parent (item:items) = case item of+    KeyVal{}            -> Node item [] <:> groupWithParent parent items+    InlineTable{}       -> Node item [] <:> groupWithParent parent items+    InlineTableArray{}  -> Node item [] <:> groupWithParent parent items+    TableName name      -> groupTable item name+    TableArrayName name -> groupTable item name+  where+    -- prepend to the first list, just to remove some code noise+    (<:>) :: a -> ([a], b) -> ([a], b)+    a <:> tup = first (a :) tup++    -- takes table item and its name, collects all children into table subforest+    -- and returns all elements after the table+    groupTable :: TomlItem -> Key -> (Forest TomlItem, [TomlItem])+    groupTable tableItem tableName = case parent of+        Nothing -> tableWithChildren tableName+        Just parentKey -> case keysDiff parentKey tableName of+            FstIsPref diff -> tableWithChildren diff+            _              -> ([], item:items)+      where+        tableWithChildren :: Key -> (Forest TomlItem, [TomlItem])+        tableWithChildren newName =+            let (children, rest) = groupWithParent (Just tableName) items+                newItem = setTableName newName tableItem+            in Node newItem children <:> groupWithParent parent rest++----------------------------------------------------------------------------+-- Decoding+----------------------------------------------------------------------------++{- | Error that happens during validating TOML which is already syntactically+correct. For the list of all possible validation errors and their explanation,+see the following issue on GitHub:++* https://github.com/kowainik/tomland/issues/5+-}++data ValidationError+    = DuplicateKey !Key+    | DuplicateTable !Key+    | SameNameKeyTable !Key+    | SameNameTableArray !Key+    deriving stock (Show, Eq)++{- | Construct 'TOML' from the 'Forest' of 'TomlItem' and performing validation+of TOML at the same time.+-}+validateItemForest :: Forest TomlItem -> Either ValidationError TOML+validateItemForest = go mempty+  where+    go :: TOML -> Forest TomlItem -> Either ValidationError TOML+    go toml [] = Right toml+    go toml@TOML{..} (node:nodes) = case rootLabel node of+        -- ignore subforest here+        KeyVal key val -> do+            HashMap.lookup key tomlPairs `errorOnJust` DuplicateKey key+            PrefixMap.lookup key tomlTables `errorOnJust` SameNameKeyTable key+            go (insertKeyAnyVal key val toml) nodes++        -- ignore subforest here+        InlineTable key table -> do+            HashMap.lookup key tomlPairs `errorOnJust` SameNameKeyTable key+            PrefixMap.lookup key tomlTables `errorOnJust` DuplicateTable key+            tableToml <- createTomlFromTable table+            go (insertTable key tableToml toml) nodes++        -- ignore subforest here+        InlineTableArray key tables -> do+            PrefixMap.lookup key tomlTables `errorOnJust` SameNameTableArray key+            arrayToml <- mapM createTomlFromTable tables+            go (insertTableArrays key arrayToml toml) nodes++        TableName key -> do+            HashMap.lookup key tomlPairs `errorOnJust` SameNameKeyTable key+            PrefixMap.lookup key tomlTables `errorOnJust` DuplicateTable key+            subTable <- go mempty (subForest node)+            go (insertTable key subTable toml) nodes++        TableArrayName key -> do+            PrefixMap.lookup key tomlTables `errorOnJust` SameNameTableArray key+            subTable <- go mempty (subForest node)+            let newArray = case HashMap.lookup key tomlTableArrays of+                    Nothing  -> HashMap.insert key (subTable :| []) tomlTableArrays+                    Just arr ->+                        HashMap.insert key (arr <> (subTable :| [])) tomlTableArrays+            go (toml { tomlTableArrays = newArray }) nodes++    createTomlFromTable :: Table -> Either ValidationError TOML+    createTomlFromTable (Table table) =+        go mempty $ map (\(k, v) -> Node (KeyVal k v) []) table++++errorOnJust :: Maybe a -> e -> Either e ()+errorOnJust (Just _) e = Left e+errorOnJust Nothing  _ = Right ()

@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveAnyClass             #-}-{-# LANGUAGE DerivingStrategies         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PatternSynonyms            #-}+{-# LANGUAGE DeriveAnyClass  #-}+{-# LANGUAGE PatternSynonyms #-}  -- | Implementation of prefix tree for TOML AST. @@ -53,9 +51,10 @@   -- | Represents the key piece of some layer.-newtype Piece = Piece { unPiece :: Text }-    deriving stock (Generic)-    deriving newtype (Show, Eq, Ord, Hashable, IsString, NFData)+newtype Piece = Piece+    { unPiece :: Text+    } deriving stock (Generic)+      deriving newtype (Show, Eq, Ord, Hashable, IsString, NFData)  {- | Key of value in @key = val@ pair. Represents as non-empty list of key components — 'Piece's. Key like@@ -70,9 +69,10 @@ Key (Piece "site" :| [Piece "\\"google.com\\""]) @ -}-newtype Key = Key { unKey :: NonEmpty Piece }-    deriving stock (Generic)-    deriving newtype (Show, Eq, Ord, Hashable, NFData, Semigroup)+newtype Key = Key+    { unKey :: NonEmpty Piece+    } deriving stock (Generic)+      deriving newtype (Show, Eq, Ord, Hashable, NFData, Semigroup)  {- | Split a dot-separated string into 'Key'. Empty string turns into a 'Key' with single element — empty 'Piece'.@@ -113,7 +113,8 @@         !Prefix        -- ^ Greatest common key prefix.         !(Maybe a)     -- ^ Possible value at that point.         !(PrefixMap a) -- ^ Values at suffixes of the prefix.-    deriving (Show, Eq, NFData, Generic)+    deriving stock (Show, Eq, Generic)+    deriving anyclass (NFData)  instance Semigroup (PrefixTree a) where     a <> b = foldl' (\tree (k, v) -> insertT k v tree) a (toListT b)@@ -130,7 +131,7 @@         !Key     -- ^ Common prefix.         !Key     -- ^ Rest of the first key.         !Key     -- ^ Rest of the second key.-    deriving (Show, Eq)+    deriving stock (Show, Eq)  -- | Compares two keys keysDiff :: Key -> Key -> KeysDiff@@ -150,10 +151,12 @@ -- | Prepends 'Piece' to the beginning of the 'Key'. (<|) :: Piece -> Key -> Key (<|) p k = Key (p NonEmpty.<| unKey k)+{-# INLINE (<|) #-}  -- | Creates a 'PrefixTree' of one key-value element. singleT :: Key -> a -> PrefixTree a singleT = Leaf+{-# INLINE singleT #-}  -- | Creates a 'PrefixMap' of one key-value element. single :: Key -> a -> PrefixMap a

@@ -13,7 +13,7 @@ import Data.Bifunctor (first) import Data.Function (on) import Data.HashMap.Strict (HashMap)-import Data.List (sortBy, splitAt)+import Data.List (sortBy) import Data.List.NonEmpty (NonEmpty) import Data.Monoid ((<>)) import Data.Text (Text)@@ -25,6 +25,7 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text as Text+  {- | Configures the pretty printer. -} data PrintOptions = PrintOptions

@@ -52,9 +52,10 @@  -- | Value type mismatch error. data MatchError = MatchError-    { valueExpected :: TValue-    , valueActual   :: AnyValue-    } deriving (Eq, Show, Generic, NFData)+    { valueExpected :: !TValue+    , valueActual   :: !AnyValue+    } deriving stock (Eq, Show, Generic)+      deriving anyclass (NFData)  -- | Helper function to create 'MatchError'. mkMatchError :: TValue -> Value t -> Either MatchError a@@ -68,46 +69,55 @@ matchBool :: Value t -> Either MatchError Bool matchBool (Bool b) = Right b matchBool value    = mkMatchError TBool value+{-# INLINE matchBool #-}  -- | Extract 'Prelude.Integer' from 'Value'. matchInteger :: Value t -> Either MatchError Integer matchInteger (Integer n) = Right n matchInteger value       = mkMatchError TInteger value+{-# INLINE matchInteger #-}  -- | Extract 'Prelude.Double' from 'Value'. matchDouble :: Value t -> Either MatchError Double matchDouble (Double f) = Right f matchDouble value      = mkMatchError TDouble value+{-# INLINE matchDouble #-}  -- | Extract 'Data.Text.Text' from 'Value'. matchText :: Value t -> Either MatchError Text matchText (Text s) = Right s matchText value    = mkMatchError TText value+{-# INLINE matchText #-}  -- | Extract 'Data.Time.ZonedTime' from 'Value'. matchZoned :: Value t -> Either MatchError ZonedTime matchZoned (Zoned d) = Right d matchZoned value     = mkMatchError TZoned value+{-# INLINE matchZoned #-}  -- | Extract 'Data.Time.LocalTime' from 'Value'. matchLocal :: Value t -> Either MatchError LocalTime matchLocal (Local d) = Right d matchLocal value     = mkMatchError TLocal value+{-# INLINE matchLocal #-}  -- | Extract 'Data.Time.Day' from 'Value'. matchDay :: Value t -> Either MatchError Day matchDay (Day d) = Right d matchDay value   = mkMatchError TDay value+{-# INLINE matchDay #-}  -- | Extract 'Data.Time.TimeOfDay' from 'Value'. matchHours :: Value t -> Either MatchError TimeOfDay matchHours (Hours d) = Right d matchHours value     = mkMatchError THours value+{-# INLINE matchHours #-}  -- | Extract list of elements of type @a@ from array. matchArray :: (AnyValue -> Either MatchError a) -> Value t -> Either MatchError [a] matchArray matchValue (Array a) = mapM (applyAsToAny matchValue) a matchArray _          value     = mkMatchError TArray value+{-# INLINE matchArray #-}  -- | Make function that works with 'AnyValue' also work with specific 'Value'. applyAsToAny :: (AnyValue -> r) -> (Value t -> r)

@@ -86,37 +86,49 @@ @ -} data TOML = TOML-    { tomlPairs       :: HashMap Key AnyValue-    , tomlTables      :: PrefixMap TOML-    , tomlTableArrays :: HashMap Key (NonEmpty TOML)-    } deriving (Show, Eq, NFData, Generic)+    { tomlPairs       :: !(HashMap Key AnyValue)+    , tomlTables      :: !(PrefixMap TOML)+    , tomlTableArrays :: !(HashMap Key (NonEmpty TOML))+    } deriving stock (Show, Eq, Generic)+      deriving anyclass (NFData)  instance Semigroup TOML where-    (TOML pairsA tablesA arraysA) <> (TOML pairsB tablesB arraysB) = TOML+    (<>) :: TOML -> TOML -> TOML+    TOML pairsA tablesA arraysA <> TOML pairsB tablesB arraysB = TOML         (pairsA <> pairsB)         (HashMap.unionWith (<>) tablesA tablesB)         (arraysA <> arraysB)+    {-# INLINE (<>) #-}  instance Monoid TOML where-    mappend = (<>)+    mempty :: TOML     mempty = TOML mempty mempty mempty+    {-# INLINE mempty #-} +    mappend :: TOML -> TOML -> TOML+    mappend = (<>)+    {-# INLINE mappend #-}+ -- | Inserts given key-value into the 'TOML'. insertKeyVal :: Key -> Value a -> TOML -> TOML insertKeyVal k v = insertKeyAnyVal k (AnyValue v)+{-# INLINE insertKeyVal #-}  -- | Inserts given key-value into the 'TOML'. insertKeyAnyVal :: Key -> AnyValue -> TOML -> TOML-insertKeyAnyVal k av toml =toml { tomlPairs = HashMap.insert k av (tomlPairs toml) }+insertKeyAnyVal k av toml = toml { tomlPairs = HashMap.insert k av (tomlPairs toml) }+{-# INLINE insertKeyAnyVal #-}  -- | Inserts given table into the 'TOML'. insertTable :: Key -> TOML -> TOML -> TOML insertTable k inToml toml = toml     { tomlTables = Prefix.insert k inToml (tomlTables toml)     }+{-# INLINE insertTable #-}  -- | Inserts given array of tables into the 'TOML'. insertTableArrays :: Key -> NonEmpty TOML -> TOML -> TOML insertTableArrays k arr toml = toml     { tomlTableArrays = HashMap.insert k arr (tomlTableArrays toml)     }+{-# INLINE insertTableArrays #-}

@@ -14,6 +14,7 @@ import Toml.Type.AnyValue (AnyValue (..)) import Toml.Type.Value (TypeMismatchError, Value (..), sameValue) + -- | Untyped value of @TOML@. You shouldn't use this type in your code. Use -- 'Value' instead. data UValue@@ -26,7 +27,7 @@     | UDay !Day     | UHours !TimeOfDay     | UArray ![UValue]-    deriving (Show)+    deriving stock (Show)  instance Eq UValue where     (UBool b1)    == (UBool b2)    = b1 == b2

@@ -30,9 +30,20 @@ import Data.Type.Equality ((:~:) (..)) import GHC.Generics (Generic) + -- | Needed for GADT parameterization-data TValue = TBool | TInteger | TDouble | TText | TZoned | TLocal | TDay | THours | TArray-    deriving (Eq, Show, Read, NFData, Generic)+data TValue+    = TBool+    | TInteger+    | TDouble+    | TText+    | TZoned+    | TLocal+    | TDay+    | THours+    | TArray+    deriving stock (Eq, Show, Read, Generic)+    deriving anyclass (NFData)  -- | Convert 'TValue' constructors to 'String' without @T@ prefix. showType :: TValue -> String@@ -167,7 +178,7 @@     -}     Array  :: [Value t] -> Value 'TArray -deriving instance Show (Value t)+deriving stock instance Show (Value t)  instance NFData (Value t) where     rnf (Bool n)    = rnf n@@ -190,6 +201,7 @@  instance (t ~ 'TText) => IsString (Value t) where     fromString = Text . fromString @Text+    {-# INLINE fromString #-}  instance Eq (Value t) where     (Bool b1)    == (Bool b2)    = b1 == b2@@ -231,9 +243,9 @@  -- | Data type that holds expected vs. actual type. data TypeMismatchError = TypeMismatchError-  { typeExpected :: TValue-  , typeActual   :: TValue-  } deriving (Eq)+  { typeExpected :: !TValue+  , typeActual   :: !TValue+  } deriving stock (Eq)  instance Show TypeMismatchError where     show TypeMismatchError{..} = "Expected type '" ++ showType typeExpected

@@ -25,6 +25,7 @@ import qualified Hedgehog.Range as Range import qualified Toml + test_encodeDecodeProp :: PropertyTest test_encodeDecodeProp = prop "decode . encode == id" $ do     bigType <- forAll genBigType@@ -55,11 +56,12 @@     , btNewtype       :: !BigTypeNewtype     , btSum           :: !BigTypeSum     , btRecord        :: !BigTypeRecord-    } deriving (Show, Eq)+    } deriving stock (Show, Eq)  -- | Wrapper over 'Double' and 'Float' to be equal on @NaN@ values.-newtype Batman a = Batman a-    deriving (Show)+newtype Batman a = Batman+    { unBatman :: a+    } deriving stock (Show)  instance RealFloat a => Eq (Batman a) where     Batman a == Batman b =@@ -67,19 +69,22 @@             then isNaN b             else a == b -newtype BigTypeNewtype = BigTypeNewtype ZonedTime-    deriving (Show)+newtype BigTypeNewtype = BigTypeNewtype+    { unBigTypeNewtype :: ZonedTime+    } deriving stock (Show)  instance Eq BigTypeNewtype where     (BigTypeNewtype a) == (BigTypeNewtype b) = zonedTimeToUTC a == zonedTimeToUTC b -data BigTypeSum = BigTypeSumA Integer | BigTypeSumB Text-    deriving (Show, Eq)+data BigTypeSum+    = BigTypeSumA !Integer+    | BigTypeSumB !Text+    deriving stock (Show, Eq)  data BigTypeRecord = BigTypeRecord-    { btrBoolSet     :: Set Bool-    , btrNewtypeList :: [BigTypeSum]-    } deriving (Show, Eq)+    { btrBoolSet     :: !(Set Bool)+    , btrNewtypeList :: ![BigTypeSum]+    } deriving stock (Show, Eq)  bigTypeCodec :: TomlCodec BigType bigTypeCodec = BigType

@@ -39,6 +39,7 @@     , prop "Natural" (testBiMap B._Natural G.genNatural)     , prop "Int" (testBiMap B._Int G.genInt)     , prop "Word" (testBiMap B._Word G.genWord)+    , prop "Word8" (testBiMap B._Word8 G.genWord8)     , prop "Double" testDouble     , prop "Float" (testBiMap B._Float G.genFloat)     , prop "Text" (testBiMap B._Text G.genText)@@ -47,6 +48,8 @@     , prop "Read (Integer)" (testBiMap B._Read G.genInteger)     , prop "ByteString" (testBiMap B._ByteString G.genByteString)     , prop "Lazy ByteString" (testBiMap B._LByteString G.genLByteString)+    , prop "ByteStringArray" (testBiMap B._ByteStringArray G.genByteString)+    , prop "Lazy ByteStringArray" (testBiMap B._LByteStringArray G.genLByteString)     , prop "ZonedTime" (testBiMap B._ZonedTime G.genZoned)     , prop "LocalTime" (testBiMap B._LocalTime G.genLocal)     , prop "TimeOfDay" (testBiMap B._TimeOfDay G.genHours)

@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds           #-}+{-# LANGUAGE MultiWayIf          #-} {-# LANGUAGE PatternSynonyms     #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications    #-}@@ -17,6 +18,7 @@        , genInteger        , genDouble        , genWord+       , genWord8        , genNatural        , genFloat @@ -61,6 +63,7 @@ import Data.Text (Text) import Data.Time (Day, LocalTime (..), TimeOfDay (..), ZonedTime (..), fromGregorian,                   minutesToTimeZone)+import Data.Word (Word8) import GHC.Exts (fromList) import GHC.Stack (HasCallStack) import Hedgehog (Gen, GenBase, MonadGen, PropertyT, Range, property)@@ -102,7 +105,7 @@ genVal = Gen.int (Range.constant 0 256)  -- | Generates random value of 'AnyValue' type.-genAnyValue :: MonadGen m => m AnyValue+genAnyValue :: (MonadGen m, GenBase m ~ Identity) => m AnyValue genAnyValue = Gen.choice $     (AnyValue <$> genArray) : noneArrayList @@ -126,7 +129,7 @@     quotedWith c = wrapChar c <$> Gen.text (Range.constant 1 10) (Gen.filter (/= c) notControl)      quoted :: m Text-    quoted = Gen.choice [quotedWith '"', quotedWith '\'']+    quoted = genNotEscape $ Gen.choice [quotedWith '"', quotedWith '\'']  genKey :: (MonadGen m, GenBase m ~ Identity) => m Key genKey = Key <$> Gen.nonEmpty (Range.constant 1 10) genPiece@@ -234,6 +237,9 @@ genWord :: MonadGen m => m Word genWord = Gen.word Range.constantBounded +genWord8 :: MonadGen m => m Word8+genWord8 = Gen.word8 Range.constantBounded+ genNatural :: MonadGen m => m Natural genNatural = fromIntegral <$> genWord @@ -286,7 +292,7 @@  -- | Generates text from different symbols. genText :: MonadGen m => m Text-genText =  fmap Text.concat $ Gen.list (Range.constant 0 256) $ Gen.choice+genText = genNotEscape $ fmap Text.concat $ Gen.list (Range.constant 0 256) $ Gen.choice     [ Text.singleton <$> Gen.alphaNum     , genEscapeSequence     , genPunctuation@@ -332,7 +338,16 @@ Nested array of AnyValue: Array [Array [Text "ACyz38VcLz0hxwdFkHTU6PYK8h8CeaiEpI2xAaiZTKBQ3zC1W717cZY35lk8EAK6pPw3WvwIdNktxIV2LrvFSpU8ee6zkXvpvePitW9aspAeeOCF9Q9ry20y7skFZ2qShi7CSx8888zWIqyc8iBkoLNvq4fONLtuUqSw2SlNee4hDIwrnx5O4RuHW1dQfJcnC34h9S0DlIGYP08qq6QHxO4E0HE74cNmiViGm3xpDC8Ro5D8Y6p0FLSN1ELq9Lwm",Text "HhNv0LKICdlKxN"],Array [Integer 986479839551009895,Integer 8636972066308796678,Integer (-3464941350081979804),Integer (-6560688879547055621),Integer (-4749037439349044738)],Array []] -}-genArray :: MonadGen m => m (Value 'TArray)+genArray :: (MonadGen m, GenBase m ~ Identity) => m (Value 'TArray) genArray = Gen.recursive Gen.choice     [Gen.choice $ map genArrayFrom noneArrayList]     [Array <$> Gen.list (Range.constant 0 5) genArray]++-- filters++-- | Discards strings that end with \+genNotEscape :: MonadGen m => m Text -> m Text+genNotEscape gen = gen >>= \t ->+    if | Text.null t -> pure t+       | Text.last t == '\\' -> Gen.discard+       | otherwise -> pure t

@@ -12,8 +12,10 @@ import Text.Megaparsec (Parsec, ShowErrorComponent, Stream, parse)  import Toml.Edsl (mkToml, table, tableArray, (=:))+import Toml.Parser.Item (tomlP)+import Toml.Parser.Key (keyP) import Toml.Parser.String (textP)-import Toml.Parser.TOML (keyP, tomlP)+import Toml.Parser.Validate (validateItems) import Toml.Parser.Value (arrayP, boolP, dateTimeP, doubleP, integerP) import Toml.PrefixTree (Key (..), Piece (..), fromList) import Toml.Type (AnyValue (..), TOML (..), UValue (..), Value (..))@@ -397,12 +399,21 @@             parseToml "table = {}" (tomlFromTable [(makeKey ["table"], mempty)])         it "can parse a table followed by an inline table" $             parseToml "[table1] \n  key1 = \"some string\" \n table2 = {key2 = 123}"-                (tomlFromTable [(makeKey ["table1"], tomlFromKeyVal [str])-                               ,(makeKey ["table2"], tomlFromKeyVal [int])])+                (tomlFromTable+                    [ ( "table1"+                      , tomlFromKeyVal [str]+                        <> tomlFromTable [ ("table2", tomlFromKeyVal [int]) ]+                      )+                    ]+                )         it "can parse an empty table followed by an inline table" $             parseToml "[table1] \n table2 = {key2 = 123}"-                (tomlFromTable [(makeKey ["table1"], mempty)-                               ,(makeKey ["table2"], tomlFromKeyVal [int])])+                (tomlFromTable+                    [ ( "table1"+                      , tomlFromTable [ ("table2", tomlFromKeyVal [int]) ]+                      )+                    ]+                )         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)])@@ -481,8 +492,9 @@ -- Utilities ---------------------------------------------------------------------------- -parseX :: (ShowErrorComponent e, Stream s, Show a, Eq a)-       => Parsec e s a -> s -> a -> Expectation+parseX+    :: (ShowErrorComponent e, Stream s, Show a, Eq a)+    => Parsec e s a -> s -> a -> Expectation parseX p given expected = parse p "" given `shouldParse` expected  failOn :: Show a => Parsec e s a -> s -> Expectation@@ -490,23 +502,35 @@  parseArray :: Text -> [UValue] -> Expectation parseArray = parseX arrayP+ parseBool :: Text -> Bool -> Expectation parseBool = parseX boolP+ parseDateTime :: Text -> UValue -> Expectation parseDateTime = parseX dateTimeP+ parseDouble :: Text -> Double -> Expectation parseDouble = parseX doubleP+ parseInteger :: Text -> Integer -> Expectation parseInteger = parseX integerP+ parseKey :: Text -> Key -> Expectation parseKey = parseX keyP+ parseText :: Text -> Text -> Expectation parseText = parseX textP  parseToml :: Text -> TOML -> Expectation-parseToml = parseX tomlP+parseToml test toml = parseX (validateItems <$> tomlP) test (Right toml) -arrayFailOn, boolFailOn, dateTimeFailOn, doubleFailOn, integerFailOn, textFailOn, tomlFailOn :: Text -> Expectation+arrayFailOn+  , boolFailOn+  , dateTimeFailOn+  , doubleFailOn+  , integerFailOn+  , textFailOn+  , tomlFailOn :: Text -> Expectation arrayFailOn     = failOn arrayP boolFailOn      = failOn boolP dateTimeFailOn  = failOn dateTimeP

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                tomland-version:             1.1.0.1+version:             1.2.0.0 synopsis:            Bidirectional TOML serialization description:     Implementation of bidirectional TOML serialization. Simple codecs look like this:@@ -31,19 +31,20 @@ category:            TOML, Text, Configuration build-type:          Simple extra-doc-files:     README.md-                   , CHANGELOG.md+                     CHANGELOG.md extra-source-files:  test/golden/*.golden-                   , test/examples/*.toml+                     test/examples/*.toml tested-with:         GHC == 8.2.2-                   , GHC == 8.4.4-                   , GHC == 8.6.5+                     GHC == 8.4.4+                     GHC == 8.6.5+                     GHC == 8.8.1  source-repository head   type:                git   location:            https://github.com/kowainik/tomland.git  common common-options-  build-depends:       base >= 4.10 && < 4.13+  build-depends:       base >= 4.10 && < 4.14    ghc-options:         -Wall                        -Wincomplete-uni-patterns@@ -54,9 +55,14 @@                        -Wpartial-fields                        -fhide-source-paths                        -freverse-errors+  if impl(ghc >= 8.8.1)+    ghc-options:       -Wmissing-deriving-strategies+                       -Werror=missing-deriving-strategies    default-language:    Haskell2010   default-extensions:  DeriveGeneric+                       DerivingStrategies+                       GeneralizedNewtypeDeriving                        InstanceSigs                        LambdaCase                        OverloadedStrings@@ -78,9 +84,11 @@                          Toml.Generic                          Toml.Parser                            Toml.Parser.Core+                           Toml.Parser.Item+                           Toml.Parser.Key                            Toml.Parser.String+                           Toml.Parser.Validate                            Toml.Parser.Value-                           Toml.Parser.TOML                          Toml.PrefixTree                          Toml.Printer                          Toml.Type@@ -92,10 +100,10 @@   build-depends:       bytestring ^>= 0.10                      , containers >= 0.5.7 && < 0.7                      , deepseq ^>= 1.4-                     , hashable ^>= 1.2+                     , hashable >= 1.2 && < 1.4                      , megaparsec ^>= 7.0.5                      , mtl ^>= 2.2-                     , parser-combinators ^>= 1.1.0+                     , parser-combinators >= 1.1.0 && < 1.3                      , text ^>= 1.2                      , time >= 1.8 && < 1.10                      , transformers ^>= 0.5@@ -103,6 +111,9 @@  executable readme   import:              common-options+  -- doesn't work on windows for unknown reasons+  if os(windows)+    buildable: False   main-is:             README.lhs   build-depends:       text                      , tomland@@ -112,8 +123,10 @@  executable play-tomland   import:              common-options-  main-is:             Playground.hs+  main-is:             Main.hs   build-depends:       tomland+                     , containers+                     , hashable                      , text                      , time                      , unordered-containers@@ -143,7 +156,7 @@   build-depends:       bytestring ^>= 0.10                      , containers >= 0.5.7 && < 0.7                      , hashable-                     , hedgehog ^>= 1.0+                     , hedgehog ^>= 1.0.1                      , hspec-megaparsec ^>= 2.0.0                      , megaparsec                      , tasty ^>= 1.2@@ -157,31 +170,3 @@                      , unordered-containers    ghc-options:         -threaded -rtsopts -with-rtsopts=-N--benchmark tomland-benchmark-  import:             common-options-  type:               exitcode-stdio-1.0-  main-is:            Main.hs-  hs-source-dirs:     benchmark--  other-modules:      Benchmark.Type-                      Benchmark.Htoml-                      Benchmark.HtomlMegaparsec-                      Benchmark.Tomland-                      Benchmark.TomlParser--  ghc-options:        -threaded-                      -rtsopts-                      -with-rtsopts=-N-                      -O2--  build-depends:      aeson-                    , deepseq ^>= 1.4-                    , gauge ^>= 0.2.4-                    , htoml ^>= 1.0.0.3-                    , htoml-megaparsec ^>= 2.1.0.3-                    , parsec-                    , text-                    , time-                    , toml-parser ^>= 0.1.0.0-                    , tomland