htoml-megaparsec 2.1.0.3 → 2.1.0.4

raw patch · 4 files changed

+117/−117 lines, 4 filesdep −semigroupsdep ~basedep ~megaparsecdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: semigroups

Dependency ranges changed: base, megaparsec, text

API changes (from Hackage documentation)

Files

• htoml-megaparsec.cabal +67/−65
• internal/Text/Toml/Parser.hs +19/−19
• internal/Text/Toml/Types.hs +30/−28
• src/Text/Toml.hs +1/−5

@@ -1,20 +1,21 @@-cabal-version: 2.0-name: htoml-megaparsec-version: 2.1.0.3-license: BSD3-license-file: LICENSE-copyright: (c) 2013-2016 Cies Breijs, 2017-2018 Vanessa McHale-maintainer: Vanessa McHale <vamchale@gmail.com>-author: Cies Breijs, Vanessa McHale-homepage: https://hub.darcs.net/vmchale/htoml-megaparsec-bug-reports: https://hub.darcs.net/vmchale/htoml-megaparsec/issues-synopsis: Parser for TOML files+cabal-version:      2.0+name:               htoml-megaparsec+version:            2.1.0.4+license:            BSD3+license-file:       LICENSE+copyright:          (c) 2013-2016 Cies Breijs, 2017-2018 Vanessa McHale+maintainer:         Vanessa McHale <vamchale@gmail.com>+author:             Cies Breijs, Vanessa McHale+homepage:           https://hub.darcs.net/vmchale/htoml-megaparsec+bug-reports:        https://hub.darcs.net/vmchale/htoml-megaparsec/issues+synopsis:           Parser for TOML files description:     TOML is an obvious and minimal format for config files.     This package provides a TOML parser     built with the Megaparsec.-category: Data, Text, Configuration, Language, TOML-build-type: Simple++category:           Data, Text, Configuration, Language, TOML+build-type:         Simple extra-source-files:     test/BurntSushi/fetch-toml-tests.sh     test/BurntSushi/valid/*.toml@@ -22,25 +23,28 @@     test/BurntSushi/invalid/*.toml     benchmarks/example.toml     benchmarks/repeated.toml-extra-doc-files: README.md-                 CHANGES.md +extra-doc-files:+    README.md+    CHANGES.md+ source-repository head-    type: darcs+    type:     darcs     location: https://hub.darcs.net/vmchale/htoml-megaparsec  library-    exposed-modules:-        Text.Toml-    hs-source-dirs: src+    exposed-modules:  Text.Toml+    hs-source-dirs:   src     default-language: Haskell2010-    other-extensions: ConstraintKinds DeriveGeneric FlexibleContexts-                      OverloadedStrings RankNTypes GADTs MonoLocalBinds DeriveAnyClass-    ghc-options: -Wall+    other-extensions:+        ConstraintKinds DeriveGeneric FlexibleContexts OverloadedStrings+        RankNTypes GADTs MonoLocalBinds DeriveAnyClass++    ghc-options:      -Wall     build-depends:         base >=4.8 && <5,         megaparsec >=6.0.0,-        htoml-internal -any,+        htoml-internal,         text >=1.0 && <2,         mtl >=2.2,         composition-prelude >=0.1.1.0@@ -52,71 +56,69 @@     exposed-modules:         Text.Toml.Parser         Text.Toml.Types-    hs-source-dirs: internal-    other-modules:-        Text.Megaparsec.CharRW++    hs-source-dirs:   internal+    other-modules:    Text.Megaparsec.CharRW     default-language: Haskell2010-    other-extensions: ConstraintKinds DeriveGeneric FlexibleContexts-                      OverloadedStrings RankNTypes GADTs MonoLocalBinds-    ghc-options: -Wall+    other-extensions:+        ConstraintKinds DeriveGeneric FlexibleContexts OverloadedStrings+        RankNTypes GADTs MonoLocalBinds++    ghc-options:      -Wall     build-depends:-        base >=4.7 && <5,+        base >=4.7 && <5.0,         containers >=0.5,-        megaparsec >=7.0.0,+        megaparsec >=6.0.0,         unordered-containers >=0.2,         vector >=0.10,         text >=1.0 && <2,         mtl >=2.2,-        deepseq -any,+        deepseq,         time >=1.5.0 -    if !impl(ghc >=8.0)-        build-depends:-            semigroups -any-     if !impl(ghc >=7.10)-        build-depends:-            void -any+        build-depends: void      if impl(ghc >=8.0)         ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates  test-suite htoml-test-    type: exitcode-stdio-1.0-    main-is: Test.hs-    hs-source-dirs: test+    type:             exitcode-stdio-1.0+    main-is:          Test.hs+    hs-source-dirs:   test     other-modules:         BurntSushi         JSON         Text.Toml.Parser.Spec+     default-language: Haskell2010-    ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+    ghc-options:      -Wall -threaded -rtsopts -with-rtsopts=-N     build-depends:         base >=4.9 && <5,-        megaparsec -any,-        containers -any,-        unordered-containers -any,-        vector -any,-        aeson -any,-        text -any,-        time -any,-        htoml-megaparsec -any,-        htoml-internal -any,-        bytestring -any,-        file-embed -any,-        tasty -any,-        tasty-hspec -any,-        tasty-hunit -any+        megaparsec,+        containers,+        unordered-containers,+        vector,+        aeson,+        text,+        time,+        htoml-megaparsec,+        htoml-internal,+        bytestring,+        file-embed,+        tasty,+        tasty-hspec,+        tasty-hunit  benchmark benchmarks-    type: exitcode-stdio-1.0-    main-is: Benchmarks.hs-    hs-source-dirs: benchmarks .+    type:             exitcode-stdio-1.0+    main-is:          Benchmarks.hs+    hs-source-dirs:   benchmarks .     default-language: Haskell2010-    ghc-options: -Wall+    ghc-options:      -Wall     build-depends:-        base -any,-        htoml-megaparsec -any,-        htoml-internal -any,-        criterion -any,-        text -any+        base,+        htoml-megaparsec,+        htoml-internal,+        criterion,+        text

@@ -11,7 +11,7 @@ import           Control.Monad import           Control.Monad.State    (evalState) import           Data.Functor-import qualified Data.HashMap.Lazy      as HM+import qualified Data.HashMap.Lazy      as M import qualified Data.Set               as S import           Data.Text              (Text, pack, unpack) import qualified Data.Text              as T@@ -39,15 +39,15 @@     -- Ensure the input is completely consumed     eof     -- Load each named section into the top table-    foldM (flip (insert Explicit)) topTable namedSections+    foldM (\x y -> insert Explicit y x) topTable namedSections  -- | Parses a table of key-value pairs. table :: (TomlM m) => Parser m Table table = do-    pairs <- many (assignment <* skipBlanks) <|> (skipBlanks Data.Functor.$> [])+    pairs <- many (assignment <* skipBlanks) <|> (skipBlanks >> pure [])     case maybeDupe (map fst pairs) of       Just k  -> throwParser $ "Cannot redefine key '" ++ unpack k ++ "'"-      Nothing -> pure $ HM.fromList pairs+      Nothing -> return $ M.fromList pairs  -- | Parses an inline table of key-value pairs. inlineTable :: (TomlM m) => Parser m (Either (S.Set (ErrorFancy Void)) Node)@@ -56,11 +56,11 @@     case maybeDupe (map fst pairs) of       Just k  ->         pure $ Left (S.fromList [ErrorFail $ "Cannot redefine key " ++ unpack k ])-      Nothing -> pure $ Right $ VTable $ HM.fromList pairs+      Nothing -> pure $ Right $ VTable $ M.fromList pairs   where     skipSpaces      = many (satisfy isSpc)     separatedValues = sepBy (skipSpaces *> assignment <* skipSpaces) comma-    comma           = skipSpaces *> char ',' *> skipSpaces+    comma           = skipSpaces >> char ',' >> skipSpaces  -- | Find dupes, if any. maybeDupe :: Ord a => [a] -> Maybe a@@ -79,8 +79,8 @@     skipBlanks     tbl <- table     skipBlanks-    pure $ case eitherHdr of Left  ns -> (ns, VTable tbl)-                             Right ns -> (ns, VTArray $ V.singleton tbl)+    return $ case eitherHdr of Left  ns -> (ns, VTable tbl )+                               Right ns -> (ns, VTArray $ V.singleton tbl)   -- | Parses a table header.@@ -103,12 +103,12 @@ assignment :: (TomlM m) => Parser m (Text, Node) assignment = do     k <- (pack <$> some keyChar) <|> anyStr'-    many (satisfy isSpc) *> char '=' *> skipBlanks+    many (satisfy isSpc) >> char '=' >> skipBlanks     v' <- value     v <- case v' of         Right x -> pure x         Left y  -> fancyFailure y-    pure (k, v)+    return (k, v)   where     -- TODO: Follow the spec, e.g.: only first char cannot be '['.     keyChar = alphaNumChar <|> oneOf ("-_" :: String)@@ -164,7 +164,7 @@     -- | Parse a string char, accepting escaped codes, ignoring escaped white space     strChar     = escSeq <|> noneOf ("\\" :: String) <* escWhiteSpc     -- | Parse escaped white space, if any-    escWhiteSpc = many $ char '\\' *> char '\n' *> many (oneOf ("\n\t " :: String))+    escWhiteSpc = many $ char '\\' >> char '\n' >> many (oneOf ("\n\t " :: String))   literalStr :: (TomlM m) => Parser m Text@@ -184,22 +184,22 @@ datetime = do     d <- manyTill anySingle (char 'Z')     let  mt = parseTimeM True defaultTimeLocale (iso8601DateFormat $ Just "%X") d-    case mt of Just t  -> pure $ VDatetime t+    case mt of Just t  -> return $ VDatetime t                Nothing -> throwParser "parsing datetime failed"  -- | Attoparsec 'double' parses scientific "e" notation; reimplement according to Toml spec. float :: (TomlM m) => Parser m Node float = VFloat <$> do     n <- intStr <* lookAhead (oneOf (".eE" :: String))-    d <- (char '.' *> uintStr) <|> pure "0"-    e <- (oneOf ("eE" :: String) *> intStr) <|> pure "0"-    pure . read . join $ [n, ".", d, "e", e]+    d <- (char '.' *> uintStr) <|> return "0"+    e <- (oneOf ("eE" :: String) *> intStr) <|> return "0"+    return . read . join $ [n, ".", d, "e", e]   where-    sign    = (T.singleton <$> char '-') <|> (char '+' Data.Functor.$> "") <|> pure ""+    sign    = (T.singleton <$> char '-') <|> (char '+' >> return "") <|> return ""     uintStr = (:) <$> digitChar <*> many (optional (char '_') *> digitChar)     intStr  = do s <- T.unpack <$> sign                  u <- uintStr-                 pure . join $ s : [u]+                 return . join $ s : [u]  integer :: (TomlM m) => Parser m Node integer = VInteger <$> signed (read <$> uintStr)@@ -217,7 +217,7 @@                 between (char '[') (char ']') (skipBlanks *> separatedValues)   where     separatedValues = sepEndBy (skipBlanks *> try p <* skipBlanks) comma <* skipBlanks-    comma           = skipBlanks *> char ',' *> skipBlanks+    comma           = skipBlanks >> char ',' >> skipBlanks  -- | Parser for escape sequences. escSeq :: (TomlM m) => Parser m Char@@ -240,7 +240,7 @@ unicodeHex n = do     h <- count n hexDigitChar -- (satisfy isHex)     let v = fst . head . readHex $ h-    pure $ if v <= maxChar then toEnum v else '�'+    return $ if v <= maxChar then toEnum v else '�'   where     -- isHex x = or . sequence [isDigit, isAsciiUpper, isAsciiLower]     maxChar = fromEnum (maxBound :: Char)

@@ -1,6 +1,6 @@ {-# LANGUAGE ConstraintKinds   #-}-{-# LANGUAGE DeriveAnyClass    #-} {-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveAnyClass     #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes        #-}@@ -26,11 +26,13 @@ import           Control.Monad.State       (State) import           Control.Monad.State.Class (MonadState, get, modify) import           Control.Monad.Trans       (lift)-import qualified Data.HashMap.Lazy         as HM+import           Data.HashMap.Lazy         (HashMap)+import qualified Data.HashMap.Lazy         as M import           Data.Int                  (Int64) import           Data.List                 (intersect)-import           Data.Semigroup+import           Data.Set                  (Set) import qualified Data.Set                  as S+import           Data.Text                 (Text) import qualified Data.Text                 as T import           Data.Time.Clock           (UTCTime) import           Data.Time.Format          ()@@ -40,18 +42,18 @@ import           GHC.Generics              (Generic) import           Text.Megaparsec           hiding (State) -type Parser m a = (MonadState (S.Set [T.Text]) m) => ParsecT Void T.Text m a+type Parser m a = (MonadState (Set [Text]) m) => ParsecT Void Text m a -type TomlM m = (MonadState (S.Set [T.Text]) m)+type TomlM m = (MonadState (S.Set [Text]) m) -type Toml = State (S.Set [T.Text])+type Toml = State (S.Set [Text])  -- | The TOML 'Table' is a mapping ('HashMap') of 'Text' keys to 'Node' values.-type Table = HM.HashMap T.Text Node+type Table = HashMap Text Node  -- | Contruct an empty 'Table'. emptyTable :: Table-emptyTable = HM.empty+emptyTable = M.empty  -- | An array of 'Table's, implemented using a 'Vector'. type VTArray = Vector Table@@ -62,7 +64,7 @@ -- | A 'Node' may contain any type of value that may be put in a 'VArray'. data Node = VTable    Table           | VTArray   VTArray-          | VString   T.Text+          | VString   Text           | VInteger  Int64           | VFloat    Double           | VBoolean  Bool@@ -85,40 +87,40 @@ -- | Inserts a table, 'Table', with the namespaced name, '[Text]', (which -- may be part of a table array) into a 'Table'. -- It may result in an error in the 'ParsecT' monad for redefinitions.-insert :: (TomlM m) => Explicitness -> ([T.Text], Node) -> Table -> Parser m Table+insert :: (TomlM m) => Explicitness -> ([Text], Node) -> Table -> Parser m Table insert _ ([], _) _ = throwParser "FATAL: Cannot call 'insert' without a name." insert ex ([name], node) ttbl =     -- In case 'name' is final (a top-level name)-    case HM.lookup name ttbl of+    case M.lookup name ttbl of       Nothing -> do when (isExplicit ex) $ updateExStateOrError [name] node-                    pure $ HM.insert name node ttbl+                    return $ M.insert name node ttbl       Just (VTable t) -> case node of           (VTable nt) -> case merge t nt of                   Left ds -> nameInsertError ds name                   Right r -> do when (isExplicit ex) $                                   updateExStateOrError [name] node-                                pure $ HM.insert name (VTable r) ttbl+                                return $ M.insert name (VTable r) ttbl           _ -> commonInsertError node [name]       Just (VTArray a) -> case node of-          (VTArray na) -> pure $ HM.insert name (VTArray $ a <> na) ttbl+          (VTArray na) -> return $ M.insert name (VTArray $ a V.++ na) ttbl           _            -> commonInsertError node [name]       Just _ -> commonInsertError node [name] insert ex (fullName@(name:ns), node) ttbl =     -- In case 'name' is not final (not a top-level name)-    case HM.lookup name ttbl of+    case M.lookup name ttbl of       Nothing -> do           r <- insert Implicit (ns, node) emptyTable           when (isExplicit ex) $ updateExStateOrError fullName node-          pure $ HM.insert name (VTable r) ttbl+          return $ M.insert name (VTable r) ttbl       Just (VTable t) -> do           r <- insert Implicit (ns, node) t           when (isExplicit ex) $ updateExStateOrError fullName node-          pure $ HM.insert name (VTable r) ttbl+          return $ M.insert name (VTable r) ttbl       Just (VTArray a) ->           if V.null a           then throwParser "FATAL: Call to 'insert' found impossibly empty VArray."           else do r <- insert Implicit (ns, node) (V.last a)-                  pure $ HM.insert name (VTArray $ V.init a `V.snoc` r) ttbl+                  return $ M.insert name (VTArray $ V.init a `V.snoc` r) ttbl       Just _ -> commonInsertError node fullName  @@ -126,9 +128,9 @@ -- | Merge two tables, resulting in an error when overlapping keys are -- found ('Left' will contain those keys).  When no overlapping keys are -- found the result will contain the union of both tables in a 'Right'.-merge :: Table -> Table -> Either [T.Text] Table-merge existing new = case HM.keys existing `intersect` HM.keys new of-                       [] -> Right $ HM.union existing new+merge :: Table -> Table -> Either [Text] Table+merge existing new = case M.keys existing `intersect` M.keys new of+                       [] -> Right $ M.union existing new                        ds -> Left ds  -- TOML tables maybe redefined when first definition was implicit.@@ -137,36 +139,36 @@ -- explicitly (namely with `[a]`), it is then not possible to (re-)define it again. -- A parser state of all explicitly defined tables is maintained, which allows -- raising errors for illegal redefinitions of such.-updateExStateOrError :: (TomlM m) => [T.Text] -> Node -> Parser m ()+updateExStateOrError :: (TomlM m) => [Text] -> Node -> Parser m () updateExStateOrError name node@(VTable _) = do     explicitlyDefinedNames <- lift get     let ns = explicitlyDefinedNames     when (S.member name ns) $ tableClashError name     updateExState name node-updateExStateOrError _ _ = pure ()+updateExStateOrError _ _ = return ()  -- | Like 'updateExStateOrError' but does not raise errors. Only use this when sure -- that redefinitions cannot occur.-updateExState :: (TomlM m) => [T.Text] -> Node -> Parser m ()+updateExState :: (TomlM m) => [Text] -> Node -> Parser m () updateExState name (VTable _) = lift $ modify (S.insert name)-updateExState _ _             = pure ()+updateExState _ _             = return ()   -- * Parse errors resulting from invalid TOML  -- | Key(s) redefintion error.-nameInsertError :: (TomlM m) => [T.Text] -> T.Text -> Parser m a+nameInsertError :: (TomlM m) => [Text] -> Text -> Parser m a nameInsertError ns name = throwParser . T.unpack $ T.concat     [ "Cannot redefine key(s) (", T.intercalate ", " ns     , "), from table named '", name, "'." ]  -- | Table redefinition error.-tableClashError :: (TomlM m) => [T.Text] -> Parser m a+tableClashError :: (TomlM m) => [Text] -> Parser m a tableClashError name = throwParser . T.unpack $ T.concat     [ "Cannot redefine table named: '", T.intercalate "." name, "'." ]  -- | Common redefinition error.-commonInsertError :: (TomlM m) => Node -> [T.Text] -> Parser m a+commonInsertError :: (TomlM m) => Node -> [Text] -> Parser m a commonInsertError what name = throwParser . join $     [ "Cannot insert ", w, " as '", n, "' since key already exists." ]   where

@@ -2,12 +2,8 @@                  , parseErrorPretty                  , Table                  , Node (..)-                 , TomlError-                 , VTArray-                 , VArray                  ) where -import           Control.Composition import           Control.Monad.State (evalState) import           Data.Text           (Text) import           Text.Megaparsec@@ -19,4 +15,4 @@ parseTomlDoc :: FilePath -- ^ For error generation              -> Text -- ^ TOML source              -> Either TomlError Table-parseTomlDoc = flip evalState mempty .* runParserT tomlDoc+parseTomlDoc _ = flip evalState mempty . runParserT tomlDoc "noneSrc"