htoml-megaparsec 1.0.1.3 → 1.0.1.4

raw patch · 6 files changed

+83/−33 lines, 6 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• benchmarks/Benchmarks.hs +5/−0
• htoml-megaparsec.cabal +2/−1
• src/Text/Megaparsec/CharRW.hs +30/−0
• src/Text/Toml.hs +3/−0
• src/Text/Toml/Parser.hs +42/−32
• src/Text/Toml/Types.hs +1/−0

@@ -30,4 +30,9 @@         , bench "repeated-4x" $ whnf (parseTomlDoc "") repeatedToml         ] +      , bgroup "file-check"+        [ bench "example"     $ whnf (checkTomlDoc "") exampleToml+        , bench "repeated-4x" $ whnf (checkTomlDoc "") repeatedToml+        ]+       ]

@@ -1,5 +1,5 @@ name:                     htoml-megaparsec-version:                  1.0.1.3+version:                  1.0.1.4 synopsis:                 Parser for TOML files description:              TOML is an obvious and minimal format for config files.                           This package provides a TOML parser@@ -32,6 +32,7 @@   exposed-modules:        Text.Toml                         , Text.Toml.Parser                         , Text.Toml.Types+                        , Text.Megaparsec.CharRW   hs-source-dirs:         src   default-language:       Haskell2010   build-depends:          base                   >= 4.8    && < 5

@@ -0,0 +1,30 @@+{-# LANGUAGE GADTs #-}++module Text.Megaparsec.CharRW ( module X+                              , oneOf+                              , noneOf+                              ) where++import           Text.Megaparsec+import           Text.Megaparsec.Char as X hiding (noneOf, oneOf)+import qualified Text.Megaparsec.Char as Megaparsec++{-# RULES+"noneOf/char"       forall c.    noneOf [c]     = char 'c'+"noneOf/satsify"    forall c c'. noneOf [c, c'] = satisfy (\x -> x /= c && x /= c')+"oneOf/notChar"     forall c.    oneOf [c]      = notChar 'c'+"oneOf/satisfy"     forall c c'. oneOf [c, c']  = satisfy (\x -> x == c || x == c')+  #-}++{-# RULES+"noneOf/satsify"    forall c c' c''. noneOf [c, c', c''] = satisfy (\x -> x /= c && x /= c' && x /= c'')+"oneOf/satsify"     forall c c' c''. oneOf [c, c', c'']  = satisfy (\x -> x == c || x == c' || x == c'')+  #-}++{-# INLINE [1] noneOf #-}+noneOf :: (Foldable f, MonadParsec e s m, Token s ~ Char) => f Char -> m Char+noneOf = Megaparsec.noneOf++{-# INLINE [1] oneOf #-}+oneOf :: (Foldable f, MonadParsec e s m, Token s ~ Char) => f Char -> m Char+oneOf = Megaparsec.oneOf

@@ -11,3 +11,6 @@ -- of the document as a 'Table'. parseTomlDoc :: String -> Text -> Either TomlError Table parseTomlDoc = flip evalState mempty .* runParserT tomlDoc++checkTomlDoc :: String -> Text -> Either TomlError ()+checkTomlDoc = flip evalState mempty .* runParserT tomlCheck

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} {-# LANGUAGE CPP               #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE MonoLocalBinds    #-}@@ -9,33 +10,32 @@   , module Text.Toml.Types   ) where -import           Control.Applicative  hiding (many, optional, (<|>))+import           Control.Applicative    hiding (many, optional, (<|>)) import           Control.Monad-import           Control.Monad.State  (evalState)-import           Data.Char            (isAsciiLower, isAsciiUpper, isDigit)-import qualified Data.HashMap.Strict  as M-import qualified Data.Set             as S-import           Data.Text            (Text, pack, unpack)-import qualified Data.Text            as T-import qualified Data.Vector          as V+import           Control.Monad.State    (evalState)+import qualified Data.HashMap.Strict    as M+import qualified Data.Set               as S+import           Data.Text              (Text, pack, unpack)+import qualified Data.Text              as T+import qualified Data.Vector            as V import           Data.Void-import           Text.Megaparsec.Char+import           Text.Megaparsec.CharRW  #if MIN_VERSION_time(1,5,0)-import           Data.Time.Format     (defaultTimeLocale, iso8601DateFormat,-                                       parseTimeM)+import           Data.Time.Format       (defaultTimeLocale, iso8601DateFormat,+                                         parseTimeM) #else-import           Data.Time.Format     (parseTime)-import           System.Locale        (defaultTimeLocale, iso8601DateFormat)+import           Data.Time.Format       (parseTime)+import           System.Locale          (defaultTimeLocale, iso8601DateFormat) #endif -import           Numeric              (readHex)-import           Text.Megaparsec      hiding (runParser)+import           Numeric                (readHex)+import           Text.Megaparsec        hiding (runParser)  import           Text.Toml.Types  -- Imported last to fix redundancy warning-import           Prelude              hiding (concat, takeWhile)+import           Prelude                hiding (concat, takeWhile)   type TomlError = ParseError (Token Text) Void@@ -44,6 +44,17 @@ parseOnly :: Parser Toml a -> Text -> Either TomlError a parseOnly parser = flip evalState mempty . runParserT parser "noneSrc" +-- | Checks a complete document formatted according to the TOML spec.+tomlCheck :: (TomlM m) => Parser m ()+tomlCheck = do+    skipBlanks+    table+    many namedSection+    -- Ensure the input is completely consumed+    eof+    -- make a set of named sections.+    pure ()+ -- | Parses a complete document formatted according to the TOML spec. tomlDoc :: (TomlM m) => Parser m Table tomlDoc = do@@ -58,7 +69,7 @@ -- | Parses a table of key-value pairs. table :: (TomlM m) => Parser m Table table = do-    pairs <- many (assignment <* skipBlanks) <|> (skipBlanks >> return [])+    pairs <- many (assignment <* skipBlanks) <|> (skipBlanks >> pure [])     case maybeDupe (map fst pairs) of       Just k  -> throwParser $ "Cannot redefine key " ++ unpack k       Nothing -> return $ M.fromList pairs@@ -88,7 +99,7 @@ -- 'NTable' or 'NTArray' in the second. namedSection :: (TomlM m) => Parser m ([Text], Node) namedSection = do-    eitherHdr <- try (Left <$> tableHeader) <|> try (Right <$> tableArrayHeader)+    eitherHdr <- try (Left <$> tableHeader) <|> (Right <$> tableArrayHeader)     skipBlanks     tbl <- table     skipBlanks@@ -134,7 +145,7 @@     <|> (try datetime    <?> "datetime")     <|> (try float       <?> "float")     <|> (try integer     <?> "integer")-    <|> (inlineTable <?> "inline table")+    <|> (inlineTable     <?> "inline table")   --@@ -147,7 +158,7 @@     <|> (try (arrayOf anyStr)   <?> "array of strings")     <|> (try (arrayOf datetime) <?> "array of datetimes")     <|> (try (arrayOf float)    <?> "array of floats")-    <|> (try (arrayOf integer)  <?> "array of integers")+    <|> (arrayOf integer        <?> "array of integers")   boolean :: (TomlM m) => Parser m Node@@ -159,31 +170,30 @@ anyStr = VString <$> anyStr'  anyStr' :: (TomlM m) => Parser m Text-anyStr' = try multiBasicStr <|> try basicStr <|> try multiLiteralStr <|> try literalStr+anyStr' = try multiBasicStr <|> try basicStr <|> try multiLiteralStr <|> literalStr   basicStr :: (TomlM m) => Parser m Text basicStr = between dQuote dQuote (pack <$> many strChar)   where-    strChar = escSeq <|> noneOf ("\"\\" :: String) --satisfy (\c -> c /= '"' && c /= '\\'))+    strChar = escSeq <|> noneOf ("\"\\" :: String)     dQuote  = char '\"' - multiBasicStr :: (TomlM m) => Parser m Text multiBasicStr = openDQuote3 *> escWhiteSpc *> (pack <$> manyTill strChar (try dQuote3))   where     -- | Parse the a tripple-double quote, with possibly a newline attached-    openDQuote3 = try (dQuote3 <* char '\n') <|> try dQuote3+    openDQuote3 = try (dQuote3 <* char '\n') <|> dQuote3     -- | Parse tripple-double quotes     dQuote3     = count 3 $ char '"'     -- | Parse a string char, accepting escaped codes, ignoring escaped white space-    strChar     = escSeq <|> satisfy (/= '\\') <* escWhiteSpc+    strChar     = escSeq <|> noneOf ("\\" :: String) <* escWhiteSpc     -- | Parse escaped white space, if any-    escWhiteSpc = many $ char '\\' >> char '\n' >> many (satisfy (\c -> isSpc c || c == '\n'))+    escWhiteSpc = many $ char '\\' >> char '\n' >> many (oneOf ("\n\t " :: String))   literalStr :: (TomlM m) => Parser m Text-literalStr = between sQuote sQuote (pack <$> many (satisfy (/= '\'')))+literalStr = between sQuote sQuote (pack <$> many (noneOf ("'" :: String)))   where     sQuote = char '\'' @@ -192,14 +202,14 @@ multiLiteralStr = openSQuote3 *> (pack <$> manyTill anyChar sQuote3)   where     -- | Parse the a tripple-single quote, with possibly a newline attached-    openSQuote3 = try (sQuote3 <* char '\n') <|> try sQuote3+    openSQuote3 = try (sQuote3 <* char '\n') <|> sQuote3     -- | Parse tripple-single quotes     sQuote3     = try . count 3 . char $ '\''   datetime :: (TomlM m) => Parser m Node datetime = do-    d <- try $ manyTill anyChar (char 'Z')+    d <- manyTill anyChar (char 'Z') #if MIN_VERSION_time(1,5,0)     let  mt = parseTimeM True defaultTimeLocale (iso8601DateFormat $ Just "%X") d #else@@ -221,7 +231,7 @@     uintStr = (:) <$> digitChar <*> many (optional (char '_') *> digitChar)     intStr  = do s <- T.unpack <$> sign                  u <- uintStr-                 return . join $ [s, u]+                 return . join $ s : [u]   integer :: (TomlM m) => Parser m Node@@ -263,11 +273,11 @@ -- | Parser for unicode hexadecimal values of representation length 'n'. unicodeHex :: (TomlM m) => Int -> Parser m Char unicodeHex n = do-    h <- count n (satisfy isHex)+    h <- count n hexDigitChar -- (satisfy isHex)     let v = fst . head . readHex $ h     return $ if v <= maxChar then toEnum v else '_'   where-    isHex = or . sequence [isDigit, isAsciiUpper, isAsciiLower]+    -- isHex x = or . sequence [isDigit, isAsciiUpper, isAsciiLower]     maxChar = fromEnum (maxBound :: Char)  

@@ -125,6 +125,7 @@       Just _ -> commonInsertError node fullName  +-- FIXME use a Set here (?) -- | 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'.