toml-parser 1.1.0.0 → 1.1.1.0
raw patch · 8 files changed
+59/−29 lines, 8 filesdep ~basedep ~template-haskelldep ~time
Dependency ranges changed: base, template-haskell, time
Files
- ChangeLog.md +4/−0
- src/Toml/FromValue.hs +4/−1
- src/Toml/Lexer/Token.hs +9/−1
- src/Toml/Parser.y +1/−1
- src/Toml/Pretty.hs +22/−18
- src/Toml/Semantics.hs +1/−1
- test/DecodeSpec.hs +13/−2
- toml-parser.cabal +5/−5
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for toml-parser +## 1.1.1.0 -- 2023-07-03++* Add support for GHC 8.10.7 and 9.0.2+ ## 1.1.0.0 -- 2023-07-03 * Add Toml.FromValue.Generic and Toml.ToValue.Generic
src/Toml/FromValue.hs view
@@ -187,7 +187,10 @@ -- | A 'Matcher' that tracks a current set of unmatched key-value -- pairs from a table. ----- Use 'optKey', 'reqKey', 'rej+-- Use 'optKey' and 'reqKey' to extract keys.+--+-- Use 'getTable' and 'setTable' to override the table and implement+-- other primitives. newtype ParseTable a = ParseTable (StateT Table Matcher a) deriving (Functor, Applicative, Monad, Alternative, MonadPlus)
src/Toml/Lexer/Token.hs view
@@ -36,8 +36,9 @@ mkError, ) where +import Data.Char (digitToInt) import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)-import Numeric (readBin, readHex, readOct)+import Numeric (readInt, readHex, readOct) -- | Lexical token data Token@@ -89,6 +90,13 @@ mkBinInteger :: String -> Token mkBinInteger ('0':'b':xs) = TokInteger (fst (head (readBin (scrub xs)))) mkBinInteger _ = error "processHex: bad input"++-- This wasn't added to base until 4.16+readBin :: (Eq a, Num a) => ReadS a+readBin = readInt 2 isBinDigit digitToInt++isBinDigit :: Char -> Bool+isBinDigit x = x == '0' || x == '1' -- | Construct a 'TokFloat' from a floating-point literal lexeme. mkFloat :: String -> Token
src/Toml/Parser.y view
@@ -121,7 +121,7 @@ : sepBy1_(p,q) { NonEmpty.reverse $1 } sepBy1_(p,q) :: { NonEmpty p }- : p { NonEmpty.singleton $1 }+ : p { pure $1 } | sepBy1_(p,q) q p { NonEmpty.cons $3 $1 } {
src/Toml/Pretty.hs view
@@ -36,7 +36,7 @@ import Data.Char (ord, isAsciiLower, isAsciiUpper, isDigit, isPrint) import Data.Foldable (fold) import Data.List (partition)-import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map import Data.String (fromString)@@ -130,7 +130,7 @@ TokEOF -> "end-of-input" prettyAssignment :: String -> Value -> TomlDoc-prettyAssignment = go . NonEmpty.singleton+prettyAssignment = go . pure where go ks (Table (Map.assocs -> [(k,v)])) = go (NonEmpty.cons k ks) v go ks v = prettyKey (NonEmpty.reverse ks) <+> equals <+> prettyValue v@@ -139,23 +139,23 @@ -- of an equals sign. This value will always occupy a single line. prettyValue :: Value -> TomlDoc prettyValue = \case- Integer i -> annotate NumberClass (pretty i)+ Integer i -> annotate NumberClass (pretty i) Float f- | isNaN f -> annotate NumberClass "nan"- | isInfinite f -> annotate NumberClass (if f > 0 then "inf" else "-inf")- | otherwise -> annotate NumberClass (pretty f)- Array a -> align (list [prettyValue v | v <- a])- Table t -> lbrace <> concatWith (surround ", ") [prettyAssignment k v | (k,v) <- Map.assocs t] <> rbrace- Bool True -> annotate BoolClass "true"- Bool False -> annotate BoolClass "false"- String str -> annotate StringClass (fromString (quoteString str))- TimeOfDay tod -> annotate DateClass (fromString (formatTime defaultTimeLocale "%H:%M:%S%Q" tod))+ | isNaN f -> annotate NumberClass "nan"+ | isInfinite f -> annotate NumberClass (if f > 0 then "inf" else "-inf")+ | otherwise -> annotate NumberClass (pretty f)+ Array a -> align (list [prettyValue v | v <- a])+ Table t -> lbrace <> concatWith (surround ", ") [prettyAssignment k v | (k,v) <- Map.assocs t] <> rbrace+ Bool True -> annotate BoolClass "true"+ Bool False -> annotate BoolClass "false"+ String str -> annotate StringClass (fromString (quoteString str))+ TimeOfDay tod -> annotate DateClass (fromString (formatTime defaultTimeLocale "%H:%M:%S%Q" tod)) ZonedTime zt- | timeZoneMinutes (zonedTimeZone zt) == 0 ->- annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" zt))- | otherwise -> annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Ez" zt))- LocalTime lt -> annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" lt))- Day d -> annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%d" d))+ | timeZoneMinutes (zonedTimeZone zt) == 0 ->+ annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" zt))+ | otherwise -> annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Ez" zt))+ LocalTime lt -> annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q" lt))+ Day d -> annotate DateClass (fromString (formatTime defaultTimeLocale "%Y-%m-%d" d)) isAlwaysSimple :: Value -> Bool isAlwaysSimple = \case@@ -199,7 +199,11 @@ assignments = [prettyAssignment k v <> hardline | (k,v) <- simple] - subtables = [prettySection (prefix `NonEmpty.prependList` pure k) v | (k,v) <- sections]+ subtables = [prettySection (prefix `snoc` k) v | (k,v) <- sections]++snoc :: [a] -> a -> NonEmpty a+snoc [] y = y :| []+snoc (x : xs) y = x :| xs ++ [y] prettySection :: NonEmpty String -> Value -> TomlDoc prettySection key (Table t) =
src/Toml/Semantics.hs view
@@ -120,7 +120,7 @@ Nothing -> case kind of TableKind -> go (FrameTable Closed) Map.empty- ArrayTableKind -> go (FrameArray . NonEmpty.singleton) Map.empty+ ArrayTableKind -> go (FrameArray . pure) Map.empty -- defining a super table of a previously defined subtable Just (FrameTable Open t) ->
test/DecodeSpec.hs view
@@ -4,13 +4,14 @@ import Data.Map qualified as Map import Data.Maybe (fromMaybe) import GHC.Generics (Generic)-import QuoteStr (quoteStr )+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 (ToTable(..), ToValue(toValue), (.=), defaultTableToValue) import Toml.ToValue.Generic (genericToTable)+import Toml (Result(..)) newtype Fruits = Fruits { fruits :: [Fruit] } deriving (Eq, Show, Generic)@@ -126,3 +127,13 @@ "Unexpected keys: count, taste in top.fruits[0]", "Unexpected key: color in top.fruits[1]"] (Fruits [Fruit "peach" Nothing [], Fruit "pineapple" Nothing []])+ + it "handles missing key errors" $+ (decode "[[fruits]]" :: Result Fruits)+ `shouldBe`+ Failure ["Missing key: name in top.fruits[0]"]++ it "handles parse errors while decoding" $+ (decode "x =" :: Result Fruits)+ `shouldBe`+ Failure ["1:4: parse error: unexpected end-of-input"]
toml-parser.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: toml-parser-version: 1.1.0.0+version: 1.1.1.0 synopsis: TOML 1.0.0 parser description: TOML parser using generated lexers and parsers with@@ -13,7 +13,7 @@ copyright: 2023 Eric Mertens category: Text build-type: Simple-tested-with: GHC == 9.2.8, GHC == 9.4.5, GHC == 9.6.2+tested-with: GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.8, GHC == 9.4.5, GHC == 9.6.2 extra-doc-files: ChangeLog.md@@ -65,10 +65,10 @@ Toml.Value build-depends: array ^>= 0.5,- base ^>= 4.16 || ^>= 4.17 || ^>= 4.18,+ base >= 4.14 && < 4.19, containers ^>= 0.5 || ^>= 0.6, prettyprinter ^>= 1.7,- time ^>= 1.11 || ^>= 1.12,+ time >= 1.9 && < 1.13, transformers ^>= 0.5 || ^>= 0.6, build-tool-depends: alex:alex >= 3.2,@@ -87,7 +87,7 @@ base, containers, hspec >= 2.10 && < 2.12,- template-haskell ^>= 2.18 || ^>= 2.19 || ^>= 2.20,+ template-haskell >= 2.16 && < 2.21, time, toml-parser, other-modules: