packages feed

htoml-megaparsec 1.0.0.4 → 1.0.1.0

raw patch · 7 files changed

+116/−101 lines, 7 filesdep +deepseqdep +htoml-megaparsecdep −htomlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: deepseq, htoml-megaparsec

Dependencies removed: htoml

API changes (from Hackage documentation)

- Text.Toml.Types: class ToBsJSON a
- Text.Toml.Types: class ToJSON a
- Text.Toml.Types: instance Data.Aeson.Types.ToJSON.ToJSON Text.Toml.Types.Node
- Text.Toml.Types: instance Text.Toml.Types.ToBsJSON Text.Toml.Types.Node
- Text.Toml.Types: instance Text.Toml.Types.ToBsJSON a => Text.Toml.Types.ToBsJSON (Data.Vector.Vector a)
- Text.Toml.Types: instance Text.Toml.Types.ToBsJSON v => Text.Toml.Types.ToBsJSON (Data.HashMap.Base.HashMap Data.Text.Internal.Text v)
- Text.Toml.Types: toBsJSON :: ToBsJSON a => a -> Value
- Text.Toml.Types: toEncoding :: ToJSON a => a -> Encoding
- Text.Toml.Types: toEncodingList :: ToJSON a => [a] -> Encoding
- Text.Toml.Types: toJSON :: ToJSON a => a -> Value
- Text.Toml.Types: toJSONList :: ToJSON a => [a] -> Value
+ Text.Toml.Types: instance Control.DeepSeq.NFData Text.Toml.Types.Node
+ Text.Toml.Types: instance GHC.Generics.Generic Text.Toml.Types.Node

Files

benchmarks/Benchmarks.hs view
@@ -1,12 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -import           Prelude        hiding (readFile)+import           Prelude         hiding (readFile)  import           Criterion.Main-import           Data.Text.IO   (readFile)+import           Data.Text.IO    (readFile)  import           Text.Toml+import           Text.Toml.Types () +eitherToMaybe :: Either a b -> Maybe b+eitherToMaybe Left{}    = Nothing+eitherToMaybe (Right x) = Just x  main :: IO () main = do
htoml-megaparsec.cabal view
@@ -1,5 +1,5 @@ name:                     htoml-megaparsec-version:                  1.0.0.4+version:                  1.0.1.0 synopsis:                 Parser for TOML files description:              TOML is an obvious and minimal format for config files.                           This package provides a TOML parser@@ -35,7 +35,7 @@                         , Text.Toml.Types   hs-source-dirs:         src   default-language:       Haskell2010-  build-depends:          base                   >= 4.3    && < 5+  build-depends:          base                   >= 4.8    && < 5                         , containers             >= 0.5                         , megaparsec             >= 6.0.0                         , unordered-containers   >= 0.2@@ -44,6 +44,7 @@                         , text                   >= 1.0    && < 2                         , mtl                    >= 2.2                         , composition-prelude    >= 0.1.1.0+                        , deepseq                         , time                   -any                         , old-locale             -any   if impl(ghc >= 8.0)@@ -55,6 +56,7 @@   ghc-options:            -Wall -threaded -rtsopts -with-rtsopts=-N   main-is:                Test.hs   other-modules:          BurntSushi+                        , JSON                         , Text.Toml.Parser.Spec   type:                   exitcode-stdio-1.0   default-language:       Haskell2010@@ -66,8 +68,7 @@                         , aeson                         , text                         , time-			  -- from here non-lib deps-                        , htoml+                        , htoml-megaparsec                         , bytestring                         , file-embed                         , tasty@@ -89,5 +90,5 @@                         , text                         , time 			  -- from here non-lib deps-                        , htoml+                        , htoml-megaparsec                         , criterion
src/Text/Toml.hs view
@@ -6,7 +6,6 @@ import           Text.Megaparsec import           Text.Toml.Parser - -- | Parse a 'Text' that results in 'Either' a 'String' -- containing the error message, or an internal representation -- of the document as a 'Table'.
src/Text/Toml/Parser.hs view
@@ -57,9 +57,9 @@ -- | Parses a table of key-value pairs. table :: (TomlM m) => Parser m Table table = do-    pairs <- try (many (assignment <* skipBlanks)) <|> (try skipBlanks >> return [])+    pairs <- (many (assignment <* skipBlanks) <|> (skipBlanks >> return []))     case maybeDupe (map fst pairs) of-      Just k  -> fail $ "Cannot redefine key " ++ (unpack k)+      Just k  -> fail $ "Cannot redefine key " ++ unpack k       Nothing -> return $ M.fromList pairs  -- | Parses an inline table of key-value pairs.@@ -150,8 +150,8 @@   boolean :: (TomlM m) => Parser m Node-boolean = VBoolean <$> ( (try . string $ "true")  *> return True  <|>-                         (try . string $ "false") *> return False )+boolean = VBoolean <$> ( (string $ "true")  *> return True  <|>+                         (string $ "false") *> return False )   anyStr :: (TomlM m) => Parser m Node@@ -164,7 +164,7 @@ basicStr :: (TomlM m) => Parser m Text basicStr = between dQuote dQuote (fmap pack $ many strChar)   where-    strChar = try escSeq <|> try (satisfy (\c -> c /= '"' && c /= '\\'))+    strChar = escSeq <|> noneOf ("\"\\" :: String) --satisfy (\c -> c /= '"' && c /= '\\'))     dQuote  = char '\"'  @@ -211,12 +211,12 @@ -- | Attoparsec 'double' parses scientific "e" notation; reimplement according to Toml spec. float :: (TomlM m) => Parser m Node float = VFloat <$> do-    n <- intStr <* lookAhead (satisfy (\c -> c == '.' || c == 'e' || c == 'E'))-    d <- (satisfy (== '.') *> uintStr) <|> return "0"-    e <- (satisfy (\c -> c == 'e' || c == 'E') *> intStr) <|> return "0"+    n <- intStr <* lookAhead (oneOf (".eE" :: String))+    d <- (char '.' *> uintStr) <|> return "0"+    e <- (oneOf ("eE" :: String) *> intStr) <|> return "0"     return . read . join $ [n, ".", d, "e", e]   where-    sign    = try (string "-") <|> (try (char '+') >> return "") <|> return ""+    sign    = string "-" <|> (char '+' >> return "") <|> return ""     uintStr = (:) <$> digitChar <*> many (optional (char '_') *> digitChar)     intStr  = do s <- T.unpack <$> sign                  u <- uintStr@@ -246,16 +246,16 @@ escSeq :: (TomlM m) => Parser m Char escSeq = char '\\' *> escSeqChar   where-    escSeqChar =  try (char '"')  *> return '"'-              <|> try (char '\\') *> return '\\'-              <|> try (char '/')  *> return '/'-              <|> try (char 'b')  *> return '\b'-              <|> try (char 't')  *> return '\t'-              <|> try (char 'n')  *> return '\n'-              <|> try (char 'f')  *> return '\f'-              <|> try (char 'r')  *> return '\r'-              <|> try (char 'u')  *> unicodeHex 4-              <|> try (char 'U')  *> unicodeHex 8+    escSeqChar =  (char '"')  *> return '"'+              <|> (char '\\') *> return '\\'+              <|> (char '/')  *> return '/'+              <|> (char 'b')  *> return '\b'+              <|> (char 't')  *> return '\t'+              <|> (char 'n')  *> return '\n'+              <|> (char 'f')  *> return '\f'+              <|> (char 'r')  *> return '\r'+              <|> (char 'u')  *> unicodeHex 4+              <|> (char 'U')  *> unicodeHex 8               <?> "escape character"  @@ -272,19 +272,21 @@  -- | Parser for signs (a plus or a minus). signed :: (Num a, TomlM m) => Parser m a -> Parser m a-signed p =  try (negate <$> (char '-' *> p))-        <|> try (char '+' *> p)-        <|> try p+signed p = (negate <$> (char '-' *> p))+        <|> (char '+' *> p)+        <|> p   -- | Parses the (rest of the) line including an EOF, whitespace and comments. skipBlanks :: (TomlM m) => Parser m () skipBlanks = skipMany blank   where-    blank   = try ((some $ satisfy isSpc) >> return ()) <|> try comment <|> try (void eol)-    comment = char '#' >> (many $ satisfy (/= '\n')) >> return ()+    blank   = try ((some $ satisfy isSpc) >> return ()) <|> comment <|> (void eol)+    comment = char '#' >> (many $ (noneOf ("\n" :: String))) >> return ()   -- | Results in 'True' for whitespace chars, tab or space, according to spec. isSpc :: Char -> Bool-isSpc c = c == ' ' || c == '\t'+isSpc ' '  = True+isSpc '\t' = True+isSpc _    = False
src/Text/Toml/Types.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds   #-}+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes        #-} @@ -13,19 +14,17 @@   , Explicitness (..)   , isExplicit   , insert-  , ToJSON (..)-  , ToBsJSON (..)   , Toml   , TomlM   , Parser   ) where  import           Control.Applicative       (Alternative)+import           Control.DeepSeq           (NFData) import           Control.Monad             (MonadPlus, join, when) import           Control.Monad.State       (State) import           Control.Monad.State.Class (MonadState, get, modify) import           Control.Monad.Trans       (lift)-import           Data.Aeson.Types          hiding (Parser) import           Data.HashMap.Strict       (HashMap) import qualified Data.HashMap.Strict       as M import           Data.Int                  (Int64)@@ -39,6 +38,7 @@ import           Data.Vector               (Vector) import qualified Data.Vector               as V import           Data.Void                 (Void)+import           GHC.Generics              (Generic) import           Text.Megaparsec           hiding (State)  type Parser m a = (MonadState (Set [Text]) m) => ParsecT Void Text m a@@ -69,7 +69,7 @@           | VBoolean  !Bool           | VDatetime !UTCTime           | VArray    !VArray-  deriving (Eq, Show)+  deriving (Eq, Show, Generic, NFData)  -- | To mark whether or not a 'Table' has been explicitly defined. -- See: https://github.com/toml-lang/toml/issues/376@@ -174,65 +174,3 @@     n = T.unpack $ T.intercalate "." name     w = case what of (VTable _) -> "tables"                      _          -> "array of tables"----- * Regular ToJSON instances---- | 'ToJSON' instances for the 'Node' type that produce Aeson (JSON)--- in line with the TOML specification.-instance ToJSON Node where-  toJSON (VTable v)    = toJSON v-  toJSON (VTArray v)   = toJSON v-  toJSON (VString v)   = toJSON v-  toJSON (VInteger v)  = toJSON v-  toJSON (VFloat v)    = toJSON v-  toJSON (VBoolean v)  = toJSON v-  toJSON (VDatetime v) = toJSON v-  toJSON (VArray v)    = toJSON v------ * Special BurntSushi ToJSON type class and instances---- | Type class for conversion to BurntSushi-style JSON.------ BurntSushi has made a language agnostic test suite available that--- this library uses. This test suit expects that values are encoded--- as JSON objects with a 'type' and a 'value' member.-class ToBsJSON a where-  toBsJSON :: a -> Value---- | Provide a 'toBsJSON' instance to the 'VTArray'.-instance (ToBsJSON a) => ToBsJSON (Vector a) where-  toBsJSON = Array . V.map toBsJSON-  {-# INLINE toBsJSON #-}---- | Provide a 'toBsJSON' instance to the 'NTable'.-instance (ToBsJSON v) => ToBsJSON (M.HashMap Text v) where-  toBsJSON = Object . M.map toBsJSON-  {-# INLINE toBsJSON #-}---- | 'ToBsJSON' instances for the 'TValue' type that produce Aeson (JSON)--- in line with BurntSushi's language agnostic TOML test suite.------ As seen in this function, BurntSushi's JSON encoding explicitly--- specifies the types of the values.-instance ToBsJSON Node where-  toBsJSON (VTable v)    = toBsJSON v-  toBsJSON (VTArray v)   = toBsJSON v-  toBsJSON (VString v)   = object [ "type"  .= toJSON ("string" :: String)-                                  , "value" .= toJSON v ]-  toBsJSON (VInteger v)  = object [ "type"  .= toJSON ("integer" :: String)-                                  , "value" .= toJSON (show v) ]-  toBsJSON (VFloat v)    = object [ "type"  .= toJSON ("float" :: String)-                                  , "value" .= toJSON (show v) ]-  toBsJSON (VBoolean v)  = object [ "type"  .= toJSON ("bool" :: String)-                                  , "value" .= toJSON (if v then "true" else "false" :: String) ]-  toBsJSON (VDatetime v) = object [ "type"  .= toJSON ("datetime" :: String)-                                  , "value" .= toJSON (let s = show v-                                                           z = take (length s - 4)  s ++ "Z"-                                                           d = take (length z - 10) z-                                                           t = drop (length z - 9)  z-                                                       in  d ++ "T" ++ t) ]-  toBsJSON (VArray v)    = object [ "type"  .= toJSON ("array" :: String)-                                  , "value" .= toBsJSON v ]
test/BurntSushi.hs view
@@ -3,6 +3,7 @@  module BurntSushi (tests) where +import           JSON import           Test.Tasty           (TestTree, testGroup) import           Test.Tasty.HUnit @@ -58,5 +59,5 @@           Right jsonCorrect -> assertEqual "" jsonCorrect (toBsJSON tomlTry)     assertParseFailure f tomlBS =       case parseTomlDoc "test" (decodeUtf8 tomlBS) of-        Left _ -> return ()+        Left _  -> return ()         Right _ -> assertFailure $ "Parser accepted invalid TOML file: " ++ f
+ test/JSON.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module JSON where++import           Data.Aeson.Types+import qualified Data.HashMap.Strict as M+import           Data.Text           (Text)+import           Data.Vector         (Vector)+import qualified Data.Vector         as V+import           Text.Toml.Types++-- * Regular ToJSON instances++-- | 'ToJSON' instances for the 'Node' type that produce Aeson (JSON)+-- in line with the TOML specification.+instance ToJSON Node where+  toJSON (VTable v)    = toJSON v+  toJSON (VTArray v)   = toJSON v+  toJSON (VString v)   = toJSON v+  toJSON (VInteger v)  = toJSON v+  toJSON (VFloat v)    = toJSON v+  toJSON (VBoolean v)  = toJSON v+  toJSON (VDatetime v) = toJSON v+  toJSON (VArray v)    = toJSON v++-- * Special BurntSushi ToJSON type class and instances++-- | Type class for conversion to BurntSushi-style JSON.+--+-- BurntSushi has made a language agnostic test suite available that+-- this library uses. This test suite expects that values are encoded+-- as JSON objects with a 'type' and a 'value' member.+class ToBsJSON a where+  toBsJSON :: a -> Value++-- | Provide a 'toBsJSON' instance to the 'VTArray'.+instance (ToBsJSON a) => ToBsJSON (Vector a) where+  toBsJSON = Array . V.map toBsJSON+  {-# INLINE toBsJSON #-}++-- | Provide a 'toBsJSON' instance to the 'NTable'.+instance (ToBsJSON v) => ToBsJSON (M.HashMap Text v) where+  toBsJSON = Object . M.map toBsJSON+  {-# INLINE toBsJSON #-}++-- | 'ToBsJSON' instances for the 'TValue' type that produce Aeson (JSON)+-- in line with BurntSushi's language agnostic TOML test suite.+--+-- As seen in this function, BurntSushi's JSON encoding explicitly+-- specifies the types of the values.+instance ToBsJSON Node where+  toBsJSON (VTable v)    = toBsJSON v+  toBsJSON (VTArray v)   = toBsJSON v+  toBsJSON (VString v)   = object [ "type"  .= toJSON ("string" :: String)+                                  , "value" .= toJSON v ]+  toBsJSON (VInteger v)  = object [ "type"  .= toJSON ("integer" :: String)+                                  , "value" .= toJSON (show v) ]+  toBsJSON (VFloat v)    = object [ "type"  .= toJSON ("float" :: String)+                                  , "value" .= toJSON (show v) ]+  toBsJSON (VBoolean v)  = object [ "type"  .= toJSON ("bool" :: String)+                                  , "value" .= toJSON (if v then "true" else "false" :: String) ]+  toBsJSON (VDatetime v) = object [ "type"  .= toJSON ("datetime" :: String)+                                  , "value" .= toJSON (let s = show v+                                                           z = take (length s - 4)  s ++ "Z"+                                                           d = take (length z - 10) z+                                                           t = drop (length z - 9)  z+                                                       in  d ++ "T" ++ t) ]+  toBsJSON (VArray v)    = object [ "type"  .= toJSON ("array" :: String)+                                  , "value" .= toBsJSON v ]