toml-parser 1.2.0.0 → 1.2.1.0
raw patch · 19 files changed
+532/−83 lines, 19 filesdep +textdep ~basedep ~hspecdep ~template-haskell
Dependencies added: text
Dependency ranges changed: base, hspec, template-haskell, time
Files
- ChangeLog.md +7/−1
- README.lhs +163/−0
- README.md +26/−10
- src/Toml/FromValue.hs +48/−7
- src/Toml/FromValue/Matcher.hs +7/−3
- src/Toml/FromValue/ParseTable.hs +11/−11
- src/Toml/Located.hs +8/−3
- src/Toml/Position.hs +11/−3
- src/Toml/Pretty.hs +85/−24
- src/Toml/Semantics.hs +10/−6
- src/Toml/ToValue.hs +15/−0
- src/Toml/Value.hs +9/−1
- test/DecodeSpec.hs +1/−1
- test/FromValueSpec.hs +105/−0
- test/HieDemoSpec.hs +1/−1
- test/LexerSpec.hs +0/−0
- test/QuoteStr.hs +1/−1
- test/ToValueSpec.hs +2/−2
- toml-parser.cabal +22/−9
ChangeLog.md view
@@ -1,6 +1,12 @@ # Revision history for toml-parser -## 1.2.0.0 --+## 1.2.1.0 -- 2023-07-12++* Added `Toml.Pretty.prettyTomlOrdered` to allow user-specified section ordering.+* Added `FromValue` and `ToValue` instances for `Text`+* Added `reqKeyOf` and `optKeyOf` for easier custom matching without `FromValue` instances.++## 1.2.0.0 -- 2023-07-09 * Remove `FromTable` class. This class existed for things that could be matched specifically from tables, which is what the top-level values
+ README.lhs view
@@ -0,0 +1,163 @@+# TOML Parser++This package implements a validating parser for [TOML 1.0.0](https://toml.io/en/v1.0.0).++This package uses an [alex](https://haskell-alex.readthedocs.io/en/latest/)-generated+lexer and [happy](https://haskell-happy.readthedocs.io/en/latest/)-generated parser.++It also provides a pair of classes for serializing into and out of TOML.++## Package Structure++```mermaid+---+title: Package Structure+---+stateDiagram-v2+ classDef important font-weight:bold;++ TOML:::important --> ApplicationTypes:::important : decode+ ApplicationTypes --> TOML : encode+ TOML --> [Token]: Toml.Lexer+ [Token] --> [Expr]: Toml.Parser+ [Expr] --> Table : Toml.Semantics+ Table --> ApplicationTypes : Toml.FromValue+ ApplicationTypes --> Table : Toml.ToValue+ Table --> TOML : Toml.Pretty++```++The highest-level interface to this package is to define `FromValue` and `ToTable`+instances for your application-specific datatypes. These can be used with `encode`+and `decode` to convert to and from TOML.++For low-level access to the TOML format, the lexer, parser, and validator are available+for direct use. The diagram above shows how the different modules enable you to+advance through the increasingly high-level TOML representations.++## Examples++This file uses [markdown-unlit](https://hackage.haskell.org/package/markdown-unlit)+to ensure that its code typechecks and stays in sync with the rest of the package.++```haskell+import Toml (parse, decode, Value(..))+import Toml.FromValue (FromValue(fromValue), parseTableFromValue, reqKey, optKey)+import Toml.FromValue.Generic (genericParseTable)+import Toml.ToValue (ToValue(toValue), ToTable(toTable), defaultTableToValue)+import Toml.ToValue.Generic (genericToTable)+import GHC.Generics (Generic)+main = pure ()+```++### Using the raw parser++Consider this sample TOML text from the specification.++```toml+[[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"+```++Parsing using this package generates the following value++```haskell ignore+>>> parse fruitStr+Right (fromList [+ ("fruits",Array [+ Table (fromList [+ ("name",String "apple"),+ ("physical",Table (fromList [+ ("color",String "red"),+ ("shape",String "round")])),+ ("varieties",Array [+ Table (fromList [("name",String "red delicious")]),+ Table (fromList [("name",String "granny smith")])])]),+ Table (fromList [+ ("name",String "banana"),+ ("varieties",Array [+ Table (fromList [("name",String "plantain")])])])])])+```++We can render this parsed value back to TOML text using `prettyToml fruitToml`.+In this case the input was already sorted, so the generated text will happen+to match almost exactly.++### Using decoding classes++Here's an example of defining datatypes and deserializers for the TOML above.++```haskell+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 FromValue Fruits where+ fromValue = parseTableFromValue (Fruits <$> reqKey "fruits")++instance FromValue Fruit where+ fromValue = parseTableFromValue (Fruit <$> reqKey "name" <*> optKey "physical" <*> reqKey "varieties")++instance FromValue Physical where+ fromValue = parseTableFromValue (Physical <$> reqKey "color" <*> reqKey "shape")++instance FromValue Variety where+ fromValue = parseTableFromValue (Variety <$> reqKey "name")+```++We can run this example on the original value to deserialize it into domain-specific datatypes.++```haskell ignore+>>> decode fruitStr :: Result Fruits+Success [] (Fruits [+ 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 FromValue ExampleRecord where fromValue = parseTableFromValue genericParseTable+instance ToTable ExampleRecord where toTable = genericToTable+instance ToValue ExampleRecord where toValue = defaultTableToValue+```++### Larger Example++A demonstration of using this package at a more realistic scale+can be found in [HieDemoSpec](test/HieDemoSpec.hs).
README.md view
@@ -35,8 +35,23 @@ for direct use. The diagram above shows how the different modules enable you to advance through the increasingly high-level TOML representations. -## Example+## Examples +This file uses [markdown-unlit](https://hackage.haskell.org/package/markdown-unlit)+to ensure that its code typechecks and stays in sync with the rest of the package.++```haskell+import Toml (parse, decode, Value(..))+import Toml.FromValue (FromValue(fromValue), parseTableFromValue, reqKey, optKey)+import Toml.FromValue.Generic (genericParseTable)+import Toml.ToValue (ToValue(toValue), ToTable(toTable), defaultTableToValue)+import Toml.ToValue.Generic (genericToTable)+import GHC.Generics (Generic)+main = pure ()+```++### Using the raw parser+ Consider this sample TOML text from the specification. ```toml@@ -63,9 +78,8 @@ Parsing using this package generates the following value -```haskell->>> Right fruitToml = parse fruitStr->>> fruitToml+```haskell ignore+>>> parse fruitStr Right (fromList [ ("fruits",Array [ Table (fromList [@@ -86,6 +100,8 @@ In this case the input was already sorted, so the generated text will happen to match almost exactly. +### Using decoding classes+ Here's an example of defining datatypes and deserializers for the TOML above. ```haskell@@ -104,7 +120,7 @@ instance FromValue Fruits where fromValue = parseTableFromValue (Fruits <$> reqKey "fruits") -instance FroValue Fruit where+instance FromValue Fruit where fromValue = parseTableFromValue (Fruit <$> reqKey "name" <*> optKey "physical" <*> reqKey "varieties") instance FromValue Physical where@@ -116,14 +132,14 @@ We can run this example on the original value to deserialize it into domain-specific datatypes. -```haskell->>> decode fruitToml :: Either String Fruits-Right (Fruits [+```haskell ignore+>>> decode fruitStr :: Result Fruits+Success [] (Fruits [ Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious", Variety "granny smith"], Fruit "banana" Nothing [Variety "plantain"]]) ``` -## Generics+### Generics Code for generating and matching tables to records can be derived using GHC.Generics. This will generate tables using the field names@@ -141,7 +157,7 @@ instance ToValue ExampleRecord where toValue = defaultTableToValue ``` -## Larger Example+### Larger Example A demonstration of using this package at a more realistic scale can be found in [HieDemoSpec](test/HieDemoSpec.hs).
src/Toml/FromValue.hs view
@@ -34,8 +34,10 @@ ParseTable, runParseTable, parseTableFromValue,- optKey, reqKey,+ optKey,+ reqKeyOf,+ optKeyOf, warnTable, KeyAlt(..), pickKey,@@ -46,7 +48,7 @@ liftMatcher, ) where -import Control.Applicative (Alternative, optional)+import Control.Applicative (Alternative) import Control.Monad (MonadPlus, zipWithM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict (StateT(..), put, get)@@ -55,13 +57,15 @@ import Data.Map (Map) import Data.Map qualified as Map import Data.String (IsString (fromString))+import Data.Text qualified+import Data.Text.Lazy qualified import Data.Time (ZonedTime, LocalTime, Day, TimeOfDay) import Data.Word (Word8, Word16, Word32, Word64) import Numeric.Natural (Natural) import Toml.FromValue.Matcher (Matcher, Result(..), runMatcher, withScope, warning, inIndex, inKey)+import Toml.FromValue.ParseTable import Toml.Pretty (prettySimpleKey, prettyValue) import Toml.Value (Value(..), Table)-import Toml.FromValue.ParseTable -- | Class for types that can be decoded from a TOML value. class FromValue a where@@ -143,7 +147,19 @@ listFromValue (String xs) = pure xs listFromValue v = typeError "string" v +-- | Matches string literals+instance FromValue Data.Text.Text where+ fromValue v = Data.Text.pack <$> fromValue v++-- | Matches string literals+--+-- @since 1.2.1.0+instance FromValue Data.Text.Lazy.Text where+ fromValue v = Data.Text.Lazy.pack <$> fromValue v+ -- | Matches floating-point and integer values+--+-- @since 1.2.1.0 instance FromValue Double where fromValue (Float x) = pure x fromValue (Integer x) = pure (fromInteger x)@@ -188,10 +204,35 @@ instance FromValue Value where fromValue = pure --- | Match a table entry by key if it exists or return 'Nothing' if not.+-- | Convenience function for matching an optional key with a 'FromValue'+-- instance.+--+-- @optKey key = 'optKeyOf' key 'fromValue'@ optKey :: FromValue a => String -> ParseTable (Maybe a)-optKey = optional . reqKey+optKey key = optKeyOf key fromValue --- | Match a table entry by key or report an error if missing.+-- | Convenience function for matching a required key with a 'FromValue'+-- instance.+--+-- @reqKey key = 'reqKeyOf' key 'fromValue'@ reqKey :: FromValue a => String -> ParseTable a-reqKey key = pickKey [Key key fromValue]+reqKey key = reqKeyOf key fromValue++-- | Match a table entry by key if it exists or return 'Nothing' if not.+-- If the key is defined, it is matched by the given function.+--+-- See 'pickKey' for more complex cases.+optKeyOf ::+ String {- ^ key -} ->+ (Value -> Matcher a) {- ^ value matcher -} ->+ ParseTable (Maybe a)+optKeyOf key k = pickKey [Key key (fmap Just . k), Else (pure Nothing)]++-- | Match a table entry by key or report an error if missing.+--+-- See 'pickKey' for more complex cases.+reqKeyOf ::+ String {- ^ key -} ->+ (Value -> Matcher a) {- ^ value matcher -} ->+ ParseTable a+reqKeyOf key k = pickKey [Key key k]
src/Toml/FromValue/Matcher.hs view
@@ -61,9 +61,13 @@ -- 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 messages- | Success [String] a -- warnings and result- deriving (Read, Show, Eq, Ord)+ = Failure [String] -- ^ error messages+ | Success [String] a -- ^ warning messages and result+ deriving (+ Read {- ^ Default instance -},+ Show {- ^ Default instance -},+ Eq {- ^ Default instance -},+ Ord {- ^ Default instance -}) -- | Run a 'Matcher' with an empty scope. runMatcher :: Matcher a -> Result a
src/Toml/FromValue/ParseTable.hs view
@@ -31,7 +31,7 @@ getTable, ) where -import Control.Applicative (Alternative)+import Control.Applicative (Alternative, empty) import Control.Monad (MonadPlus) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict (StateT(..), get, put)@@ -44,7 +44,7 @@ -- | A 'Matcher' that tracks a current set of unmatched key-value -- pairs from a table. ----- Use 'optKey' and 'reqKey' to extract keys.+-- Use 'Toml.FromValue.optKey' and 'Toml.FromValue.reqKey' to extract keys. -- -- Use 'getTable' and 'setTable' to override the table and implement -- other primitives.@@ -99,16 +99,16 @@ -- If no keys match, an error message is generated explaining which keys -- would have been accepted. ----- This is provided as an alternative to chaining multiple 'reqKey' cases--- together with @('<|>')@ because that will generate one error message for--- each unmatched alternative as well as the error associate with the--- matched alternative.+-- This is provided as an alternative to chaining multiple+-- 'Toml.FromValue.reqKey' cases together with @('<|>')@ because that will+-- generate one error message for each unmatched alternative as well as+-- the error associate with the matched alternative. -- -- @since 1.2.0.0 pickKey :: [KeyAlt a] -> ParseTable a pickKey xs = do t <- getTable- foldr (f t) (fail errMsg) xs+ foldr (f t) errCase xs where f t (Else m) _ = liftMatcher m f t (Key k c) continue =@@ -118,8 +118,8 @@ do setTable $! Map.delete k t liftMatcher (inKey k (c v)) - errMsg =+ errCase = case xs of- [] -> "no alternatives"- [Key k _] -> "missing key: " ++ show (prettySimpleKey k)- _ -> "possible keys: " ++ intercalate ", " [show (prettySimpleKey k) | Key k _ <- xs]+ [] -> empty -- there's nothing a user can do here+ [Key k _] -> fail ("missing key: " ++ show (prettySimpleKey k))+ _ -> fail ("possible keys: " ++ intercalate ", " [show (prettySimpleKey k) | Key k _ <- xs])
src/Toml/Located.hs view
@@ -17,7 +17,12 @@ -- | A value annotated with its text file position data Located a = Located- { locPosition :: {-# UNPACK #-} !Position- , locThing :: !a+ { locPosition :: {-# UNPACK #-} !Position -- ^ position+ , locThing :: !a -- ^ thing at position }- deriving (Read, Show, Functor, Foldable, Traversable)+ deriving (+ Read {- ^ Default instance -},+ Show {- ^ Default instance -},+ Functor {- ^ Default instance -},+ Foldable {- ^ Default instance -},+ Traversable {- ^ Default instance -})
src/Toml/Position.hs view
@@ -9,6 +9,8 @@ in files while doing lexing and parsing for providing more useful error messages. +This module assumes 8 column wide tab stops.+ -} module Toml.Position ( Position(..),@@ -17,9 +19,15 @@ ) where -- | A position in a text file-data Position = Position- { posIndex, posLine, posColumn :: {-# UNPACK #-} !Int }- deriving (Read, Show, Ord, Eq)+data Position = Position {+ posIndex :: {-# UNPACK #-} !Int, -- ^ code-point index (zero-based)+ posLine :: {-# UNPACK #-} !Int, -- ^ line index (one-based)+ posColumn :: {-# UNPACK #-} !Int -- ^ column index (one-based)+ } deriving (+ Read {- ^ Default instance -},+ Show {- ^ Default instance -},+ Ord {- ^ Default instance -},+ Eq {- ^ Default instance -}) -- | The initial 'Position' for the start of a file startPos :: Position
src/Toml/Pretty.hs view
@@ -1,4 +1,4 @@-{-# Language OverloadedStrings #-}+{-# Language OverloadedStrings, GADTs #-} {-| Module : Toml.Pretty Description : Human-readable representations for error messages@@ -20,22 +20,23 @@ TomlDoc, DocClass(..), - -- * semantic values+ -- * Printing semantic values prettyToml,+ prettyTomlOrdered, prettyValue, - -- * syntactic components+ -- * Printing syntactic components prettyToken, prettySectionKind, - -- * keys+ -- * Printing keys prettySimpleKey, prettyKey, ) where import Data.Char (ord, isAsciiLower, isAsciiUpper, isDigit, isPrint) import Data.Foldable (fold)-import Data.List (partition)+import Data.List (partition, sortOn) import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.NonEmpty qualified as NonEmpty import Data.Map qualified as Map@@ -136,7 +137,8 @@ go ks v = prettyKey (NonEmpty.reverse ks) <+> equals <+> prettyValue v -- | Render a value suitable for assignment on the right-hand side--- of an equals sign. This value will always occupy a single line.+-- of an equals sign. This value will always use inline table and list+-- syntax. prettyValue :: Value -> TomlDoc prettyValue = \case Integer i -> annotate NumberClass (pretty i)@@ -172,23 +174,82 @@ isTable :: Value -> Bool isTable Table {} = True-isTable _ = False+isTable _ = False isSingularTable :: Table -> Bool-isSingularTable (Map.elems -> [Table v]) = isSingularTable v-isSingularTable (Map.elems -> [v]) = isAlwaysSimple v-isSingularTable _ = False+isSingularTable (Map.elems -> [v]) = isAlwaysSimple v+isSingularTable _ = False --- | Render a complete TOML document using top-level table--- and array of table sections where appropriate.-prettyToml :: Table -> TomlDoc-prettyToml = prettyToml_ TableKind []+-- | Render a complete TOML document using top-level table and array of+-- table sections where possible.+--+-- Keys are sorted alphabetically. To provide a custom ordering, see+-- 'prettyTomlOrdered'.+prettyToml ::+ Table {- ^ table to print -} ->+ TomlDoc {- ^ TOML syntax -}+prettyToml = prettyToml_ NoProjection TableKind [] -prettyToml_ :: SectionKind -> [String] -> Table -> TomlDoc-prettyToml_ kind prefix t = vcat (topLines ++ subtables)+-- | Render a complete TOML document like 'prettyToml' but use a+-- custom key ordering. The comparison function has access to the+-- complete key path. Note that only keys in the same table will+-- every be compared.+--+-- This operation allows you to render your TOML files with the+-- most important sections first. A TOML file describing a package+-- might desire to have the @[package]@ section first before any+-- of the ancilliary configuration sections.+--+-- The /table path/ is the name of the table being sorted. This allows+-- the projection to be aware of which table is being sorted.+--+-- The /key/ is the key in the table being sorted. These are the+-- keys that will be compared to each other.+--+-- Here's a projection that puts the @package@ section first, the+-- @secondary@ section second, and then all remaining cases are+-- sorted alphabetically afterward.+--+-- @+-- example :: [String] -> String -> Either Int String+-- example [] "package" = Left 1+-- example [] "second" = Left 2+-- example _ other = Right other+-- @+--+-- We could also put the tables in reverse-alphabetical order+-- by leveraging an existing newtype.+--+-- @+-- reverseOrderProj :: [String] -> String -> Down String+-- reverseOrderProj _ = Down+-- @+--+-- @since 1.2.1.0+prettyTomlOrdered ::+ Ord a =>+ ([String] -> String -> a) {- ^ table path -> key -> projection -} ->+ Table {- ^ table to print -} ->+ TomlDoc {- ^ TOML syntax -}+prettyTomlOrdered proj = prettyToml_ (KeyProjection proj) TableKind []++-- | Optional projection used to order rendered tables+data KeyProjection where+ -- | No projection provided; alphabetical order used+ NoProjection :: KeyProjection+ -- | Projection provided: table name and current key are available+ KeyProjection :: Ord a => ([String] -> String -> a) -> KeyProjection++prettyToml_ :: KeyProjection -> SectionKind -> [String] -> Table -> TomlDoc+prettyToml_ mbKeyProj kind prefix t = vcat (topLines ++ subtables) where- (simple, sections) = partition (isAlwaysSimple . snd) (Map.assocs t)+ order =+ case mbKeyProj of+ NoProjection -> id+ KeyProjection f -> sortOn (f prefix . fst) + (simple, sections) = partition (isAlwaysSimple . snd) (order (Map.assocs t))+ topLines = [fold topElts | let topElts = headers ++ assignments, not (null topElts)] headers =@@ -201,13 +262,13 @@ subtables = [prettySection (prefix `snoc` k) v | (k,v) <- sections] + prettySection key (Table t) =+ prettyToml_ mbKeyProj TableKind (NonEmpty.toList key) t+ prettySection key (Array a) =+ vcat [prettyToml_ mbKeyProj ArrayTableKind (NonEmpty.toList key) t | Table t <- a]+ prettySection _ _ = error "prettySection applied to simple value"++-- | Create a 'NonEmpty' with a given prefix and last element. snoc :: [a] -> a -> NonEmpty a snoc [] y = y :| [] snoc (x : xs) y = x :| xs ++ [y]--prettySection :: NonEmpty String -> Value -> TomlDoc-prettySection key (Table t) =- prettyToml_ TableKind (NonEmpty.toList key) t-prettySection key (Array a) =- vcat [prettyToml_ ArrayTableKind (NonEmpty.toList key) t | Table t <- a]-prettySection _ _ = error "prettySection applied to simple value"
src/Toml/Semantics.hs view
@@ -36,7 +36,7 @@ m1 <- assignKeyVals topKVs Map.empty m2 <- foldM (\m (kind, key, kvs) -> addSection kind kvs key m) m1 tables- pure (fmap frameToValue m2)+ pure (framesToTable m2) -- | Line number, key, value type KeyVals = [(Key, Val)]@@ -71,11 +71,15 @@ | Closed -- ^ table closed to further extension deriving Show -frameToValue :: Frame -> Value-frameToValue = \case- FrameTable _ t -> Table (frameToValue <$> t)- FrameArray a -> Array (reverse (Table . fmap frameToValue <$> NonEmpty.toList a))- FrameValue v -> v+framesToTable :: Map String Frame -> Table+framesToTable =+ fmap \case+ FrameTable _ t -> Table (framesToTable t)+ FrameArray a -> Array (toArray a)+ FrameValue v -> v+ where+ -- reverses the list while converting the frames to tables+ toArray = foldl (\acc frame -> Table (framesToTable frame) : acc) [] constructTable :: [(Key, Value)] -> Either String Table constructTable entries =
src/Toml/ToValue.hs view
@@ -30,6 +30,8 @@ import Data.Int (Int8, Int16, Int32, Int64) import Data.Map (Map) import Data.Map qualified as Map+import Data.Text qualified+import Data.Text.Lazy qualified import Data.Time (Day, TimeOfDay, LocalTime, ZonedTime) import Data.Word (Word8, Word16, Word32, Word64) import Numeric.Natural (Natural)@@ -81,6 +83,7 @@ defaultTableToValue :: ToTable a => a -> Value defaultTableToValue = Table . toTable +-- | Identity function instance ToValue Value where toValue = id @@ -89,6 +92,18 @@ instance ToValue Char where toValue x = String [x] toValueList = String++-- | Encodes as string literal+--+-- @since 1.2.1.0+instance ToValue Data.Text.Text where+ toValue = toValue . Data.Text.unpack++-- | Encodes as string literal+--+-- @since 1.2.1.0+instance ToValue Data.Text.Lazy.Text where+ toValue = toValue . Data.Text.Lazy.unpack -- | This instance defers to the list element's 'toValueList' implementation. instance ToValue a => ToValue [a] where
src/Toml/Value.hs view
@@ -35,7 +35,15 @@ | ZonedTime ZonedTime | LocalTime LocalTime | Day Day- deriving (Show, Read, Data, Generic)+ deriving (+ Show {- ^ Default instance -},+ Read {- ^ Default instance -},+ Data {- ^ Default instance -},+ Generic {- ^ Default instance -})++-- | Nearly default instance except 'ZonedTime' doesn't have an+-- 'Eq' instance. 'ZonedTime' values are equal if their times and+-- timezones are both equal. instance Eq Value where Integer x == Integer y = x == y
test/DecodeSpec.hs view
@@ -123,7 +123,7 @@ "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`
+ test/FromValueSpec.hs view
@@ -0,0 +1,105 @@+{-|+Module : FromValueSpec+Description : Exercise various components of FromValue+Copyright : (c) Eric Mertens, 2023+License : ISC+Maintainer : emertens@gmail.com++-}+module FromValueSpec (spec) where++import Control.Applicative ((<|>), empty)+import Test.Hspec (it, shouldBe, Spec)+import Toml (Result(..), Value(..))+import Toml.FromValue (Result(..), FromValue(fromValue), optKey, parseTableFromValue, reqKey, warnTable, pickKey)+import Toml.FromValue.Matcher (runMatcher)+import Toml.ToValue (table)+import Control.Monad (when)+import Toml.FromValue.ParseTable (KeyAlt(..))++spec :: Spec+spec =+ do it "handles one reqKey" $+ runMatcher (parseTableFromValue (reqKey "test") (table [("test", String "val")]))+ `shouldBe`+ Success [] "val"++ it "handles one optKey" $+ runMatcher (parseTableFromValue (optKey "test") (table [("test", String "val")]))+ `shouldBe`+ Success [] (Just "val")++ it "handles one missing optKey" $+ runMatcher (parseTableFromValue (optKey "test") (table [("nottest", String "val")]))+ `shouldBe`+ Success ["unexpected key: nottest in top"] (Nothing :: Maybe String)++ it "handles one missing reqKey" $+ runMatcher (parseTableFromValue (reqKey "test") (table [("nottest", String "val")]))+ `shouldBe`+ (Failure ["missing key: test in top"] :: Result String)++ it "handles one mismatched reqKey" $+ runMatcher (parseTableFromValue (reqKey "test") (table [("test", String "val")]))+ `shouldBe`+ (Failure ["type error. wanted: integer got: string in top.test"] :: Result Integer)++ it "handles one mismatched optKey" $+ runMatcher (parseTableFromValue (optKey "test") (table [("test", String "val")]))+ `shouldBe`+ (Failure ["type error. wanted: integer got: string in top.test"] :: Result (Maybe Integer))++ it "handles concurrent errors" $+ runMatcher (parseTableFromValue (reqKey "a" <|> empty <|> reqKey "b") (table []))+ `shouldBe`+ (Failure ["missing key: a in top", "missing key: b in top"] :: Result Integer)++ it "handles concurrent value mismatch" $+ let v = String "" in+ runMatcher (Left <$> fromValue v <|> empty <|> Right <$> fromValue v)+ `shouldBe`+ (Failure [+ "type error. wanted: boolean got: string in top",+ "type error. wanted: integer got: string in top"]+ :: Result (Either Bool Int))++ it "doesn't emit an error for empty" $+ runMatcher (parseTableFromValue empty (table []))+ `shouldBe`+ (Failure [] :: Result Integer)++ it "matches single characters" $+ runMatcher (fromValue (String "x"))+ `shouldBe`+ Success [] 'x'++ it "rejections non-single characters" $+ runMatcher (fromValue (String "xy"))+ `shouldBe`+ (Failure ["type error. wanted: character got: string in top"] :: Result Char)++ it "collects warnings in table matching" $+ let pt =+ do i1 <- reqKey "k1"+ i2 <- reqKey "k2"+ let n = i1 + i2+ when (odd n) (warnTable "k1 and k2 sum to an odd value")+ pure n+ in+ runMatcher (parseTableFromValue pt (table [("k1", Integer 1), ("k2", Integer 2)]))+ `shouldBe`+ Success ["k1 and k2 sum to an odd value in top"] (3 :: Integer)++ it "offers helpful messages when no keys match" $+ let pt = pickKey [Key "this" \_ -> pure 'a', Key "." \_ -> pure 'b']+ in+ runMatcher (parseTableFromValue pt (table []))+ `shouldBe`+ (Failure ["possible keys: this, \".\" in top"] :: Result Char)++ it "generates an error message on an empty pickKey" $+ let pt = pickKey []+ in+ runMatcher (parseTableFromValue pt (table []))+ `shouldBe`+ (Failure [] :: Result Char)
test/HieDemoSpec.hs view
@@ -331,7 +331,7 @@ [cradle.cabal] cabalProject = "cabal.project"- + [[cradle.cabal.components]] path = "./src" component = "toml-parser:lib:toml-parser"
test/LexerSpec.hs view
test/QuoteStr.hs view
@@ -27,7 +27,7 @@ processString :: String -> ExpQ processString ('\n':xs) = let ws = takeWhile (' '==) xs- + cleanup "" = pure "" cleanup x = case stripPrefix ws x of Nothing -> fail "bad prefix"
test/ToValueSpec.hs view
@@ -8,9 +8,9 @@ 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]
toml-parser.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: toml-parser-version: 1.2.0.0+version: 1.2.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 == 8.10.7, GHC == 9.0.2, GHC == 9.2.8, GHC == 9.4.5, GHC == 9.6.2+tested-with: GHC == {8.10.7, 9.0.2, 9.2.8, 9.4.5, 9.6.2} extra-doc-files: ChangeLog.md@@ -66,11 +66,12 @@ Toml.Value build-depends: array ^>= 0.5,- base >= 4.14 && < 4.19,- containers ^>= 0.5 || ^>= 0.6,+ base ^>= {4.14, 4.15, 4.16, 4.17, 4.18},+ containers ^>= {0.5, 0.6}, prettyprinter ^>= 1.7,- time >= 1.9 && < 1.13,- transformers ^>= 0.5 || ^>= 0.6,+ text >= 0.2 && < 3,+ time ^>= {1.9, 1.10, 1.11, 1.12},+ transformers ^>= {0.5, 0.6}, build-tool-depends: alex:alex >= 3.2, happy:happy >= 1.19,@@ -83,19 +84,31 @@ default-extensions: QuasiQuotes build-tool-depends:- hspec-discover:hspec-discover == 2.*+ hspec-discover:hspec-discover ^>= 2 build-depends: base, containers,- hspec >= 2.10 && < 2.12,- template-haskell >= 2.16 && < 2.21,+ hspec ^>= {2.10, 2.11},+ template-haskell ^>= {2.16, 2.17, 2.18, 2.19, 2.20}, time, toml-parser, other-modules: DecodeSpec+ FromValueSpec HieDemoSpec LexerSpec PrettySpec QuoteStr TomlSpec ToValueSpec++test-suite readme+ import: extensions+ type: exitcode-stdio-1.0+ main-is: README.lhs+ ghc-options: -pgmL markdown-unlit+ build-depends:+ base,+ toml-parser,+ build-tool-depends:+ markdown-unlit:markdown-unlit ^>= {0.5.1, 0.6.0},