diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,23 @@ `tomland` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 🐂 1.3.2.0 — Feb 12, 2021 + +* [#186](https://github.com/kowainik/tomland/issues/186): + Implement TOML difference. Add `decodeExact` and `decodeFileExact`. +* [#325](https://github.com/kowainik/tomland/issues/325): + Add ability to one or multiline printing to `PrintOptions` for arrays. +* [#329](https://github.com/kowainik/tomland/issues/329): + Add `_Harcoded` codec and `hardcoded` combinator. +* [#333](https://github.com/kowainik/tomland/issues/333): + Fix bug with parsing leading zeroes in numeric values. +* [#334](https://github.com/kowainik/tomland/issues/334): + Escape unicode characters correctly in `encode`. +* [#364](https://github.com/kowainik/tomland/issues/364): + Update GHC from `8.10.2` to `8.10.4`. +* [#358](https://github.com/kowainik/tomland/issues/358): + Upgrade `parser-combinators` upper bound to allow `1.3`. + ## 1.3.1.0 — Sep 21, 2020 * [#331](https://github.com/kowainik/tomland/issues/331): diff --git a/README.lhs b/README.lhs --- a/README.lhs +++ b/README.lhs @@ -3,11 +3,11 @@ ![palm](https://user-images.githubusercontent.com/4276606/51088259-7a777000-176e-11e9-9d76-6be4023c0ac3.png) [![GitHub CI](https://github.com/kowainik/tomland/workflows/CI/badge.svg)](https://github.com/kowainik/tomland/actions) -[![AppVeyor CI](https://ci.appveyor.com/api/projects/status/github/kowainik/tomland?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/tomland) +[![AppVeyor CI](https://ci.appveyor.com/api/projects/status/github/kowainik/tomland?branch=main&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) -[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/tomland/blob/master/LICENSE) +[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/tomland/blob/main/LICENSE) > “A library is like an island in the middle of a vast sea of ignorance, > particularly if the library is very tall and the surrounding area has been diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,11 +3,11 @@ ![palm](https://user-images.githubusercontent.com/4276606/51088259-7a777000-176e-11e9-9d76-6be4023c0ac3.png) [![GitHub CI](https://github.com/kowainik/tomland/workflows/CI/badge.svg)](https://github.com/kowainik/tomland/actions) -[![AppVeyor CI](https://ci.appveyor.com/api/projects/status/github/kowainik/tomland?branch=master&svg=true)](https://ci.appveyor.com/project/kowainik/tomland) +[![AppVeyor CI](https://ci.appveyor.com/api/projects/status/github/kowainik/tomland?branch=main&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) -[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/tomland/blob/master/LICENSE) +[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](https://github.com/kowainik/tomland/blob/main/LICENSE) > “A library is like an island in the middle of a vast sea of ignorance, > particularly if the library is very tall and the surrounding area has been diff --git a/examples/Main.hs b/examples/Main.hs --- a/examples/Main.hs +++ b/examples/Main.hs @@ -8,8 +8,8 @@ import Control.Applicative ((<|>)) import Control.Arrow ((>>>)) import Data.ByteString (ByteString) -import Data.Hashable (Hashable) import Data.HashSet (HashSet) +import Data.Hashable (Hashable) import Data.IntSet (IntSet) import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) @@ -19,7 +19,7 @@ import GHC.Generics (Generic) import Toml (TomlCodec, TomlParseError (..), pretty, (.=), ()) -import Toml.Codec.Generic (ByteStringAsBytes (..), HasCodec (..), TomlTable (..), +import Toml.Codec.Generic (ByteStringAsBytes (..), HasCodec (..), TomlTableStrip (..), stripTypeNameCodec) import Toml.Type (TOML (..), Value (..)) import Toml.Type.Edsl (mkToml, table, (=:)) @@ -84,12 +84,12 @@ matchHex :: Colour -> Maybe Text matchHex = \case Hex t -> Just t - _ -> Nothing + _ -> Nothing matchRgb :: Colour -> Maybe Rgb matchRgb = \case RGB rgb -> Just rgb - _ -> Nothing + _ -> Nothing colourCodec :: Toml.Key -> TomlCodec Colour colourCodec key = @@ -124,31 +124,32 @@ <$> Toml.tableMap Toml._KeyText (Toml.list innerCodec) "mapList" .= mapList data Test = Test - { testB :: !Bool - , testI :: !Int - , testF :: !Double - , testS :: !Text - , testA :: ![Text] - , testNE :: !(NonEmpty Text) - , testNET :: !(NonEmpty Int) - , testM :: !(Maybe Bool) - , testX :: !TestInside - , testY :: !(Maybe TestInside) - , testEven :: !Int - , testN :: !N - , testC :: !ColorScheme - , testPair :: !(Int, Text) - , testTriple :: !(Int, Text, Bool) - , testE1 :: !(Either Integer String) - , testE2 :: !(Either String Double) - , testStatus :: !UserStatus - , users :: ![User] - , susers :: !(Set User) - , husers :: !(HashSet User) - , intset :: !IntSet - , payloads :: !(Map Text Int) - , colours :: !(Map Text Colour) - , tableList :: !MapWithList + { testB :: !Bool + , testI :: !Int + , testF :: !Double + , testS :: !Text + , testA :: ![Text] + , testNE :: !(NonEmpty Text) + , testNET :: !(NonEmpty Int) + , testM :: !(Maybe Bool) + , testX :: !TestInside + , testY :: !(Maybe TestInside) + , testEven :: !Int + , testN :: !N + , testC :: !ColorScheme + , testPair :: !(Int, Text) + , testTriple :: !(Int, Text, Bool) + , testE1 :: !(Either Integer String) + , testE2 :: !(Either String Double) + , testStatus :: !UserStatus + , users :: ![User] + , susers :: !(Set User) + , husers :: !(HashSet User) + , intset :: !IntSet + , payloads :: !(Map Text Int) + , colours :: !(Map Text Colour) + , tableList :: !MapWithList + , testHardcoded :: !Text } @@ -179,6 +180,7 @@ <*> Toml.map (Toml.text "name") (Toml.int "payload") "payloads" .= payloads <*> Toml.tableMap Toml._KeyText colourCodec "colours" .= colours <*> mapWithListCodec .= tableList + <*> Toml.hardcoded "abc" Toml._Text "testHardcoded" .= testHardcoded where pairC :: TomlCodec (Int, Text) pairC = Toml.pair (Toml.int "pNum") (Toml.text "pName") @@ -208,7 +210,7 @@ { addressStreet :: !Text , addressHouse :: !Int } deriving stock (Generic) - deriving HasCodec via (TomlTable Address) + deriving HasCodec via (TomlTableStrip Address) testGeneric :: TomlCodec GenericPerson testGeneric = stripTypeNameCodec diff --git a/src/Toml.hs b/src/Toml.hs --- a/src/Toml.hs +++ b/src/Toml.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module reexports all functionality of the @tomland@ package. It's recommended to import this module qualified, like this: diff --git a/src/Toml/Codec.hs b/src/Toml/Codec.hs --- a/src/Toml/Codec.hs +++ b/src/Toml/Codec.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module provides utilities for implementing and using bidirectional TOML codecs. The concept of bidirectional conversion in diff --git a/src/Toml/Codec/BiMap.hs b/src/Toml/Codec/BiMap.hs --- a/src/Toml/Codec/BiMap.hs +++ b/src/Toml/Codec/BiMap.hs @@ -6,12 +6,15 @@ {-# LANGUAGE Rank2Types #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.BiMap +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable -Implementation of /Tagged Partial Bidirectional Isomorphism/. This -module contains the 'BiMap' type that represents conversion between +Implementation of /Tagged Partial Bidirectional Isomorphism/. +This module contains the 'BiMap' type that represents conversion between two types with the possibility of failure. See "Toml.Codec.BiMap.Conversion" for examples of 'BiMap' with diff --git a/src/Toml/Codec/BiMap/Conversion.hs b/src/Toml/Codec/BiMap/Conversion.hs --- a/src/Toml/Codec/BiMap/Conversion.hs +++ b/src/Toml/Codec/BiMap/Conversion.hs @@ -1,13 +1,16 @@ {-# LANGUAGE GADTs #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.BiMap.Conversion +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Implementations of 'BiMap' for specific Haskell types and TOML -values. Usually, you use codecs from the "Toml.Codec.Combinator" -module. You may need to use these 'BiMap's instead of codecs in the +values. Usually, you use codecs from the "Toml.Codec.Combinator" module. +You may need to use these 'BiMap's instead of codecs in the following situations: 1. When using 'Toml.Codec.Combinator.List.arrayOf' combinator (or similar). @@ -60,6 +63,7 @@ , _Read , _TextBy , _Validate + , _Hardcoded -- * 'Key's , _KeyText @@ -548,6 +552,28 @@ _EnumBounded :: (Show a, Enum a, Bounded a) => TomlBiMap a AnyValue _EnumBounded = _EnumBoundedText >>> _Text {-# INLINE _EnumBounded #-} + + +{- | 'BiMap' for hardcoded values. +It returns the same value in case of success and 'ArbitraryError' in other case. + +@since 1.3.2.0 +-} +_Hardcoded :: forall a . (Show a, Eq a) => a -> TomlBiMap a a +_Hardcoded a = BiMap + { forward = const (Right a) + , backward = checkValue + } + where + checkValue :: a -> Either TomlBiMapError a + checkValue v = if v == a + then Right v + else Left (ArbitraryError msg) + where + msg :: Text + msg = "Value '" <> T.pack (show v) + <> "' doesn't align with the hardcoded value '" + <> T.pack (show a) <> "'" ---------------------------------------------------------------------------- -- Keys diff --git a/src/Toml/Codec/Code.hs b/src/Toml/Codec/Code.hs --- a/src/Toml/Codec/Code.hs +++ b/src/Toml/Codec/Code.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Code +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Conversion from textual representation of @TOML@ values to the Haskell data types by the given 'TomlCodec'. @@ -12,9 +15,11 @@ module Toml.Codec.Code ( -- * Decode decode + , decodeExact , decodeValidation , decodeFileEither , decodeFile + , decodeFileExact -- * Encode , encode , encodeToFile @@ -31,7 +36,7 @@ import Toml.Codec.Error (LoadTomlException (..), TomlDecodeError (..), prettyTomlDecodeErrors) import Toml.Codec.Types (Codec (..), TomlCodec, TomlState (..)) import Toml.Parser (parse) -import Toml.Type (TOML (..)) +import Toml.Type (TOML (..), tomlDiff) import Toml.Type.Printer (pretty) import qualified Data.Text.IO as TIO @@ -55,6 +60,26 @@ decode :: TomlCodec a -> Text -> Either [TomlDecodeError] a decode codec = validationToEither . decodeValidation codec +{- | Convert textual representation of @TOML@ into user data type by the +provided codec. + +Unlike 'decode', this function returns 'NotExactDecode' error in case if given +@TOML@ has redundant fields and other elements. + +@since 1.3.2.0 +-} +decodeExact :: TomlCodec a -> Text -> Either [TomlDecodeError] a +decodeExact codec text = case parse text of + Left err -> Left [ParseError err] + Right toml -> case runTomlCodec codec toml of + Failure errs -> Left errs + Success a -> + let tomlExpected = execTomlCodec codec a + aDiff = tomlDiff toml tomlExpected in + if aDiff == mempty + then Right a + else Left [NotExactDecode aDiff] + {- | Similar to 'decodeValidation', but takes a path to a file with textual @TOML@ values from which it decodes them with the provided codec. @@ -78,6 +103,18 @@ -> FilePath -> m (Either [TomlDecodeError] a) decodeFileEither codec = fmap validationToEither . decodeFileValidation codec + +{- | Similar to 'decodeExact', but takes a path to a file with textual @TOML@ +values from which it decodes them with the provided codec. + +@since 1.3.2.0 +-} +decodeFileExact + :: forall a m . (MonadIO m) + => TomlCodec a + -> FilePath + -> m (Either [TomlDecodeError] a) +decodeFileExact codec = fmap (decodeExact codec) . liftIO . TIO.readFile {- | Similar to 'decodeFileEither', throws 'LoadTomlException' in case of parse errors ('TomlDecodeError'). diff --git a/src/Toml/Codec/Combinator.hs b/src/Toml/Codec/Combinator.hs --- a/src/Toml/Codec/Combinator.hs +++ b/src/Toml/Codec/Combinator.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Contains TOML-specific combinators for converting between TOML and user data types. @@ -63,7 +66,7 @@ TOML-specific combinators for converting between TOML and Haskell primitive types, e.g. 'int' \<-\> 'Int', 'byteString' \<-\> 'ByteString'. -See the "Toml.Codec.Combinators.Primitive" module documentation for the overview +See the "Toml.Codec.Combinator.Primitive" module documentation for the overview table and more examples. -} @@ -73,21 +76,21 @@ can use in your configuration. @tomland@ provides mapping of those primitives to types from the @time@ library. -See the "Toml.Codec.Combinators.Time" module documentation for the overview +See the "Toml.Codec.Combinator.Time" module documentation for the overview table and more examples. -} {- $table Combinators for the @TOML@ tables. -See the "Toml.Codec.Combinators.Table" module documentation for more examples. +See the "Toml.Codec.Combinator.Table" module documentation for more examples. -} {- $list TOML-specific combinators for converting between TOML and Haskell list-like data types. -See the "Toml.Codec.Combinators.List" module documentation for the overview +See the "Toml.Codec.Combinator.List" module documentation for the overview table and more examples. -} @@ -95,7 +98,7 @@ TOML-specific combinators for converting between TOML and Haskell set-like data types. -See the "Toml.Codec.Combinators.Set" module documentation for the overview +See the "Toml.Codec.Combinator.Set" module documentation for the overview table and more examples. -} @@ -103,7 +106,7 @@ TOML-specific combinators for converting between TOML and Haskell map-like data types. -See the "Toml.Codec.Combinators.Map" module documentation for the overview +See the "Toml.Codec.Combinator.Map" module documentation for the overview table and more examples. -} @@ -114,7 +117,7 @@ constructors of sum types), you can find codecs from this module helpful. -See the "Toml.Codec.Combinators.Tuple" module documentation for the overview +See the "Toml.Codec.Combinator.Tuple" module documentation for the overview table and more examples. -} @@ -124,7 +127,7 @@ the [Partial Options Monoid](https://medium.com/@jonathangfischoff/the-partial-options-monoid-pattern-31914a71fc67) pattern. -See the "Toml.Codec.Combinators.Monoid" module documentation for the overview +See the "Toml.Codec.Combinator.Monoid" module documentation for the overview table and more examples. -} @@ -137,7 +140,7 @@ 'Bounded' instances of the data type only and provides descriptive error messages at the same time. -See the "Toml.Codec.Combinators.Custom" module documentation for the overview +See the "Toml.Codec.Combinator.Custom" module documentation for the overview table and more examples. -} @@ -148,5 +151,5 @@ ones. But if you need something that library doesn't provide, you can find functions in this module useful. -See the "Toml.Codec.Combinators.Common" module documentation for more examples. +See the "Toml.Codec.Combinator.Common" module documentation for more examples. -} diff --git a/src/Toml/Codec/Combinator/Common.hs b/src/Toml/Codec/Combinator/Common.hs --- a/src/Toml/Codec/Combinator/Common.hs +++ b/src/Toml/Codec/Combinator/Common.hs @@ -1,9 +1,12 @@ {-# LANGUAGE FlexibleContexts #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Common +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module implements common utilities for writing custom codecs without diving into internal implementation details. Most of the time @@ -61,7 +64,6 @@ output a = do anyVal <- eitherToTomlState $ forward a a <$ modify (insertKeyAnyVal key anyVal) - {- | Throw error on 'Left', or perform a given action with 'Right'. diff --git a/src/Toml/Codec/Combinator/Custom.hs b/src/Toml/Codec/Combinator/Custom.hs --- a/src/Toml/Codec/Combinator/Custom.hs +++ b/src/Toml/Codec/Combinator/Custom.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Custom +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Contains TOML-specific custom combinators for converting between TOML and special user data types. @@ -16,6 +19,7 @@ textBy , read , enumBounded + , hardcoded -- * Validation , validate @@ -24,10 +28,11 @@ import Prelude hiding (read) +import Control.Category ((>>>)) import Data.Text (Text) import Toml.Codec.BiMap (TomlBiMap) -import Toml.Codec.BiMap.Conversion (_EnumBounded, _Read, _TextBy, _Validate) +import Toml.Codec.BiMap.Conversion (_EnumBounded, _Read, _TextBy, _Validate, _Hardcoded) import Toml.Codec.Combinator.Common (match) import Toml.Codec.Types (TomlCodec) import Toml.Type.AnyValue (AnyValue) @@ -149,6 +154,32 @@ enumBounded :: (Bounded a, Enum a, Show a) => Key -> TomlCodec a enumBounded = match _EnumBounded {-# INLINE enumBounded #-} + +{- | Codec for hardcoded provided values and its 'BiMap'. + +If you want to decode a single key-value pair where only one value is allowed. +Like in the example below: + +@ +scope = "all" +@ + +To decode that you could use the following function: + +@ +Toml.hardcoded "all" Toml._Text "scope" +@ + +in case if the value in @TOML@ is not the same as hardcoded, you will get the following error: + +@ +tomland decode error: BiMap error in key 'scope' : Value '"foo"' doesn't align with the hardcoded value '"all"' +@ + +@since 1.3.2.0 +-} +hardcoded :: (Show a, Eq a) => a -> TomlBiMap a AnyValue -> Key -> TomlCodec a +hardcoded a aBm = match (_Hardcoded a >>> aBm) {- | Codec that checks the 'BiMap' on the given predicate. The predicate function returns the value, if the validation is successful, or diff --git a/src/Toml/Codec/Combinator/List.hs b/src/Toml/Codec/Combinator/List.hs --- a/src/Toml/Codec/Combinator/List.hs +++ b/src/Toml/Codec/Combinator/List.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.List +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable TOML-specific combinators for converting between TOML and Haskell list-like data types. diff --git a/src/Toml/Codec/Combinator/Map.hs b/src/Toml/Codec/Combinator/Map.hs --- a/src/Toml/Codec/Combinator/Map.hs +++ b/src/Toml/Codec/Combinator/Map.hs @@ -3,9 +3,12 @@ {-# LANGUAGE TupleSections #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Map +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable TOML-specific combinators for converting between TOML and Haskell Map-like data types. diff --git a/src/Toml/Codec/Combinator/Monoid.hs b/src/Toml/Codec/Combinator/Monoid.hs --- a/src/Toml/Codec/Combinator/Monoid.hs +++ b/src/Toml/Codec/Combinator/Monoid.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Monoid +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable TOML-specific combinators for converting between TOML and Haskell 'Monoid' wrapper data types. These codecs are especially handy when you are implementing diff --git a/src/Toml/Codec/Combinator/Primitive.hs b/src/Toml/Codec/Combinator/Primitive.hs --- a/src/Toml/Codec/Combinator/Primitive.hs +++ b/src/Toml/Codec/Combinator/Primitive.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Primitive +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable TOML-specific combinators for converting between TOML and Haskell primitive types, e.g. 'Int', 'ByteString'. diff --git a/src/Toml/Codec/Combinator/Set.hs b/src/Toml/Codec/Combinator/Set.hs --- a/src/Toml/Codec/Combinator/Set.hs +++ b/src/Toml/Codec/Combinator/Set.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Set +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable TOML-specific combinators for converting between TOML and Haskell Set-like data types. diff --git a/src/Toml/Codec/Combinator/Table.hs b/src/Toml/Codec/Combinator/Table.hs --- a/src/Toml/Codec/Combinator/Table.hs +++ b/src/Toml/Codec/Combinator/Table.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Table +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Contains TOML-specific combinators for converting between TOML and user data types. diff --git a/src/Toml/Codec/Combinator/Time.hs b/src/Toml/Codec/Combinator/Time.hs --- a/src/Toml/Codec/Combinator/Time.hs +++ b/src/Toml/Codec/Combinator/Time.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Time +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable TOML-specific combinators for converting between TOML and Haskell date and time data types. TOML specification describes date and time primitives you diff --git a/src/Toml/Codec/Combinator/Tuple.hs b/src/Toml/Codec/Combinator/Tuple.hs --- a/src/Toml/Codec/Combinator/Tuple.hs +++ b/src/Toml/Codec/Combinator/Tuple.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Combinator.Tuple +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable TOML-specific combinators for converting between TOML and Haskell tuples. It's recommended to create your custom data types and implement codecs diff --git a/src/Toml/Codec/Di.hs b/src/Toml/Codec/Di.hs --- a/src/Toml/Codec/Di.hs +++ b/src/Toml/Codec/Di.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Di +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Forward and backward mapping functions and combinators (similar to profunctors). diff --git a/src/Toml/Codec/Error.hs b/src/Toml/Codec/Error.hs --- a/src/Toml/Codec/Error.hs +++ b/src/Toml/Codec/Error.hs @@ -1,9 +1,12 @@ {-# LANGUAGE DeriveAnyClass #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Error +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Core error types, including 'TomlDecodeError' and 'LoadTomlException'. @@ -26,7 +29,8 @@ import Toml.Codec.BiMap (TomlBiMapError, prettyBiMapError) import Toml.Parser (TomlParseError (..)) import Toml.Type.Key (Key (..)) -import Toml.Type.Printer (prettyKey) +import Toml.Type.TOML (TOML) +import Toml.Type.Printer (prettyKey, pretty) import qualified Data.Text as Text @@ -45,6 +49,11 @@ @since 1.3.0.0 -} | ParseError !TomlParseError -- ^ Exception during parsing + | NotExactDecode !TOML + {- ^ Unused field left in the decoded TOML. + + @since 1.3.2.0 + -} deriving stock (Show, Eq, Generic) deriving anyclass (NFData) @@ -69,7 +78,10 @@ TableNotFound name -> "Table [" <> prettyKey name <> "] is not found" TableArrayNotFound name -> "Table array [[" <> prettyKey name <> "]] is not found" ParseError (TomlParseError msg) -> - "Parse error during conversion from TOML to custom user type: \n " <> msg + "Parse error during conversion from TOML to custom user type:\n " <> msg + NotExactDecode toml -> + "The following fields are present in TOML but not used:\n" + <> pretty toml {- | File loading error data type. diff --git a/src/Toml/Codec/Generic.hs b/src/Toml/Codec/Generic.hs --- a/src/Toml/Codec/Generic.hs +++ b/src/Toml/Codec/Generic.hs @@ -10,9 +10,12 @@ {-# LANGUAGE UndecidableInstances #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Generic +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module contains implementation of the 'Generic' TOML codec. If your data types are big and nested, and you want to have codecs for them without writing a lot of @@ -128,14 +131,15 @@ -- * Deriving Via , TomlTable (..) + , TomlTableStrip (..) ) where import Data.ByteString (ByteString) import Data.Char (isLower, toLower) import Data.Coerce (coerce) -import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import Data.HashSet (HashSet) +import Data.Hashable (Hashable) import Data.IntMap.Strict (IntMap) import Data.IntSet (IntSet) import Data.Kind (Type) @@ -150,8 +154,8 @@ import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime) import Data.Typeable (Typeable, typeRep) import Data.Word (Word8) -import GHC.Generics ((:*:) (..), (:+:), C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1, - Selector (..)) +import GHC.Generics (C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1, Selector (..), (:*:) (..), + (:+:)) import GHC.TypeLits (ErrorMessage (..), TypeError) import Numeric.Natural (Natural) @@ -716,6 +720,39 @@ -- | @since 1.3.0.0 instance (Generic a, GenericCodec (Rep a)) => HasItemCodec (TomlTable a) where hasItemCodec = Right $ Toml.diwrap $ genericCodec @a + {-# INLINE hasItemCodec #-} + +{- | @newtype@ for generic deriving of 'HasCodec' typeclass for custom data +types that should be wrapped into a separate table. + +Similar to 'TomlTable' but also strips the data type name prefix from +TOML keys. + +@personCodec@ from the 'TomlTable' comment corresponds to the TOML of +the following structure: + +@ +name = "foo" +[address] + street = \"Bar\" + house = 42 +@ + +@since 1.3.2.0 +-} +newtype TomlTableStrip a = TomlTableStrip + { unTomlTableStrip :: a + } + +-- | @since 1.3.2.0 +instance (Generic a, GenericCodec (Rep a), Typeable a) => HasCodec (TomlTableStrip a) where + hasCodec :: Key -> TomlCodec (TomlTableStrip a) + hasCodec = Toml.diwrap . Toml.table (stripTypeNameCodec @a) + {-# INLINE hasCodec #-} + +-- | @since 1.3.2.0 +instance (Generic a, GenericCodec (Rep a), Typeable a) => HasItemCodec (TomlTableStrip a) where + hasItemCodec = Right $ Toml.diwrap $ stripTypeNameCodec @a {-# INLINE hasItemCodec #-} {- $bytestring diff --git a/src/Toml/Codec/Types.hs b/src/Toml/Codec/Types.hs --- a/src/Toml/Codec/Types.hs +++ b/src/Toml/Codec/Types.hs @@ -5,9 +5,12 @@ {-# LANGUAGE UndecidableInstances #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Codec.Types +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Contains general underlying monad for bidirectional conversion. diff --git a/src/Toml/Parser.hs b/src/Toml/Parser.hs --- a/src/Toml/Parser.hs +++ b/src/Toml/Parser.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Parser +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Parser for text to TOML AST. diff --git a/src/Toml/Parser/Core.hs b/src/Toml/Parser/Core.hs --- a/src/Toml/Parser/Core.hs +++ b/src/Toml/Parser/Core.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Parser.Core +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Core functions for TOML parser. -} diff --git a/src/Toml/Parser/Item.hs b/src/Toml/Parser/Item.hs --- a/src/Toml/Parser/Item.hs +++ b/src/Toml/Parser/Item.hs @@ -1,7 +1,10 @@ -{-| -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +{- | +Module : Toml.Parser.Item +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module contains the definition of the 'TomlItem' data type which represents either key-value pair or table name. This data type serves the diff --git a/src/Toml/Parser/Key.hs b/src/Toml/Parser/Key.hs --- a/src/Toml/Parser/Key.hs +++ b/src/Toml/Parser/Key.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Parser.Key +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Parsers for keys and table names. diff --git a/src/Toml/Parser/String.hs b/src/Toml/Parser/String.hs --- a/src/Toml/Parser/String.hs +++ b/src/Toml/Parser/String.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Parser.String +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Parsers for strings in TOML format, including basic and literal strings both singleline and multiline. diff --git a/src/Toml/Parser/Validate.hs b/src/Toml/Parser/Validate.hs --- a/src/Toml/Parser/Validate.hs +++ b/src/Toml/Parser/Validate.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Parser.Validate +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module contains functions that aggregate the result of 'Toml.Parser.Item.tomlP' parser into 'TOML'. This approach allows to keep parser diff --git a/src/Toml/Parser/Value.hs b/src/Toml/Parser/Value.hs --- a/src/Toml/Parser/Value.hs +++ b/src/Toml/Parser/Value.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Parser.Value +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Parser for 'UValue'. -} @@ -25,7 +28,7 @@ import Data.String (fromString) import Text.Read (readMaybe) -import Text.Megaparsec (parseMaybe) +import Text.Megaparsec (observing, parseMaybe) import Toml.Parser.Core (Parser, char, digitChar, hexDigitChar, octDigitChar, binDigitChar, hexadecimal, octal, binary, lexeme, sc, signed, string, text, try, ()) @@ -35,14 +38,26 @@ -- | Parser for decimap 'Integer': included parsing of underscore. decimalP :: Parser Integer -decimalP = zero <|> more +decimalP = do + value <- observing $ try leadingZeroP + case value of + Left _ -> do + try more + Right _ -> + fail "Leading zero." + where - zero, more :: Parser Integer - zero = 0 <$ char '0' + leadingZeroP :: Parser String + leadingZeroP = do + count 1 (char '0') >>= (\_ -> some digitChar) + + more :: Parser Integer more = check =<< readMaybe . concat <$> sepBy1 (some digitChar) (char '_') check :: Maybe Integer -> Parser Integer check = maybe (fail "Not an integer") pure + + -- | Parser for hexadecimal, octal and binary numbers : included parsing numberP :: Parser Integer -> Parser Char -> String -> Parser Integer diff --git a/src/Toml/Type.hs b/src/Toml/Type.hs --- a/src/Toml/Type.hs +++ b/src/Toml/Type.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Core types for TOML AST. -} diff --git a/src/Toml/Type/AnyValue.hs b/src/Toml/Type/AnyValue.hs --- a/src/Toml/Type/AnyValue.hs +++ b/src/Toml/Type/AnyValue.hs @@ -6,9 +6,12 @@ {-# LANGUAGE KindSignatures #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.AnyValue +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Existential wrapper over 'Value' type and matching functions. diff --git a/src/Toml/Type/Edsl.hs b/src/Toml/Type/Edsl.hs --- a/src/Toml/Type/Edsl.hs +++ b/src/Toml/Type/Edsl.hs @@ -1,7 +1,10 @@ {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.Edsl +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable This module introduces EDSL for manually specifying 'TOML' data types. diff --git a/src/Toml/Type/Key.hs b/src/Toml/Type/Key.hs --- a/src/Toml/Type/Key.hs +++ b/src/Toml/Type/Key.hs @@ -1,9 +1,12 @@ {-# LANGUAGE PatternSynonyms #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.Key +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Implementation of key type. The type is used for key-value pairs and table names. diff --git a/src/Toml/Type/PrefixTree.hs b/src/Toml/Type/PrefixTree.hs --- a/src/Toml/Type/PrefixTree.hs +++ b/src/Toml/Type/PrefixTree.hs @@ -2,9 +2,12 @@ {-# LANGUAGE PatternSynonyms #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.PrefixTree +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Implementation of prefix tree for TOML AST. @@ -19,6 +22,8 @@ , insertT , lookupT , toListT + , addPrefixT + , differenceWithT -- * Prefix map that stores roots of 'PrefixTree' , PrefixMap @@ -27,6 +32,7 @@ , lookup , fromList , toList + , differenceWith ) where import Prelude hiding (lookup) @@ -67,7 +73,29 @@ instance Semigroup (PrefixTree a) where a <> b = foldl' (\tree (k, v) -> insertT k v tree) a (toListT b) +{- | Push 'Prefix' inside the given 'PrefixTree'. +@since 1.3.2.0 +-} +addPrefixT :: Prefix -> PrefixTree a -> PrefixTree a +addPrefixT pref = \case + Leaf k a -> Leaf (pref <> k) a + Branch k ma pma -> Branch (pref <> k) ma pma + +{- | Convert branches to 'Leaf' or remove them at all. + +@since 1.3.2.0 +-} +compressTree :: PrefixTree a -> Maybe (PrefixTree a) +compressTree = \case + l@(Leaf _ _) -> Just l + b@(Branch p ma pma) -> case HashMap.toList pma of + [] -> ma >>= \a -> Just (Leaf p a) + [(_, child)] -> case ma of + Just _ -> Just b + Nothing -> compressTree $ addPrefixT p child + _ : _ : _ -> Just b + {- | Creates a 'PrefixTree' of one key-value element. @since 0.0.0 @@ -165,3 +193,53 @@ -} toList :: PrefixMap a -> [(Key, a)] toList = concatMap (\(p, tr) -> first (p <|) <$> toListT tr) . HashMap.toList + +{- | Difference of two 'PrefixMap's. Returns elements of the first 'PrefixMap' +that are not existing in the second one. + +@since 1.3.2.0 +-} +differenceWith :: (a -> b -> Maybe a) -> PrefixMap a -> PrefixMap b -> PrefixMap a +differenceWith f = HashMap.differenceWith (differenceWithT f) + +{- | Difference of two 'PrefixTree's. Returns elements of the first 'PrefixTree' +that are not existing in the second one. + +@since 1.3.2.0 +-} +differenceWithT :: (a -> b -> Maybe a) -> PrefixTree a -> PrefixTree b -> Maybe (PrefixTree a) +differenceWithT f pt1 pt2 = case (pt1, pt2) of + (Leaf k1 a, Leaf k2 b) + | k1 == k2 -> f a b >>= \aNew -> Just (Leaf k1 aNew) + | otherwise -> Just (Leaf k1 a) + + (l@(Leaf k a), Branch p mb pmb) -> case keysDiff k p of + Equal -> mb >>= f a >>= \aNew -> Just (Leaf k aNew) + NoPrefix -> Just l + FstIsPref _ -> Just l + SndIsPref kSuf -> case HashMap.toList $ differenceWith f (single kSuf a) pmb of + -- zero elements + [] -> Nothing + -- our single key + [(_, aNew)] -> Just $ addPrefixT k aNew + -- shouldn't happen, but for some reasons + _ : _ : _ -> Nothing + Diff _ _ _ -> Just l + + (br@(Branch p ma pma), Leaf k b) -> case keysDiff p k of + Equal -> compressTree $ Branch p (ma >>= \a -> f a b) pma + NoPrefix -> Just br + FstIsPref kSuf -> compressTree $ Branch p ma (differenceWith f pma $ single kSuf b) + SndIsPref _ -> Just br + Diff _ _ _ -> Just br + + (b1@(Branch p1 ma pma), Branch p2 mb pmb) -> case keysDiff p1 p2 of + Equal -> compressTree $ + Branch p1 (ma >>= \a -> mb >>= \b -> f a b) (differenceWith f pma pmb) + NoPrefix -> Just b1 + FstIsPref p2Suf@(p2Head :|| _) -> compressTree $ + Branch p1 ma (differenceWith f pma $ HashMap.singleton p2Head $ Branch p2Suf mb pmb) + SndIsPref p1Suf@(p1Head :|| _) -> case HashMap.lookup p1Head pmb of + Nothing -> Just b1 + Just ch -> addPrefixT p2 <$> differenceWithT f (Branch p1Suf ma pma) ch + Diff _ _ _ -> Just b1 diff --git a/src/Toml/Type/Printer.hs b/src/Toml/Type/Printer.hs --- a/src/Toml/Type/Printer.hs +++ b/src/Toml/Type/Printer.hs @@ -1,9 +1,12 @@ {-# LANGUAGE TypeFamilies #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.Printer +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Contains functions for pretty printing @toml@ types. @@ -12,6 +15,7 @@ module Toml.Type.Printer ( PrintOptions(..) + , Lines(..) , defaultOptions , pretty , prettyOptions @@ -19,14 +23,18 @@ ) where import Data.Bifunctor (first) +import Data.Char (isAscii, ord) import Data.Coerce (coerce) import Data.Function (on) import Data.HashMap.Strict (HashMap) -import Data.List (sortBy) +import Data.List (sortBy, foldl') import Data.List.NonEmpty (NonEmpty) +import Data.Semigroup (stimes) import Data.Text (Text) import Data.Time (ZonedTime, defaultTimeLocale, formatTime) +import Text.Printf (printf) + import Toml.Type.AnyValue (AnyValue (..)) import Toml.Type.Key (Key (..), Piece (..)) import Toml.Type.PrefixTree (PrefixMap, PrefixTree (..)) @@ -38,6 +46,7 @@ import qualified Data.Text as Text + {- | Configures the pretty printer. @since 0.5.0 @@ -54,6 +63,25 @@ @since 1.1.0.0 -} , printOptionsIndent :: !Int + {- | How to print Array. + OneLine: + + @ + foo = [a, b] + @ + + MultiLine: + + @ + foo = + [ a + , b + ] + @ + + Default is 'OneLine'. + -} + , printOptionsLines :: !Lines } {- | Default printing options. @@ -64,8 +92,10 @@ @since 0.5.0 -} defaultOptions :: PrintOptions -defaultOptions = PrintOptions (Just compare) 2 +defaultOptions = PrintOptions (Just compare) 2 OneLine +data Lines = OneLine | MultiLine + {- | Converts 'TOML' type into 'Data.Text.Text' (using 'defaultOptions'). For example, this @@ -132,22 +162,39 @@ where kvText :: (Key, AnyValue) -> Text kvText (k, AnyValue v) = - tabWith options i <> prettyKey k <> " = " <> valText v + tabWith options i <> prettyKey k <> " = " <> valText v valText :: Value t -> Text valText (Bool b) = Text.toLower $ showText b valText (Integer n) = showText n valText (Double d) = showDouble d - valText (Text s) = showText s + valText (Text s) = showTextUnicode s valText (Zoned z) = showZonedTime z valText (Local l) = showText l valText (Day d) = showText d valText (Hours h) = showText h - valText (Array a) = "[" <> Text.intercalate ", " (map valText a) <> "]" + valText (Array a) = withLines options valText a showText :: Show a => a -> Text showText = Text.pack . show + + -- | Function encodes all non-ascii characters in TOML defined form using the isAscii function + showTextUnicode :: Text -> Text + showTextUnicode text = Text.pack $ show finalText + where + xss = Text.unpack text + finalText = foldl' (\acc (ch, asciiCh) -> acc ++ getCh ch asciiCh) "" asciiArr + + asciiArr = zip xss $ asciiStatus xss + + getCh :: Char -> Bool -> String + getCh ch True = [ch] -- it is true ascii character + getCh ch False = printf "\\U%08x" (ord ch) :: String -- it is not true ascii character, it must be encoded + + asciiStatus :: String -> [Bool] + asciiStatus = map isAscii + showDouble :: Double -> Text showDouble d | isInfinite d && d < 0 = "-inf" | isInfinite d = "inf" @@ -227,3 +274,11 @@ addPrefix key = \case "" -> prettyKey key prefix -> prefix <> "." <> prettyKey key + +withLines :: PrintOptions -> (Value t -> Text) -> [Value t] -> Text +withLines PrintOptions{..} valTxt a = case printOptionsLines of + OneLine -> "[" <> Text.intercalate ", " (map valTxt a) <> "]" + MultiLine -> off <> "[ " <> Text.intercalate (off <> ", ") (map valTxt a) <> off <> "]" + where + off :: Text + off = "\n" <> stimes printOptionsIndent " " diff --git a/src/Toml/Type/TOML.hs b/src/Toml/Type/TOML.hs --- a/src/Toml/Type/TOML.hs +++ b/src/Toml/Type/TOML.hs @@ -1,9 +1,12 @@ {-# LANGUAGE DeriveAnyClass #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.TOML +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Type of TOML AST. This is intermediate representation of TOML parsed from text. -} @@ -14,6 +17,8 @@ , insertKeyAnyVal , insertTable , insertTableArrays + + , tomlDiff ) where import Control.DeepSeq (NFData) @@ -27,6 +32,7 @@ import Toml.Type.Value (Value) import qualified Data.HashMap.Strict as HashMap +import qualified Data.List.NonEmpty as NE import qualified Toml.Type.PrefixTree as Prefix @@ -142,3 +148,41 @@ { tomlTableArrays = HashMap.insert k arr (tomlTableArrays toml) } {-# INLINE insertTableArrays #-} + +{- | Difference of two 'TOML's. Returns elements of the first 'TOML' that are +not existing in the second one. + +@since 1.3.2.0 +-} +tomlDiff :: TOML -> TOML -> TOML +tomlDiff t1 t2 = TOML + { tomlPairs = HashMap.difference (tomlPairs t1) (tomlPairs t2) + , tomlTables = prefixMapDiff (tomlTables t1) (tomlTables t2) + , tomlTableArrays = HashMap.differenceWith interTomlsDiff + (tomlTableArrays t1) + (tomlTableArrays t2) + } + where + interTomlsDiff :: NonEmpty TOML -> NonEmpty TOML -> Maybe (NonEmpty TOML) + interTomlsDiff tl1 tl2 = NE.nonEmpty $ tomlListDiff (NE.toList tl1) (NE.toList tl2) +{-# INLINE tomlDiff #-} + +{- | Difference of two 'PrefixMap's. Returns elements of the first 'PrefixMap' +that are not existing in the second one. + +@since 1.3.2.0 +-} +prefixMapDiff :: PrefixMap TOML -> PrefixMap TOML -> PrefixMap TOML +prefixMapDiff = Prefix.differenceWith $ \toml1 toml2 -> let diff = tomlDiff toml1 toml2 in + if diff == mempty + then Nothing + else Just diff + + +tomlListDiff :: [TOML] -> [TOML] -> [TOML] +tomlListDiff [] _ = [] +tomlListDiff ts [] = ts +tomlListDiff (t1:t1s) (t2:t2s) = let diff = tomlDiff t1 t2 in + if diff == mempty + then tomlListDiff t1s t2s + else diff : tomlListDiff t1s t2s diff --git a/src/Toml/Type/UValue.hs b/src/Toml/Type/UValue.hs --- a/src/Toml/Type/UValue.hs +++ b/src/Toml/Type/UValue.hs @@ -1,9 +1,12 @@ {-# LANGUAGE GADTs #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.UValue +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable Intermediate untype value representation used for parsing. diff --git a/src/Toml/Type/Value.hs b/src/Toml/Type/Value.hs --- a/src/Toml/Type/Value.hs +++ b/src/Toml/Type/Value.hs @@ -7,9 +7,12 @@ {-# LANGUAGE TypeOperators #-} {- | -Copyright: (c) 2018-2020 Kowainik -SPDX-License-Identifier: MPL-2.0 -Maintainer: Kowainik +Module : Toml.Type.Value +Copyright : (c) 2018-2021 Kowainik +SPDX-License-Identifier : MPL-2.0 +Maintainer : Kowainik +Stability : Stable +Portability : Portable GADT value for TOML. diff --git a/test/Test/Toml/Codec/BiMap/Conversion.hs b/test/Test/Toml/Codec/BiMap/Conversion.hs --- a/test/Test/Toml/Codec/BiMap/Conversion.hs +++ b/test/Test/Toml/Codec/BiMap/Conversion.hs @@ -55,6 +55,9 @@ it "EnumBounded (Ordering)" $ testBiMap B._EnumBounded $ Gen.enumBounded @_ @Ordering it "Read (Integer)" $ testBiMap B._Read G.genInteger it "TextBy (Text)" $ testBiMap (B._TextBy id Right) G.genText + it "Hardcoded (Text)" $ do + txt <- forAll G.genText + testBiMap (B._Hardcoded txt) (pure txt) describe "Key" $ do it "KeyText" $ testBiMap B._KeyText G.genKey diff --git a/test/Test/Toml/Codec/Code.hs b/test/Test/Toml/Codec/Code.hs --- a/test/Test/Toml/Codec/Code.hs +++ b/test/Test/Toml/Codec/Code.hs @@ -5,13 +5,15 @@ import Test.Hspec (Spec, describe, it, shouldBe) import Toml.Codec.BiMap (TomlBiMapError (..)) -import Toml.Codec.Code (decode) +import Toml.Codec.Code (decode, decodeExact) import Toml.Codec.Error (TomlDecodeError (..)) import Toml.Parser (TomlParseError (..)) import Toml.Type.AnyValue (AnyValue (..), MatchError (..)) import Toml.Type.Key (Key) import Toml.Type.Value (TValue (..), Value (..)) +import Toml.Type.Edsl (mkToml, table, tableArray, (=:)) +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Text as Text import qualified Toml.Codec as Toml @@ -33,6 +35,13 @@ it "fails decode text as Toml.int" $ decode (Toml.int "a") "a = 'foo'" `shouldBe` Left [ matchErr "a" TInteger $ AnyValue $ Text "foo"] + it "exact decode" $ + decodeExact (Toml.int "a") "a = 4" `shouldBe` + Right 4 + it "fails to decode exact when there is other field" $ + decodeExact (Toml.int "a") "a = 4\nb = 'foo'" `shouldBe` + Left [ NotExactDecode $ mkToml $ "b" =: "foo"] + -- table it "fails to decode table on missing field" $ decode (Toml.table (Toml.int "x") "foo") "" `shouldBe` @@ -40,6 +49,12 @@ it "fails to decode table on missing field" $ decode (Toml.table (Toml.int "x") "foo") "[foo]" `shouldBe` Left [ KeyNotFound "foo.x"] + it "exact decode table" $ + decodeExact (Toml.table (Toml.int "x") "foo") "[foo]\nx = 5" `shouldBe` + Right 5 + it "fails to decode exact table on missing field" $ + decodeExact (Toml.table (Toml.int "x") "foo") "[foo]\ny = 'abc'\nx = 5" `shouldBe` + Left [ NotExactDecode $ mkToml $ table "foo" $ "y" =: "abc"] -- lists @@ -69,6 +84,15 @@ decode (Toml.nonEmpty (Toml.int "i") "foo") "foo = []" `shouldBe` Left [TableArrayNotFound "foo"] + -- table arrays + it "exact decode table array" $ + decodeExact (Toml.list (Toml.int "x") "foo") "[[foo]]\nx = 1" `shouldBe` + Right [1] + + it "fails to exact decode table array with redundant field" $ + decodeExact (Toml.list (Toml.int "x") "foo") "[[foo]]\nx = 1\ny = 'abc'" `shouldBe` + Left [NotExactDecode $ mkToml $ tableArray "foo" $ ("y" =: "abc") NE.:| []] + -- map it "map: decodes to an empty map when field is missing" $ decode (Toml.map (Toml.int "key") (Toml.text "val") "foo") "" `shouldBe` @@ -105,6 +129,9 @@ it "fails to validateIf" $ decode (Toml.validateIf even Toml._Int "foo") "foo = 5" `shouldBe` Left [BiMapError "foo" $ ArbitraryError "Value does not pass the validation for key: foo"] + it "fails to hardcoded" $ + decode (Toml.hardcoded "bar" Toml._Text "foo") "foo = \"baz\"" `shouldBe` + Left [BiMapError "foo" $ ArbitraryError "Value '\"baz\"' doesn't align with the hardcoded value '\"bar\"'"] where matchErr :: Key -> TValue -> AnyValue -> TomlDecodeError matchErr key valueExpected valueActual = BiMapError key $ WrongValue $ MatchError {..} diff --git a/test/Test/Toml/Codec/Combinator/Common.hs b/test/Test/Toml/Codec/Combinator/Common.hs --- a/test/Test/Toml/Codec/Combinator/Common.hs +++ b/test/Test/Toml/Codec/Combinator/Common.hs @@ -1,5 +1,6 @@ module Test.Toml.Codec.Combinator.Common ( codecRoundtrip + , exactCodecRoundtrip -- * Double helpers , Batman (..) @@ -8,12 +9,14 @@ , batmanFloatCodec ) where +import Data.Text (Text) import Hedgehog (Gen, forAll, tripping) import Test.Hspec (Arg, Expectation, SpecWith, it) import Test.Hspec.Hedgehog (hedgehog) import Toml.Codec.BiMap (TomlBiMap) -import Toml.Codec.Code (decode, encode) +import Toml.Codec.Code (decode, decodeExact, encode) +import Toml.Codec.Error (TomlDecodeError) import Toml.Codec.Types (TomlCodec) import Toml.Type.AnyValue (AnyValue) import Toml.Type.Key (Key) @@ -22,20 +25,39 @@ import qualified Toml.Codec as Toml -codecRoundtrip +codecRoundtripWith :: forall a . (Eq a, Show a) - => String + => (TomlCodec a -> Text -> Either [TomlDecodeError] a) + -> String -> (Key -> TomlCodec a) -> Gen a -> SpecWith (Arg Expectation) -codecRoundtrip typeName mkCodec genA = it label $ hedgehog $ do +codecRoundtripWith dcode typeName mkCodec genA = it label $ hedgehog $ do a <- forAll genA let codec = mkCodec "a" - tripping a (encode codec) (decode codec) + tripping a (encode codec) (dcode codec) where label :: String label = typeName ++ ": decode . encode ≡ id" + +codecRoundtrip + :: forall a + . (Eq a, Show a) + => String + -> (Key -> TomlCodec a) + -> Gen a + -> SpecWith (Arg Expectation) +codecRoundtrip = codecRoundtripWith decode + +exactCodecRoundtrip + :: forall a + . (Eq a, Show a) + => String + -> (Key -> TomlCodec a) + -> Gen a + -> SpecWith (Arg Expectation) +exactCodecRoundtrip str = codecRoundtripWith decodeExact ("Exact " <> str) -- | Wrapper over 'Double' and 'Float' to be equal on @NaN@ values. newtype Batman a = Batman diff --git a/test/Test/Toml/Codec/Combinator/Custom.hs b/test/Test/Toml/Codec/Combinator/Custom.hs --- a/test/Test/Toml/Codec/Combinator/Custom.hs +++ b/test/Test/Toml/Codec/Combinator/Custom.hs @@ -25,3 +25,4 @@ codecRoundtrip "TextBy " (Toml.textBy (Text.pack . show) (first Text.pack . readEither . Text.unpack)) Gen.genInt + codecRoundtrip "Hardcoded (Text)" (Toml.hardcoded "abc" Toml._Text) (pure "abc") diff --git a/test/Test/Toml/Codec/SmallType.hs b/test/Test/Toml/Codec/SmallType.hs --- a/test/Test/Toml/Codec/SmallType.hs +++ b/test/Test/Toml/Codec/SmallType.hs @@ -14,7 +14,7 @@ import Hedgehog (Gen) import Test.Hspec (Spec, describe) -import Test.Toml.Codec.Combinator.Common (codecRoundtrip) +import Test.Toml.Codec.Combinator.Common (codecRoundtrip, exactCodecRoundtrip) import Toml.Codec (ByteStringAsBytes (..), TomlCodec, (.=)) import qualified Hedgehog.Gen as Gen @@ -23,8 +23,9 @@ smallTypeSpec :: Spec -smallTypeSpec = describe "SmallType: tests for custom data type" $ +smallTypeSpec = describe "SmallType: tests for custom data type" $ do codecRoundtrip "SmallType" (Toml.table smallTypeCodec) genSmallType + exactCodecRoundtrip "SmallType" (Toml.table smallTypeCodec) genSmallType data SmallType = SmallType { smallTypeInt :: !Int diff --git a/test/Test/Toml/Gen.hs b/test/Test/Toml/Gen.hs --- a/test/Test/Toml/Gen.hs +++ b/test/Test/Toml/Gen.hs @@ -299,6 +299,13 @@ hex <- genDiffHex 8 pure . Text.pack $ "\\U" ++ hex +-- | Generates some unescaped unicode string +genUnicodeChar :: Gen Text +genUnicodeChar = Gen.element + [ "č", "ć", "š", "đ", "ž", "Ö", "ё" + , "в", "ь", "ж", "ю", "ч", "ü", "я" + ] + -- | Generates text from different symbols. genText :: Gen Text genText = genNotEscape $ fmap Text.concat $ Gen.list (Range.constant 0 256) $ Gen.choice @@ -307,7 +314,9 @@ , genPunctuation , genUniHex4Color , genUniHex8Color + --, genUnicodeChar ] + genString :: Gen String genString = Text.unpack <$> genText diff --git a/test/Test/Toml/Parser/Integer.hs b/test/Test/Toml/Parser/Integer.hs --- a/test/Test/Toml/Parser/Integer.hs +++ b/test/Test/Toml/Parser/Integer.hs @@ -33,8 +33,10 @@ integerFailOn "_13" integerFailOn "_" it "does not parse numbers with leading zeros" $ do - parseInteger "0123" 0 - parseInteger "-023" 0 + integerFailOn "0123" + integerFailOn "00123" + integerFailOn "-023" + integerFailOn "-0023" context "when the integer is in binary representation" $ do it "can parse numbers prefixed with `0b`" $ do parseInteger "0b1101" 13 diff --git a/test/Test/Toml/Type/Printer.hs b/test/Test/Toml/Type/Printer.hs --- a/test/Test/Toml/Type/Printer.hs +++ b/test/Test/Toml/Type/Printer.hs @@ -11,7 +11,7 @@ import Toml.Type.Edsl (empty, mkToml, table, tableArray, (=:)) import Toml.Type.Key (Key (..), (<|)) -import Toml.Type.Printer (PrintOptions (..), defaultOptions, prettyOptions) +import Toml.Type.Printer (PrintOptions (..), Lines(..), defaultOptions, prettyOptions) import Toml.Type.TOML (TOML) import Toml.Type.Value (Value (..)) @@ -25,6 +25,7 @@ test "pretty_indented_only" noFormatting { printOptionsIndent = 4 } test "pretty_unformatted" noFormatting test "pretty_custom_sorted" noFormatting { printOptionsSorting = Just spamEgg } + test "pretty_lines" defaultOptions { printOptionsLines = MultiLine } where test :: String -> PrintOptions -> SpecWith (Arg Expectation) test name options = it ("Golden " ++ name) $ @@ -44,6 +45,7 @@ table "foo" empty table "doo" empty table "baz" empty + "list" =: Array ["one", "two"] tableArray "deepest" $ "ping" =: "pong" :| [empty] @@ -55,6 +57,7 @@ noFormatting = PrintOptions { printOptionsSorting = Nothing , printOptionsIndent = 0 + , printOptionsLines = OneLine } -- | Decorate keys as tuples so spam comes before egg diff --git a/test/golden/pretty_custom_sorted.golden b/test/golden/pretty_custom_sorted.golden --- a/test/golden/pretty_custom_sorted.golden +++ b/test/golden/pretty_custom_sorted.golden @@ -9,6 +9,8 @@ [foo] +list = ["one", "two"] + [qux.doo] spam = "!" egg = "?" diff --git a/test/golden/pretty_default.golden b/test/golden/pretty_default.golden --- a/test/golden/pretty_default.golden +++ b/test/golden/pretty_default.golden @@ -5,6 +5,8 @@ [baz] +list = ["one", "two"] + [doo] [foo] diff --git a/test/golden/pretty_indented_only.golden b/test/golden/pretty_indented_only.golden --- a/test/golden/pretty_indented_only.golden +++ b/test/golden/pretty_indented_only.golden @@ -9,6 +9,8 @@ [baz] +list = ["one", "two"] + [qux.doo] egg = "?" spam = "!" diff --git a/test/golden/pretty_lines.golden b/test/golden/pretty_lines.golden new file mode 100644 --- /dev/null +++ b/test/golden/pretty_lines.golden @@ -0,0 +1,31 @@ +a = "a" +b = "bb" +c = "cccc" +d = "ddd" + +[baz] + +list = + [ "one" + , "two" + ] + +[doo] + +[foo] + +[qux.doo] + egg = "?" + spam = "!" + +[[deeper]] + green = true + +[[deeper]] + [deeper.blue] + red = 255 + +[[deepest]] + ping = "pong" + +[[deepest]] diff --git a/test/golden/pretty_sorted_only.golden b/test/golden/pretty_sorted_only.golden --- a/test/golden/pretty_sorted_only.golden +++ b/test/golden/pretty_sorted_only.golden @@ -5,6 +5,8 @@ [baz] +list = ["one", "two"] + [doo] [foo] diff --git a/test/golden/pretty_unformatted.golden b/test/golden/pretty_unformatted.golden --- a/test/golden/pretty_unformatted.golden +++ b/test/golden/pretty_unformatted.golden @@ -9,6 +9,8 @@ [baz] +list = ["one", "two"] + [qux.doo] egg = "?" spam = "!" diff --git a/tomland.cabal b/tomland.cabal --- a/tomland.cabal +++ b/tomland.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: tomland -version: 1.3.1.0 +version: 1.3.2.0 synopsis: Bidirectional TOML serialization description: Implementation of bidirectional TOML serialization. Simple codecs look like this: @@ -27,7 +27,7 @@ license-file: LICENSE author: Dmitrii Kovanikov, Veronika Romashkina maintainer: Kowainik -copyright: 2018-2020 Kowainik +copyright: 2018-2021 Kowainik category: TOML, Text, Configuration build-type: Simple extra-doc-files: README.md @@ -37,7 +37,7 @@ tested-with: GHC == 8.4.4 GHC == 8.6.5 GHC == 8.8.4 - GHC == 8.10.2 + GHC == 8.10.4 source-repository head type: git @@ -121,7 +121,7 @@ , hashable >= 1.2 && < 1.4 , megaparsec >= 7.0.5 && < 9.1 , mtl ^>= 2.2 - , parser-combinators >= 1.1.0 && < 1.3 + , parser-combinators >= 1.1.0 && < 1.4 , text ^>= 1.2 , time >= 1.8 && < 1.11 , transformers ^>= 0.5