toml-reader 0.2.2.0 → 0.3.0.0
raw patch · 34 files changed
+639/−594 lines, 34 filesdep +skeletestdep −tastydep −tasty-goldendep −tasty-hunit
Dependencies added: skeletest
Dependencies removed: tasty, tasty-golden, tasty-hunit
Files
- CHANGELOG.md +7/−0
- src/TOML/Decode.hs +14/−14
- src/TOML/Error.hs +2/−2
- src/TOML/Parser.hs +14/−9
- src/TOML/Utils/Map.hs +1/−1
- src/TOML/Utils/NonEmpty.hs +1/−1
- src/TOML/Value.hs +2/−2
- test/specs/Main.hs +1/−0
- test/specs/TOML/DecodeSpec.hs +303/−0
- test/specs/TOML/ErrorSpec.hs +103/−0
- test/specs/TOML/ParserSpec.hs +15/−0
- test/specs/TOML/Utils/MapSpec.hs +47/−0
- test/specs/TOML/Utils/NonEmptySpec.hs +22/−0
- test/specs/TOML/__snapshots__/ErrorSpec.snap.md +83/−0
- test/tasty/Main.hs +0/−18
- test/tasty/TOML/DecodeTest.hs +0/−260
- test/tasty/TOML/ErrorTest.hs +0/−119
- test/tasty/TOML/ParserTest.hs +0/−20
- test/tasty/TOML/Utils/MapTest.hs +0/−62
- test/tasty/TOML/Utils/NonEmptyTest.hs +0/−31
- test/tasty/goldens/renderTOMLError/DecodeError.InvalidValue.golden +0/−1
- test/tasty/goldens/renderTOMLError/DecodeError.MissingField.golden +0/−1
- test/tasty/goldens/renderTOMLError/DecodeError.OtherDecodeError.golden +0/−1
- test/tasty/goldens/renderTOMLError/DecodeError.TypeMismatch.golden +0/−1
- test/tasty/goldens/renderTOMLError/NormalizeError.DuplicateKeyError.golden +0/−3
- test/tasty/goldens/renderTOMLError/NormalizeError.DuplicateSectionError.golden +0/−1
- test/tasty/goldens/renderTOMLError/NormalizeError.ExtendTableError.golden +0/−2
- test/tasty/goldens/renderTOMLError/NormalizeError.ExtendTableInInlineArrayError.golden +0/−2
- test/tasty/goldens/renderTOMLError/NormalizeError.ImplicitArrayForDefinedKeyError.golden +0/−3
- test/tasty/goldens/renderTOMLError/NormalizeError.NonTableInNestedImplicitArrayError.golden +0/−3
- test/tasty/goldens/renderTOMLError/NormalizeError.NonTableInNestedKeyError.golden +0/−3
- test/tasty/goldens/renderTOMLError/ParseError.golden +0/−1
- test/toml-test/ValidateParser.hs +9/−7
- toml-reader.cabal +15/−26
CHANGELOG.md view
@@ -1,3 +1,10 @@+## v0.3.0.0++* Drop support for GHC < 9.8+* Fix compatibility with toml-test 1.5.0+ * Allow specifying new table section in dotted table path+ * Error when setting dotted path inside array+ ## v0.2.2.0 * Add support for GHC 9.10 + 9.12
src/TOML/Decode.hs view
@@ -52,30 +52,30 @@ import Data.Functor.Identity (Identity (..)) import Data.Int (Int16, Int32, Int64, Int8) import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap+import Data.IntMap qualified as IntMap import Data.IntSet (IntSet)-import qualified Data.IntSet as IntSet+import Data.IntSet qualified as IntSet import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty+import Data.List.NonEmpty qualified as NonEmpty import Data.Map (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe)-import qualified Data.Monoid as Monoid+import Data.Monoid qualified as Monoid import Data.Proxy (Proxy (..)) import Data.Ratio (Ratio)-import qualified Data.Semigroup as Semigroup+import Data.Semigroup qualified as Semigroup import Data.Sequence (Seq)-import qualified Data.Sequence as Seq+import Data.Sequence qualified as Seq import Data.Set (Set)-import qualified Data.Set as Set+import Data.Set qualified as Set import Data.String (IsString, fromString) import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text-import qualified Data.Text.Lazy as Lazy (Text)-import qualified Data.Text.Lazy as Text.Lazy-import qualified Data.Time as Time-import qualified Data.Time.Clock.System as Time+import Data.Text qualified as Text+import Data.Text.IO qualified as Text+import Data.Text.Lazy qualified as Lazy (Text)+import Data.Text.Lazy qualified as Text.Lazy+import Data.Time qualified as Time+import Data.Time.Clock.System qualified as Time import Data.Version (Version, parseVersion) import Data.Void (Void) import Data.Word (Word16, Word32, Word64, Word8)
src/TOML/Error.hs view
@@ -13,9 +13,9 @@ import Control.Exception (Exception (..)) import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty+import Data.List.NonEmpty qualified as NonEmpty import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import TOML.Value (Table, Value (..), renderValue)
src/TOML/Parser.hs view
@@ -28,19 +28,19 @@ #endif import Data.Functor (($>)) import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty+import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Time (Day, LocalTime, TimeOfDay, TimeZone)-import qualified Data.Time as Time+import Data.Time qualified as Time import Data.Void (Void)-import qualified Numeric+import Numeric qualified import Text.Megaparsec hiding (sepBy1) import Text.Megaparsec.Char hiding (space, space1)-import qualified Text.Megaparsec.Char.Lexer as L+import Text.Megaparsec.Char.Lexer qualified as L import TOML.Error (NormalizeError (..), TOMLError (..)) import TOML.Utils.Map (getPathLens)@@ -554,9 +554,10 @@ ValueAtPathOptions { shouldRecurse = \case InlineTable -> False- ImplicitKey -> False+ ImplicitKey -> True ExplicitSection -> True ImplicitSection -> True+ , recurseArray = True , implicitType = ImplicitSection , makeMidPathNotTableError = nonTableInNestedKeyError sectionKey table }@@ -609,9 +610,10 @@ ValueAtPathOptions { shouldRecurse = \case InlineTable -> False- ImplicitKey -> False+ ImplicitKey -> True ExplicitSection -> True ImplicitSection -> True+ , recurseArray = True , implicitType = ImplicitSection , makeMidPathNotTableError = \history existingValue -> NonTableInNestedImplicitArrayError@@ -643,6 +645,7 @@ ImplicitKey -> True ExplicitSection -> True ImplicitSection -> recurseImplicitSections+ , recurseArray = False , implicitType = ImplicitKey , makeMidPathNotTableError = nonTableInNestedKeyError key table }@@ -674,6 +677,7 @@ data ValueAtPathOptions = ValueAtPathOptions { shouldRecurse :: TableType -> Bool+ , recurseArray :: Bool , implicitType :: TableType , makeMidPathNotTableError :: Key -> AnnValue -> NormalizeError }@@ -716,7 +720,8 @@ -- Any reference to an array of tables points to the -- most recently defined table element of the array. Just (GenericArray aMeta vs)- | Just vs' <- NonEmpty.nonEmpty vs+ | recurseArray+ , Just vs' <- NonEmpty.nonEmpty vs , GenericTable tMeta subTable <- NonEmpty.last vs' -> do when (isStaticArray aMeta) $ normalizeError $
src/TOML/Utils/Map.hs view
@@ -8,7 +8,7 @@ import Data.Foldable (foldlM) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import TOML.Utils.NonEmpty (zipHistory)
src/TOML/Utils/NonEmpty.hs view
@@ -6,7 +6,7 @@ import Data.List (scanl') import Data.List.NonEmpty (NonEmpty ((:|)))-import qualified Data.List.NonEmpty as NonEmpty+import Data.List.NonEmpty qualified as NonEmpty -- | -- Annotates each element with the history of all past elements.
src/TOML/Value.hs view
@@ -8,9 +8,9 @@ ) where import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Data.Time (Day, LocalTime, TimeOfDay, TimeZone) type Table = Map Text Value
+ test/specs/Main.hs view
@@ -0,0 +1,1 @@+import Skeletest.Main
+ test/specs/TOML/DecodeSpec.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE NegativeLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module TOML.DecodeSpec (spec) where++import Data.Int (Int8)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Time qualified as Time+import Numeric.Natural (Natural)+import Skeletest+import Skeletest.Predicate qualified as P++import TOML.Decode (+ DecodeTOML,+ Decoder,+ decodeWith,+ getArrayOf,+ getField,+ getFieldOpt,+ getFieldOptWith,+ getFieldOr,+ getFieldWith,+ getFields,+ getFieldsOpt,+ getFieldsOptWith,+ getFieldsWith,+ tomlDecoder,+ )+import TOML.Error (+ ContextItem (..),+ DecodeError (..),+ TOMLError (..),+ )+import TOML.Value (Value (..))++-- | A test decoder+succDecoder :: (Enum a, DecodeTOML a) => Decoder a+succDecoder = succ <$> tomlDecoder++spec :: Spec+spec = do+ describe "getField" $ do+ it "decodes field" $+ decodeWith (getField @Int "a") "a = 1" `shouldBe` Right 1++ it "errors if field does not exist" $+ decodeWith (getField @Int "a") "" `shouldBe` Left (DecodeError [Key "a"] MissingField)++ it "errors if field is the wrong type" $+ decodeWith (getField @Int "a") "a = true" `shouldBe` Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))++ describe "getFieldOr" $ do+ it "decodes field" $+ decodeWith (getFieldOr @Int 42 "a") "a = 1" `shouldBe` Right 1++ it "returns default if field does not exist" $+ decodeWith (getFieldOr @Int 42 "a") "" `shouldBe` Right 42++ it "errors if field is the wrong type" $+ decodeWith (getFieldOr @Int 42 "a") "a = true" `shouldBe` Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))++ describe "getFieldOpt" $ do+ it "decodes field" $+ decodeWith (getFieldOpt @Int "a") "a = 1" `shouldBe` Right (Just 1)++ it "returns Nothing if field does not exist" $+ decodeWith (getFieldOpt @Int "a") "" `shouldBe` Right Nothing++ it "errors if field is the wrong type" $+ decodeWith (getFieldOpt @Int "a") "a = true" `shouldBe` Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))++ describe "getFieldWith" $ do+ it "decodes field" $+ decodeWith (getFieldWith @Int succDecoder "a") "a = 1" `shouldBe` Right 2++ it "errors if field does not exist" $+ decodeWith (getFieldWith @Int succDecoder "a") "" `shouldBe` Left (DecodeError [Key "a"] MissingField)++ it "errors if field is the wrong type" $+ decodeWith (getFieldWith @Int succDecoder "a") "a = true" `shouldBe` Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))++ describe "getFieldOptWith" $ do+ it "decodes field" $+ decodeWith (getFieldOptWith @Int succDecoder "a") "a = 1" `shouldBe` Right (Just 2)++ it "returns Nothing if field does not exist" $+ decodeWith (getFieldOptWith @Int succDecoder "a") "" `shouldBe` Right Nothing++ it "errors if field is the wrong type" $+ decodeWith (getFieldOptWith @Int succDecoder "a") "a = true" `shouldBe` Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))++ describe "getFields" $ do+ it "decodes field" $+ decodeWith (getFields @Int ["a", "b"]) "a = { b = 1 }" `shouldBe` Right 1++ it "errors if field does not exist" $+ decodeWith (getFields @Int ["a", "b"]) "a = {}" `shouldBe` Left (DecodeError [Key "a", Key "b"] MissingField)++ it "errors if intermediate field does not exist" $+ decodeWith (getFields @Int ["a", "b", "c"]) "a = {}" `shouldBe` Left (DecodeError [Key "a", Key "b"] MissingField)++ it "errors if field is the wrong type" $+ decodeWith (getFields @Int ["a", "b"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ it "errors if intermediate field is the wrong type" $+ decodeWith (getFields @Int ["a", "b", "c"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ describe "getFieldsOpt" $ do+ it "decodes field" $+ decodeWith (getFieldsOpt @Int ["a", "b"]) "a = { b = 1 }" `shouldBe` Right (Just 1)++ it "returns Nothing if field does not exist" $+ decodeWith (getFieldsOpt @Int ["a", "b"]) "a = {}" `shouldBe` Right Nothing++ it "returns Nothing if intermediate field does not exist" $+ decodeWith (getFieldsOpt @Int ["a", "b", "c"]) "a = {}" `shouldBe` Right Nothing++ it "errors if field is the wrong type" $+ decodeWith (getFieldsOpt @Int ["a", "b"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ it "errors if intermediate field is the wrong type" $+ decodeWith (getFieldsOpt @Int ["a", "b", "c"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ describe "getFieldsWith" $ do+ it "decodes field" $+ decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = { b = 1 }" `shouldBe` Right 2++ it "errors if field does not exist" $+ decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = {}" `shouldBe` Left (DecodeError [Key "a", Key "b"] MissingField)++ it "errors if intermediate field does not exist" $+ decodeWith (getFieldsWith @Int succDecoder ["a", "b", "c"]) "a = {}" `shouldBe` Left (DecodeError [Key "a", Key "b"] MissingField)++ it "errors if field is the wrong type" $+ decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ it "errors if intermediate field is the wrong type" $+ decodeWith (getFieldsWith @Int succDecoder ["a", "b", "c"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ describe "getFieldsOptWith" $ do+ it "decodes field" $+ decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = { b = 1 }" `shouldBe` Right (Just 2)++ it "returns Nothing if field does not exist" $+ decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = {}" `shouldBe` Right Nothing++ it "returns Nothing if intermediate field does not exist" $+ decodeWith (getFieldsOptWith @Int succDecoder ["a", "b", "c"]) "a = {}" `shouldBe` Right Nothing++ it "errors if field is the wrong type" $+ decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ it "errors if intermediate field is the wrong type" $+ decodeWith (getFieldsOptWith @Int succDecoder ["a", "b", "c"]) "a = { b = true }" `shouldBe` Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))++ describe "getArrayOf" $ do+ it "decodes field" $+ decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = [1, 2]" `shouldBe` Right [2, 3]++ it "errors if value is the wrong type" $+ decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = true" `shouldBe` Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))++ it "errors if value in array is the wrong type" $+ decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = [1, 2, true]" `shouldBe` Left (DecodeError [Key "a", Index 2] (TypeMismatch (Boolean True)))++ describe "decoding multiple fields at once" $ do+ it "works" $ do+ let decoder :: Decoder (Int, Maybe String, Maybe Int, Bool)+ decoder =+ (,,,)+ <$> getField "a"+ <*> getFieldOpt "b"+ <*> getFieldOpt "missing"+ <*> getFields ["c", "d"]+ doc =+ Text.unlines+ [ "a = 1"+ , "b = \"hello\""+ , "[c]"+ , "d = true"+ ]+ decodeWith decoder doc `shouldBe` Right (1, Just "hello", Nothing, True)++ describe "DecodeTOML instances" $ do+ describe "Bool" $ do+ it "decodes successfully" $ do+ decodeWith (getField @Bool "a") "a = true" `shouldBe` Right True+ decodeWith (getField @Bool "a") "a = false" `shouldBe` Right False++ describe "String" $ do+ it "decodes successfully" $ do+ decodeWith (getField @String "a") "a = 'z'" `shouldBe` Right "z"+ decodeWith (getField @String "a") "a = 'asdf'" `shouldBe` Right "asdf"++ describe "Char" $ do+ it "decodes successfully" $+ decodeWith (getField @Char "a") "a = 'z'" `shouldBe` Right 'z'++ it "errors with multi-character string" $+ decodeWith (getField @Char "a") "a = 'asdf'" `shouldFailWith` "Expected single character string"++ describe "Int" $ do+ it "decodes successfully" $ do+ decodeWith (getField @Int "a") "a = 42" `shouldBe` Right 42+ decodeWith (getField @Int "a") "a = -13" `shouldBe` Right (-13)++ describe "Natural" $ do+ it "decodes successfully" $+ decodeWith (getField @Natural "a") "a = 42" `shouldBe` Right 42++ it "errors with negative numbers" $+ decodeWith (getField @Natural "a") "a = -13" `shouldFailWith` "Got negative number"++ describe "Int8" $ do+ it "decodes successfully" $ do+ decodeWith (getField @Int8 "a") "a = 127" `shouldBe` Right 127+ decodeWith (getField @Int8 "a") "a = 42" `shouldBe` Right 42+ decodeWith (getField @Int8 "a") "a = -13" `shouldBe` Right (-13)+ decodeWith (getField @Int8 "a") "a = -128" `shouldBe` Right (-128)++ it "errors with underflow/overflow" $ do+ decodeWith (getField @Int8 "a") "a = 128" `shouldFailWith` "Overflow"+ decodeWith (getField @Int8 "a") "a = -129" `shouldFailWith` "Underflow"++ describe "Double" $ do+ it "decodes successfully" $ do+ decodeWith (getField @Double "a") "a = 42.0" `shouldBe` Right 42.0+ decodeWith (getField @Double "a") "a = -13.2" `shouldBe` Right (-13.2)++ describe "Array" $+ it "decodes successfully" $ do+ decodeWith (getField @[Int] "a") "a = [1, 2]" `shouldBe` Right [1, 2]++ describe "UTCTime" $+ it "decodes successfully" $ do+ decodeWith (getField @Time.UTCTime "a") "a = 2020-01-31T00:00:01-01:00"+ `shouldBe` Right (Time.UTCTime (Time.fromGregorian 2020 1 31) 3601)++ describe "ZonedTime" $+ it "decodes successfully" $ do+ -- ZonedTime does not have an Eq instance+ decodeWith (getField @Time.ZonedTime "a") "a = 2020-01-31T00:00:01-01:00"+ `shouldSatisfy` P.right+ ( P.con $+ Time.ZonedTime+ (P.eq $ Time.LocalTime (Time.fromGregorian 2020 1 31) (Time.TimeOfDay 0 0 1))+ (P.con $ Time.TimeZone (P.eq -60) P.anything P.anything)+ )++ describe "LocalTime" $+ it "decodes successfully" $ do+ decodeWith (getField @Time.LocalTime "a") "a = 2020-01-31T00:00:01"+ `shouldBe` Right (Time.LocalTime (Time.fromGregorian 2020 1 31) (Time.TimeOfDay 0 0 1))++ describe "Day" $+ it "decodes successfully" $ do+ decodeWith (getField @Time.Day "a") "a = 2020-01-31"+ `shouldBe` Right (Time.fromGregorian 2020 1 31)++ describe "TimeOfDay" $+ it "decodes successfully" $ do+ decodeWith (getField @Time.TimeOfDay "a") "a = 07:32:59.1"+ `shouldBe` Right (Time.TimeOfDay 7 32 59.1)++ describe "Maybe" $+ it "decodes successfully" $ do+ decodeWith (getField @(Maybe Int) "a") "a = 1" `shouldBe` Right (Just 1)++ describe "Either" $ do+ it "decodes successfully" $ do+ decodeWith (getField @(Either Int Double) "a") "a = 1" `shouldBe` Right (Left 1)+ decodeWith (getField @(Either Int Double) "a") "a = 1.0" `shouldBe` Right (Right 1)++ describe "()" $+ it "decodes successfully" $ do+ decodeWith (getField @() "a") "a = []" `shouldBe` Right ()++ describe "(a, b)" $ do+ it "decodes successfully" $ do+ decodeWith (getField @(Int, Double) "a") "a = [1, 2.5]" `shouldBe` Right (1, 2.5)++ it "includes index in errors" $+ decodeWith (getField @(Int, Double) "a") "a = [1, true]"+ `shouldSatisfy` P.left (P.con $ DecodeError (P.eq [Key "a", Index 1]) P.anything)++ describe "Map" $ do+ it "decodes successfully" $+ decodeWith (getField @(Map Text Int) "a") "a = {x = 1, y = 2}"+ `shouldBe` Right (Map.fromList [("x", 1), ("y", 2)])++ it "includes key in errors" $+ decodeWith (getField @(Map Text Int) "a") "a = {x = true}"+ `shouldSatisfy` P.left (P.con $ DecodeError (P.eq [Key "a", Key "x"]) P.anything)++shouldFailWith :: Either TOMLError a -> Text -> IO ()+result `shouldFailWith` message = result `shouldSatisfy` P.left decodeError+ where+ decodeError = P.con $ DecodeError P.anything invalidValue+ invalidValue = P.con $ InvalidValue (P.eq message) P.anything
+ test/specs/TOML/ErrorSpec.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}++module TOML.ErrorSpec (spec) where++import Control.Monad (forM_)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict qualified as Map+import Skeletest+import Skeletest.Predicate qualified as P++import TOML.Error (+ ContextItem (..),+ DecodeError (..),+ NormalizeError (..),+ TOMLError (..),+ renderTOMLError,+ )+import TOML.Value (Value (..))++spec :: Spec+spec = do+ describe "renderTOMLError" $ do+ forM_ allErrors $ \(label, e) ->+ it ("renders " <> label) $ do+ renderTOMLError e `shouldSatisfy` P.matchesSnapshot++ it "renders context items correctly" $ do+ let msg = renderTOMLError (DecodeError [Key "a", Index 1, Key "b"] MissingField)+ msg `shouldSatisfy` P.hasPrefix "Decode error at '.a[1].b':"+ where+ allErrors =+ [ ("ParseError", ParseError "megaparsec error")+ ,+ ( "NormalizeError.DuplicateKeyError"+ , NormalizeError+ DuplicateKeyError+ { _path = fullPath+ , _existingValue = value1+ , _valueToSet = value2+ }+ )+ ,+ ( "NormalizeError.DuplicateSectionError"+ , NormalizeError+ DuplicateSectionError+ { _sectionKey = fullPath+ }+ )+ ,+ ( "NormalizeError.ExtendTableError"+ , NormalizeError+ ExtendTableError+ { _path = subPath+ , _originalKey = fullPath+ }+ )+ ,+ ( "NormalizeError.ExtendTableInInlineArrayError"+ , NormalizeError+ ExtendTableInInlineArrayError+ { _path = subPath+ , _originalKey = fullPath+ }+ )+ ,+ ( "NormalizeError.ImplicitArrayForDefinedKeyError"+ , NormalizeError+ ImplicitArrayForDefinedKeyError+ { _path = fullPath+ , _existingValue = Array [value1]+ , _tableSection = Map.fromList [("a", value2)]+ }+ )+ ,+ ( "NormalizeError.NonTableInNestedKeyError"+ , NormalizeError+ NonTableInNestedKeyError+ { _path = subPath+ , _existingValue = value1+ , _originalKey = fullPath+ , _originalValue = value2+ }+ )+ ,+ ( "NormalizeError.NonTableInNestedImplicitArrayError"+ , NormalizeError+ NonTableInNestedImplicitArrayError+ { _path = subPath+ , _existingValue = value1+ , _sectionKey = fullPath+ , _tableSection = Map.fromList [("a", value2)]+ }+ )+ , ("DecodeError.MissingField", DecodeError ctx MissingField)+ , ("DecodeError.InvalidValue", DecodeError ctx $ InvalidValue "bad value" value1)+ , ("DecodeError.TypeMismatch", DecodeError ctx $ TypeMismatch value1)+ , ("DecodeError.OtherDecodeError", DecodeError ctx $ OtherDecodeError "decode failure")+ ]+ fullPath = NonEmpty.fromList ["a", "b"]+ subPath = NonEmpty.fromList ["a"]+ value1 = Boolean True+ value2 = Integer 1+ ctx = [Key "a", Key "b"]
+ test/specs/TOML/ParserSpec.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}++module TOML.ParserSpec (spec) where++import Data.Map.Strict qualified as Map+import Skeletest++import TOML.Parser (parseTOML)+import TOML.Value (Value (..))++spec :: Spec+spec = do+ it "parses large floats efficiently" $ do+ let input = "a = 1e1000000000000000000000000000000000000000000000000000000000000000"+ parseTOML "" input `shouldBe` Right (Table $ Map.singleton "a" (Float $ read "Infinity"))
+ test/specs/TOML/Utils/MapSpec.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE LambdaCase #-}++module TOML.Utils.MapSpec (spec) where++import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Skeletest++import TOML.Utils.Map (getPath, getPathLens)++spec :: Spec+spec = do+ describe "getPathLens" $ do+ it "gets and sets value at path" $ do+ let obj = Map.fromList [("a", Map [("b", Map [("c", Int 1)])])]++ Right (mValue, setValue) <- pure $ getPathLens recurseMapOrInt (NonEmpty.fromList ["a", "b", "c"]) obj++ mValue `shouldBe` Just (Int 1)++ let newVal = Map [("foo", Int 100)]+ setValue newVal `shouldBe` Map.fromList [("a", Map [("b", Map [("c", newVal)])])]++ describe "getPath" $ do+ it "gets value at path" $ do+ let obj = Map.fromList [("a", Map [("b", Map [("c", Int 1)])])]++ let doRecurse history = fmap fst . recurseMapOrInt history+ Right mValue <- pure $ getPath doRecurse (NonEmpty.fromList ["a", "b", "c"]) obj++ mValue `shouldBe` Just (Int 1)++data MapOrInt = Map [(String, MapOrInt)] | Int Int+ deriving (Show, Eq)++recurseMapOrInt ::+ NonEmpty String+ -> Maybe MapOrInt+ -> Either String (Map String MapOrInt, Map String MapOrInt -> MapOrInt)+recurseMapOrInt _ = \case+ Nothing -> Right (Map.empty, fromMap)+ Just (Map kvs) -> Right (Map.fromList kvs, fromMap)+ Just (Int x) -> Left $ "Could not recurse on: " ++ show x+ where+ fromMap = Map . Map.toList
+ test/specs/TOML/Utils/NonEmptySpec.hs view
@@ -0,0 +1,22 @@+module TOML.Utils.NonEmptySpec (spec) where++import Data.List.NonEmpty qualified as NonEmpty+import Skeletest++import TOML.Utils.NonEmpty (zipHistory)++spec :: Spec+spec = do+ describe "zipHistory" $ do+ it "should zip already-seen keys with each key" $+ zipHistory (ne ["a", "b", "c"])+ `shouldBe` ne+ [ (ne ["a"], "a")+ , (ne ["a", "b"], "b")+ , (ne ["a", "b", "c"], "c")+ ]+ it "works with one-element list" $+ zipHistory (ne ["a"]) `shouldBe` ne [(ne ["a"], "a")]++ne :: [a] -> NonEmpty.NonEmpty a+ne = NonEmpty.fromList
+ test/specs/TOML/__snapshots__/ErrorSpec.snap.md view
@@ -0,0 +1,83 @@+# TOML.Error++## renderTOMLError / renders DecodeError.InvalidValue++```+Decode error at '.a.b': Invalid value: bad value: true+```++## renderTOMLError / renders DecodeError.MissingField++```+Decode error at '.a.b': Field does not exist+```++## renderTOMLError / renders DecodeError.OtherDecodeError++```+Decode error at '.a.b': decode failure+```++## renderTOMLError / renders DecodeError.TypeMismatch++```+Decode error at '.a.b': Type mismatch, got: true+```++## renderTOMLError / renders NormalizeError.DuplicateKeyError++```+Could not add value to path "a.b":+ Existing value: true+ Value to set: 1+```++## renderTOMLError / renders NormalizeError.DuplicateSectionError++```+Found duplicate section: "a.b"+```++## renderTOMLError / renders NormalizeError.ExtendTableError++```+Invalid table key: "a.b"+ Table already statically defined at "a"+```++## renderTOMLError / renders NormalizeError.ExtendTableInInlineArrayError++```+Invalid table key: "a.b"+ Table defined in inline array at "a"+```++## renderTOMLError / renders NormalizeError.ImplicitArrayForDefinedKeyError++```+Could not create implicit array at path "a.b":+ Existing value: [true]+ Array table section: {"a": 1}+```++## renderTOMLError / renders NormalizeError.NonTableInNestedImplicitArrayError++```+Found non-Table at path "a" when initializing implicit array at path "a.b":+ Existing value: true+ Array table section: {"a": 1}+```++## renderTOMLError / renders NormalizeError.NonTableInNestedKeyError++```+Found non-Table at path "a" when defining nested key "a.b":+ Existing value: true+ Original value: 1+```++## renderTOMLError / renders ParseError++```+megaparsec error+```
− test/tasty/Main.hs
@@ -1,18 +0,0 @@-import Test.Tasty--import qualified TOML.DecodeTest-import qualified TOML.ErrorTest-import qualified TOML.ParserTest-import qualified TOML.Utils.MapTest-import qualified TOML.Utils.NonEmptyTest--main :: IO ()-main =- defaultMain $- testGroup "toml-reader" $- [ TOML.Utils.MapTest.test- , TOML.Utils.NonEmptyTest.test- , TOML.ErrorTest.test- , TOML.ParserTest.test- , TOML.DecodeTest.test- ]
− test/tasty/TOML/DecodeTest.hs
@@ -1,260 +0,0 @@-{-# LANGUAGE NegativeLiterals #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}--module TOML.DecodeTest (test) where--import Data.Int (Int8)-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import qualified Data.Text as Text-import qualified Data.Time as Time-import Numeric.Natural (Natural)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit--import TOML.Decode (- DecodeTOML,- Decoder,- decodeWith,- getArrayOf,- getField,- getFieldOpt,- getFieldOptWith,- getFieldOr,- getFieldWith,- getFields,- getFieldsOpt,- getFieldsOptWith,- getFieldsWith,- tomlDecoder,- )-import TOML.Error (- ContextItem (..),- DecodeError (..),- TOMLError (..),- )-import TOML.Value (Value (..))--test :: TestTree-test =- testGroup "TOML.Decode" . concat $- [ getFieldTests- , [decoderInstanceTests]- ]--getFieldTests :: [TestTree]-getFieldTests =- [ testGroup- "getField"- [ testCase "decodes field" $- decodeWith (getField @Int "a") "a = 1" @?= Right 1- , testCase "errors if field does not exist" $- decodeWith (getField @Int "a") "" @?= Left (DecodeError [Key "a"] MissingField)- , testCase "errors if field is the wrong type" $- decodeWith (getField @Int "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFieldOr"- [ testCase "decodes field" $- decodeWith (getFieldOr @Int 42 "a") "a = 1" @?= Right 1- , testCase "returns default if field does not exist" $- decodeWith (getFieldOr @Int 42 "a") "" @?= Right 42- , testCase "errors if field is the wrong type" $- decodeWith (getFieldOr @Int 42 "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFieldOpt"- [ testCase "decodes field" $- decodeWith (getFieldOpt @Int "a") "a = 1" @?= Right (Just 1)- , testCase "returns Nothing if field does not exist" $- decodeWith (getFieldOpt @Int "a") "" @?= Right Nothing- , testCase "errors if field is the wrong type" $- decodeWith (getFieldOpt @Int "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFieldWith"- [ testCase "decodes field" $- decodeWith (getFieldWith @Int succDecoder "a") "a = 1" @?= Right 2- , testCase "errors if field does not exist" $- decodeWith (getFieldWith @Int succDecoder "a") "" @?= Left (DecodeError [Key "a"] MissingField)- , testCase "errors if field is the wrong type" $- decodeWith (getFieldWith @Int succDecoder "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFieldOptWith"- [ testCase "decodes field" $- decodeWith (getFieldOptWith @Int succDecoder "a") "a = 1" @?= Right (Just 2)- , testCase "returns Nothing if field does not exist" $- decodeWith (getFieldOptWith @Int succDecoder "a") "" @?= Right Nothing- , testCase "errors if field is the wrong type" $- decodeWith (getFieldOptWith @Int succDecoder "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFields"- [ testCase "decodes field" $- decodeWith (getFields @Int ["a", "b"]) "a = { b = 1 }" @?= Right 1- , testCase "errors if field does not exist" $- decodeWith (getFields @Int ["a", "b"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)- , testCase "errors if intermediate field does not exist" $- decodeWith (getFields @Int ["a", "b", "c"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)- , testCase "errors if field is the wrong type" $- decodeWith (getFields @Int ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- , testCase "errors if intermediate field is the wrong type" $- decodeWith (getFields @Int ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFieldsOpt"- [ testCase "decodes field" $- decodeWith (getFieldsOpt @Int ["a", "b"]) "a = { b = 1 }" @?= Right (Just 1)- , testCase "returns Nothing if field does not exist" $- decodeWith (getFieldsOpt @Int ["a", "b"]) "a = {}" @?= Right Nothing- , testCase "returns Nothing if intermediate field does not exist" $- decodeWith (getFieldsOpt @Int ["a", "b", "c"]) "a = {}" @?= Right Nothing- , testCase "errors if field is the wrong type" $- decodeWith (getFieldsOpt @Int ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- , testCase "errors if intermediate field is the wrong type" $- decodeWith (getFieldsOpt @Int ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFieldsWith"- [ testCase "decodes field" $- decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = { b = 1 }" @?= Right 2- , testCase "errors if field does not exist" $- decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)- , testCase "errors if intermediate field does not exist" $- decodeWith (getFieldsWith @Int succDecoder ["a", "b", "c"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)- , testCase "errors if field is the wrong type" $- decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- , testCase "errors if intermediate field is the wrong type" $- decodeWith (getFieldsWith @Int succDecoder ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getFieldsOptWith"- [ testCase "decodes field" $- decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = { b = 1 }" @?= Right (Just 2)- , testCase "returns Nothing if field does not exist" $- decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = {}" @?= Right Nothing- , testCase "returns Nothing if intermediate field does not exist" $- decodeWith (getFieldsOptWith @Int succDecoder ["a", "b", "c"]) "a = {}" @?= Right Nothing- , testCase "errors if field is the wrong type" $- decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- , testCase "errors if intermediate field is the wrong type" $- decodeWith (getFieldsOptWith @Int succDecoder ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))- ]- , testGroup- "getArrayOf"- [ testCase "decodes field" $- decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = [1, 2]" @?= Right [2, 3]- , testCase "errors if value is the wrong type" $- decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))- , testCase "errors if value in array is the wrong type" $- decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = [1, 2, true]" @?= Left (DecodeError [Key "a", Index 2] (TypeMismatch (Boolean True)))- ]- , testCase "Decoding multiple fields at once" $ do- let decoder :: Decoder (Int, Maybe String, Maybe Int, Bool)- decoder =- (,,,)- <$> getField "a"- <*> getFieldOpt "b"- <*> getFieldOpt "missing"- <*> getFields ["c", "d"]- doc =- Text.unlines- [ "a = 1"- , "b = \"hello\""- , "[c]"- , "d = true"- ]- decodeWith decoder doc @?= Right (1, Just "hello", Nothing, True)- ]- where- succDecoder :: (Enum a, DecodeTOML a) => Decoder a- succDecoder = succ <$> tomlDecoder--decoderInstanceTests :: TestTree-decoderInstanceTests =- testGroup- "DecodeTOML instances"- [ testCase "Bool" $ do- decodeWith (getField @Bool "a") "a = true" @?= Right True- decodeWith (getField @Bool "a") "a = false" @?= Right False- , testCase "String" $ do- decodeWith (getField @String "a") "a = 'z'" @?= Right "z"- decodeWith (getField @String "a") "a = 'asdf'" @?= Right "asdf"- , testCase "Char" $- decodeWith (getField @Char "a") "a = 'z'" @?= Right 'z'- , testCase "Char errors with multi-character string" $- assertInvalidValue "Expected single character string" $- decodeWith (getField @Char "a") "a = 'asdf'"- , testCase "Int" $ do- decodeWith (getField @Int "a") "a = 42" @?= Right 42- decodeWith (getField @Int "a") "a = -13" @?= Right (-13)- , testCase "Natural" $- decodeWith (getField @Natural "a") "a = 42" @?= Right 42- , testCase "Natural errors with negative numbers" $- assertInvalidValue "Got negative number" $- decodeWith (getField @Natural "a") "a = -13"- , testCase "Int8" $ do- decodeWith (getField @Int8 "a") "a = 127" @?= Right 127- decodeWith (getField @Int8 "a") "a = 42" @?= Right 42- decodeWith (getField @Int8 "a") "a = -13" @?= Right (-13)- decodeWith (getField @Int8 "a") "a = -128" @?= Right (-128)- , testCase "Int8 errors with underflow/overflow" $ do- assertInvalidValue "Overflow" $- decodeWith (getField @Int8 "a") "a = 128"- assertInvalidValue "Underflow" $- decodeWith (getField @Int8 "a") "a = -129"- , testCase "Double" $ do- decodeWith (getField @Double "a") "a = 42.0" @?= Right 42.0- decodeWith (getField @Double "a") "a = -13.2" @?= Right (-13.2)- , testCase "Array" $- decodeWith (getField @[Int] "a") "a = [1, 2]" @?= Right [1, 2]- , testCase "UTCTime" $- decodeWith (getField @Time.UTCTime "a") "a = 2020-01-31T00:00:01-01:00"- @?= Right (Time.UTCTime (Time.fromGregorian 2020 1 31) 3601)- , testCase "ZonedTime" $- -- ZonedTime does not have an Eq instance- case decodeWith (getField @Time.ZonedTime "a") "a = 2020-01-31T00:00:01-01:00" of- Right (Time.ZonedTime (Time.LocalTime day time) (Time.TimeZone (-60) _ _))- | day == Time.fromGregorian 2020 1 31- , time == Time.TimeOfDay 0 0 1 ->- return ()- result -> unexpectedResult result- , testCase "LocalTime" $- decodeWith (getField @Time.LocalTime "a") "a = 2020-01-31T00:00:01"- @?= Right (Time.LocalTime (Time.fromGregorian 2020 1 31) (Time.TimeOfDay 0 0 1))- , testCase "Day" $- decodeWith (getField @Time.Day "a") "a = 2020-01-31"- @?= Right (Time.fromGregorian 2020 1 31)- , testCase "TimeOfDay" $- decodeWith (getField @Time.TimeOfDay "a") "a = 07:32:59.1"- @?= Right (Time.TimeOfDay 7 32 59.1)- , testCase "Maybe" $- decodeWith (getField @(Maybe Int) "a") "a = 1" @?= Right (Just 1)- , testCase "Either" $ do- decodeWith (getField @(Either Int Double) "a") "a = 1" @?= Right (Left 1)- decodeWith (getField @(Either Int Double) "a") "a = 1.0" @?= Right (Right 1)- , testCase "()" $- decodeWith (getField @() "a") "a = []" @?= Right ()- , testCase "(a, b)" $- decodeWith (getField @(Int, Double) "a") "a = [1, 2.5]" @?= Right (1, 2.5)- , testCase "Map" $- decodeWith (getField @(Map Text.Text Int) "a") "a = {x = 1, y = 2}"- @?= Right (Map.fromList [("x", 1), ("y", 2)])- , testCase "Tuples show errors with index" $- case decodeWith (getField @(Int, Double) "a") "a = [1, true]" of- Left (DecodeError [Key "a", Index 1] _) -> return ()- result -> unexpectedResult result- , testCase "Maps show errors with key" $- case decodeWith (getField @(Map Text.Text Int) "a") "a = {x = true}" of- Left (DecodeError [Key "a", Key "x"] _) -> return ()- result -> unexpectedResult result- ]- where- assertInvalidValue expected result =- case result of- Left (DecodeError _ (InvalidValue actual _)) -> actual @?= expected- _ -> unexpectedResult result-- unexpectedResult result = assertFailure $ "Got unexpected result: " <> show result
− test/tasty/TOML/ErrorTest.hs
@@ -1,119 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module TOML.ErrorTest (test) where--import Control.Monad (unless)-import qualified Data.List.NonEmpty as NonEmpty-import qualified Data.Map.Strict as Map-import qualified Data.Text as Text-import qualified Data.Text.Lazy as TextL-import qualified Data.Text.Lazy.Encoding as TextL-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Golden-import Test.Tasty.HUnit--import TOML.Error (- ContextItem (..),- DecodeError (..),- NormalizeError (..),- TOMLError (..),- renderTOMLError,- )-import TOML.Value (Value (..))--test :: TestTree-test =- testGroup- "TOML.Error"- [ renderTOMLErrorTests- ]--renderTOMLErrorTests :: TestTree-renderTOMLErrorTests =- testGroup- "renderTOMLError"- [ testGroup "renders errors correctly" $- flip map allErrors $ \(label, e) ->- goldenVsString label ("test/tasty/goldens/renderTOMLError/" <> label <> ".golden") $- pure (TextL.encodeUtf8 . TextL.fromStrict . renderTOMLError $ e)- , testCase "renders context items correctly" $ do- let msg = renderTOMLError (DecodeError [Key "a", Index 1, Key "b"] MissingField)- let expectedPrefix = "Decode error at '.a[1].b':"- unless (expectedPrefix `Text.isPrefixOf` msg) $- assertFailure $- "Expected message to start with prefix: " <> show expectedPrefix <> ", got: " <> Text.unpack msg- ]- where- allErrors =- [ ("ParseError", ParseError "megaparsec error")- ,- ( "NormalizeError.DuplicateKeyError"- , NormalizeError- DuplicateKeyError- { _path = fullPath- , _existingValue = value1- , _valueToSet = value2- }- )- ,- ( "NormalizeError.DuplicateSectionError"- , NormalizeError- DuplicateSectionError- { _sectionKey = fullPath- }- )- ,- ( "NormalizeError.ExtendTableError"- , NormalizeError- ExtendTableError- { _path = subPath- , _originalKey = fullPath- }- )- ,- ( "NormalizeError.ExtendTableInInlineArrayError"- , NormalizeError- ExtendTableInInlineArrayError- { _path = subPath- , _originalKey = fullPath- }- )- ,- ( "NormalizeError.ImplicitArrayForDefinedKeyError"- , NormalizeError- ImplicitArrayForDefinedKeyError- { _path = fullPath- , _existingValue = Array [value1]- , _tableSection = Map.fromList [("a", value2)]- }- )- ,- ( "NormalizeError.NonTableInNestedKeyError"- , NormalizeError- NonTableInNestedKeyError- { _path = subPath- , _existingValue = value1- , _originalKey = fullPath- , _originalValue = value2- }- )- ,- ( "NormalizeError.NonTableInNestedImplicitArrayError"- , NormalizeError- NonTableInNestedImplicitArrayError- { _path = subPath- , _existingValue = value1- , _sectionKey = fullPath- , _tableSection = Map.fromList [("a", value2)]- }- )- , ("DecodeError.MissingField", DecodeError ctx MissingField)- , ("DecodeError.InvalidValue", DecodeError ctx $ InvalidValue "bad value" value1)- , ("DecodeError.TypeMismatch", DecodeError ctx $ TypeMismatch value1)- , ("DecodeError.OtherDecodeError", DecodeError ctx $ OtherDecodeError "decode failure")- ]- fullPath = NonEmpty.fromList ["a", "b"]- subPath = NonEmpty.fromList ["a"]- value1 = Boolean True- value2 = Integer 1- ctx = [Key "a", Key "b"]
− test/tasty/TOML/ParserTest.hs
@@ -1,20 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module TOML.ParserTest (test) where--import qualified Data.Map.Strict as Map-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit--import TOML.Parser (parseTOML)-import TOML.Value (Value (..))--test :: TestTree-test =- testGroup- "TOML.Parser"- [ testCase "Large floats are parsed efficiently" $- case parseTOML "" "a = 1e1000000000000000000000000000000000000000000000000000000000000000" of- Right (Table t) -> Map.lookup "a" t @?= Just (Float (read "Infinity"))- result -> assertFailure $ "Got unexpected result: " ++ show result- ]
− test/tasty/TOML/Utils/MapTest.hs
@@ -1,62 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module TOML.Utils.MapTest (test) where--import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit--import TOML.Utils.Map (getPath, getPathLens)--test :: TestTree-test =- testGroup- "TOML.Utils.Map"- [ getPathLensTest- , getPathTest- ]--data MapOrInt = Map [(String, MapOrInt)] | Int Int- deriving (Show, Eq)--recurseMapOrInt ::- NonEmpty String- -> Maybe MapOrInt- -> Either String (Map String MapOrInt, Map String MapOrInt -> MapOrInt)-recurseMapOrInt _ = \case- Nothing -> Right (Map.empty, fromMap)- Just (Map kvs) -> Right (Map.fromList kvs, fromMap)- Just (Int x) -> Left $ "Could not recurse on: " ++ show x- where- fromMap = Map . Map.toList--getPathLensTest :: TestTree-getPathLensTest =- testGroup- "getPathLens"- [ testCase "gets and sets value at path" $ do- let obj = Map.fromList [("a", Map [("b", Map [("c", Int 1)])])]-- Right (mValue, setValue) <- pure $ getPathLens recurseMapOrInt (NonEmpty.fromList ["a", "b", "c"]) obj-- mValue @?= Just (Int 1)-- let newVal = Map [("foo", Int 100)]- setValue newVal @?= Map.fromList [("a", Map [("b", Map [("c", newVal)])])]- ]--getPathTest :: TestTree-getPathTest =- testGroup- "getPath"- [ testCase "gets value at path" $ do- let obj = Map.fromList [("a", Map [("b", Map [("c", Int 1)])])]-- let doRecurse history = fmap fst . recurseMapOrInt history- Right mValue <- pure $ getPath doRecurse (NonEmpty.fromList ["a", "b", "c"]) obj-- mValue @?= Just (Int 1)- ]
− test/tasty/TOML/Utils/NonEmptyTest.hs
@@ -1,31 +0,0 @@-module TOML.Utils.NonEmptyTest (test) where--import qualified Data.List.NonEmpty as NonEmpty-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit--import TOML.Utils.NonEmpty (zipHistory)--test :: TestTree-test =- testGroup- "TOML.Utils.NonEmpty"- [ zipHistoryTest- ]--zipHistoryTest :: TestTree-zipHistoryTest =- testGroup- "zipHistory"- [ testCase "should zip already-seen keys with each key" $- zipHistory (ne ["a", "b", "c"])- @?= ne- [ (ne ["a"], "a")- , (ne ["a", "b"], "b")- , (ne ["a", "b", "c"], "c")- ]- , testCase "works with one-element list" $- zipHistory (ne ["a"]) @?= ne [(ne ["a"], "a")]- ]- where- ne = NonEmpty.fromList
− test/tasty/goldens/renderTOMLError/DecodeError.InvalidValue.golden
@@ -1,1 +0,0 @@-Decode error at '.a.b': Invalid value: bad value: true
− test/tasty/goldens/renderTOMLError/DecodeError.MissingField.golden
@@ -1,1 +0,0 @@-Decode error at '.a.b': Field does not exist
− test/tasty/goldens/renderTOMLError/DecodeError.OtherDecodeError.golden
@@ -1,1 +0,0 @@-Decode error at '.a.b': decode failure
− test/tasty/goldens/renderTOMLError/DecodeError.TypeMismatch.golden
@@ -1,1 +0,0 @@-Decode error at '.a.b': Type mismatch, got: true
− test/tasty/goldens/renderTOMLError/NormalizeError.DuplicateKeyError.golden
@@ -1,3 +0,0 @@-Could not add value to path "a.b":- Existing value: true- Value to set: 1
− test/tasty/goldens/renderTOMLError/NormalizeError.DuplicateSectionError.golden
@@ -1,1 +0,0 @@-Found duplicate section: "a.b"
− test/tasty/goldens/renderTOMLError/NormalizeError.ExtendTableError.golden
@@ -1,2 +0,0 @@-Invalid table key: "a.b"- Table already statically defined at "a"
− test/tasty/goldens/renderTOMLError/NormalizeError.ExtendTableInInlineArrayError.golden
@@ -1,2 +0,0 @@-Invalid table key: "a.b"- Table defined in inline array at "a"
− test/tasty/goldens/renderTOMLError/NormalizeError.ImplicitArrayForDefinedKeyError.golden
@@ -1,3 +0,0 @@-Could not create implicit array at path "a.b":- Existing value: [true]- Array table section: {"a": 1}
− test/tasty/goldens/renderTOMLError/NormalizeError.NonTableInNestedImplicitArrayError.golden
@@ -1,3 +0,0 @@-Found non-Table at path "a" when initializing implicit array at path "a.b":- Existing value: true- Array table section: {"a": 1}
− test/tasty/goldens/renderTOMLError/NormalizeError.NonTableInNestedKeyError.golden
@@ -1,3 +0,0 @@-Found non-Table at path "a" when defining nested key "a.b":- Existing value: true- Original value: 1
− test/tasty/goldens/renderTOMLError/ParseError.golden
@@ -1,1 +0,0 @@-megaparsec error
test/toml-test/ValidateParser.hs view
@@ -3,15 +3,15 @@ {-# LANGUAGE OverloadedStrings #-} import Data.Aeson ((.=))-import qualified Data.Aeson as Aeson-import qualified Data.ByteString.Lazy.Char8 as Char8+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy.Char8 qualified as Char8 import Data.Map (Map)-import qualified Data.Map as Map+import Data.Map qualified as Map import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text+import Data.Text qualified as Text+import Data.Text.IO qualified as Text import Data.Time (ZonedTime (..))-import qualified Data.Vector as Vector+import Data.Vector qualified as Vector import System.Directory (findExecutable) import System.Environment (getArgs, getExecutablePath) import System.Exit (exitFailure)@@ -52,8 +52,10 @@ -- don't error, so that Hackage's test run doesn't fail putStrLn "WARNING: toml-test not installed. Skipping test suite..." Just tomlTestExe ->+ -- don't run in parallel, in case we're running tests with coverage, which+ -- behaves poorly if multiple processes try to read/write .tix files callProcess tomlTestExe $- args ++ ["-color", "always", "--", thisExe, "--check"]+ args ++ ["-color", "always", "-parallel", "1", "--", thisExe, "--check"] -- | Parse TOML data in stdin. checkTOML :: IO ()
toml-reader.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: toml-reader-version: 0.2.2.0+version: 0.3.0.0 synopsis: TOML format parser compliant with v1.0.0. description: TOML format parser compliant with v1.0.0. See README.md for more details. category: TOML, Text, Configuration@@ -19,18 +19,7 @@ extra-source-files: README.md CHANGELOG.md- test/tasty/goldens/renderTOMLError/DecodeError.InvalidValue.golden- test/tasty/goldens/renderTOMLError/DecodeError.MissingField.golden- test/tasty/goldens/renderTOMLError/DecodeError.OtherDecodeError.golden- test/tasty/goldens/renderTOMLError/DecodeError.TypeMismatch.golden- test/tasty/goldens/renderTOMLError/NormalizeError.DuplicateKeyError.golden- test/tasty/goldens/renderTOMLError/NormalizeError.DuplicateSectionError.golden- test/tasty/goldens/renderTOMLError/NormalizeError.ExtendTableError.golden- test/tasty/goldens/renderTOMLError/NormalizeError.ExtendTableInInlineArrayError.golden- test/tasty/goldens/renderTOMLError/NormalizeError.ImplicitArrayForDefinedKeyError.golden- test/tasty/goldens/renderTOMLError/NormalizeError.NonTableInNestedImplicitArrayError.golden- test/tasty/goldens/renderTOMLError/NormalizeError.NonTableInNestedKeyError.golden- test/tasty/goldens/renderTOMLError/ParseError.golden+ test/specs/TOML/__snapshots__/ErrorSpec.snap.md source-repository head type: git@@ -57,7 +46,7 @@ , parser-combinators , text , time- default-language: Haskell2010+ default-language: GHC2021 test-suite parser-validator type: exitcode-stdio-1.0@@ -79,28 +68,28 @@ , toml-reader , unordered-containers , vector- default-language: Haskell2010+ default-language: GHC2021 test-suite toml-reader-tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules:- TOML.DecodeTest- TOML.ErrorTest- TOML.ParserTest- TOML.Utils.MapTest- TOML.Utils.NonEmptyTest+ TOML.DecodeSpec+ TOML.ErrorSpec+ TOML.ParserSpec+ TOML.Utils.MapSpec+ TOML.Utils.NonEmptySpec Paths_toml_reader hs-source-dirs:- test/tasty- ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wunused-packages+ test/specs+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wunused-packages -F -pgmF skeletest-preprocessor+ build-tool-depends:+ skeletest:skeletest-preprocessor build-depends: base , containers- , tasty- , tasty-golden- , tasty-hunit+ , skeletest , text , time , toml-reader- default-language: Haskell2010+ default-language: GHC2021