tomland 1.2.0.0 → 1.2.1.0
raw patch · 36 files changed
+1031/−612 lines, 36 filesdep ~hspec-megaparsecdep ~megaparsecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspec-megaparsec, megaparsec
API changes (from Hackage documentation)
+ Toml.Bi.Combinators: all :: Key -> TomlCodec All
+ Toml.Bi.Combinators: any :: Key -> TomlCodec Any
+ Toml.Bi.Combinators: first :: (Key -> TomlCodec a) -> Key -> TomlCodec (First a)
+ Toml.Bi.Combinators: last :: (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)
+ Toml.Bi.Combinators: map :: forall k v. Ord k => TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
+ Toml.Bi.Combinators: product :: (Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
+ Toml.Bi.Combinators: sum :: (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
Files
- CHANGELOG.md +10/−0
- examples/Main.hs +3/−0
- src/Toml.hs +6/−1
- src/Toml/Bi.hs +6/−1
- src/Toml/Bi/Code.hs +6/−1
- src/Toml/Bi/Combinators.hs +147/−3
- src/Toml/Bi/Map.hs +6/−1
- src/Toml/Bi/Monad.hs +7/−1
- src/Toml/Edsl.hs +6/−1
- src/Toml/Generic.hs +6/−1
- src/Toml/Parser.hs +7/−1
- src/Toml/Parser/Core.hs +8/−0
- src/Toml/Parser/Item.hs +6/−1
- src/Toml/Parser/Key.hs +6/−1
- src/Toml/Parser/String.hs +6/−1
- src/Toml/Parser/Validate.hs +6/−1
- src/Toml/Parser/Value.hs +7/−1
- src/Toml/PrefixTree.hs +7/−1
- src/Toml/Printer.hs +7/−1
- src/Toml/Type.hs +7/−1
- src/Toml/Type/AnyValue.hs +7/−1
- src/Toml/Type/TOML.hs +7/−1
- src/Toml/Type/UValue.hs +7/−1
- src/Toml/Type/Value.hs +7/−1
- test/Test/Toml/BiCode/Property.hs +27/−4
- test/Test/Toml/Parsing/Unit.hs +10/−584
- test/Test/Toml/Parsing/Unit/Array.hs +45/−0
- test/Test/Toml/Parsing/Unit/Bool.hs +21/−0
- test/Test/Toml/Parsing/Unit/Common.hs +140/−0
- test/Test/Toml/Parsing/Unit/Date.hs +61/−0
- test/Test/Toml/Parsing/Unit/Double.hs +45/−0
- test/Test/Toml/Parsing/Unit/Integer.hs +82/−0
- test/Test/Toml/Parsing/Unit/Key.hs +35/−0
- test/Test/Toml/Parsing/Unit/Text.hs +95/−0
- test/Test/Toml/Parsing/Unit/Toml.hs +162/−0
- tomland.cabal +10/−1
CHANGELOG.md view
@@ -3,6 +3,16 @@ tomland uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 1.2.1.0 — Nov 6, 2019++* [#203](https://github.com/kowainik/tomland/issues/203):+ Implement codecs for `Map`-like data structures.+ (by [@chshersh](https://github.com/chshersh))+* [#241](https://github.com/kowainik/tomland/issues/241):+ Implement codecs for `Monoid` wrappers:+ `all`, `any`, `sum`, `product`, `first`, `last`.+ (by [@vrom911](https://github.com/vrom911))+ ## 1.2.0.0 — Oct 12, 2019 * [#216](https://github.com/kowainik/tomland/issues/216):
examples/Main.hs view
@@ -7,6 +7,7 @@ import Control.Arrow ((>>>)) import Data.Hashable (Hashable) import Data.HashSet (HashSet)+import Data.Map.Strict (Map) import Data.Set (Set) import Data.Text (Text) import Data.Time (fromGregorian)@@ -84,6 +85,7 @@ , users :: ![User] , susers :: !(Set User) , husers :: !(HashSet User)+ , payloads :: !(Map Text Int) } @@ -105,6 +107,7 @@ <*> Toml.list userCodec "user" .= users <*> Toml.set userCodec "suser" .= susers <*> Toml.hashSet userCodec "huser" .= husers+ <*> Toml.map (Toml.text "name") (Toml.int "payload") "payloads" .= payloads where -- different keys for sum type eitherT1 :: TomlCodec (Either Integer String)
src/Toml.hs view
@@ -1,4 +1,9 @@-{- | This module reexports all functionality of @tomland@ package. It's+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++This module reexports all functionality of @tomland@ package. It's recommended to import this module qualified, like this: @
src/Toml/Bi.hs view
@@ -1,4 +1,9 @@-{- | Reexports functions under @Toml.Bi.*@.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Reexports functions under @Toml.Bi.*@. * __"Toml.Bi.Map"__: contains implementation of tagged bidirectional isomorphisms.
src/Toml/Bi/Code.hs view
@@ -1,6 +1,11 @@ {-# LANGUAGE DeriveAnyClass #-} -{- | Coding functions like 'decode' and 'encode'. Also contains specialization of 'Codec' for TOML.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Coding functions like 'decode' and 'encode'. Also contains specialization of 'Codec' for TOML. -} module Toml.Bi.Code
src/Toml/Bi/Combinators.hs view
@@ -2,8 +2,14 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} --- | Contains TOML-specific combinators for converting between TOML and user data types.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com> +Contains TOML-specific combinators for converting between TOML and user data types.+-}+ module Toml.Bi.Combinators ( -- * Basic codecs for primitive values -- ** Boolean@@ -38,6 +44,17 @@ , arrayHashSetOf , arrayNonEmptyOf + -- * Codecs for 'Monoid's+ -- ** Bool wrappers+ , all+ , any+ -- ** 'Num' wrappers+ , sum+ , product+ -- ** 'Maybe' wrappers+ , first+ , last+ -- * Additional codecs for custom types , textBy , read@@ -50,11 +67,14 @@ , set , hashSet + -- * Combinators for Maps+ , map+ -- * General construction of codecs , match ) where -import Prelude hiding (read)+import Prelude hiding (all, any, last, map, product, read, sum) import Control.Monad (forM) import Control.Monad.Except (catchError, throwError)@@ -66,7 +86,9 @@ import Data.HashSet (HashSet) import Data.IntSet (IntSet) import Data.List.NonEmpty (NonEmpty (..), toList)+import Data.Map.Strict (Map) import Data.Maybe (fromMaybe)+import Data.Monoid (All (..), Any (..), First (..), Last (..), Product (..), Sum (..)) import Data.Semigroup ((<>)) import Data.Set (Set) import Data.Text (Text)@@ -79,17 +101,20 @@ _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.Bi.Monad (Codec (..), dimap, dioptional) 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.List.NonEmpty as NE+import qualified Data.Map.Strict as Map 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':@@ -280,6 +305,64 @@ arrayNonEmptyOf = match . _NonEmpty {-# INLINE arrayNonEmptyOf #-} +----------------------------------------------------------------------------+-- Monoid codecs+----------------------------------------------------------------------------++{- | Codec for 'All' wrapper for boolean values.+Returns @'All' 'True'@ on missing fields.++@since 1.2.1.0+-}+all :: Key -> TomlCodec All+all = dimap (Just . getAll) (All . fromMaybe True) . dioptional . bool+{-# INLINE all #-}++{- | Codec for 'Any' wrapper for boolean values.+Returns @'Any' 'False'@ on missing fields.++@since 1.2.1.0+-}+any :: Key -> TomlCodec Any+any = dimap (Just . getAny) (Any . fromMaybe False) . dioptional . bool+{-# INLINE any #-}++{- | Codec for 'Sum' wrapper for given converter's values.++@since 1.2.1.0+-}+sum :: (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)+sum codec = dimap getSum Sum . codec+{-# INLINE sum #-}++{- | Codec for 'Product' wrapper for given converter's values.++@since 1.2.1.0+-}+product :: (Key -> TomlCodec a) -> Key -> TomlCodec (Product a)+product codec = dimap getProduct Product . codec+{-# INLINE product #-}++{- | Codec for 'First' wrapper for given converter's values.++@since 1.2.1.0+-}+first :: (Key -> TomlCodec a) -> Key -> TomlCodec (First a)+first codec = dimap getFirst First . dioptional . codec+{-# INLINE first #-}++{- | Codec for 'Last' wrapper for given converter's values.++@since 1.2.1.0+-}+last :: (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)+last codec = dimap getLast Last . dioptional . codec+{-# INLINE last #-}++----------------------------------------------------------------------------+-- Tables and arrays of tables+----------------------------------------------------------------------------+ {- | 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 key, not only the last one.@@ -369,3 +452,64 @@ 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 #-}++----------------------------------------------------------------------------+-- Map-like combinators+----------------------------------------------------------------------------++{- | Bidirectional codec for 'Map'. It takes birectional converter for keys and+values and produces bidirectional codec for 'Map'. Currently it works only with array+of tables, so you need to specify 'Map's in TOML files like this:++@+myMap =+ [ { name = "foo", payload = 42 }+ , { name = "bar", payload = 69 }+ ]+@++'TomlCodec' for such TOML field can look like this:++@+Toml.'map' (Toml.'text' "name") (Toml.'int' "payload") "myMap"+@++If there's no key with the name @"myMap"@ then empty 'Map' is returned.++@since 1.2.1.0+-}+map :: forall k v .+ Ord k+ => TomlCodec k -- ^ Codec for 'Map' keys+ -> TomlCodec v -- ^ Codec for 'Map' values+ -> Key -- ^ TOML key where 'Map' is stored+ -> TomlCodec (Map k v) -- ^ Codec for the 'Map'+map keyCodec valCodec key = Codec input output+ where+ input :: Env (Map k v)+ input = do+ mTables <- asks $ HashMap.lookup key . tomlTableArrays+ case mTables of+ Nothing -> pure Map.empty+ Just tomls -> fmap Map.fromList $ forM (NE.toList tomls) $ \toml -> do+ k <- codecReadTOML toml keyCodec+ v <- codecReadTOML toml valCodec+ pure (k, v)++ output :: Map k v -> St (Map k v)+ output dict = do+ let tomls = fmap+ (\(k, v) -> execTomlCodec keyCodec k <> execTomlCodec valCodec v)+ (Map.toList dict)++ mTables <- gets $ HashMap.lookup key . tomlTableArrays++ let updateAction :: TOML -> TOML+ updateAction = case mTables of+ Nothing -> case tomls of+ [] -> id+ t:ts -> insertTableArrays key (t :| ts)+ Just (t :| ts) ->+ insertTableArrays key $ t :| (ts ++ tomls)++ dict <$ modify updateAction
src/Toml/Bi/Map.hs view
@@ -5,7 +5,12 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} -{- | Implementation of tagged partial bidirectional isomorphism.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Implementation of tagged partial bidirectional isomorphism. -} module Toml.Bi.Map
src/Toml/Bi/Monad.hs view
@@ -1,4 +1,10 @@--- | Contains general underlying monad for bidirectional conversion.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Contains general underlying monad for bidirectional conversion.+-} module Toml.Bi.Monad ( Codec (..)
src/Toml/Edsl.hs view
@@ -1,4 +1,9 @@-{- | This module introduces EDSL for manually specifying 'TOML' data types.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++This module introduces EDSL for manually specifying 'TOML' data types. Consider the following raw TOML:
src/Toml/Generic.hs view
@@ -9,7 +9,12 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} -{- | This module contains implementation of the 'Generic' TOML codec. If your+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++This module contains implementation of the 'Generic' TOML codec. If your data types are big and nested, and you want to have codecs for them without writing a lot of boilerplate code, you can find this module helpful. Below you can find the detailed explanation on how the 'Generic' codecs work.
src/Toml/Parser.hs view
@@ -1,6 +1,12 @@ {-# LANGUAGE DeriveAnyClass #-} --- | Parser for text to TOML AST.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Parser for text to TOML AST.+-} module Toml.Parser ( ParseException (..)
src/Toml/Parser/Core.hs view
@@ -1,3 +1,11 @@+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Core functions for TOML parser.+-}+ module Toml.Parser.Core ( -- * Reexports from @megaparsec@ module Text.Megaparsec
src/Toml/Parser/Item.hs view
@@ -1,4 +1,9 @@-{-| This module contains the definition of the 'TomlItem' data type which+{-|+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++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.
src/Toml/Parser/Key.hs view
@@ -1,4 +1,9 @@-{- | Parsers for keys and table names.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Parsers for keys and table names. @since 1.2.0.0 -}
src/Toml/Parser/String.hs view
@@ -1,4 +1,9 @@-{- | Parsers for strings in TOML format, including basic and literal strings+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Parsers for strings in TOML format, including basic and literal strings both singleline and multiline. -}
src/Toml/Parser/Validate.hs view
@@ -1,4 +1,9 @@-{- | This module contains functions that aggregate the result of+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++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.
src/Toml/Parser/Value.hs view
@@ -1,4 +1,10 @@--- | Parser for 'UValue'.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Parser for 'UValue'.+-} module Toml.Parser.Value ( arrayP
src/Toml/PrefixTree.hs view
@@ -1,7 +1,13 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE PatternSynonyms #-} --- | Implementation of prefix tree for TOML AST.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Implementation of prefix tree for TOML AST.+-} module Toml.PrefixTree ( -- * Core types
src/Toml/Printer.hs view
@@ -1,6 +1,12 @@ {-# LANGUAGE TypeFamilies #-} -{- | Contains functions for pretty printing @toml@ types. -}+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Contains functions for pretty printing @toml@ types.+-} module Toml.Printer ( PrintOptions(..)
src/Toml/Type.hs view
@@ -1,4 +1,10 @@--- | Core types for TOML AST.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Core types for TOML AST.+-} module Toml.Type ( module Toml.Type.AnyValue
src/Toml/Type/AnyValue.hs view
@@ -5,7 +5,13 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} --- | Existential wrapper over 'Value' type and matching functions.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Existential wrapper over 'Value' type and matching functions.+-} module Toml.Type.AnyValue ( AnyValue (..)
src/Toml/Type/TOML.hs view
@@ -1,6 +1,12 @@ {-# LANGUAGE DeriveAnyClass #-} --- | Type of TOML AST. This is intermediate representation of TOML parsed from text.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Type of TOML AST. This is intermediate representation of TOML parsed from text.+-} module Toml.Type.TOML ( TOML (..)
src/Toml/Type/UValue.hs view
@@ -1,6 +1,12 @@ {-# LANGUAGE GADTs #-} --- | Intermediate untype value representation used for parsing.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++Intermediate untype value representation used for parsing.+-} module Toml.Type.UValue ( UValue (..)
src/Toml/Type/Value.hs view
@@ -6,7 +6,13 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} --- | GADT value for TOML.+{- |+Copyright: (c) 2018-2019 Kowainik+SPDX-License-Identifier: MPL-2.0+Maintainer: Kowainik <xrom.xkov@gmail.com>++GADT value for TOML.+-} module Toml.Type.Value ( -- * Type of value
test/Test/Toml/BiCode/Property.hs view
@@ -1,11 +1,13 @@ module Test.Toml.BiCode.Property where -import Control.Applicative ((<|>))+import Control.Applicative (liftA2, (<|>)) import Control.Category ((>>>)) import Data.ByteString (ByteString) import Data.HashSet (HashSet) import Data.IntSet (IntSet) import Data.List.NonEmpty (NonEmpty)+import Data.Map.Strict (Map)+import Data.Monoid (All (..), Any (..), First (..), Last (..), Product (..), Sum (..)) import Data.Set (Set) import Data.Text (Text) import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime, zonedTimeToUTC)@@ -54,8 +56,15 @@ , btNonEmpty :: !(NonEmpty ByteString) , btList :: ![Bool] , btNewtype :: !BigTypeNewtype- , btSum :: !BigTypeSum+ , btSumType :: !BigTypeSum , btRecord :: !BigTypeRecord+ , btMap :: !(Map Int Bool)+ , btAll :: !All+ , btAny :: !Any+ , btSum :: !(Sum Int)+ , btProduct :: !(Product Int)+ , btFirst :: !(First Int)+ , btLast :: !(Last Int) } deriving stock (Show, Eq) -- | Wrapper over 'Double' and 'Float' to be equal on @NaN@ values.@@ -110,8 +119,15 @@ <*> Toml.nonEmpty (Toml.byteString "bs") "nonEmptyBS" .= btNonEmpty <*> Toml.list (Toml.bool "bool") "listBool" .= btList <*> Toml.diwrap (Toml.zonedTime "nt.zonedTime") .= btNewtype- <*> bigTypeSumCodec .= btSum+ <*> bigTypeSumCodec .= btSumType <*> Toml.table bigTypeRecordCodec "table-record" .= btRecord+ <*> Toml.map (Toml.int "key") (Toml.bool "val") "map" .= btMap+ <*> Toml.all "all" .= btAll+ <*> Toml.any "any" .= btAny+ <*> Toml.sum Toml.int "sum" .= btSum+ <*> Toml.product Toml.int "product" .= btProduct+ <*> Toml.first Toml.int "first" .= btFirst+ <*> Toml.last Toml.int "last" .= btLast _BigTypeSumA :: TomlBiMap BigTypeSum Integer _BigTypeSumA = Toml.prism BigTypeSumA $ \case@@ -161,8 +177,15 @@ btNonEmpty <- genNonEmpty genByteString btList <- Gen.list (Range.constant 0 5) genBool btNewtype <- genNewType- btSum <- genSum+ btSumType <- genSum btRecord <- genRec+ btMap <- Gen.map (Range.constant 0 10) (liftA2 (,) genInt genBool)+ btAll <- All <$> genBool+ btAny <- Any <$> genBool+ btSum <- Sum <$> genInt+ btProduct <- Product <$> genInt+ btFirst <- First <$> Gen.maybe genInt+ btLast <- Last <$> Gen.maybe genInt pure BigType {..} -- Custom generators
test/Test/Toml/Parsing/Unit.hs view
@@ -1,597 +1,23 @@-{-# LANGUAGE FlexibleContexts #-}- module Test.Toml.Parsing.Unit where -import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Semigroup ((<>))-import Data.Text (Text)-import Data.Time (Day, LocalTime (..), TimeOfDay (..), TimeZone, ZonedTime (..), fromGregorian,- minutesToTimeZone)-import Test.Hspec.Megaparsec (parseSatisfies, shouldFailOn, shouldParse)-import Test.Tasty.Hspec (Expectation, Spec, context, describe, it)-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.Validate (validateItems)-import Toml.Parser.Value (arrayP, boolP, dateTimeP, doubleP, integerP)-import Toml.PrefixTree (Key (..), Piece (..), fromList)-import Toml.Type (AnyValue (..), TOML (..), UValue (..), Value (..))+import Test.Tasty.Hspec (Spec) -import qualified Data.HashMap.Lazy as HashMap-import qualified Data.List.NonEmpty as NE-import qualified Data.Text as T+import Test.Toml.Parsing.Unit.Array (arraySpecs)+import Test.Toml.Parsing.Unit.Bool (boolSpecs)+import Test.Toml.Parsing.Unit.Date (dateSpecs)+import Test.Toml.Parsing.Unit.Double (doubleSpecs)+import Test.Toml.Parsing.Unit.Integer (integerSpecs)+import Test.Toml.Parsing.Unit.Key (keySpecs)+import Test.Toml.Parsing.Unit.Text (textSpecs)+import Test.Toml.Parsing.Unit.Toml (tomlSpecs) spec_Parser :: Spec spec_Parser = do arraySpecs boolSpecs+ dateSpecs doubleSpecs integerSpecs keySpecs textSpecs- dateSpecs tomlSpecs--arraySpecs :: Spec-arraySpecs = describe "arrayP" $ do- it "can parse arrays" $ do- parseArray "[]" []- parseArray "[1]" [int1]- parseArray "[1, 2, 3]" [int1, int2, int3]- parseArray "[1.2, 2.3, 3.4]" [UDouble 1.2, UDouble 2.3, UDouble 3.4]- parseArray "['x', 'y']" [UText "x", UText "y"]- parseArray "[[1], [2]]" [UArray [UInteger 1], UArray [UInteger 2]]- parseArray "[1920-12-10, 1979-05-27]" [UDay day2, UDay day1]- parseArray "[16:33:05, 10:15:30]" [UHours (TimeOfDay 16 33 5), UHours (TimeOfDay 10 15 30)]- it "can parse multiline arrays" $- parseArray "[\n1,\n2\n]" [int1, int2]- it "can parse an array of arrays" $- parseArray "[[1], [2.3, 5.1]]" [UArray [int1], UArray [UDouble 2.3, UDouble 5.1]]- it "can parse an array with terminating commas (trailing commas)" $ do- parseArray "[1, 2,]" [int1, int2]- parseArray "[1, 2, 3, , ,]" [int1, int2, int3]- it "allows an arbitrary number of comments and newlines before or after a value" $- parseArray "[\n\n#c\n1, #c 2 \n 2, \n\n\n 3, #c \n #c \n 4]" [int1, int2, int3, int4]- it "ignores white spaces" $- parseArray "[ 1 , 2,3, 4 ]" [int1, int2, int3, int4]- it "fails if the elements are not surrounded by square brackets" $ do- arrayFailOn "1, 2, 3"- arrayFailOn "[1, 2, 3"- arrayFailOn "1, 2, 3]"- arrayFailOn "{'x', 'y', 'z'}"- arrayFailOn "(\"ab\", \"cd\")"- arrayFailOn "<true, false>"- it "fails if the elements are not separated by commas" $ do- arrayFailOn "[1 2 3]"- arrayFailOn "[1 . 2 . 3]"- arrayFailOn "['x' - 'y' - 'z']"- arrayFailOn "[1920-12-10, 10:15:30]"--boolSpecs :: Spec-boolSpecs = describe "boolP" $ do- it "can parse `true` and `false`" $ do- parseBool "true" True- parseBool "false" False- parseBool "true " True- it "fails if `true` or `false` are not all lowercase" $ do- boolFailOn "True"- boolFailOn "False"- boolFailOn "TRUE"- boolFailOn "FALSE"- boolFailOn "tRuE"- boolFailOn "fAlSE"--doubleSpecs :: Spec-doubleSpecs = describe "doubleP" $ do- it "can parse a number which consists of an integral part, and a fractional part" $ do- parseDouble "+1.0" 1.0- parseDouble "3.1415" 3.1415- parseDouble "0.0" 0.0- parseDouble "-0.01" (-0.01)- parseDouble "5e+22" 5e+22- parseDouble "1e6" 1e6- parseDouble "-2E-2" (-2E-2)- parseDouble "6.626e-34" 6.626e-34- it "can parse a number with underscores" $ do- parseDouble "5e+2_2" 5e+22- parseDouble "1.1_1e6" 1.11e6- parseDouble "-2_2.21_9E-0_2" (-22.219E-2)- it "can parse sign-prefixed zero" $ do- parseDouble "+0.0" 0.0- parseDouble "-0.0" (-0.0)- it "can parse positive and negative special float values (inf and nan)" $ do- parseDouble "inf" (1 / 0)- parseDouble "+inf" (1 / 0)- parseDouble "-inf" (-1 / 0)- doubleSatisfies "nan" isNaN- doubleSatisfies "+nan" isNaN- doubleSatisfies "-nan" isNaN- it "fails if `inf` or `nan` are not all lowercase" $ do- doubleFailOn "Inf"- doubleFailOn "INF"- doubleFailOn "Nan"- doubleFailOn "NAN"- doubleFailOn "NaN"- where- doubleSatisfies given f = parse doubleP "" given `parseSatisfies` f--integerSpecs :: Spec-integerSpecs = describe "integerP" $ do- context "when the integer is in decimal representation" $ do- it "can parse positive integer numbers" $ do- parseInteger "10" 10- parseInteger "+3" 3- parseInteger "0" 0- it "can parse negative integer numbers" $- parseInteger "-123" (-123)- it "can parse sign-prefixed zero as an unprefixed zero" $ do- parseInteger "+0" 0- parseInteger "-0" 0- it "can parse both the minimum and maximum numbers in the 64 bit range" $ do- parseInteger "-9223372036854775808" (-9223372036854775808)- parseInteger "9223372036854775807" 9223372036854775807- it "can parse numbers with underscores between digits" $ do- parseInteger "1_000" 1000- parseInteger "5_349_221" 5349221- parseInteger "1_2_3_4_5" 12345- it "does not parse incorrect underscores" $ do- integerFailOn "1_2_3_"- integerFailOn "13_"- integerFailOn "_123_"- integerFailOn "_13"- integerFailOn "_"- it "does not parse numbers with leading zeros" $ do- parseInteger "0123" 0- parseInteger "-023" 0- context "when the integer is in binary representation" $ do- it "can parse numbers prefixed with `0b`" $ do- parseInteger "0b1101" 13- parseInteger "0b0" 0- it "does not parse numbers prefixed with `0B`" $- parseInteger "0B1101" 0- it "can parse numbers with leading zeros after the prefix" $ do- parseInteger "0b000" 0- parseInteger "0b00011" 3- it "does not parse negative numbers" $- parseInteger "-0b101" 0- it "does not parse numbers with non-valid binary digits" $- parseInteger "0b123" 1- context "when the integer is in octal representation" $ do- it "can parse numbers prefixed with `0o`" $ do- parseInteger "0o567" 0o567- parseInteger "0o0" 0- it "does not parse numbers prefixed with `0O`" $- parseInteger "0O567" 0- it "can parse numbers with leading zeros after the prefix" $ do- parseInteger "0o000000" 0- parseInteger "0o000567" 0o567- it "does not parse negative numbers" $- parseInteger "-0o123" 0- it "does not parse numbers with non-valid octal digits" $- parseInteger "0o789" 0o7- context "when the integer is in hexadecimal representation" $ do- it "can parse numbers prefixed with `0x`" $ do- parseInteger "0x12af" 0x12af- parseInteger "0x0" 0- it "does not parse numbers prefixed with `0X`" $- parseInteger "0Xfff" 0- it "can parse numbers with leading zeros after the prefix" $ do- parseInteger "0x00000" 0- parseInteger "0x012af" 0x12af- it "does not parse negative numbers" $- parseInteger "-0xfff" 0- it "does not parse numbers with non-valid hexadecimal digits" $- parseInteger "0xfgh" 0xf- it "can parse numbers when hex digits are lowercase" $- parseInteger "0xabcdef" 0xabcdef- it "can parse numbers when hex digits are uppercase" $- parseInteger "0xABCDEF" 0xABCDEF- it "can parse numbers when hex digits are in both lowercase and uppercase" $ do- parseInteger "0xAbCdEf" 0xAbCdEf- parseInteger "0xaBcDeF" 0xaBcDeF--keySpecs :: Spec-keySpecs = describe "keyP" $ do- context "when the key is a bare key" $ do- it "can parse keys which contain ASCII letters, digits, underscores, and dashes" $ do- parseKey "key" (makeKey ["key"])- parseKey "bare_key1" (makeKey ["bare_key1"])- parseKey "bare-key2" (makeKey ["bare-key2"])- it "can parse keys which contain only digits" $- parseKey "1234" (makeKey ["1234"])- context "when the key is a quoted key" $ do- it "can parse keys that follow the exact same rules as basic strings" $ do- parseKey (dquote "127.0.0.1") (makeKey [dquote "127.0.0.1"])- parseKey (dquote "character encoding") (makeKey [dquote "character encoding"])- parseKey (dquote "ʎǝʞ") (makeKey [dquote "ʎǝʞ"])- it "can parse keys that follow the exact same rules as literal strings" $ do- parseKey (squote "key2") (makeKey [squote "key2"])- parseKey (squote "quoted \"value\"") (makeKey [squote "quoted \"value\""])- context "when the key is a dotted key" $ do- it "can parse a sequence of bare or quoted keys joined with a dot" $ do- parseKey "name" (makeKey ["name"])- parseKey "physical.color" (makeKey ["physical", "color"])- parseKey "physical.shape" (makeKey ["physical", "shape"])- parseKey "site.\"google.com\"" (makeKey ["site", dquote "google.com"])- -- it "ignores whitespaces around dot-separated parts" $ do- -- parseKey "a . b . c. d" (makeKey ["a", "b", "c", "d"])--textSpecs :: Spec-textSpecs = describe "textP" $ do- context "when the string is a basic string" $ do- it "can parse strings surrounded by double quotes" $ do- parseText (dquote "xyz") "xyz"- parseText (dquote "") ""- textFailOn "\"xyz"- textFailOn "xyz\""- textFailOn "xyz"- it "can parse escaped quotation marks, backslashes, and control characters" $ do- parseText (dquote "backspace: \\b") "backspace: \b"- parseText (dquote "tab: \\t") "tab: \t"- parseText (dquote "linefeed: \\n") "linefeed: \n"- parseText (dquote "form feed: \\f") "form feed: \f"- parseText (dquote "carriage return: \\r") "carriage return: \r"- parseText (dquote "quote: \\\"") "quote: \""- parseText (dquote "backslash: \\\\") "backslash: \\"- parseText (dquote "a\\uD7FFxy\\U0010FFFF\\uE000") "a\55295xy\1114111\57344"- it "fails if the string has an unescaped backslash, or control character" $ do- textFailOn (dquote "new \n line")- textFailOn (dquote "back \\ slash")- it "fails if the string has an escape sequence that is not listed in the TOML specification" $- textFailOn (dquote "xy\\z \\abc")- it "fails if the string is not on a single line" $ do- textFailOn (dquote "\nabc")- textFailOn (dquote "ab\r\nc")- textFailOn (dquote "abc\n")- it "fails if escape codes are not valid Unicode scalar values" $ do- textFailOn (dquote "\\u1")- textFailOn (dquote "\\uxyzw")- textFailOn (dquote "\\U0000")- textFailOn (dquote "\\uD8FF")- textFailOn (dquote "\\U001FFFFF")- context "when the string is a multi-line basic string" $ do-- it "can parse multi-line strings surrounded by three double quotes" $- parseText (dquote3 "Roses are red\nViolets are blue")- "Roses are red\nViolets are blue"- it "can parse single-line strings surrounded by three double quotes" $- parseText (dquote3 "Roses are red Violets are blue")- "Roses are red Violets are blue"- it "can parse all of the escape sequences that are valid for basic strings" $ do- parseText (dquote3 "backspace: \\b") "backspace: \b"- parseText (dquote3 "tab: \\t") "tab: \t"- parseText (dquote3 "linefeed: \\n") "linefeed: \n"- parseText (dquote3 "form feed: \\f") "form feed: \f"- parseText (dquote3 "carriage return: \\r") "carriage return: \r"- parseText (dquote3 "quote: \\\"") "quote: \""- parseText (dquote3 "backslash: \\\\") "backslash: \\"- parseText (dquote3 "a\\uD7FFxy\\U0010FFFF\\uE000") "a\55295xy\1114111\57344"- it "does not ignore whitespaces or newlines" $- parseText (dquote3 "\nabc \n xyz") "abc \n xyz"- it "ignores a newline only if it immediately follows the opening delimiter" $- parseText (dquote3 "\nThe quick brown") "The quick brown"- it "ignores whitespaces and newlines after line ending backslash" $- parseText (dquote3 "The quick brown \\\n\n fox jumps over") "The quick brown fox jumps over"- it "fails if the string has an unescaped backslash, or control character" $ do- textFailOn (dquote3 "backslash \\ .")- textFailOn (dquote3 "backspace \b ..")- textFailOn (dquote3 "tab \t ..")- context "when the string is a literal string" $ do- it "can parse strings surrounded by single quotes" $ do- parseText (squote "C:\\Users\\nodejs\\templates")- "C:\\Users\\nodejs\\templates"- parseText (squote "\\\\ServerX\\admin$\\system32\\")- "\\\\ServerX\\admin$\\system32\\"- parseText (squote "Tom \"Dubs\" Preston-Werner")- "Tom \"Dubs\" Preston-Werner"- parseText (squote "<\\i\\c*\\s*>") "<\\i\\c*\\s*>"- parseText (squote "a \t tab") "a \t tab"- it "fails if the string is not on a single line" $ do- textFailOn (squote "\nabc")- textFailOn (squote "ab\r\nc")- textFailOn (squote "abc\n")- context "when the string is a multi-line literal string" $ do- it "can parse multi-line strings surrounded by three single quotes" $- parseText (squote3 "first line \nsecond.\n 3\n")- "first line \nsecond.\n 3\n"- it "can parse single-line strings surrounded by three single quotes" $- parseText (squote3 "I [dw]on't need \\d{2} apples")- "I [dw]on't need \\d{2} apples"- it "ignores a newline immediately following the opening delimiter" $- parseText (squote3 "\na newline \nsecond.\n 3\n")- "a newline \nsecond.\n 3\n"- it "fails if the string has an unescaped control character other than tab" $ do- parseText (squote3 "\t") "\t"- textFailOn (squote3 "\b")--dateSpecs :: Spec-dateSpecs = describe "dateTimeP" $ do- it "can parse a date-time with an offset" $ do- parseDateTime "1979-05-27T07:32:00Z" $ makeZoned day1 hours1 offset0- parseDateTime "1979-05-27T00:32:00+07:10" $- makeZoned day1 (TimeOfDay 0 32 0) offset710- parseDateTime "1979-05-27T00:32:00.999999-07:25" $- makeZoned day1 (TimeOfDay 0 32 0.999999) (makeOffset (-7) 25)- it "can parse a date-time with an offset when the T delimiter is replaced with a space" $- parseDateTime "1979-05-27 07:32:00Z" $ makeZoned day1 hours1 offset0- it "can parse a date-time without an offset" $ do- parseDateTime "1979-05-27T17:32:00"- (ULocal $ LocalTime day1 (TimeOfDay 17 32 0))- parseDateTime "1979-05-27T00:32:00.999999"- (ULocal $ LocalTime day1 (TimeOfDay 0 32 0.999999))- it "can parse a local date"- $ parseDateTime "1979-05-27" (UDay day1)- it "can parse a local time" $ do- parseDateTime "07:32:00" (UHours hours1)- parseDateTime "00:32:00.999999" (UHours $ TimeOfDay 0 32 0.999999)- it "truncates the additional precision after picoseconds in the fractional seconds" $- parseDateTime "00:32:00.99999999999199" (UHours $ TimeOfDay 0 32 0.999999999991)- it "fails if the date is not valid" $ do- dateTimeFailOn "1920-15-12"- dateTimeFailOn "1920-12-40"- it "fails if the date does not have the form: 'yyyy-mm-dd'" $ do- dateTimeFailOn "1920-01-1"- dateTimeFailOn "1920-1-01"- dateTimeFailOn "920-01-01"- dateTimeFailOn "1920/10/01"- it "fails if the time is not valid" $ do- dateTimeFailOn "25:10:10"- dateTimeFailOn "10:70:10"- dateTimeFailOn "10:10:70"- it "fails if the time does not have the form: 'hh:mm:ss'" $ do- dateTimeFailOn "1:12:12"- dateTimeFailOn "12:1:12"- dateTimeFailOn "12:12:1"- dateTimeFailOn "12-12-12"- it "fails if the offset does not have any of the forms: 'Z', '+hh:mm', '-hh:mm'" $ do- parseDateTime "1979-05-27T00:32:00X"- (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))- parseDateTime "1979-05-27T00:32:00+07:1"- (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))- parseDateTime "1979-05-27T00:32:00+7:01"- (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))- parseDateTime "1979-05-27T00:32:0007:00"- (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))--tomlSpecs :: Spec-tomlSpecs = do- describe "Key/values" $ do- it "can parse key/value pairs" $ do- parseToml "x='abcdef'" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Text "abcdef"))])- parseToml "x=1" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Integer 1))])- parseToml "x=5.2" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Double 5.2))])- parseToml "x=true" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Bool True))])- parseToml "x=[1, 2, 3]" (tomlFromKeyVal [(makeKey ["x"] , AnyValue (Array [Integer 1, Integer 2, Integer 3]))])- parseToml "x = 1920-12-10" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Day day2))])- it "ignores white spaces around key names and values" $ do- let toml = tomlFromKeyVal [(makeKey ["x"], AnyValue (Integer 1))]- parseToml "x=1 " toml- parseToml "x= 1" toml- parseToml "x =1" toml- parseToml "x\t= 1 " toml- parseToml "\"x\" = 1" (tomlFromKeyVal [(makeKey [dquote "x"], AnyValue (Integer 1))])- --xit "fails if the key, equals sign, and value are not on the same line" $ do- -- keyValFailOn "x\n=\n1"- -- keyValFailOn "x=\n1"- -- keyValFailOn "\"x\"\n=\n1"- it "works if the value is broken over multiple lines" $- parseToml "x=[1, \n2\n]" (tomlFromKeyVal [(makeKey ["x"], AnyValue (Array [Integer 1, Integer 2]))])- it "fails if the value is not specified" $- tomlFailOn "x="-- describe "tables" $ do- it "can parse a TOML table" $- parseToml "[table] \n key1 = \"some string\"\nkey2 = 123"- $ tomlFromTable [(makeKey ["table"], tomlFromKeyVal [str, int])]- it "can parse an empty TOML table" $- parseToml "[table]" (tomlFromTable [(makeKey ["table"], mempty)])- it "can parse a table with subarrays" $ do- let t = tomlFromTable [(makeKey ["table"], tomlFromArray [(makeKey ["array"], strT :| [intT])])]- parseToml "[table] \n [[table.array]] \nkey1 = \"some string\"\n \- \[[table.array]] \nkey2 = 123" t- it "can parse a TOML inline table" $- parseToml "table={key1 = \"some string\", key2 = 123}"- (tomlFromTable [(makeKey ["table"], tomlFromKeyVal [str, int])])- it "can parse an empty inline TOML table" $- parseToml "table = {}" (tomlFromTable [(makeKey ["table"], mempty)])- it "can parse a table followed by an inline table" $- parseToml "[table1] \n key1 = \"some string\" \n table2 = {key2 = 123}"- (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- [ ( "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)])- parseToml "j.\"ʞ\".'l'={}"- (tomlFromTable [(makeKey ["j", dquote "ʞ", squote "l"], mempty)])-- describe "array of tables" $ do- it "can parse an empty array" $- parseToml "[[array]]" (tomlFromArray [(makeKey ["array"], mempty :| [])])- it "can parse an array of key/values" $ do- let array = tomlFromArray [(makeKey ["array"], NE.fromList [strT, intT])]- parseToml "[[array]]\n key1 = \"some string\"\n \- \[[array]]\n key2 = 123" array- it "can parse an array of tables" $ do- let table1 = tomlFromTable [(makeKey ["table1"], strT)]- table2 = tomlFromTable [(makeKey ["table2"], intT)]- array = tomlFromArray [(makeKey ["array"], NE.fromList [table1, table2])]- parseToml "[[array]]\n[array.table1] \n key1 = \"some string\"\n \- \[[array]]\n[array.table2] \n key2 = 123" array- it "can parse an array of array" $ do- let arr = tomlFromArray [(makeKey ["subarray"], NE.fromList [strT, intT])]- array = tomlFromArray [(makeKey ["array"], arr :| [])]- parseToml "[[array]] \n [[array.subarray]] \nkey1 = \"some string\"\n \- \[[array.subarray]] \nkey2 = 123" array- it "can parse an array of arrays" $ do- let arr1 = (makeKey ["table-1"], strT :| [])- arr2 = (makeKey ["table-2"], intT :| [])- array = tomlFromArray [(makeKey ["array"], tomlFromArray [arr1, arr2] :| [])]- parseToml "[[array]]\n [[array.table-1]] \nkey1 = \"some string\"\n \- \[[array.table-2]] \nkey2 = 123" array- it "can parse very large arrays" $ do- let array = tomlFromArray [(makeKey ["array"], NE.fromList $ replicate 1000 mempty)]- parseToml (mconcat $ replicate 1000 "[[array]]\n") array- it "can parse an inline array of tables" $ do- let array = tomlFromArray [(makeKey ["table"], NE.fromList [strT, intT])]- parseToml "table = [{key1 = \"some string\"}, {key2 = 123}]" array-- describe "TOML" $ do- it "can parse TOML files" $- parseToml tomlStr1 toml1- it "can parse mix of tables and arrays" $- parseToml tomlStr2 toml2- where- tomlStr1, tomlStr2 :: Text- tomlStr1 = T.unlines- [ " # This is a TOML document.\n\n"- , "title = \"TOML Example\" # Comment \n\n"- , "[owner]\n"- , " name = \"Tom Preston-Werner\" "- , " enabled = true # First class dates"- ]- tomlStr2 = T.unlines- [ "[[array1]]\n key1 = \"some string\" \n"- , ""- , "[table1] \n key2 = 123 \n"- , "[[array2]]\n key3 = 3.14 \n"- , " [table2] \n key4 = true"- ]-- toml1, toml2 :: TOML- toml1 = mkToml $ do- "title" =: "TOML Example"- table "owner" $ do- "name" =: "Tom Preston-Werner"- "enabled" =: Bool True-- toml2 = mkToml $ do- tableArray "array1" $- "key1" =: "some string" :| []- table "table1" $ "key2" =: 123- tableArray "array2" $- "key3" =: Double 3.14 :| []- table "table2" $ "key4" =: Bool True--------------------------------------------------------------------------------- Utilities-------------------------------------------------------------------------------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-failOn p given = parse p "" `shouldFailOn` given--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 test toml = parseX (validateItems <$> tomlP) test (Right toml)--arrayFailOn- , boolFailOn- , dateTimeFailOn- , doubleFailOn- , integerFailOn- , textFailOn- , tomlFailOn :: Text -> Expectation-arrayFailOn = failOn arrayP-boolFailOn = failOn boolP-dateTimeFailOn = failOn dateTimeP-doubleFailOn = failOn doubleP-integerFailOn = failOn integerP-textFailOn = failOn textP-tomlFailOn = failOn tomlP---- UValue Util--makeZoned :: Day -> TimeOfDay -> TimeZone -> UValue-makeZoned d h offset = UZoned $ ZonedTime (LocalTime d h) offset--makeOffset :: Int -> Int -> TimeZone-makeOffset hours mins = minutesToTimeZone (hours * 60 + mins * signum hours)--makeKey :: [Text] -> Key-makeKey = Key . NE.fromList . map Piece--tomlFromKeyVal :: [(Key, AnyValue)] -> TOML-tomlFromKeyVal kv = TOML (HashMap.fromList kv) mempty mempty--tomlFromTable :: [(Key, TOML)] -> TOML-tomlFromTable t = TOML mempty (fromList t) mempty--tomlFromArray :: [(Key, NonEmpty TOML)] -> TOML-tomlFromArray = TOML mempty mempty . HashMap.fromList---- Surround given text with quotes.-quoteWith :: Text -> Text -> Text-quoteWith q t = q <> t <> q-squote, dquote, squote3, dquote3 :: Text -> Text-squote = quoteWith "'"-dquote = quoteWith "\""-squote3 = quoteWith "'''"-dquote3 = quoteWith "\"\"\""---- Test Data---- Key-Value pairs-str, int :: (Key, AnyValue)-str = (makeKey ["key1"], AnyValue (Text "some string"))-int = (makeKey ["key2"], AnyValue (Integer 123))--strT, intT :: TOML-strT = tomlFromKeyVal [str]-intT = tomlFromKeyVal [int]--int1, int2, int3, int4 :: UValue-int1 = UInteger 1-int2 = UInteger 2-int3 = UInteger 3-int4 = UInteger 4--offset0, offset710 :: TimeZone-offset0 = makeOffset 0 0-offset710 = makeOffset 7 10--day1, day2 :: Day-day1 = fromGregorian 1979 5 27 -- 1979-05-27-day2 = fromGregorian 1920 12 10 -- 1920-12-10--hours1 :: TimeOfDay-hours1 = TimeOfDay 7 32 0 -- 07:32:00
+ test/Test/Toml/Parsing/Unit/Array.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Toml.Parsing.Unit.Array where++import Data.Time (TimeOfDay (..))+import Test.Tasty.Hspec (Spec, describe, it)++import Toml.Type (UValue (..))++import Test.Toml.Parsing.Unit.Common (arrayFailOn, day1, day2, int1, int2, int3, int4, parseArray)++arraySpecs :: Spec+arraySpecs = describe "arrayP" $ do+ it "can parse arrays" $ do+ parseArray "[]" []+ parseArray "[1]" [int1]+ parseArray "[1, 2, 3]" [int1, int2, int3]+ parseArray "[1.2, 2.3, 3.4]" [UDouble 1.2, UDouble 2.3, UDouble 3.4]+ parseArray "['x', 'y']" [UText "x", UText "y"]+ parseArray "[[1], [2]]" [UArray [UInteger 1], UArray [UInteger 2]]+ parseArray "[1920-12-10, 1979-05-27]" [UDay day2, UDay day1]+ parseArray "[16:33:05, 10:15:30]" [UHours (TimeOfDay 16 33 5), UHours (TimeOfDay 10 15 30)]+ it "can parse multiline arrays" $+ parseArray "[\n1,\n2\n]" [int1, int2]+ it "can parse an array of arrays" $+ parseArray "[[1], [2.3, 5.1]]" [UArray [int1], UArray [UDouble 2.3, UDouble 5.1]]+ it "can parse an array with terminating commas (trailing commas)" $ do+ parseArray "[1, 2,]" [int1, int2]+ parseArray "[1, 2, 3, , ,]" [int1, int2, int3]+ it "allows an arbitrary number of comments and newlines before or after a value" $+ parseArray "[\n\n#c\n1, #c 2 \n 2, \n\n\n 3, #c \n #c \n 4]" [int1, int2, int3, int4]+ it "ignores white spaces" $+ parseArray "[ 1 , 2,3, 4 ]" [int1, int2, int3, int4]+ it "fails if the elements are not surrounded by square brackets" $ do+ arrayFailOn "1, 2, 3"+ arrayFailOn "[1, 2, 3"+ arrayFailOn "1, 2, 3]"+ arrayFailOn "{'x', 'y', 'z'}"+ arrayFailOn "(\"ab\", \"cd\")"+ arrayFailOn "<true, false>"+ it "fails if the elements are not separated by commas" $ do+ arrayFailOn "[1 2 3]"+ arrayFailOn "[1 . 2 . 3]"+ arrayFailOn "['x' - 'y' - 'z']"+ arrayFailOn "[1920-12-10, 10:15:30]"
+ test/Test/Toml/Parsing/Unit/Bool.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Toml.Parsing.Unit.Bool where++import Test.Tasty.Hspec (Spec, describe, it)++import Test.Toml.Parsing.Unit.Common (boolFailOn, parseBool)++boolSpecs :: Spec+boolSpecs = describe "boolP" $ do+ it "can parse `true` and `false`" $ do+ parseBool "true" True+ parseBool "false" False+ parseBool "true " True+ it "fails if `true` or `false` are not all lowercase" $ do+ boolFailOn "True"+ boolFailOn "False"+ boolFailOn "TRUE"+ boolFailOn "FALSE"+ boolFailOn "tRuE"+ boolFailOn "fAlSE"
+ test/Test/Toml/Parsing/Unit/Common.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Toml.Parsing.Unit.Common+ ( parseX+ , failOn+ , parseArray+ , parseBool+ , parseDouble+ , parseInteger+ , parseKey+ , parseText+ , parseToml+ , parseDateTime+ , arrayFailOn+ , boolFailOn+ , integerFailOn+ , dateTimeFailOn+ , doubleFailOn+ , textFailOn+ , tomlFailOn+ , quoteWith+ , squote+ , dquote+ , squote3+ , dquote3+ , makeOffset+ , makeZoned+ , int1+ , int2+ , int3+ , int4+ , offset710+ , offset0+ , day1+ , day2+ , hours1+ ) where++import Data.Semigroup ((<>))+import Data.Text (Text)+import Data.Time (Day, LocalTime (..), TimeOfDay (..), TimeZone, ZonedTime (..), fromGregorian,+ minutesToTimeZone)+import Test.Hspec.Megaparsec (shouldFailOn, shouldParse)+import Test.Tasty.Hspec (Expectation)+import Text.Megaparsec (Parsec, ShowErrorComponent, Stream, parse)++import Toml.Parser.Item (tomlP)+import Toml.Parser.Key (keyP)+import Toml.Parser.String (textP)+import Toml.Parser.Validate (validateItems)+import Toml.Parser.Value (arrayP, boolP, dateTimeP, doubleP, integerP)+import Toml.PrefixTree (Key (..))+import Toml.Type (TOML (..), UValue (..))++----------------------------------------------------------------------------+-- Utilities+----------------------------------------------------------------------------++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+failOn p given = parse p "" `shouldFailOn` given++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 test toml = parseX (validateItems <$> tomlP) test (Right toml)++arrayFailOn+ , boolFailOn+ , dateTimeFailOn+ , doubleFailOn+ , integerFailOn+ , textFailOn+ , tomlFailOn :: Text -> Expectation+arrayFailOn = failOn arrayP+boolFailOn = failOn boolP+dateTimeFailOn = failOn dateTimeP+doubleFailOn = failOn doubleP+integerFailOn = failOn integerP+textFailOn = failOn textP+tomlFailOn = failOn tomlP++-- Surround given text with quotes.+quoteWith :: Text -> Text -> Text+quoteWith q t = q <> t <> q+squote, dquote, squote3, dquote3 :: Text -> Text+squote = quoteWith "'"+dquote = quoteWith "\""+squote3 = quoteWith "'''"+dquote3 = quoteWith "\"\"\""++-- UValue Util++makeZoned :: Day -> TimeOfDay -> TimeZone -> UValue+makeZoned d h offset = UZoned $ ZonedTime (LocalTime d h) offset++makeOffset :: Int -> Int -> TimeZone+makeOffset hours mins = minutesToTimeZone (hours * 60 + mins * signum hours)++-- Test Data++int1, int2, int3, int4 :: UValue+int1 = UInteger 1+int2 = UInteger 2+int3 = UInteger 3+int4 = UInteger 4++offset0, offset710 :: TimeZone+offset0 = makeOffset 0 0+offset710 = makeOffset 7 10++day1, day2 :: Day+day1 = fromGregorian 1979 5 27 -- 1979-05-27+day2 = fromGregorian 1920 12 10 -- 1920-12-10++hours1 :: TimeOfDay+hours1 = TimeOfDay 7 32 0 -- 07:32:00
+ test/Test/Toml/Parsing/Unit/Date.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Toml.Parsing.Unit.Date where++import Data.Time (LocalTime (..), TimeOfDay (..))++import Toml.Type (UValue (..))++import Test.Tasty.Hspec (Spec, describe, it)++import Test.Toml.Parsing.Unit.Common (dateTimeFailOn, day1, hours1, makeOffset, makeZoned, offset0,+ offset710, parseDateTime)++dateSpecs :: Spec+dateSpecs = describe "dateTimeP" $ do+ it "can parse a date-time with an offset" $ do+ parseDateTime "1979-05-27T07:32:00Z" $ makeZoned day1 hours1 offset0+ parseDateTime "1979-05-27T00:32:00+07:10" $+ makeZoned day1 (TimeOfDay 0 32 0) offset710+ parseDateTime "1979-05-27T00:32:00.999999-07:25" $+ makeZoned day1 (TimeOfDay 0 32 0.999999) (makeOffset (-7) 25)+ it "can parse a date-time with an offset when the T delimiter is replaced with a space" $+ parseDateTime "1979-05-27 07:32:00Z" $ makeZoned day1 hours1 offset0+ it "can parse a date-time without an offset" $ do+ parseDateTime "1979-05-27T17:32:00"+ (ULocal $ LocalTime day1 (TimeOfDay 17 32 0))+ parseDateTime "1979-05-27T00:32:00.999999"+ (ULocal $ LocalTime day1 (TimeOfDay 0 32 0.999999))+ it "can parse a local date"+ $ parseDateTime "1979-05-27" (UDay day1)+ it "can parse a local time" $ do+ parseDateTime "07:32:00" (UHours hours1)+ parseDateTime "00:32:00.999999" (UHours $ TimeOfDay 0 32 0.999999)+ it "truncates the additional precision after picoseconds in the fractional seconds" $+ parseDateTime "00:32:00.99999999999199" (UHours $ TimeOfDay 0 32 0.999999999991)+ it "fails if the date is not valid" $ do+ dateTimeFailOn "1920-15-12"+ dateTimeFailOn "1920-12-40"+ it "fails if the date does not have the form: 'yyyy-mm-dd'" $ do+ dateTimeFailOn "1920-01-1"+ dateTimeFailOn "1920-1-01"+ dateTimeFailOn "920-01-01"+ dateTimeFailOn "1920/10/01"+ it "fails if the time is not valid" $ do+ dateTimeFailOn "25:10:10"+ dateTimeFailOn "10:70:10"+ dateTimeFailOn "10:10:70"+ it "fails if the time does not have the form: 'hh:mm:ss'" $ do+ dateTimeFailOn "1:12:12"+ dateTimeFailOn "12:1:12"+ dateTimeFailOn "12:12:1"+ dateTimeFailOn "12-12-12"+ it "fails if the offset does not have any of the forms: 'Z', '+hh:mm', '-hh:mm'" $ do+ parseDateTime "1979-05-27T00:32:00X"+ (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))+ parseDateTime "1979-05-27T00:32:00+07:1"+ (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))+ parseDateTime "1979-05-27T00:32:00+7:01"+ (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))+ parseDateTime "1979-05-27T00:32:0007:00"+ (ULocal $ LocalTime day1 (TimeOfDay 0 32 0))
+ test/Test/Toml/Parsing/Unit/Double.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Toml.Parsing.Unit.Double where++import Test.Hspec.Megaparsec (parseSatisfies)+import Test.Tasty.Hspec (Spec, describe, it)+import Text.Megaparsec (parse)++import Toml.Parser.Value (doubleP)++import Test.Toml.Parsing.Unit.Common (doubleFailOn, parseDouble)++doubleSpecs :: Spec+doubleSpecs = describe "doubleP" $ do+ it "can parse a number which consists of an integral part, and a fractional part" $ do+ parseDouble "+1.0" 1.0+ parseDouble "3.1415" 3.1415+ parseDouble "0.0" 0.0+ parseDouble "-0.01" (-0.01)+ parseDouble "5e+22" 5e+22+ parseDouble "1e6" 1e6+ parseDouble "-2E-2" (-2E-2)+ parseDouble "6.626e-34" 6.626e-34+ it "can parse a number with underscores" $ do+ parseDouble "5e+2_2" 5e+22+ parseDouble "1.1_1e6" 1.11e6+ parseDouble "-2_2.21_9E-0_2" (-22.219E-2)+ it "can parse sign-prefixed zero" $ do+ parseDouble "+0.0" 0.0+ parseDouble "-0.0" (-0.0)+ it "can parse positive and negative special float values (inf and nan)" $ do+ parseDouble "inf" (1 / 0)+ parseDouble "+inf" (1 / 0)+ parseDouble "-inf" (-1 / 0)+ doubleSatisfies "nan" isNaN+ doubleSatisfies "+nan" isNaN+ doubleSatisfies "-nan" isNaN+ it "fails if `inf` or `nan` are not all lowercase" $ do+ doubleFailOn "Inf"+ doubleFailOn "INF"+ doubleFailOn "Nan"+ doubleFailOn "NAN"+ doubleFailOn "NaN"+ where+ doubleSatisfies given f = parse doubleP "" given `parseSatisfies` f
+ test/Test/Toml/Parsing/Unit/Integer.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Toml.Parsing.Unit.Integer where++import Test.Tasty.Hspec (Spec, context, describe, it)++import Test.Toml.Parsing.Unit.Common (integerFailOn, parseInteger)++integerSpecs :: Spec+integerSpecs = describe "integerP" $ do+ context "when the integer is in decimal representation" $ do+ it "can parse positive integer numbers" $ do+ parseInteger "10" 10+ parseInteger "+3" 3+ parseInteger "0" 0+ it "can parse negative integer numbers" $+ parseInteger "-123" (-123)+ it "can parse sign-prefixed zero as an unprefixed zero" $ do+ parseInteger "+0" 0+ parseInteger "-0" 0+ it "can parse both the minimum and maximum numbers in the 64 bit range" $ do+ parseInteger "-9223372036854775808" (-9223372036854775808)+ parseInteger "9223372036854775807" 9223372036854775807+ it "can parse numbers with underscores between digits" $ do+ parseInteger "1_000" 1000+ parseInteger "5_349_221" 5349221+ parseInteger "1_2_3_4_5" 12345+ it "does not parse incorrect underscores" $ do+ integerFailOn "1_2_3_"+ integerFailOn "13_"+ integerFailOn "_123_"+ integerFailOn "_13"+ integerFailOn "_"+ it "does not parse numbers with leading zeros" $ do+ parseInteger "0123" 0+ parseInteger "-023" 0+ context "when the integer is in binary representation" $ do+ it "can parse numbers prefixed with `0b`" $ do+ parseInteger "0b1101" 13+ parseInteger "0b0" 0+ it "does not parse numbers prefixed with `0B`" $+ parseInteger "0B1101" 0+ it "can parse numbers with leading zeros after the prefix" $ do+ parseInteger "0b000" 0+ parseInteger "0b00011" 3+ it "does not parse negative numbers" $+ parseInteger "-0b101" 0+ it "does not parse numbers with non-valid binary digits" $+ parseInteger "0b123" 1+ context "when the integer is in octal representation" $ do+ it "can parse numbers prefixed with `0o`" $ do+ parseInteger "0o567" 0o567+ parseInteger "0o0" 0+ it "does not parse numbers prefixed with `0O`" $+ parseInteger "0O567" 0+ it "can parse numbers with leading zeros after the prefix" $ do+ parseInteger "0o000000" 0+ parseInteger "0o000567" 0o567+ it "does not parse negative numbers" $+ parseInteger "-0o123" 0+ it "does not parse numbers with non-valid octal digits" $+ parseInteger "0o789" 0o7+ context "when the integer is in hexadecimal representation" $ do+ it "can parse numbers prefixed with `0x`" $ do+ parseInteger "0x12af" 0x12af+ parseInteger "0x0" 0+ it "does not parse numbers prefixed with `0X`" $+ parseInteger "0Xfff" 0+ it "can parse numbers with leading zeros after the prefix" $ do+ parseInteger "0x00000" 0+ parseInteger "0x012af" 0x12af+ it "does not parse negative numbers" $+ parseInteger "-0xfff" 0+ it "does not parse numbers with non-valid hexadecimal digits" $+ parseInteger "0xfgh" 0xf+ it "can parse numbers when hex digits are lowercase" $+ parseInteger "0xabcdef" 0xabcdef+ it "can parse numbers when hex digits are uppercase" $+ parseInteger "0xABCDEF" 0xABCDEF+ it "can parse numbers when hex digits are in both lowercase and uppercase" $ do+ parseInteger "0xAbCdEf" 0xAbCdEf+ parseInteger "0xaBcDeF" 0xaBcDeF
+ test/Test/Toml/Parsing/Unit/Key.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-}++module Test.Toml.Parsing.Unit.Key where++import Test.Tasty.Hspec (Spec, context, describe, it)+import Toml.PrefixTree (pattern (:||))++import Test.Toml.Parsing.Unit.Common (dquote, parseKey, squote)++keySpecs :: Spec+keySpecs = describe "keyP" $ do+ context "when the key is a bare key" $ do+ it "can parse keys which contain ASCII letters, digits, underscores, and dashes" $ do+ parseKey "key" "key"+ parseKey "bare_key1" "bare_key1"+ parseKey "bare-key2" "bare-key2"+ it "can parse keys which contain only digits" $+ parseKey "1234" "1234"+ context "when the key is a quoted key" $ do+ it "can parse keys that follow the exact same rules as basic strings" $ do+ parseKey (dquote "127.0.0.1") ("\"127.0.0.1\"" :|| [])+ parseKey (dquote "character encoding") "\"character encoding\""+ parseKey (dquote "ʎǝʞ") "\"ʎǝʞ\""+ it "can parse keys that follow the exact same rules as literal strings" $ do+ parseKey (squote "key2") "'key2'"+ parseKey (squote "quoted \"value\"") "'quoted \"value\"'"+ context "when the key is a dotted key" $ do+ it "can parse a sequence of bare or quoted keys joined with a dot" $ do+ parseKey "name" "name"+ parseKey "physical.color" "physical.color"+ parseKey "physical.shape" "physical.shape"+ parseKey "site.\"google.com\"" ("site" :|| ["\"google.com\""])+ -- it "ignores whitespaces around dot-separated parts" $ do+ -- parseKey "a . b . c. d" (makeKey ["a", "b", "c", "d"])
+ test/Test/Toml/Parsing/Unit/Text.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE FlexibleContexts #-}++module Test.Toml.Parsing.Unit.Text where++import Test.Tasty.Hspec (Spec, context, describe, it)++import Test.Toml.Parsing.Unit.Common (dquote, dquote3, parseText, squote, squote3, textFailOn)++textSpecs :: Spec+textSpecs = describe "textP" $ do+ context "when the string is a basic string" $ do+ it "can parse strings surrounded by double quotes" $ do+ parseText (dquote "xyz") "xyz"+ parseText (dquote "") ""+ textFailOn "\"xyz"+ textFailOn "xyz\""+ textFailOn "xyz"+ it "can parse escaped quotation marks, backslashes, and control characters" $ do+ parseText (dquote "backspace: \\b") "backspace: \b"+ parseText (dquote "tab: \\t") "tab: \t"+ parseText (dquote "linefeed: \\n") "linefeed: \n"+ parseText (dquote "form feed: \\f") "form feed: \f"+ parseText (dquote "carriage return: \\r") "carriage return: \r"+ parseText (dquote "quote: \\\"") "quote: \""+ parseText (dquote "backslash: \\\\") "backslash: \\"+ parseText (dquote "a\\uD7FFxy\\U0010FFFF\\uE000") "a\55295xy\1114111\57344"+ it "fails if the string has an unescaped backslash, or control character" $ do+ textFailOn (dquote "new \n line")+ textFailOn (dquote "back \\ slash")+ it "fails if the string has an escape sequence that is not listed in the TOML specification" $+ textFailOn (dquote "xy\\z \\abc")+ it "fails if the string is not on a single line" $ do+ textFailOn (dquote "\nabc")+ textFailOn (dquote "ab\r\nc")+ textFailOn (dquote "abc\n")+ it "fails if escape codes are not valid Unicode scalar values" $ do+ textFailOn (dquote "\\u1")+ textFailOn (dquote "\\uxyzw")+ textFailOn (dquote "\\U0000")+ textFailOn (dquote "\\uD8FF")+ textFailOn (dquote "\\U001FFFFF")+ context "when the string is a multi-line basic string" $ do++ it "can parse multi-line strings surrounded by three double quotes" $+ parseText (dquote3 "Roses are red\nViolets are blue")+ "Roses are red\nViolets are blue"+ it "can parse single-line strings surrounded by three double quotes" $+ parseText (dquote3 "Roses are red Violets are blue")+ "Roses are red Violets are blue"+ it "can parse all of the escape sequences that are valid for basic strings" $ do+ parseText (dquote3 "backspace: \\b") "backspace: \b"+ parseText (dquote3 "tab: \\t") "tab: \t"+ parseText (dquote3 "linefeed: \\n") "linefeed: \n"+ parseText (dquote3 "form feed: \\f") "form feed: \f"+ parseText (dquote3 "carriage return: \\r") "carriage return: \r"+ parseText (dquote3 "quote: \\\"") "quote: \""+ parseText (dquote3 "backslash: \\\\") "backslash: \\"+ parseText (dquote3 "a\\uD7FFxy\\U0010FFFF\\uE000") "a\55295xy\1114111\57344"+ it "does not ignore whitespaces or newlines" $+ parseText (dquote3 "\nabc \n xyz") "abc \n xyz"+ it "ignores a newline only if it immediately follows the opening delimiter" $+ parseText (dquote3 "\nThe quick brown") "The quick brown"+ it "ignores whitespaces and newlines after line ending backslash" $+ parseText (dquote3 "The quick brown \\\n\n fox jumps over") "The quick brown fox jumps over"+ it "fails if the string has an unescaped backslash, or control character" $ do+ textFailOn (dquote3 "backslash \\ .")+ textFailOn (dquote3 "backspace \b ..")+ textFailOn (dquote3 "tab \t ..")+ context "when the string is a literal string" $ do+ it "can parse strings surrounded by single quotes" $ do+ parseText (squote "C:\\Users\\nodejs\\templates")+ "C:\\Users\\nodejs\\templates"+ parseText (squote "\\\\ServerX\\admin$\\system32\\")+ "\\\\ServerX\\admin$\\system32\\"+ parseText (squote "Tom \"Dubs\" Preston-Werner")+ "Tom \"Dubs\" Preston-Werner"+ parseText (squote "<\\i\\c*\\s*>") "<\\i\\c*\\s*>"+ parseText (squote "a \t tab") "a \t tab"+ it "fails if the string is not on a single line" $ do+ textFailOn (squote "\nabc")+ textFailOn (squote "ab\r\nc")+ textFailOn (squote "abc\n")+ context "when the string is a multi-line literal string" $ do+ it "can parse multi-line strings surrounded by three single quotes" $+ parseText (squote3 "first line \nsecond.\n 3\n")+ "first line \nsecond.\n 3\n"+ it "can parse single-line strings surrounded by three single quotes" $+ parseText (squote3 "I [dw]on't need \\d{2} apples")+ "I [dw]on't need \\d{2} apples"+ it "ignores a newline immediately following the opening delimiter" $+ parseText (squote3 "\na newline \nsecond.\n 3\n")+ "a newline \nsecond.\n 3\n"+ it "fails if the string has an unescaped control character other than tab" $ do+ parseText (squote3 "\t") "\t"+ textFailOn (squote3 "\b")
+ test/Test/Toml/Parsing/Unit/Toml.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-}++module Test.Toml.Parsing.Unit.Toml where++import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Semigroup ((<>))+import Data.Text (Text)++import Test.Tasty.Hspec (Spec, describe, it)++import Toml.Edsl (empty, mkToml, table, tableArray, (=:))+import Toml.PrefixTree (pattern (:||))+import Toml.Type (TOML (..), Value (..))++import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T++import Test.Toml.Parsing.Unit.Common (day2, parseToml, tomlFailOn)++tomlSpecs :: Spec+tomlSpecs = do+ describe "Key/values" $ do+ it "can parse key/value pairs" $ do+ parseToml "x='abcdef'" $ mkToml ("x" =: "abcdef")+ parseToml "x= 1" $ mkToml ("x" =: 1)+ parseToml "x =5.2" $ mkToml ("x" =: Double 5.2)+ parseToml "x = true" $ mkToml ("x" =: Bool True)+ parseToml "x= [1, 2, 3]" $ mkToml ("x" =: Array [1, 2, 3])+ parseToml "x =1920-12-10" $ mkToml ("x" =: Day day2)+ it "ignores white spaces around key names and values" $ do+ let toml = mkToml ("x" =: 1)+ parseToml "x=1 " toml+ parseToml "x= 1" toml+ parseToml "x =1" toml+ parseToml "x\t= 1 " toml+ parseToml "\"x\" = 1" $ mkToml ("\"x\"" =: 1)+ --xit "fails if the key, equals sign, and value are not on the same line" $ do+ -- keyValFailOn "x\n=\n1"+ -- keyValFailOn "x=\n1"+ -- keyValFailOn "\"x\"\n=\n1"+ it "works if the value is broken over multiple lines" $+ parseToml "x=[1, \n2\n]" $ mkToml ("x" =: Array [1, 2])+ it "fails if the value is not specified" $+ tomlFailOn "x="++ describe "tables" $ do+ it "can parse a TOML table" $ do+ let t = mkToml $+ table "table" $ do+ "key1" =: "some string"+ "key2" =: 123++ parseToml "[table] \n key1 = \"some string\"\nkey2 = 123" t+ it "can parse an empty TOML table" $+ parseToml "[table]" $ mkToml (table "table" empty)+ it "can parse a table with subarrays" $ do+ let t = mkToml $+ table "table" $+ tableArray "array" ("key1" =: "some string" :| ["key2" =: 123])++ parseToml "[table] \n [[table.array]] \nkey1 = \"some string\"\n \+ \[[table.array]] \nkey2 = 123" t+ it "can parse a TOML inline table" $+ parseToml "table={key1 = \"some string\", key2 = 123}" $+ mkToml $+ table "table" $ do+ "key1" =: "some string"+ "key2" =: 123+ it "can parse an empty inline TOML table" $+ parseToml "table = {}" $ mkToml (table "table" empty)+ it "can parse a table followed by an inline table" $+ parseToml "[table1] \n key1 = \"some string\" \n table2 = {key2 = 123}" $+ mkToml $+ table "table1" $ do+ "key1" =: "some string"+ table "table2" $ "key2" =: 123+ it "can parse an empty table followed by an inline table" $+ parseToml "[table1] \n table2 = {key2 = 123}" $+ mkToml $+ table "table1" $+ table "table2" $+ "key2" =: 123+ it "allows the name of the table to be any valid TOML key" $ do+ parseToml "dog.\"tater.man\"={}" $ mkToml $ table ("dog" :|| ["\"tater.man\""]) empty+ parseToml "j.\"ʞ\".'l'={}" $ mkToml $ table "j.\"ʞ\".'l'" empty++ describe "array of tables" $ do+ it "can parse an empty array" $+ parseToml "[[array]]" $ mkToml $ tableArray "array" (empty :| [])+ it "can parse an array of key/values" $ do+ let array = mkToml $+ tableArray "array" $+ "key1" =: "some string" :|+ ["key2" =: 123]++ parseToml "[[array]]\n key1 = \"some string\"\n \+ \[[array]]\n key2 = 123" array+ it "can parse an array of tables" $ do+ let table1 = table "table1" ("key1" =: "some string")+ table2 = table "table2" ("key2" =: 123)+ array = mkToml $ tableArray "array" $ table1 :| [table2]++ parseToml "[[array]]\n[array.table1] \n key1 = \"some string\"\n \+ \[[array]]\n[array.table2] \n key2 = 123" array+ it "can parse an array of array" $ do+ let arr = tableArray "subarray" ("key1" =: "some string" :| ["key2" =: 123])+ array = mkToml $ tableArray "array" (arr :| [])++ parseToml "[[array]] \n [[array.subarray]] \nkey1 = \"some string\"\n \+ \[[array.subarray]] \nkey2 = 123" array+ it "can parse an array of arrays" $ do+ let+ arr1 = tableArray "table-1" ("key1" =: Text "some string" :| [])+ arr2 = tableArray "table-2" ("key2" =: Integer 123 :| [])+ array = mkToml $ tableArray "array" $ (arr1 >> arr2) :| []++ parseToml "[[array]]\n [[array.table-1]] \nkey1 = \"some string\"\n \+ \[[array.table-2]] \nkey2 = 123" array+ it "can parse very large arrays" $ do+ let array = mkToml $ tableArray "array" $ NE.fromList $ replicate 1000 empty+ parseToml (mconcat $ replicate 1000 "[[array]]\n") array+ it "can parse an inline array of tables" $ do+ let array = mkToml $ tableArray "table" $ NE.fromList ["key1" =: "some string", "key2" =: 123]+ parseToml "table = [{key1 = \"some string\"}, {key2 = 123}]" array++ describe "TOML" $ do+ it "can parse TOML files" $+ parseToml tomlStr1 toml1+ it "can parse mix of tables and arrays" $+ parseToml tomlStr2 toml2+ where+ tomlStr1, tomlStr2 :: Text+ tomlStr1 = T.unlines+ [ " # This is a TOML document.\n\n"+ , "title = \"TOML Example\" # Comment \n\n"+ , "[owner]\n"+ , " name = \"Tom Preston-Werner\" "+ , " enabled = true # First class dates"+ ]+ tomlStr2 = T.unlines+ [ "[[array1]]\n key1 = \"some string\" \n"+ , ""+ , "[table1] \n key2 = 123 \n"+ , "[[array2]]\n key3 = 3.14 \n"+ , " [table2] \n key4 = true"+ ]++ toml1, toml2 :: TOML+ toml1 = mkToml $ do+ "title" =: "TOML Example"+ table "owner" $ do+ "name" =: "Tom Preston-Werner"+ "enabled" =: Bool True++ toml2 = mkToml $ do+ tableArray "array1" $+ "key1" =: "some string" :| []+ table "table1" $ "key2" =: 123+ tableArray "array2" $+ "key3" =: Double 3.14 :| []+ table "table2" $ "key4" =: Bool True
tomland.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: tomland-version: 1.2.0.0+version: 1.2.1.0 synopsis: Bidirectional TOML serialization description: Implementation of bidirectional TOML serialization. Simple codecs look like this:@@ -146,6 +146,15 @@ Test.Toml.Property Test.Toml.Parsing.Property Test.Toml.Parsing.Unit+ Test.Toml.Parsing.Unit.Array+ Test.Toml.Parsing.Unit.Bool+ Test.Toml.Parsing.Unit.Common+ Test.Toml.Parsing.Unit.Date+ Test.Toml.Parsing.Unit.Double+ Test.Toml.Parsing.Unit.Integer+ Test.Toml.Parsing.Unit.Key+ Test.Toml.Parsing.Unit.Text+ Test.Toml.Parsing.Unit.Toml Test.Toml.Parsing.Examples Test.Toml.PrefixTree.Property Test.Toml.PrefixTree.Unit