toml-parser 1.0.1.0 → 1.1.0.0

raw patch · 21 files changed

+1391/−1030 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−1
• README.md +19/−0
• src/Toml.hs +8/−6
• src/Toml/FromValue.hs +25/−11
• src/Toml/FromValue/Generic.hs +69/−0
• src/Toml/FromValue/Matcher.hs +36/−12
• src/Toml/Lexer.x +5/−0
• src/Toml/Lexer/Token.hs +8/−7
• src/Toml/Lexer/Utils.hs +45/−22
• src/Toml/Parser.y +8/−2
• src/Toml/Pretty.hs +5/−0
• src/Toml/ToValue.hs +11/−1
• src/Toml/ToValue/Generic.hs +68/−0
• src/Toml/Value.hs +3/−1
• test/DecodeSpec.hs +128/−0
• test/LexerSpec.hs +68/−0
• test/Main.hs +1/−966
• test/PrettySpec.hs +108/−0
• test/ToValueSpec.hs +16/−0
• test/TomlSpec.hs +734/−0
• toml-parser.cabal +19/−1

@@ -1,6 +1,12 @@ # Revision history for toml-parser -## 1.0.1.0  --+## 1.1.0.0  --  2023-07-03++* Add Toml.FromValue.Generic and Toml.ToValue.Generic+* Add Alternative instance to Matcher and support multiple error messages in Result+* Add Data and Generic instances for Value++## 1.0.1.0  -- 2023-07-01  * Add ToTable and ToValue instances for Map * Refine error messages

@@ -127,3 +127,22 @@     Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious", Variety "granny smith"],     Fruit "banana" Nothing [Variety "plantain"]]) ```++## Generics++Code for generating and matching tables to records can be derived+using GHC.Generics. This will generate tables using the field names+as table keys.++```haskell+data ExampleRecord = ExampleRecord {+  exString :: String,+  exList   :: [Int],+  exOpt    :: Maybe Bool}+  deriving (Show, Generic, Eq)++instance FromTable ExampleRecord where fromTable = genericFromTable+instance FromValue ExampleRecord where fromValue = defaultTableFromValue+instance ToTable   ExampleRecord where toTable   = genericToTable+instance ToValue   ExampleRecord where toValue   = defaultTableToValue+```

@@ -1,11 +1,13 @@ {-| Module      : Toml-Description : TOML parser+Description : TOML parsing, printing, and codecs Copyright   : (c) Eric Mertens, 2023 License     : ISC Maintainer  : emertens@gmail.com -This module parses TOML into semantically meaningful values.+This is the high-level interface to the toml-parser library.+It enables parsing, printing, and coversion into and out of+application-specific representations.  This parser implements TOML 1.0.0 <https://toml.io/en/v1.0.0> as carefully as possible.@@ -13,14 +15,14 @@ -} module Toml ( -    -- * types+    -- * Types     Table,     Value(..), -    -- * parsing+    -- * Parsing     parse, -    -- * printing+    -- * Printing     prettyToml,     DocClass(..), @@ -53,7 +55,7 @@  -- | Use the 'FromTable' instance to decode a value from a TOML string. decode :: FromTable a => String -> Result a-decode = either Failure (runMatcher . fromTable) . parse+decode = either (Failure . pure) (runMatcher . fromTable) . parse  -- | Use the 'ToTable' instance to encode a value to a TOML string. encode :: ToTable a => a -> TomlDoc

@@ -20,37 +20,39 @@ problematic decodings or keys that might be unused now but were perhaps meaningful in an old version of a configuration file. +"Toml.FromValue.Generic" can be used to derive instances of 'FromTable'+automatically for record types.+ -} module Toml.FromValue (-    -- * deserialization classes+    -- * Deserialization classes     FromValue(..),     FromTable(..),     defaultTableFromValue, -    -- * matcher+    -- * Matcher     Matcher,+    Result(..),     runMatcher,     withScope,     warning, -    -- * results-    Result(..),--    -- * table matching+    -- * Table matching     ParseTable,     runParseTable,     optKey,     reqKey,     warnTable, -    -- * table matching primitives+    -- * Table matching primitives     getTable,     setTable,     ) where -import Control.Monad (zipWithM)+import Control.Applicative (Alternative)+import Control.Monad (MonadPlus, zipWithM) import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State.Strict (StateT(..), evalStateT, put, get)+import Control.Monad.Trans.State.Strict (StateT(..), put, get) import Data.Int (Int8, Int16, Int32, Int64) import Data.List (intercalate) import Data.Map (Map)@@ -63,7 +65,6 @@ import Toml.Pretty (prettySimpleKey, prettyValue) import Toml.Value (Value(..), Table) - -- | Class for types that can be decoded from a TOML value. class FromValue a where     -- | Convert a 'Value' or report an error message@@ -96,10 +97,12 @@ typeError :: String {- ^ expected type -} -> Value {- ^ actual value -} -> Matcher a typeError wanted got = fail ("Type error. wanted: " ++ wanted ++ " got: " ++ show (prettyValue got)) +-- | Matches integer values instance FromValue Integer where     fromValue (Integer x) = pure x     fromValue v = typeError "integer" v +-- | Matches non-negative integer values instance FromValue Natural where     fromValue v =      do i <- fromValue v@@ -127,6 +130,8 @@ instance FromValue Word32 where fromValue = fromValueSized "Word32" instance FromValue Word64 where fromValue = fromValueSized "Word64" +-- | Matches single-character strings with 'fromValue' and arbitrary+-- strings with 'listFromValue' to support 'Prelude.String' instance FromValue Char where     fromValue (String [c]) = pure c     fromValue v = typeError "character" v@@ -134,39 +139,48 @@     listFromValue (String xs) = pure xs     listFromValue v = typeError "string" v +-- | Matches floating-point and integer values instance FromValue Double where     fromValue (Float x) = pure x     fromValue (Integer x) = pure (fromInteger x)     fromValue v = typeError "float" v +-- | Matches floating-point and integer values instance FromValue Float where     fromValue (Float x) = pure (realToFrac x)     fromValue (Integer x) = pure (fromInteger x)     fromValue v = typeError "float" v +-- | Matches @true@ and @false@ instance FromValue Bool where     fromValue (Bool x) = pure x     fromValue v = typeError "boolean" v +-- | Implemented in terms of 'listFromValue' instance FromValue a => FromValue [a] where     fromValue = listFromValue +-- | Matches local date literals instance FromValue Day where     fromValue (Day x) = pure x     fromValue v = typeError "local date" v +-- | Matches local time literals instance FromValue TimeOfDay where     fromValue (TimeOfDay x) = pure x     fromValue v = typeError "local time" v +-- | Matches offset date-time literals instance FromValue ZonedTime where     fromValue (ZonedTime x) = pure x     fromValue v = typeError "offset date-time" v +-- | Matches local date-time literals instance FromValue LocalTime where     fromValue (LocalTime x) = pure x     fromValue v = typeError "local date-time" v +-- | Matches all values, used for pass-through instance FromValue Value where     fromValue = pure @@ -175,7 +189,7 @@ -- -- Use 'optKey', 'reqKey', 'rej newtype ParseTable a = ParseTable (StateT Table Matcher a)-    deriving (Functor, Applicative, Monad)+    deriving (Functor, Applicative, Monad, Alternative, MonadPlus)  instance MonadFail ParseTable where     fail = ParseTable . fail

@@ -0,0 +1,69 @@+{-|+Module      : Toml.FromValue.Generic+Description : GHC.Generics derived table parsing+Copyright   : (c) Eric Mertens, 2023+License     : ISC+Maintainer  : emertens@gmail.com++Use 'genericFromTable' to derive an instance of 'Toml.FromValue.FromTable'+using the field names of a record.++-}+module Toml.FromValue.Generic (+    GParseTable(..),+    genericFromTable,+    ) where++import GHC.Generics+import Toml.FromValue (FromValue(..), ParseTable, optKey, reqKey, runParseTable)+import Toml.FromValue.Matcher (Matcher)+import Toml.Value (Table)++-- | Match a 'Table' using the field names in a record.+--+-- @since 1.0.2.0+genericFromTable :: (Generic a, GParseTable (Rep a)) => Table -> Matcher a+genericFromTable = runParseTable (gParseTable (pure . to))+{-# INLINE genericFromTable #-}++-- gParseTable is written in continuation passing style because+-- it allows all the GHC.Generics constructors to inline into+-- a single location which allows the optimizer to optimize them+-- complete away.++-- | Supports conversion of product types with field selector names to+-- TOML values.+--+-- @since 1.0.2.0+class GParseTable f where+    -- | Convert a value and apply the continuation to the result.+    gParseTable :: (f a -> ParseTable b) -> ParseTable b++-- | Ignores type constructor name+instance GParseTable f => GParseTable (D1 c f) where+    gParseTable f = gParseTable (f . M1)+    {-# INLINE gParseTable #-}++-- | Ignores value constructor name+instance GParseTable f => GParseTable (C1 c f) where+    gParseTable f = gParseTable (f . M1)+    {-# INLINE gParseTable #-}++instance (GParseTable f, GParseTable g) => GParseTable (f :*: g) where+    gParseTable f = gParseTable \x -> gParseTable \y -> f (x :*: y)+    {-# INLINE gParseTable #-}++-- | Omits the key from the table on nothing, includes it on just+instance {-# OVERLAPS #-} (Selector s, FromValue a) => GParseTable (S1 s (K1 i (Maybe a))) where+    gParseTable f = f . M1 . K1 =<< optKey (selName (M1 [] :: S1 s [] ()))+    {-# INLINE gParseTable #-}++-- | Uses record selector name as table key+instance (Selector s, FromValue a) => GParseTable (S1 s (K1 i a)) where+    gParseTable f = f . M1 . K1 =<< reqKey (selName (M1 [] :: S1 s [] ()))+    {-# INLINE gParseTable #-}++-- | Emits empty table+instance GParseTable U1 where+    gParseTable f = f U1+    {-# INLINE gParseTable #-}

@@ -5,43 +5,67 @@ License     : ISC Maintainer  : emertens@gmail.com +This type helps to build up computations that can validate a TOML+value and compute some application-specific representation.++It supports warning messages which can be used to deprecate old+configuration options and to detect unused table keys.++It supports tracking multiple error messages when you have more+than one decoding option and all of them have failed.+ -} module Toml.FromValue.Matcher (      Matcher,+    Result(..),     runMatcher,     withScope,     getScope,     warning,--    Result(..),     ) where  import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (asks, local, ReaderT(..))+import Control.Monad.Trans.Except (Except, runExcept, throwE) import Control.Monad.Trans.Writer.CPS (runWriterT, tell, WriterT)+import Data.Monoid (Endo(..))+import Control.Applicative (Alternative(..))+import Control.Monad (MonadPlus)  -- | Computations that result in a 'Result' and which track a list -- of nested contexts to assist in generating warnings and error -- messages. -- -- Use 'withScope' to run a 'Matcher' in a new, nested scope.-newtype Matcher a = Matcher (ReaderT [String] (WriterT (DList String) (Either String)) a)-    deriving (Functor, Applicative, Monad)+newtype Matcher a = Matcher (ReaderT [String] (WriterT Strings (Except Strings)) a)+    deriving (Functor, Applicative, Monad, Alternative, MonadPlus) -type DList a = [a] -> [a]+-- | List of strings that supports efficient left- and right-biased append+newtype Strings = Strings (Endo [String])+    deriving (Semigroup, Monoid) --- | Computation outcome with error and warning messages.+-- | Create a singleton list of strings+string :: String -> Strings+string x = Strings (Endo (x:))++-- | Extract the list of strings+runStrings :: Strings -> [String]+runStrings (Strings s) = s `appEndo` []++-- | Computation outcome with error and warning messages. Multiple error+-- messages can occur when multiple alternatives all fail. Resolving any+-- one of the error messages could allow the computation to succeed. data Result a-    = Failure String -- error message+    = Failure [String]   -- error messages     | Success [String] a -- warnings and result     deriving (Read, Show, Eq, Ord)  -- | Run a 'Matcher' with an empty scope. runMatcher :: Matcher a -> Result a runMatcher (Matcher m) =-    case runWriterT (runReaderT m []) of-        Left e -> Failure e-        Right (x,w) -> Success (w []) x+    case runExcept (runWriterT (runReaderT m [])) of+        Left e      -> Failure (runStrings e)+        Right (x,w) -> Success (runStrings w) x  -- | Run a 'Matcher' with a locally extended scope. withScope :: String -> Matcher a -> Matcher a@@ -55,10 +79,10 @@ warning :: String -> Matcher () warning w =  do loc <- getScope-    Matcher (lift (tell ((w ++ " in top" ++ concat loc):)))+    Matcher (lift (tell (string (w ++ " in top" ++ concat loc))))  -- | Fail with an error message annotated to the current location. instance MonadFail Matcher where     fail e =      do loc <- getScope-        Matcher (lift (lift (Left (e ++ " in top" ++ concat loc))))+        Matcher (lift (lift (throwE (string (e ++ " in top" ++ concat loc)))))

@@ -166,6 +166,11 @@  { +type AlexInput = Located String++alexGetByte :: AlexInput -> Maybe (Int, AlexInput)+alexGetByte = locatedUncons+ -- | Generate a lazy-list of tokens from the input string. -- The token stream is guaranteed to be terminated either with -- 'TokEOF' or 'TokError'.

@@ -5,33 +5,34 @@ License     : ISC Maintainer  : emertens@gmail.com -This module provides the datatype for the lexical-syntax of TOML files. These tokens will drive the-parser in the "Parser" module.+This module provides the datatype for the lexical syntax of TOML files.+These tokens are generated by "Toml.Lexer" and consumed in "Toml.Parser".  -} module Toml.Lexer.Token (+    -- * Types     Token(..), +    -- * String literals     mkLiteralString,     mkMlLiteralString, -    -- * integer literals+    -- * Integer literals     mkBinInteger,     mkDecInteger,     mkOctInteger,     mkHexInteger, -    -- * float literals+    -- * Float literals     mkFloat, -    -- * date and time patterns+    -- * Date and time patterns     localDatePatterns,     localTimePatterns,     localDateTimePatterns,     offsetDateTimePatterns, -    -- * errors+    -- * Errors     mkError,     ) where 

@@ -9,6 +9,9 @@ lexer. This lexer drive provides nested states, unicode support, and file location tracking. +The various states of this module are needed to deal with the varying+lexing rules while lexing values, keys, and string-literals.+ -} module Toml.Lexer.Utils ( @@ -16,6 +19,9 @@     Action,     Context(..), +    -- * Input processing+    locatedUncons,+     -- * Actions     value,     value_,@@ -29,19 +35,14 @@      equals,     timeValue,+    eofToken, +    -- * String literals     strFrag,     startMlStr,     startStr,     endStr,     unicodeEscape,--    eofToken,--    -- * Alex extension points-    AlexInput,-    alexGetByte,-     ) where  import Control.Monad.Trans.State.Strict (State, state)@@ -54,38 +55,45 @@ import Toml.Position (move, Position) import Toml.Lexer.Token (Token(..)) +-- | Type of actions associated with lexer patterns type Action = Located String -> State [Context] [Located Token] +-- | Representation of the current lexer state. data Context   = ListContext Position -- ^ processing an inline list, lex values   | TableContext Position -- ^ processing an inline table, don't lex values   | ValueContext -- ^ processing after an equals, lex one value-  | MlStrContext Position [String]-  | StrContext   Position [String]+  | MlStrContext Position [String] -- ^ position of opening delimiter and list of fragments+  | StrContext   Position [String] -- ^ position of opening delimiter and list of fragments   deriving Show +-- | Add a literal fragment of a string to the current string state. strFrag :: Action strFrag s = state \case   StrContext   p acc : st -> ([], StrContext   p (locThing s : acc) : st)   MlStrContext p acc : st -> ([], MlStrContext p (locThing s : acc) : st)   _                       -> error "strFrag: panic" +-- | End the current string state and emit the string literal token. endStr :: Action endStr x = state \case     StrContext   p acc : st -> ([Located p (TokString   (concat (reverse (locThing x : acc))))], st)     MlStrContext p acc : st -> ([Located p (TokMlString (concat (reverse (locThing x : acc))))], st)     _                       -> error "endStr: panic" +-- | Start a basic string literal startStr :: Action startStr t = state \case   ValueContext : st -> ([], StrContext (locPosition t) [] : st)   st                -> ([], StrContext (locPosition t) [] : st) +-- | Start a multi-line basic string literal startMlStr :: Action startMlStr t = state \case   ValueContext : st -> ([], MlStrContext (locPosition t) [] : st)   st                -> ([], MlStrContext (locPosition t) [] : st) +-- | Resolve a unicode escape sequence and add it to the current string literal unicodeEscape :: Action unicodeEscape (Located p lexeme) =   case readHex (drop 2 lexeme) of@@ -94,60 +102,74 @@       | otherwise                     -> strFrag (Located p [chr n])     _                                 -> error "unicodeEscape: panic" +-- | Record an @=@ token and update the state equals :: Action equals t = state \case   st -> ([TokEquals <$ t], ValueContext : st) +-- | Record an opening square bracket and update the state squareO :: Action squareO t = state \case   ValueContext  : st -> ([TokSquareO <$ t], ListContext (locPosition t) : st)   ListContext p : st -> ([TokSquareO <$ t], ListContext (locPosition t): ListContext p : st)   st                 -> ([TokSquareO <$ t], st) +-- | Record a closing square bracket and update the state squareC :: Action squareC t = state \case   ListContext _ : st -> ([TokSquareC <$ t], st)   st                 -> ([TokSquareC <$ t], st) +-- | Record an opening curly bracket and update the state curlyO :: Action curlyO t = state \case   ValueContext  : st -> ([TokCurlyO <$ t], TableContext (locPosition t) : st)   ListContext p : st -> ([TokCurlyO <$ t], TableContext (locPosition t) : ListContext p : st)   st                 -> ([TokCurlyO <$ t], st) +-- | Record a closing curly bracket and update the state curlyC :: Action curlyC t = state \case   TableContext _ : st -> ([TokCurlyC <$ t], st)   st                  -> ([TokCurlyC <$ t], st) +-- | Emit a token ignoring the current lexeme token_ :: Token -> Action token_ t x = pure [t <$ x] +-- | Emit a token using the current lexeme token :: (String -> Token) -> Action token f x = pure [f <$> x] +-- | Emit a value token and update the current state value_ :: Token -> Action-value_ t x = emitValue (t <$ x)+value_ t = value (const t) +-- | Emit a value token using the current lexeme and update the current state value :: (String -> Token) -> Action-value f x = emitValue (f <$> x)--emitValue :: Located Token -> State [Context] [Located Token]-emitValue v = state \st ->+value f x = state \st ->   case st of-    ValueContext : st' -> ([v], st')-    _                  -> ([v], st )+    ValueContext : st' -> ([f <$> x], st')+    _                  -> ([f <$> x], st ) -timeValue :: ParseTime a => String -> [String] -> (a -> Token) -> Action+-- | Attempt to parse the current lexeme as a date-time token.+timeValue ::+  ParseTime a =>+  String       {- ^ description for error messages -} ->+  [String]     {- ^ possible valid patterns        -} ->+  (a -> Token) {- ^ token constructor              -} ->+  Action timeValue description patterns constructor = value \str ->-  case asum [parseTimeM False defaultTimeLocale pattern str | pattern <- patterns] of+  case asum [parseTimeM False defaultTimeLocale pat str | pat <- patterns] of     Nothing -> TokError ("malformed " ++ description)     Just t  -> constructor t -type AlexInput = Located String--alexGetByte :: AlexInput -> Maybe (Int, AlexInput)-alexGetByte Located { locPosition = p, locThing = str } =+-- | Pop the first character off a located string if it's not empty.+-- The resulting 'Int' will either be the ASCII value of the character+-- or @1@ for non-ASCII Unicode values. To avoid a clash, @\x1@ is+-- remapped to @0@.+locatedUncons :: Located String -> Maybe (Int, Located String)+locatedUncons Located { locPosition = p, locThing = str } =   case str of     "" -> Nothing     x:xs@@ -157,6 +179,7 @@       where         rest = Located { locPosition = move x p, locThing = xs } +-- | Generate the correct terminating token given the current lexer state. eofToken :: [Context] -> Located String -> Located Token eofToken (MlStrContext p _ : _) _ = Located p (TokError "unterminated multi-line string literal") eofToken (StrContext   p _ : _) _ = Located p (TokError "unterminated string literal")

@@ -11,13 +11,13 @@  -} module Toml.Parser (-  -- * types+  -- * Types   Expr(..),   SectionKind(..),   Val(..),   Key, -  -- * parser+  -- * Parser   parseRawToml,   ) where @@ -125,6 +125,12 @@   | sepBy1_(p,q) q p  { NonEmpty.cons $3 $1   }  {++-- | Parse a list of tokens either returning the first unexpected+-- token or a list of the TOML statements in the file to be+-- processed by "Toml.Semantics".+parseRawToml :: [Located Token] -> Either (Located Token) [Expr]+-- implementation generated by happy  errorP :: [Located Token] -> Either (Located Token) a errorP (t:_) = Left t

@@ -9,6 +9,11 @@ This module provides human-readable renderers for types used in this package to assist error message production. +The generated 'Doc' values are annotated with 'DocClass' values+to assist in producing syntax-highlighted outputs.++To extract a plain String representation, use 'show'.+ -} module Toml.Pretty (     -- * Types

@@ -1,10 +1,20 @@-{-# LANGUAGE TypeOperators, TypeFamilies #-}+{-# LANGUAGE TypeFamilies #-} {-| Module      : Toml.ToValue Description : Automation for converting application values to TOML. Copyright   : (c) Eric Mertens, 2023 License     : ISC Maintainer  : emertens@gmail.com++The 'ToValue' class provides a conversion function from+application-specific to TOML values.++Because the top-level TOML document is always a table,+the 'ToTable' class is for types that specifically support+conversion from a 'Table'.++"Toml.ToValue.Generic" can be used to derive instances of 'ToTable'+automatically for record types.  -} module Toml.ToValue (

@@ -0,0 +1,68 @@+{-|+Module      : Toml.ToValue.Matcher+Description : GHC.Generics derived table generation+Copyright   : (c) Eric Mertens, 2023+License     : ISC+Maintainer  : emertens@gmail.com++Use 'genericToTable' to derive an instance of 'Toml.ToValue.ToTable'+using the field names of a record.++-}+module Toml.ToValue.Generic (+    GToTable(..),+    genericToTable,+    ) where++import Data.Map qualified as Map+import GHC.Generics+import Toml.Value (Table)+import Toml.ToValue (ToValue(..))++-- | Use a record's field names to generate a 'Table'+--+-- @since 1.0.2.0+genericToTable :: (Generic a, GToTable (Rep a)) => a -> Table+genericToTable = gToTable . from+{-# INLINE genericToTable #-}++-- | Supports conversion of product types with field selector names+-- to TOML values.+--+-- @since 1.0.2.0+class GToTable f where+    gToTable :: f a -> Table++-- | Ignores type constructor names+instance GToTable f => GToTable (D1 c f) where+    gToTable (M1 x) = gToTable x+    {-# INLINE gToTable #-}++-- | Ignores value constructor names+instance GToTable f => GToTable (C1 c f) where+    gToTable (M1 x) = gToTable x+    {-# INLINE gToTable #-}++instance (GToTable f, GToTable g) => GToTable (f :*: g) where+    gToTable (x :*: y) = gToTable x <> gToTable y+    {-# INLINE gToTable #-}++-- | Omits the key from the table on nothing, includes it on just+instance {-# OVERLAPS #-} (Selector s, ToValue a) => GToTable (S1 s (K1 i (Maybe a))) where+    gToTable (M1 (K1 Nothing)) = Map.empty+    gToTable s@(M1 (K1 (Just x))) = Map.singleton (selName s) (toValue x)+    {-# INLINE gToTable #-}++-- | Uses record selector name as table key+instance (Selector s, ToValue a) => GToTable (S1 s (K1 i a)) where+    gToTable s@(M1 (K1 x)) = Map.singleton (selName s) (toValue x)+    {-# INLINE gToTable #-}++-- | Emits empty table+instance GToTable U1 where+    gToTable _ = Map.empty+    {-# INLINE gToTable #-}++instance GToTable V1 where+    gToTable v = case v of {}+    {-# INLINE gToTable #-}

@@ -15,8 +15,10 @@     Table,     ) where +import Data.Data (Data) import Data.Map (Map) import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime(zonedTimeToLocalTime, zonedTimeZone), timeZoneMinutes)+import GHC.Generics (Generic)  -- | Representation of a TOML key-value table. type Table = Map String Value@@ -33,7 +35,7 @@     | ZonedTime ZonedTime     | LocalTime LocalTime     | Day       Day-    deriving (Show, Read)+    deriving (Show, Read, Data, Generic)  instance Eq Value where     Integer   x == Integer   y = x == y

@@ -0,0 +1,128 @@+{-# Language DuplicateRecordFields #-}+module DecodeSpec (spec) where++import Data.Map qualified as Map+import Data.Maybe (fromMaybe)+import GHC.Generics (Generic)+import QuoteStr (quoteStr )+import Test.Hspec (it, shouldBe, Spec)+import Toml (decode, Result(Success), encode)+import Toml.FromValue (FromTable(..), FromValue(..), defaultTableFromValue, runParseTable, reqKey, optKey)+import Toml.FromValue.Generic (genericFromTable)+import Toml.ToValue+import Toml.ToValue.Generic (genericToTable)++newtype Fruits = Fruits { fruits :: [Fruit] }+    deriving (Eq, Show, Generic)++data Fruit = Fruit {+    name :: String,+    physical :: Maybe Physical,+    varieties :: [Variety]+    } deriving (Eq, Show, Generic)++data Physical = Physical {+    color :: String,+    shape :: String+    } deriving (Eq, Show, Generic)++newtype Variety = Variety {+    name :: String+    } deriving (Eq, Show, Generic)++instance FromTable Fruits   where fromTable = genericFromTable+instance FromTable Physical where fromTable = genericFromTable+instance FromTable Variety  where fromTable = genericFromTable++instance FromValue Fruits   where fromValue = defaultTableFromValue+instance FromValue Fruit    where fromValue = defaultTableFromValue+instance FromValue Physical where fromValue = defaultTableFromValue+instance FromValue Variety  where fromValue = defaultTableFromValue++instance ToTable Fruits   where toTable = genericToTable+instance ToTable Physical where toTable = genericToTable+instance ToTable Variety  where toTable = genericToTable++instance ToValue Fruits   where toValue = defaultTableToValue+instance ToValue Fruit    where toValue = defaultTableToValue+instance ToValue Physical where toValue = defaultTableToValue+instance ToValue Variety  where toValue = defaultTableToValue++instance FromTable Fruit where+    fromTable = runParseTable (Fruit+        <$> reqKey "name"+        <*> optKey "physical"+        <*> (fromMaybe [] <$> optKey "varieties"))++instance ToTable Fruit where+    toTable (Fruit n mbp vs) = Map.fromList $+        ["varieties" .= vs | not (null vs)] +++        ["physical"  .= p | Just p <- [mbp]] +++        ["name"      .= n]++spec :: Spec+spec =+ do let expect = Fruits [+            Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious", Variety "granny smith"],+            Fruit "banana" Nothing [Variety "plantain"]]++    it "handles fruit example" $+        decode [quoteStr|+            [[fruits]]+            name = "apple"++            [fruits.physical]  # subtable+            color = "red"+            shape = "round"++            [[fruits.varieties]]  # nested array of tables+            name = "red delicious"++            [[fruits.varieties]]+            name = "granny smith"++            [[fruits]]+            name = "banana"++            [[fruits.varieties]]+            name = "plantain"|]+        `shouldBe`+        Success mempty expect++    it "encodes correctly" $+        show (encode expect)+        `shouldBe`+        [quoteStr|+            [[fruits]]+            name = "apple"++            [fruits.physical]+            color = "red"+            shape = "round"++            [[fruits.varieties]]+            name = "red delicious"++            [[fruits.varieties]]+            name = "granny smith"++            [[fruits]]+            name = "banana"++            [[fruits.varieties]]+            name = "plantain"|]++    it "generates warnings for unused keys" $+        decode [quoteStr|+            [[fruits]]+            name = "peach"+            taste = "sweet"+            count = 5+            [[fruits]]+            name = "pineapple"+            color = "yellow"|]+        `shouldBe`+        Success [+            "Unexpected keys: count, taste in top.fruits[0]",+            "Unexpected key: color in top.fruits[1]"]+            (Fruits [Fruit "peach" Nothing [], Fruit "pineapple" Nothing []])

@@ -0,0 +1,68 @@+module LexerSpec (spec) where++import Data.Map qualified as Map+import Test.Hspec (it, shouldBe, Spec)+import Toml (parse, Value(Integer))++spec :: Spec+spec =+ do it "handles special cased control character" $+        parse "x = '\SOH'"+        `shouldBe`+        Left "1:6: lexical error: unexpected '\\SOH'"++    -- These seem boring, but they provide test coverage of an error case in the state machine+    it "handles unexpected '}'" $+        parse "}"+        `shouldBe`+        Left "1:1: parse error: unexpected '}'"++    it "handles unexpected '{'" $+        parse "{"+        `shouldBe`+        Left "1:1: parse error: unexpected '{'"++    it "accepts tabs" $+        parse "x\t=\t1"+        `shouldBe`+        Right (Map.singleton "x" (Integer 1))++    it "computes columns correctly with tabs" $+        parse "x\t=\t="+        `shouldBe`+        Left "1:17: parse error: unexpected '='"++    it "detects non-scalars in strings" $+        parse "x = \"\\udfff\""+        `shouldBe`+        Left "1:6: lexical error: non-scalar unicode escape"++    it "catches unclosed [" $+        parse "x = [1,2,3"+        `shouldBe`+        Left "1:5: lexical error: unterminated '['"++    it "catches unclosed {" $+        parse "x = { y"+        `shouldBe`+        Left "1:5: lexical error: unterminated '{'"++    it "catches unclosed \"" $+        parse "x = \"abc"+        `shouldBe`+        Left "1:5: lexical error: unterminated string literal"++    it "catches unclosed \"\"\"" $+        parse "x = \"\"\"test"+        `shouldBe`+        Left "1:5: lexical error: unterminated multi-line string literal"++    it "handles escapes at the end of input" $+        parse "x = \"\\"+        `shouldBe`+        Left "1:7: lexical error: unexpected end-of-input"++    it "handles invalid escapes" $+        parse "x = \"\\p\""+        `shouldBe`+        Left "1:7: lexical error: unexpected 'p'"

@@ -1,966 +1,1 @@-{-# Language QuasiQuotes #-}-{-|-Module      : Main-Description : Unit tests-Copyright   : (c) Eric Mertens, 2023-License     : ISC-Maintainer  : emertens@gmail.com--TOML parser and validator unit tests (primarily drawn from the-specification document).---}-module Main (main) where--import Data.Map (Map)-import Data.Map qualified as Map-import Data.Time (Day, TimeOfDay, LocalTime, ZonedTime)-import QuoteStr (quoteStr)-import Test.Hspec (hspec, describe, it, shouldBe, shouldSatisfy, Spec)-import Toml (Value(..), parse, decode, encode, Result(Success), prettyToml, Table)-import Toml.FromValue (FromValue(..), defaultTableFromValue, reqKey, optKey, runParseTable, ParseTable, FromTable (fromTable))-import Toml.ToValue (table, (.=), toValue)--main :: IO ()-main = hspec do--  describe "lexer"-   do it "handles special cased control character" $-        parse "x = '\SOH'"-        `shouldBe`-        Left "1:6: lexical error: unexpected '\\SOH'"--      -- These seem boring, but they provide test coverage of an error case in the state machine-      it "handles unexpected '}'" $-        parse "}"-        `shouldBe`-        Left "1:1: parse error: unexpected '}'"--      it "handles unexpected '{'" $-        parse "{"-        `shouldBe`-        Left "1:1: parse error: unexpected '{'"--      it "accepts tabs" $-        parse "x\t=\t1"-        `shouldBe`-        Right (Map.singleton "x" (Integer 1))--      it "computes columns correctly with tabs" $-        parse "x\t=\t="-        `shouldBe`-        Left "1:17: parse error: unexpected '='"--      it "detects non-scalars in strings" $-        parse "x = \"\\udfff\""-        `shouldBe`-        Left "1:6: lexical error: non-scalar unicode escape"--      it "catches unclosed [" $-        parse "x = [1,2,3"-        `shouldBe`-        Left "1:5: lexical error: unterminated '['"--      it "catches unclosed {" $-        parse "x = { y"-        `shouldBe`-        Left "1:5: lexical error: unterminated '{'"--      it "catches unclosed \"" $-        parse "x = \"abc"-        `shouldBe`-        Left "1:5: lexical error: unterminated string literal"--      it "catches unclosed \"\"\"" $-        parse "x = \"\"\"test"-        `shouldBe`-        Left "1:5: lexical error: unterminated multi-line string literal"-      -      it "handles escapes at the end of input" $-        parse "x = \"\\"-        `shouldBe`-        Left "1:7: lexical error: unexpected end-of-input"--      it "handles invalid escapes" $-        parse "x = \"\\p\""-        `shouldBe`-        Left "1:7: lexical error: unexpected 'p'"--  describe "ToValue"-   do-    it "converts characters as singleton strings" $-      toValue '!' `shouldBe` String "!"--  describe "parse" do-    describe "comment"-     do it "ignores comments" $-          parse [quoteStr|-            # This is a full-line comment-            key = "value"  # This is a comment at the end of a line-            another = "# This is not a comment"|]-          `shouldBe`-          Right (Map.fromList [("another",String "# This is not a comment"),("key",String "value")])--    describe "key/value pair"-     do it "supports the most basic assignments" $-          parse "key = \"value\"" `shouldBe` Right (Map.singleton "key" (String "value"))--        it "requires a value after equals" $-          parse "key = # INVALID"-          `shouldBe`-          Left "1:16: parse error: unexpected end-of-input"--        it "requires newlines between assignments" $-          parse "first = \"Tom\" last = \"Preston-Werner\" # INVALID"-          `shouldBe`-          Left "1:15: parse error: unexpected bare key"--    describe "keys"-     do it "allows bare keys" $-          parse [quoteStr|-            key = "value"-            bare_key = "value"-            bare-key = "value"-            1234 = "value"|]-          `shouldBe`-          Right (Map.fromList [-            "1234"     .= "value",-            "bare-key" .= "value",-            "bare_key" .= "value",-            "key"      .= "value"])--        it "allows quoted keys" $-          parse [quoteStr|-            "127.0.0.1" = "value"-            "character encoding" = "value"-            "ʎǝʞ" = "value"-            'key2' = "value"-            'quoted "value"' = "value"|]-          `shouldBe`-          Right (Map.fromList [-            "127.0.0.1"          .= "value",-            "character encoding" .= "value",-            "key2"               .= "value",-            "quoted \"value\""   .= "value",-            "ʎǝʞ"                .= "value"])--        it "allows dotted keys" $-          parse [quoteStr|-            name = "Orange"-            physical.color = "orange"-            physical.shape = "round"-            site."google.com" = true|]-          `shouldBe`-          Right (Map.fromList [-            "name"     .= "Orange",-            "physical" .= table ["color" .= "orange", "shape" .= "round"],-            "site"     .= table ["google.com" .= True]])--        it "prevents duplicate keys" $-          parse [quoteStr|-            name = "Tom"-            name = "Pradyun"|]-          `shouldBe` Left "2:1: key error: name is already assigned"--        it "prevents duplicate keys even between bare and quoted" $-          parse [quoteStr|-            spelling = "favorite"-            "spelling" = "favourite"|]-          `shouldBe` Left "2:1: key error: spelling is already assigned"--        it "allows out of order definitions" $-          parse [quoteStr|-            apple.type = "fruit"-            orange.type = "fruit"--            apple.skin = "thin"-            orange.skin = "thick"--            apple.color = "red"-            orange.color = "orange"|]-          `shouldBe`-          Right (Map.fromList [-            "apple" .= table [-                "color" .= "red",-                "skin"  .= "thin",-                "type"  .= "fruit"],-            "orange" .= table [-                "color" .= "orange",-                "skin"  .= "thick",-                "type"  .= "fruit"]])--        it "allows numeric bare keys" $-          parse "3.14159 = 'pi'" `shouldBe` Right (Map.singleton "3" (table [("14159", String "pi")]))--        it "allows keys that look like other values" $-          parse [quoteStr|-            true = true-            false = false-            1900-01-01 = 1900-01-01-            1_2 = 2_3|]-          `shouldBe`-          Right (Map.fromList [-            "1900-01-01" .= (read "1900-01-01" :: Day),-            "1_2"        .= (23::Int),-            "false"      .= False,-            "true"       .= True])--    describe "string"-     do it "parses escapes" $-          parse [quoteStr|-            str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF."|]-          `shouldBe`-          Right (Map.singleton "str" (String "I'm a string. \"You can quote me\". Name\tJos\xe9\nLocation\tSF."))--        it "strips the initial newline from multiline strings" $-          parse [quoteStr|-            str1 = """-            Roses are red-            Violets are blue"""|]-          `shouldBe` Right (Map.singleton "str1" (String "Roses are red\nViolets are blue"))--        it "strips whitespace with a trailing escape" $-          parse [quoteStr|-            # The following strings are byte-for-byte equivalent:-            str1 = "The quick brown fox jumps over the lazy dog."--            str2 = """-            The quick brown \---            fox jumps over \-                the lazy dog."""--            str3 = """\-                The quick brown \-                fox jumps over \-                the lazy dog.\-                """|]-          `shouldBe`-          Right (Map.fromList [-            "str1" .= "The quick brown fox jumps over the lazy dog.",-            "str2" .= "The quick brown fox jumps over the lazy dog.",-            "str3" .= "The quick brown fox jumps over the lazy dog."])--        it "allows quotes inside multiline quoted strings" $-          parse [quoteStr|-            str4 = """Here are two quotation marks: "". Simple enough."""-            str5 = """Here are three quotation marks: ""\"."""-            str6 = """Here are fifteen quotation marks: ""\"""\"""\"""\"""\"."""--            # "This," she said, "is just a pointless statement."-            str7 = """"This," she said, "is just a pointless statement.""""|]-          `shouldBe`-          Right (Map.fromList [-            "str4" .= "Here are two quotation marks: \"\". Simple enough.",-            "str5" .= "Here are three quotation marks: \"\"\".",-            "str6" .= "Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\".",-            "str7" .= "\"This,\" she said, \"is just a pointless statement.\""])--        it "disallows triple quotes inside a multiline string" $-          parse [quoteStr|-            str5 = """Here are three quotation marks: """."""  # INVALID|]-          `shouldBe` Left "1:46: parse error: unexpected '.'"--        it "ignores escapes in literal strings" $-          parse [quoteStr|-            # What you see is what you get.-            winpath  = 'C:\Users\nodejs\templates'-            winpath2 = '\\ServerX\admin$\system32\'-            quoted   = 'Tom "Dubs" Preston-Werner'-            regex    = '<\i\c*\s*>'|]-          `shouldBe`-          Right (Map.fromList [-            "quoted"   .= "Tom \"Dubs\" Preston-Werner",-            "regex"    .= "<\\i\\c*\\s*>",-            "winpath"  .= "C:\\Users\\nodejs\\templates",-            "winpath2" .= "\\\\ServerX\\admin$\\system32\\"])--        it "handles multiline literal strings" $-          parse [quoteStr|-            regex2 = '''I [dw]on't need \d{2} apples'''-            lines  = '''-            The first newline is-            trimmed in raw strings.-            All other whitespace-            is preserved.-            '''|]-          `shouldBe`-          Right (Map.fromList [-            "lines"  .= "The first newline is\ntrimmed in raw strings.\nAll other whitespace\nis preserved.\n",-            "regex2" .= "I [dw]on't need \\d{2} apples"])--        it "parses all the other escapes" $-          parse [quoteStr|-            x = "\\\b\f\r\U0010abcd"-            y = """\\\b\f\r\u7bca\U0010abcd\n\r\t"""|]-          `shouldBe`-          Right (Map.fromList [-            "x" .= "\\\b\f\r\x0010abcd",-            "y" .= "\\\b\f\r\x7bca\x0010abcd\n\r\t"])--        it "rejects out of range unicode escapes" $-          parse [quoteStr|-            x = "\U11111111"|]-          `shouldBe` Left "1:6: lexical error: unicode escape too large"--    describe "integer"-     do it "parses literals correctly" $-          parse [quoteStr|-            int1 = +99-            int2 = 42-            int3 = 0-            int4 = -17-            int5 = 1_000-            int6 = 5_349_221-            int7 = 53_49_221  # Indian number system grouping-            int8 = 1_2_3_4_5  # VALID but discouraged-            # hexadecimal with prefix `0x`-            hex1 = 0xDEADBEEF-            hex2 = 0xdeadbeef-            hex3 = 0xdead_beef--            # octal with prefix `0o`-            oct1 = 0o01234567-            oct2 = 0o755 # useful for Unix file permissions--            # binary with prefix `0b`-            bin1 = 0b11010110|]-          `shouldBe` Right-          (Map.fromList [-              "bin1" .= Integer 214,-              "hex1" .= Integer 0xDEADBEEF,-              "hex2" .= Integer 0xDEADBEEF,-              "hex3" .= Integer 0xDEADBEEF,-              "int1" .= Integer 99,-              "int2" .= Integer 42,-              "int3" .= Integer 0,-              "int4" .= Integer (-17),-              "int5" .= Integer 1000,-              "int6" .= Integer 5349221,-              "int7" .= Integer 5349221,-              "int8" .= Integer 12345,-              "oct1" .= Integer 0o01234567,-              "oct2" .= Integer 0o755])--    describe "float"-     do it "parses floats" $-          parse [quoteStr|-            # fractional-            flt1 = +1.0-            flt2 = 3.1415-            flt3 = -0.01--            # exponent-            flt4 = 5e+22-            flt5 = 1e06-            flt6 = -2E-2--            # both-            flt7 = 6.626e-34-            flt8 = 224_617.445_991_228-            # infinity-            sf1 = inf  # positive infinity-            sf2 = +inf # positive infinity-            sf3 = -inf # negative infinity|]-          `shouldBe`-          Right (Map.fromList [-            "flt1" .= Float 1.0,-            "flt2" .= Float 3.1415,-            "flt3" .= Float (-1.0e-2),-            "flt4" .= Float 4.9999999999999996e22,-            "flt5" .= Float 1000000.0,-            "flt6" .= Float (-2.0e-2),-            "flt7" .= Float 6.626e-34,-            "flt8" .= Float 224617.445991228,-            "sf1"  .= Float (1/0),-            "sf2"  .= Float (1/0),-            "sf3"  .= Float (-1/0)])--        it "parses nan correctly" $-          let checkNaN (Float x) = isNaN x-              checkNaN _         = False-          in-          parse [quoteStr|-            # not a number-            sf4 = nan  # actual sNaN/qNaN encoding is implementation-specific-            sf5 = +nan # same as `nan`-            sf6 = -nan # valid, actual encoding is implementation-specific|]-          `shouldSatisfy` \case-            Left{} -> False-            Right x -> all checkNaN x--    describe "boolean"-     do it "parses boolean literals" $-          parse [quoteStr|-            bool1 = true-            bool2 = false|]-          `shouldBe`-          Right (Map.fromList [-            "bool1" .= True,-            "bool2" .= False])--    describe "offset date-time"-     do it "parses offset date times" $-          parse [quoteStr|-            odt1 = 1979-05-27T07:32:00Z-            odt2 = 1979-05-27T00:32:00-07:00-            odt3 = 1979-05-27T00:32:00.999999-07:00-            odt4 = 1979-05-27 07:32:00Z|]-          `shouldBe`-          Right (Map.fromList [-            "odt1" .= ZonedTime (read "1979-05-27 07:32:00 +0000"),-            "odt2" .= ZonedTime (read "1979-05-27 00:32:00 -0700"),-            "odt3" .= ZonedTime (read "1979-05-27 00:32:00.999999 -0700"),-            "odt4" .= ZonedTime (read "1979-05-27 07:32:00 +0000")])--    describe "local date-time"-     do it "parses local date-times" $-          parse [quoteStr|-            ldt1 = 1979-05-27T07:32:00-            ldt2 = 1979-05-27T00:32:00.999999-            ldt3 = 1979-05-28 00:32:00.999999|]-          `shouldBe`-          Right (Map.fromList [-            "ldt1" .= LocalTime (read "1979-05-27 07:32:00"),-            "ldt2" .= LocalTime (read "1979-05-27 00:32:00.999999"),-            "ldt3" .= LocalTime (read "1979-05-28 00:32:00.999999")])--        it "catches invalid date-times" $-          parse [quoteStr|-            ldt = 9999-99-99T99:99:99|]-          `shouldBe`-          Left "1:7: lexical error: malformed local date-time"--    describe "local date"-     do it "parses dates" $-          parse [quoteStr|-            ld1 = 1979-05-27|]-          `shouldBe`-          Right (Map.singleton "ld1" (Day (read "1979-05-27")))--    describe "local time"-     do it "parses times" $-          parse [quoteStr|-            lt1 = 07:32:00-            lt2 = 00:32:00.999999|]-          `shouldBe`-          Right (Map.fromList [-            "lt1" .= TimeOfDay (read "07:32:00"),-            "lt2" .= TimeOfDay (read "00:32:00.999999")])--    describe "array"-     do it "parses array examples" $-          parse [quoteStr|-            integers = [ 1, 2, 3 ]-            colors = [ "red", "yellow", "green" ]-            nested_arrays_of_ints = [ [ 1, 2 ], [3, 4, 5] ]-            nested_mixed_array = [ [ 1, 2 ], ["a", "b", "c"] ]-            string_array = [ "all", 'strings', """are the same""", '''type''' ]--            # Mixed-type arrays are allowed-            numbers = [ 0.1, 0.2, 0.5, 1, 2, 5 ]-            contributors = [-            "Foo Bar <foo@example.com>",-            { name = "Baz Qux", email = "bazqux@example.com", url = "https://example.com/bazqux" }-            ]|]-            `shouldBe`-            Right (Map.fromList [-                "colors" .= ["red", "yellow", "green"],-                "contributors" .= [-                    String "Foo Bar <foo@example.com>",-                    table [-                        "email" .= "bazqux@example.com",-                        "name" .= "Baz Qux",-                        "url" .= "https://example.com/bazqux"]],-                "integers" .= [1, 2, 3 :: Integer],-                "nested_arrays_of_ints" .= [[1, 2], [3, 4, 5 :: Integer]],-                "nested_mixed_array" .= [[Integer 1, Integer 2], [String "a", String "b", String "c"]],-                "numbers" .= [Float 0.1, Float 0.2, Float 0.5, Integer 1, Integer 2, Integer 5],-                "string_array" .= ["all", "strings", "are the same", "type"]])--        it "handles newlines and comments" $-          parse [quoteStr|-            integers2 = [-            1, 2, 3-            ]--            integers3 = [-            1,-            2, # this is ok-            ]|]-            `shouldBe`-            Right (Map.fromList [-                "integers2" .= [1, 2, 3 :: Int],-                "integers3" .= [1, 2 :: Int]])--        it "disambiguates double brackets from array tables" $-          parse "x = [[1]]" `shouldBe` Right (Map.singleton "x" (Array [Array [Integer 1]]))--    describe "table"-     do it "allows empty tables" $-          parse "[table]" `shouldBe` Right (Map.singleton "table" (table []))--        it "parses simple tables" $-          parse [quoteStr|-            [table-1]-            key1 = "some string"-            key2 = 123--            [table-2]-            key1 = "another string"-            key2 = 456|]-          `shouldBe`-          Right (Map.fromList [-            "table-1" .= table [-                "key1" .= "some string",-                "key2" .= Integer 123],-            "table-2" .= table [-                "key1" .= "another string",-                "key2" .= Integer 456]])--        it "allows quoted keys" $-          parse [quoteStr|-            [dog."tater.man"]-            type.name = "pug"|]-          `shouldBe`-          Right (Map.fromList [("dog", table [("tater.man", table [("type", table [("name",String "pug")])])])])--        it "allows whitespace around keys" $-          parse [quoteStr|-            [a.b.c]            # this is best practice-            [ d.e.f ]          # same as [d.e.f]-            [ g .  h  . i ]    # same as [g.h.i]-            [ j . "ʞ" . 'l' ]  # same as [j."ʞ".'l']|]-          `shouldBe`-          Right (Map.fromList [-            "a" .= table ["b" .= table ["c" .= table []]],-            "d" .= table ["e" .= table ["f" .= table []]],-            "g" .= table ["h" .= table ["i" .= table []]],-            "j" .= table ["ʞ" .= table ["l" .= table []]]])--        it "allows supertables to be defined after subtables" $-          parse [quoteStr|-            # [x] you-            # [x.y] don't-            # [x.y.z] need these-            [x.y.z.w] # for this to work--            [x] # defining a super-table afterward is ok-            q=1|]-          `shouldBe`-          Right (Map.fromList [-            "x" .= table [-                "q" .= Integer 1,-                "y" .= table [-                    "z" .= table [-                        "w" .= table []]]]])--        it "prevents using a [table] to open a table defined with dotted keys" $-          parse [quoteStr|-            [fruit]-            apple.color = 'red'-            apple.taste.sweet = true-            [fruit.apple]|]-          `shouldBe` Left "4:8: key error: apple is a closed table"--        it "can add subtables" $-          parse [quoteStr|-            [fruit]-            apple.color = "red"-            apple.taste.sweet = true-            [fruit.apple.texture]  # you can add sub-tables-            smooth = true|]-          `shouldBe`-          Right (Map.fromList [-            "fruit" .= table [-                "apple" .= table [-                    "color" .= "red",-                    "taste" .= table [-                        "sweet" .= True],-                        "texture" .= table [-                            "smooth" .= True]]]])--    describe "inline table"-     do it "parses inline tables" $-          parse [quoteStr|-            name = { first = "Tom", last = "Preston-Werner" }-            point = { x = 1, y = 2 }-            animal = { type.name = "pug" }|]-          `shouldBe`-          Right (Map.fromList [-            "animal" .= table ["type" .= table ["name" .= "pug"]],-            "name"   .= table ["first" .= "Tom", "last" .= "Preston-Werner"],-            "point"  .= table ["x" .= Integer 1, "y" .= Integer 2]])--        it "prevents altering inline tables with dotted keys" $-          parse [quoteStr|-            [product]-            type = { name = "Nail" }-            type.edible = false  # INVALID|]-          `shouldBe` Left "3:1: key error: type is already assigned"--        it "prevents using inline tables to add keys to existing tables" $-          parse [quoteStr|-            [product]-            type.name = "Nail"-            type = { edible = false }  # INVALID|]-          `shouldBe` Left "3:1: key error: type is already assigned"--    describe "array of tables"-     do it "supports array of tables syntax" $-          decode [quoteStr|-            [[products]]-            name = "Hammer"-            sku = 738594937--            [[products]]  # empty table within the array--            [[products]]-            name = "Nail"-            sku = 284758393--            color = "gray"|]-          `shouldBe`-          Success mempty (Map.singleton "products" [-            Map.fromList [-              "name" .= "Hammer",-              "sku"  .= Integer 738594937],-            Map.empty,-            Map.fromList [-                "color" .= "gray",-                "name"  .= "Nail",-                "sku"   .= Integer 284758393]])--        it "handles subtables under array of tables" $-          parse [quoteStr|-            [[fruits]]-            name = "apple"--            [fruits.physical]  # subtable-            color = "red"-            shape = "round"--            [[fruits.varieties]]  # nested array of tables-            name = "red delicious"--            [[fruits.varieties]]-            name = "granny smith"---            [[fruits]]-            name = "banana"--            [[fruits.varieties]]-            name = "plantain"|]-          `shouldBe`-          Right (Map.fromList [-            "fruits" .= [-                table [-                    "name" .= "apple",-                    "physical" .= table [-                        "color" .= "red",-                        "shape" .= "round"],-                    "varieties" .= [-                        table ["name" .= "red delicious"],-                        table ["name" .= "granny smith"]]],-                table [-                    "name" .= "banana",-                    "varieties" .= [-                        table ["name" .= "plantain"]]]]])--        it "prevents redefining a supertable with an array of tables" $-          parse [quoteStr|-            # INVALID TOML DOC-            [fruit.physical]  # subtable, but to which parent element should it belong?-            color = "red"-            shape = "round"--            [[fruit]]  # parser must throw an error upon discovering that "fruit" is-                    # an array rather than a table-            name = "apple"|]-            `shouldBe` Left "6:3: key error: fruit is already a table"--        it "prevents redefining an inline array" $-          parse [quoteStr|-            # INVALID TOML DOC-            fruits = []--            [[fruits]] # Not allowed|]-          `shouldBe` Left "4:3: key error: fruits is already assigned"--    -- these cases are needed to complete coverage checking on Semantics module-    describe "corner cases"-     do it "stays open" $-          parse [quoteStr|-            [x.y.z]-            [x]-            [x.y]|]-          `shouldBe`-          parse "x.y.z={}"--        it "stays closed" $-          parse [quoteStr|-            [x.y]-            [x]-            [x.y]|] `shouldBe` Left "3:4: key error: y is a closed table"--        it "super tables of array tables preserve array tables" $-          parse [quoteStr|-            [[x.y]]-            [x]-            [[x.y]]|]-          `shouldBe`-          parse "x.y=[{},{}]"--        it "super tables of array tables preserve array tables" $-          parse [quoteStr|-            [[x.y]]-            [x]-            [x.y.z]|]-          `shouldBe`-          parse "x.y=[{z={}}]"--        it "detects conflicting inline keys" $-          parse [quoteStr|-            x = { y = 1, y.z = 2}|]-          `shouldBe` Left "1:14: key error: y is already assigned"--        it "handles merging dotted inline table keys" $-          parse [quoteStr|-            t = { a.x.y = 1, a.x.z = 2, a.q = 3}|]-          `shouldBe`-          Right (Map.fromList [-            ("t", table [-                ("a", table [-                    ("q",Integer 3),-                    ("x", table [-                        ("y",Integer 1),-                        ("z",Integer 2)])])])])--        it "disallows overwriting assignments with tables" $-          parse [quoteStr|-            x = 1-            [x.y]|]-          `shouldBe` Left "2:2: key error: x is already assigned"--        it "handles super super tables" $-          parse [quoteStr|-            [x.y.z]-            [x.y]-            [x]|]-          `shouldBe`-          parse "x.y.z={}"--        it "You can dot into open supertables" $-          parse [quoteStr|-            [x.y.z]-            [x]-            y.q = 1|]-          `shouldBe`-          parse "x.y={z={},q=1}"--        it "dotted tables close previously open tables" $-          parse [quoteStr|-            [x.y.z]-            [x]-            y.q = 1-            [x.y]|]-          `shouldBe` Left "4:4: key error: y is a closed table"--        it "dotted tables can't assign through closed tables!" $-          parse [quoteStr|-            [x.y]-            [x]-            y.z.w = 1|]-          `shouldBe` Left "3:1: key error: y is a closed table"--        it "super tables can't add new subtables to array tables via dotted keys" $-          parse [quoteStr|-            [[x.y]]-            [x]-            y.z.a = 1-            y.z.b = 2|]-          `shouldBe` Left "3:1: key error: y is a closed table"--        it "the previous example preserves closeness" $-          parse [quoteStr|-            [[x.y]]-            [x]-            y.z.a = 1-            y.w = 2|]-          `shouldBe` Left "3:1: key error: y is a closed table"--        it "defining a supertable closes the supertable" $-          parse [quoteStr|-            [x.y]-            [x]-            [x]|]-          `shouldBe` Left "3:2: key error: x is a closed table"--        it "prevents redefining an array of tables" $-          parse [quoteStr|-            [[x.y]]-            [x.y]|]-          `shouldBe` Left "2:4: key error: y is already an array of tables"--  describe "deserialization" deserializationTests-  describe "pretty-printing" prettyTests--tomlString :: Table -> String-tomlString = show . prettyToml--prettyTests :: Spec-prettyTests =- do it "renders example 1" $-      show (encode (Map.singleton "x" (1 :: Integer)))-        `shouldBe` [quoteStr|-        x = 1|]--    it "renders example 2" $-      fmap tomlString (parse "x=1\ny=2")-        `shouldBe` Right [quoteStr|-        x = 1-        y = 2|]--    it "renders example lists" $-      fmap tomlString (parse "x=[1,'two', [true]]")-        `shouldBe` Right [quoteStr|-        x = [1, "two", [true]]|]--    it "renders empty tables" $-      fmap tomlString (parse "x.y.z={}\nz.y.w=false")-        `shouldBe` Right [quoteStr|-        z.y.w = false--        [x.y.z]|]--    it "renders empty tables in array of tables" $-      fmap tomlString (parse "ex=[{},{},{a=9}]")-        `shouldBe` Right [quoteStr|-        [[ex]]--        [[ex]]--        [[ex]]-        a = 9|]--    it "renders multiple tables" $-      fmap tomlString (parse "a.x=1\nb.x=3\na.y=2\nb.y=4")-        `shouldBe` Right [quoteStr|-        [a]-        x = 1-        y = 2--        [b]-        x = 3-        y = 4|]--    it "renders escapes in strings" $-      fmap tomlString (parse "a=\"\\\\\\b\\t\\r\\n\\f\\\"\\u007f\\U0001000c\"")-        `shouldBe` Right [quoteStr|-        a = "\\\b\t\r\n\f\"\u007F\U0001000C"|]--    it "renders floats" $-      fmap tomlString (parse "a=0.0\nb=-0.1\nc=0.1\nd=3.141592653589793\ne=4e123")-        `shouldBe` Right [quoteStr|-        a = 0.0-        b = -0.1-        c = 0.1-        d = 3.141592653589793-        e = 4.0e123|]--    it "renders special floats" $-      fmap tomlString (parse "a=inf\nb=-inf\nc=nan")-        `shouldBe` Right [quoteStr|-        a = inf-        b = -inf-        c = nan|]--    it "renders empty documents" $-      fmap tomlString (parse "")-        `shouldBe` Right ""--    it "renders dates and time" $-      fmap tomlString (parse [quoteStr|-        a = 2020-05-07-        b = 15:16:17.990-        c = 2020-05-07T15:16:17.990-        d = 2020-05-07T15:16:17.990Z-        e = 2020-05-07T15:16:17-07:00-        f = 2021-09-06T14:15:19+08:00|])-        `shouldBe` Right [quoteStr|-        a = 2020-05-07-        b = 15:16:17.99-        c = 2020-05-07T15:16:17.99-        d = 2020-05-07T15:16:17.99Z-        e = 2020-05-07T15:16:17-07:00-        f = 2021-09-06T14:15:19+08:00|]--    it "renders quoted keys" $-      fmap tomlString (parse "''.'a b'.'\"' = 10")-        `shouldBe` Right [quoteStr|-        ""."a b"."\"" = 10|]--    it "renders inline tables" $-      fmap tomlString (parse [quoteStr|-        x = [[{a = 'this is a longer example', b = 'and it will linewrap'},{c = 'all on its own'}]]|])-        `shouldBe` Right [quoteStr|-          x = [ [ {a = "this is a longer example", b = "and it will linewrap"}-                , {c = "all on its own"} ] ]|]--newtype Fruits = Fruits [Fruit]-    deriving (Eq, Show)--data Fruit = Fruit String (Maybe Physical) [Variety]-    deriving (Eq, Show)--data Physical = Physical String String-    deriving (Eq, Show)--newtype Variety = Variety String-    deriving (Eq, Show)--instance FromTable Fruits where-    fromTable = runParseTable (Fruits <$> reqKey "fruits")--instance FromTable Fruit where-    fromTable = runParseTable (Fruit <$> reqKey "name" <*> optKey "physical" <*> reqKey "varieties")--instance FromTable Physical where-    fromTable = runParseTable (Physical <$> reqKey "color" <*> reqKey "shape")--instance FromTable Variety where-    fromTable = runParseTable (Variety <$> reqKey "name")--instance FromValue Fruits   where fromValue = defaultTableFromValue-instance FromValue Fruit    where fromValue = defaultTableFromValue-instance FromValue Physical where fromValue = defaultTableFromValue-instance FromValue Variety  where fromValue = defaultTableFromValue--deserializationTests :: Spec-deserializationTests =-     do it "handles fruit example" $-          decode [quoteStr|-              [[fruits]]-              name = "apple"--              [fruits.physical]  # subtable-              color = "red"-              shape = "round"--              [[fruits.varieties]]  # nested array of tables-              name = "red delicious"--              [[fruits.varieties]]-              name = "granny smith"--              [[fruits]]-              name = "banana"--              [[fruits.varieties]]-              name = "plantain"|]-          `shouldBe`-            Success mempty (Fruits [-                Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious", Variety "granny smith"],-                Fruit "banana" Nothing [Variety "plantain"]])+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,108 @@+module PrettySpec (spec) where++import Test.Hspec (it, shouldBe, Spec)+import QuoteStr (quoteStr)+import Toml (encode, parse, prettyToml, Table)+import Data.Map qualified as Map++tomlString :: Table -> String+tomlString = show . prettyToml++spec :: Spec+spec =+ do it "renders example 1" $+        show (encode (Map.singleton "x" (1 :: Integer)))+        `shouldBe` [quoteStr|+            x = 1|]++    it "renders example 2" $+        fmap tomlString (parse "x=1\ny=2")+        `shouldBe` Right [quoteStr|+            x = 1+            y = 2|]++    it "renders example lists" $+        fmap tomlString (parse "x=[1,'two', [true]]")+        `shouldBe` Right [quoteStr|+        x = [1, "two", [true]]|]++    it "renders empty tables" $+        fmap tomlString (parse "x.y.z={}\nz.y.w=false")+        `shouldBe` Right [quoteStr|+            z.y.w = false++            [x.y.z]|]++    it "renders empty tables in array of tables" $+        fmap tomlString (parse "ex=[{},{},{a=9}]")+        `shouldBe` Right [quoteStr|+            [[ex]]++            [[ex]]++            [[ex]]+            a = 9|]++    it "renders multiple tables" $+        fmap tomlString (parse "a.x=1\nb.x=3\na.y=2\nb.y=4")+        `shouldBe` Right [quoteStr|+            [a]+            x = 1+            y = 2++            [b]+            x = 3+            y = 4|]++    it "renders escapes in strings" $+        fmap tomlString (parse "a=\"\\\\\\b\\t\\r\\n\\f\\\"\\u007f\\U0001000c\"")+        `shouldBe` Right [quoteStr|+            a = "\\\b\t\r\n\f\"\u007F\U0001000C"|]++    it "renders floats" $+        fmap tomlString (parse "a=0.0\nb=-0.1\nc=0.1\nd=3.141592653589793\ne=4e123")+        `shouldBe` Right [quoteStr|+            a = 0.0+            b = -0.1+            c = 0.1+            d = 3.141592653589793+            e = 4.0e123|]++    it "renders special floats" $+        fmap tomlString (parse "a=inf\nb=-inf\nc=nan")+        `shouldBe` Right [quoteStr|+            a = inf+            b = -inf+            c = nan|]++    it "renders empty documents" $+        fmap tomlString (parse "")+        `shouldBe` Right ""++    it "renders dates and time" $+        fmap tomlString (parse [quoteStr|+            a = 2020-05-07+            b = 15:16:17.990+            c = 2020-05-07T15:16:17.990+            d = 2020-05-07T15:16:17.990Z+            e = 2020-05-07T15:16:17-07:00+            f = 2021-09-06T14:15:19+08:00|])+        `shouldBe` Right [quoteStr|+            a = 2020-05-07+            b = 15:16:17.99+            c = 2020-05-07T15:16:17.99+            d = 2020-05-07T15:16:17.99Z+            e = 2020-05-07T15:16:17-07:00+            f = 2021-09-06T14:15:19+08:00|]++    it "renders quoted keys" $+        fmap tomlString (parse "''.'a b'.'\"' = 10")+        `shouldBe` Right [quoteStr|+        ""."a b"."\"" = 10|]++    it "renders inline tables" $+        fmap tomlString (parse [quoteStr|+            x = [[{a = 'this is a longer example', b = 'and it will linewrap'},{c = 'all on its own'}]]|])+        `shouldBe` Right [quoteStr|+            x = [ [ {a = "this is a longer example", b = "and it will linewrap"}+                  , {c = "all on its own"} ] ]|]

@@ -0,0 +1,16 @@+module ToValueSpec where++import Test.Hspec (it, shouldBe, Spec)+import Toml (Value(..))+import Toml.ToValue (ToValue(toValue))++spec :: Spec+spec =+ do it "converts characters as singleton strings" $+        toValue '!' `shouldBe` String "!"+    +    it "converts strings normally" $+        toValue "demo" `shouldBe` String "demo"+    +    it "converts lists" $+        toValue [1,2,3::Int] `shouldBe` Array [Integer 1, Integer 2, Integer 3]

@@ -0,0 +1,734 @@+{-# Language QuasiQuotes #-}+{-|+Module      : TomlSpec+Description : Unit tests+Copyright   : (c) Eric Mertens, 2023+License     : ISC+Maintainer  : emertens@gmail.com++TOML parser and validator unit tests (primarily drawn from the+specification document).++-}+module TomlSpec (spec) where++import Data.Map qualified as Map+import Data.Time (Day)+import QuoteStr (quoteStr)+import Test.Hspec (describe, it, shouldBe, shouldSatisfy, Spec)+import Toml (Value(..), parse, decode, Result(Success))+import Toml.ToValue (table, (.=))++spec :: Spec+spec =+ do describe "comment"+     do it "ignores comments" $+          parse [quoteStr|+            # This is a full-line comment+            key = "value"  # This is a comment at the end of a line+            another = "# This is not a comment"|]+          `shouldBe`+          Right (Map.fromList [("another",String "# This is not a comment"),("key",String "value")])++    describe "key/value pair"+     do it "supports the most basic assignments" $+          parse "key = \"value\"" `shouldBe` Right (Map.singleton "key" (String "value"))++        it "requires a value after equals" $+          parse "key = # INVALID"+          `shouldBe`+          Left "1:16: parse error: unexpected end-of-input"++        it "requires newlines between assignments" $+          parse "first = \"Tom\" last = \"Preston-Werner\" # INVALID"+          `shouldBe`+          Left "1:15: parse error: unexpected bare key"++    describe "keys"+     do it "allows bare keys" $+          parse [quoteStr|+            key = "value"+            bare_key = "value"+            bare-key = "value"+            1234 = "value"|]+          `shouldBe`+          Right (Map.fromList [+            "1234"     .= "value",+            "bare-key" .= "value",+            "bare_key" .= "value",+            "key"      .= "value"])++        it "allows quoted keys" $+          parse [quoteStr|+            "127.0.0.1" = "value"+            "character encoding" = "value"+            "ʎǝʞ" = "value"+            'key2' = "value"+            'quoted "value"' = "value"|]+          `shouldBe`+          Right (Map.fromList [+            "127.0.0.1"          .= "value",+            "character encoding" .= "value",+            "key2"               .= "value",+            "quoted \"value\""   .= "value",+            "ʎǝʞ"                .= "value"])++        it "allows dotted keys" $+          parse [quoteStr|+            name = "Orange"+            physical.color = "orange"+            physical.shape = "round"+            site."google.com" = true|]+          `shouldBe`+          Right (Map.fromList [+            "name"     .= "Orange",+            "physical" .= table ["color" .= "orange", "shape" .= "round"],+            "site"     .= table ["google.com" .= True]])++        it "prevents duplicate keys" $+          parse [quoteStr|+            name = "Tom"+            name = "Pradyun"|]+          `shouldBe` Left "2:1: key error: name is already assigned"++        it "prevents duplicate keys even between bare and quoted" $+          parse [quoteStr|+            spelling = "favorite"+            "spelling" = "favourite"|]+          `shouldBe` Left "2:1: key error: spelling is already assigned"++        it "allows out of order definitions" $+          parse [quoteStr|+            apple.type = "fruit"+            orange.type = "fruit"++            apple.skin = "thin"+            orange.skin = "thick"++            apple.color = "red"+            orange.color = "orange"|]+          `shouldBe`+          Right (Map.fromList [+            "apple" .= table [+                "color" .= "red",+                "skin"  .= "thin",+                "type"  .= "fruit"],+            "orange" .= table [+                "color" .= "orange",+                "skin"  .= "thick",+                "type"  .= "fruit"]])++        it "allows numeric bare keys" $+          parse "3.14159 = 'pi'" `shouldBe` Right (Map.singleton "3" (table [("14159", String "pi")]))++        it "allows keys that look like other values" $+          parse [quoteStr|+            true = true+            false = false+            1900-01-01 = 1900-01-01+            1_2 = 2_3|]+          `shouldBe`+          Right (Map.fromList [+            "1900-01-01" .= (read "1900-01-01" :: Day),+            "1_2"        .= (23::Int),+            "false"      .= False,+            "true"       .= True])++    describe "string"+     do it "parses escapes" $+          parse [quoteStr|+            str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF."|]+          `shouldBe`+          Right (Map.singleton "str" (String "I'm a string. \"You can quote me\". Name\tJos\xe9\nLocation\tSF."))++        it "strips the initial newline from multiline strings" $+          parse [quoteStr|+            str1 = """+            Roses are red+            Violets are blue"""|]+          `shouldBe` Right (Map.singleton "str1" (String "Roses are red\nViolets are blue"))++        it "strips whitespace with a trailing escape" $+          parse [quoteStr|+            # The following strings are byte-for-byte equivalent:+            str1 = "The quick brown fox jumps over the lazy dog."++            str2 = """+            The quick brown \+++            fox jumps over \+                the lazy dog."""++            str3 = """\+                The quick brown \+                fox jumps over \+                the lazy dog.\+                """|]+          `shouldBe`+          Right (Map.fromList [+            "str1" .= "The quick brown fox jumps over the lazy dog.",+            "str2" .= "The quick brown fox jumps over the lazy dog.",+            "str3" .= "The quick brown fox jumps over the lazy dog."])++        it "allows quotes inside multiline quoted strings" $+          parse [quoteStr|+            str4 = """Here are two quotation marks: "". Simple enough."""+            str5 = """Here are three quotation marks: ""\"."""+            str6 = """Here are fifteen quotation marks: ""\"""\"""\"""\"""\"."""++            # "This," she said, "is just a pointless statement."+            str7 = """"This," she said, "is just a pointless statement.""""|]+          `shouldBe`+          Right (Map.fromList [+            "str4" .= "Here are two quotation marks: \"\". Simple enough.",+            "str5" .= "Here are three quotation marks: \"\"\".",+            "str6" .= "Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\".",+            "str7" .= "\"This,\" she said, \"is just a pointless statement.\""])++        it "disallows triple quotes inside a multiline string" $+          parse [quoteStr|+            str5 = """Here are three quotation marks: """."""  # INVALID|]+          `shouldBe` Left "1:46: parse error: unexpected '.'"++        it "ignores escapes in literal strings" $+          parse [quoteStr|+            # What you see is what you get.+            winpath  = 'C:\Users\nodejs\templates'+            winpath2 = '\\ServerX\admin$\system32\'+            quoted   = 'Tom "Dubs" Preston-Werner'+            regex    = '<\i\c*\s*>'|]+          `shouldBe`+          Right (Map.fromList [+            "quoted"   .= "Tom \"Dubs\" Preston-Werner",+            "regex"    .= "<\\i\\c*\\s*>",+            "winpath"  .= "C:\\Users\\nodejs\\templates",+            "winpath2" .= "\\\\ServerX\\admin$\\system32\\"])++        it "handles multiline literal strings" $+          parse [quoteStr|+            regex2 = '''I [dw]on't need \d{2} apples'''+            lines  = '''+            The first newline is+            trimmed in raw strings.+            All other whitespace+            is preserved.+            '''|]+          `shouldBe`+          Right (Map.fromList [+            "lines"  .= "The first newline is\ntrimmed in raw strings.\nAll other whitespace\nis preserved.\n",+            "regex2" .= "I [dw]on't need \\d{2} apples"])++        it "parses all the other escapes" $+          parse [quoteStr|+            x = "\\\b\f\r\U0010abcd"+            y = """\\\b\f\r\u7bca\U0010abcd\n\r\t"""|]+          `shouldBe`+          Right (Map.fromList [+            "x" .= "\\\b\f\r\x0010abcd",+            "y" .= "\\\b\f\r\x7bca\x0010abcd\n\r\t"])++        it "rejects out of range unicode escapes" $+          parse [quoteStr|+            x = "\U11111111"|]+          `shouldBe` Left "1:6: lexical error: unicode escape too large"++    describe "integer"+     do it "parses literals correctly" $+          parse [quoteStr|+            int1 = +99+            int2 = 42+            int3 = 0+            int4 = -17+            int5 = 1_000+            int6 = 5_349_221+            int7 = 53_49_221  # Indian number system grouping+            int8 = 1_2_3_4_5  # VALID but discouraged+            # hexadecimal with prefix `0x`+            hex1 = 0xDEADBEEF+            hex2 = 0xdeadbeef+            hex3 = 0xdead_beef++            # octal with prefix `0o`+            oct1 = 0o01234567+            oct2 = 0o755 # useful for Unix file permissions++            # binary with prefix `0b`+            bin1 = 0b11010110|]+          `shouldBe` Right+          (Map.fromList [+              "bin1" .= Integer 214,+              "hex1" .= Integer 0xDEADBEEF,+              "hex2" .= Integer 0xDEADBEEF,+              "hex3" .= Integer 0xDEADBEEF,+              "int1" .= Integer 99,+              "int2" .= Integer 42,+              "int3" .= Integer 0,+              "int4" .= Integer (-17),+              "int5" .= Integer 1000,+              "int6" .= Integer 5349221,+              "int7" .= Integer 5349221,+              "int8" .= Integer 12345,+              "oct1" .= Integer 0o01234567,+              "oct2" .= Integer 0o755])++    describe "float"+     do it "parses floats" $+          parse [quoteStr|+            # fractional+            flt1 = +1.0+            flt2 = 3.1415+            flt3 = -0.01++            # exponent+            flt4 = 5e+22+            flt5 = 1e06+            flt6 = -2E-2++            # both+            flt7 = 6.626e-34+            flt8 = 224_617.445_991_228+            # infinity+            sf1 = inf  # positive infinity+            sf2 = +inf # positive infinity+            sf3 = -inf # negative infinity|]+          `shouldBe`+          Right (Map.fromList [+            "flt1" .= Float 1.0,+            "flt2" .= Float 3.1415,+            "flt3" .= Float (-1.0e-2),+            "flt4" .= Float 4.9999999999999996e22,+            "flt5" .= Float 1000000.0,+            "flt6" .= Float (-2.0e-2),+            "flt7" .= Float 6.626e-34,+            "flt8" .= Float 224617.445991228,+            "sf1"  .= Float (1/0),+            "sf2"  .= Float (1/0),+            "sf3"  .= Float (-1/0)])++        it "parses nan correctly" $+          let checkNaN (Float x) = isNaN x+              checkNaN _         = False+          in+          parse [quoteStr|+            # not a number+            sf4 = nan  # actual sNaN/qNaN encoding is implementation-specific+            sf5 = +nan # same as `nan`+            sf6 = -nan # valid, actual encoding is implementation-specific|]+          `shouldSatisfy` \case+            Left{} -> False+            Right x -> all checkNaN x++    describe "boolean"+     do it "parses boolean literals" $+          parse [quoteStr|+            bool1 = true+            bool2 = false|]+          `shouldBe`+          Right (Map.fromList [+            "bool1" .= True,+            "bool2" .= False])++    describe "offset date-time"+     do it "parses offset date times" $+          parse [quoteStr|+            odt1 = 1979-05-27T07:32:00Z+            odt2 = 1979-05-27T00:32:00-07:00+            odt3 = 1979-05-27T00:32:00.999999-07:00+            odt4 = 1979-05-27 07:32:00Z|]+          `shouldBe`+          Right (Map.fromList [+            "odt1" .= ZonedTime (read "1979-05-27 07:32:00 +0000"),+            "odt2" .= ZonedTime (read "1979-05-27 00:32:00 -0700"),+            "odt3" .= ZonedTime (read "1979-05-27 00:32:00.999999 -0700"),+            "odt4" .= ZonedTime (read "1979-05-27 07:32:00 +0000")])++    describe "local date-time"+     do it "parses local date-times" $+          parse [quoteStr|+            ldt1 = 1979-05-27T07:32:00+            ldt2 = 1979-05-27T00:32:00.999999+            ldt3 = 1979-05-28 00:32:00.999999|]+          `shouldBe`+          Right (Map.fromList [+            "ldt1" .= LocalTime (read "1979-05-27 07:32:00"),+            "ldt2" .= LocalTime (read "1979-05-27 00:32:00.999999"),+            "ldt3" .= LocalTime (read "1979-05-28 00:32:00.999999")])++        it "catches invalid date-times" $+          parse [quoteStr|+            ldt = 9999-99-99T99:99:99|]+          `shouldBe`+          Left "1:7: lexical error: malformed local date-time"++    describe "local date"+     do it "parses dates" $+          parse [quoteStr|+            ld1 = 1979-05-27|]+          `shouldBe`+          Right (Map.singleton "ld1" (Day (read "1979-05-27")))++    describe "local time"+     do it "parses times" $+          parse [quoteStr|+            lt1 = 07:32:00+            lt2 = 00:32:00.999999|]+          `shouldBe`+          Right (Map.fromList [+            "lt1" .= TimeOfDay (read "07:32:00"),+            "lt2" .= TimeOfDay (read "00:32:00.999999")])++    describe "array"+     do it "parses array examples" $+          parse [quoteStr|+            integers = [ 1, 2, 3 ]+            colors = [ "red", "yellow", "green" ]+            nested_arrays_of_ints = [ [ 1, 2 ], [3, 4, 5] ]+            nested_mixed_array = [ [ 1, 2 ], ["a", "b", "c"] ]+            string_array = [ "all", 'strings', """are the same""", '''type''' ]++            # Mixed-type arrays are allowed+            numbers = [ 0.1, 0.2, 0.5, 1, 2, 5 ]+            contributors = [+            "Foo Bar <foo@example.com>",+            { name = "Baz Qux", email = "bazqux@example.com", url = "https://example.com/bazqux" }+            ]|]+            `shouldBe`+            Right (Map.fromList [+                "colors" .= ["red", "yellow", "green"],+                "contributors" .= [+                    String "Foo Bar <foo@example.com>",+                    table [+                        "email" .= "bazqux@example.com",+                        "name" .= "Baz Qux",+                        "url" .= "https://example.com/bazqux"]],+                "integers" .= [1, 2, 3 :: Integer],+                "nested_arrays_of_ints" .= [[1, 2], [3, 4, 5 :: Integer]],+                "nested_mixed_array" .= [[Integer 1, Integer 2], [String "a", String "b", String "c"]],+                "numbers" .= [Float 0.1, Float 0.2, Float 0.5, Integer 1, Integer 2, Integer 5],+                "string_array" .= ["all", "strings", "are the same", "type"]])++        it "handles newlines and comments" $+          parse [quoteStr|+            integers2 = [+            1, 2, 3+            ]++            integers3 = [+            1,+            2, # this is ok+            ]|]+            `shouldBe`+            Right (Map.fromList [+                "integers2" .= [1, 2, 3 :: Int],+                "integers3" .= [1, 2 :: Int]])++        it "disambiguates double brackets from array tables" $+          parse "x = [[1]]" `shouldBe` Right (Map.singleton "x" (Array [Array [Integer 1]]))++    describe "table"+     do it "allows empty tables" $+          parse "[table]" `shouldBe` Right (Map.singleton "table" (table []))++        it "parses simple tables" $+          parse [quoteStr|+            [table-1]+            key1 = "some string"+            key2 = 123++            [table-2]+            key1 = "another string"+            key2 = 456|]+          `shouldBe`+          Right (Map.fromList [+            "table-1" .= table [+                "key1" .= "some string",+                "key2" .= Integer 123],+            "table-2" .= table [+                "key1" .= "another string",+                "key2" .= Integer 456]])++        it "allows quoted keys" $+          parse [quoteStr|+            [dog."tater.man"]+            type.name = "pug"|]+          `shouldBe`+          Right (Map.fromList [("dog", table [("tater.man", table [("type", table [("name",String "pug")])])])])++        it "allows whitespace around keys" $+          parse [quoteStr|+            [a.b.c]            # this is best practice+            [ d.e.f ]          # same as [d.e.f]+            [ g .  h  . i ]    # same as [g.h.i]+            [ j . "ʞ" . 'l' ]  # same as [j."ʞ".'l']|]+          `shouldBe`+          Right (Map.fromList [+            "a" .= table ["b" .= table ["c" .= table []]],+            "d" .= table ["e" .= table ["f" .= table []]],+            "g" .= table ["h" .= table ["i" .= table []]],+            "j" .= table ["ʞ" .= table ["l" .= table []]]])++        it "allows supertables to be defined after subtables" $+          parse [quoteStr|+            # [x] you+            # [x.y] don't+            # [x.y.z] need these+            [x.y.z.w] # for this to work++            [x] # defining a super-table afterward is ok+            q=1|]+          `shouldBe`+          Right (Map.fromList [+            "x" .= table [+                "q" .= Integer 1,+                "y" .= table [+                    "z" .= table [+                        "w" .= table []]]]])++        it "prevents using a [table] to open a table defined with dotted keys" $+          parse [quoteStr|+            [fruit]+            apple.color = 'red'+            apple.taste.sweet = true+            [fruit.apple]|]+          `shouldBe` Left "4:8: key error: apple is a closed table"++        it "can add subtables" $+          parse [quoteStr|+            [fruit]+            apple.color = "red"+            apple.taste.sweet = true+            [fruit.apple.texture]  # you can add sub-tables+            smooth = true|]+          `shouldBe`+          Right (Map.fromList [+            "fruit" .= table [+                "apple" .= table [+                    "color" .= "red",+                    "taste" .= table [+                        "sweet" .= True],+                        "texture" .= table [+                            "smooth" .= True]]]])++    describe "inline table"+     do it "parses inline tables" $+          parse [quoteStr|+            name = { first = "Tom", last = "Preston-Werner" }+            point = { x = 1, y = 2 }+            animal = { type.name = "pug" }|]+          `shouldBe`+          Right (Map.fromList [+            "animal" .= table ["type" .= table ["name" .= "pug"]],+            "name"   .= table ["first" .= "Tom", "last" .= "Preston-Werner"],+            "point"  .= table ["x" .= Integer 1, "y" .= Integer 2]])++        it "prevents altering inline tables with dotted keys" $+          parse [quoteStr|+            [product]+            type = { name = "Nail" }+            type.edible = false  # INVALID|]+          `shouldBe` Left "3:1: key error: type is already assigned"++        it "prevents using inline tables to add keys to existing tables" $+          parse [quoteStr|+            [product]+            type.name = "Nail"+            type = { edible = false }  # INVALID|]+          `shouldBe` Left "3:1: key error: type is already assigned"++    describe "array of tables"+     do it "supports array of tables syntax" $+          decode [quoteStr|+            [[products]]+            name = "Hammer"+            sku = 738594937++            [[products]]  # empty table within the array++            [[products]]+            name = "Nail"+            sku = 284758393++            color = "gray"|]+          `shouldBe`+          Success mempty (Map.singleton "products" [+            Map.fromList [+              "name" .= "Hammer",+              "sku"  .= Integer 738594937],+            Map.empty,+            Map.fromList [+                "color" .= "gray",+                "name"  .= "Nail",+                "sku"   .= Integer 284758393]])++        it "handles subtables under array of tables" $+          parse [quoteStr|+            [[fruits]]+            name = "apple"++            [fruits.physical]  # subtable+            color = "red"+            shape = "round"++            [[fruits.varieties]]  # nested array of tables+            name = "red delicious"++            [[fruits.varieties]]+            name = "granny smith"+++            [[fruits]]+            name = "banana"++            [[fruits.varieties]]+            name = "plantain"|]+          `shouldBe`+          Right (Map.fromList [+            "fruits" .= [+                table [+                    "name" .= "apple",+                    "physical" .= table [+                        "color" .= "red",+                        "shape" .= "round"],+                    "varieties" .= [+                        table ["name" .= "red delicious"],+                        table ["name" .= "granny smith"]]],+                table [+                    "name" .= "banana",+                    "varieties" .= [+                        table ["name" .= "plantain"]]]]])++        it "prevents redefining a supertable with an array of tables" $+          parse [quoteStr|+            # INVALID TOML DOC+            [fruit.physical]  # subtable, but to which parent element should it belong?+            color = "red"+            shape = "round"++            [[fruit]]  # parser must throw an error upon discovering that "fruit" is+                    # an array rather than a table+            name = "apple"|]+            `shouldBe` Left "6:3: key error: fruit is already a table"++        it "prevents redefining an inline array" $+          parse [quoteStr|+            # INVALID TOML DOC+            fruits = []++            [[fruits]] # Not allowed|]+          `shouldBe` Left "4:3: key error: fruits is already assigned"++    -- these cases are needed to complete coverage checking on Semantics module+    describe "corner cases"+     do it "stays open" $+          parse [quoteStr|+            [x.y.z]+            [x]+            [x.y]|]+          `shouldBe`+          parse "x.y.z={}"++        it "stays closed" $+          parse [quoteStr|+            [x.y]+            [x]+            [x.y]|] `shouldBe` Left "3:4: key error: y is a closed table"++        it "super tables of array tables preserve array tables" $+          parse [quoteStr|+            [[x.y]]+            [x]+            [[x.y]]|]+          `shouldBe`+          parse "x.y=[{},{}]"++        it "super tables of array tables preserve array tables" $+          parse [quoteStr|+            [[x.y]]+            [x]+            [x.y.z]|]+          `shouldBe`+          parse "x.y=[{z={}}]"++        it "detects conflicting inline keys" $+          parse [quoteStr|+            x = { y = 1, y.z = 2}|]+          `shouldBe` Left "1:14: key error: y is already assigned"++        it "handles merging dotted inline table keys" $+          parse [quoteStr|+            t = { a.x.y = 1, a.x.z = 2, a.q = 3}|]+          `shouldBe`+          Right (Map.fromList [+            ("t", table [+                ("a", table [+                    ("q",Integer 3),+                    ("x", table [+                        ("y",Integer 1),+                        ("z",Integer 2)])])])])++        it "disallows overwriting assignments with tables" $+          parse [quoteStr|+            x = 1+            [x.y]|]+          `shouldBe` Left "2:2: key error: x is already assigned"++        it "handles super super tables" $+          parse [quoteStr|+            [x.y.z]+            [x.y]+            [x]|]+          `shouldBe`+          parse "x.y.z={}"++        it "You can dot into open supertables" $+          parse [quoteStr|+            [x.y.z]+            [x]+            y.q = 1|]+          `shouldBe`+          parse "x.y={z={},q=1}"++        it "dotted tables close previously open tables" $+          parse [quoteStr|+            [x.y.z]+            [x]+            y.q = 1+            [x.y]|]+          `shouldBe` Left "4:4: key error: y is a closed table"++        it "dotted tables can't assign through closed tables!" $+          parse [quoteStr|+            [x.y]+            [x]+            y.z.w = 1|]+          `shouldBe` Left "3:1: key error: y is a closed table"++        it "super tables can't add new subtables to array tables via dotted keys" $+          parse [quoteStr|+            [[x.y]]+            [x]+            y.z.a = 1+            y.z.b = 2|]+          `shouldBe` Left "3:1: key error: y is a closed table"++        it "the previous example preserves closeness" $+          parse [quoteStr|+            [[x.y]]+            [x]+            y.z.a = 1+            y.w = 2|]+          `shouldBe` Left "3:1: key error: y is a closed table"++        it "defining a supertable closes the supertable" $+          parse [quoteStr|+            [x.y]+            [x]+            [x]|]+          `shouldBe` Left "3:2: key error: x is a closed table"++        it "prevents redefining an array of tables" $+          parse [quoteStr|+            [[x.y]]+            [x.y]|]+          `shouldBe` Left "2:4: key error: y is already an array of tables"

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               toml-parser-version:            1.0.1.0+version:            1.1.0.0 synopsis:           TOML 1.0.0 parser description:     TOML parser using generated lexers and parsers with@@ -28,11 +28,18 @@     default-language:   Haskell2010     default-extensions:         BlockArguments+        DeriveDataTypeable+        DeriveGeneric         DeriveTraversable+        EmptyCase+        FlexibleContexts+        FlexibleInstances         GeneralizedNewtypeDeriving         ImportQualifiedPost         LambdaCase         ScopedTypeVariables+        TypeOperators+        TypeSynonymInstances         ViewPatterns  library@@ -42,6 +49,7 @@     exposed-modules:         Toml         Toml.FromValue+        Toml.FromValue.Generic         Toml.FromValue.Matcher         Toml.Lexer         Toml.Lexer.Token@@ -53,6 +61,7 @@         Toml.Pretty         Toml.Semantics         Toml.ToValue+        Toml.ToValue.Generic         Toml.Value     build-depends:         array           ^>= 0.5,@@ -70,6 +79,10 @@     type:               exitcode-stdio-1.0     hs-source-dirs:     test     main-is:            Main.hs+    default-extensions:+        QuasiQuotes+    build-tool-depends:+        hspec-discover:hspec-discover == 2.*     build-depends:         base,         containers,@@ -78,4 +91,9 @@         time,         toml-parser,     other-modules:+        DecodeSpec+        LexerSpec+        PrettySpec         QuoteStr+        TomlSpec+        ToValueSpec