diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,9 @@ #### dev * ... +### 1.0.0.0 +* Use `Vector` over `List` internally, as per discussion in [issue 13](https://github.com/cies/htoml/issues/13) + ### 0.2.0.1 * Expose `ToJSON` implementation * Remove unused .cabal dependency (thanks @tmcgilchrist) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -176,17 +176,16 @@ * Fails on mix-type arrays (as per spec) * Comes with a benchmark suite to make performance gains/regressions measurable * Tries to be well documented (please raise an issue if you find documentation lacking) +* Available on [Stackage](http://stackage.org) (nightlies for far -- 10 may 2016) ### Todo -* Release a stable 1.0 release and submit it to [Stackage](http://stackage.org) * Once 1.0 is out, keep a compatibility chart showing which versions of htoml are compatible with which versions of the TOML spec * More documentation * Add property tests with QuickCheck (the internet says it's possible for parsers) * Extensively test error cases -* Try using `Vector` instead of `List` (measure performance increase with the benchmarks) * See how lenses may (or may not) fit into this package, or an additional package * Consider moving to [one of the more modern parser combinators](https://www.reddit.com/r/haskell/comments/46u45o/what_is_the_current_state_of_parser_libraries_in) in Haskell (`megaparsec` maybe?) -- possibly wait until a clear winner shows diff --git a/htoml.cabal b/htoml.cabal --- a/htoml.cabal +++ b/htoml.cabal @@ -1,5 +1,5 @@ name: htoml -version: 0.2.0.1 +version: 1.0.0.0 synopsis: Parser for TOML files description: TOML is an obvious and minimal format for config files. . diff --git a/src/Text/Toml/Parser.hs b/src/Text/Toml/Parser.hs --- a/src/Text/Toml/Parser.hs +++ b/src/Text/Toml/Parser.hs @@ -15,6 +15,7 @@ import qualified Data.List as L import qualified Data.Set as S import Data.Text (Text, pack, unpack) +import qualified Data.Vector as V #if MIN_VERSION_time(1,5,0) import Data.Time.Format (defaultTimeLocale, iso8601DateFormat, @@ -90,8 +91,8 @@ skipBlanks tbl <- table skipBlanks - return $ case eitherHdr of Left ns -> (ns, VTable tbl ) - Right ns -> (ns, VTArray [tbl]) + return $ case eitherHdr of Left ns -> (ns, VTable tbl ) + Right ns -> (ns, VTArray $ V.singleton tbl) -- | Parses a table header. @@ -234,7 +235,8 @@ -- | Parses the elements of an array, while restricting them to a certain type. arrayOf :: Parser Node -> Parser Node -arrayOf p = VArray <$> between (char '[') (char ']') (skipBlanks *> separatedValues) +arrayOf p = (VArray . V.fromList) <$> + between (char '[') (char ']') (skipBlanks *> separatedValues) where separatedValues = sepEndBy (skipBlanks *> try p <* skipBlanks) comma <* skipBlanks comma = skipBlanks >> char ',' >> skipBlanks diff --git a/src/Text/Toml/Types.hs b/src/Text/Toml/Types.hs --- a/src/Text/Toml/Types.hs +++ b/src/Text/Toml/Types.hs @@ -4,6 +4,8 @@ module Text.Toml.Types ( Table , emptyTable + , VTArray + , VArray , Node (..) , Explicitness (..) , isExplicit @@ -15,6 +17,7 @@ import Control.Monad (when) import Text.Parsec import Data.Aeson.Types +import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as M import Data.Int (Int64) import Data.List (intersect) @@ -24,25 +27,32 @@ import qualified Data.Text as T import Data.Time.Clock (UTCTime) import Data.Time.Format () +import Data.Vector (Vector) import qualified Data.Vector as V --- | The 'Table' is a mapping ('HashMap') of 'Text' keys to 'Node' values. -type Table = M.HashMap Text Node +-- | The TOML 'Table' is a mapping ('HashMap') of 'Text' keys to 'Node' values. +type Table = HashMap Text Node -- | Contruct an empty 'Table'. emptyTable :: Table emptyTable = M.empty --- | A 'Node' may contain any type of value that can put in a 'VArray'. -data Node = VTable Table - | VTArray [Table] +-- | An array of 'Table's, implemented using a 'Vector'. +type VTArray = Vector Table + +-- | A \"value\" array that may contain zero or more 'Node's, implemented using a 'Vector'. +type VArray = Vector Node + +-- | A 'Node' may contain any type of value that may be put in a 'VArray'. +data Node = VTable !Table + | VTArray !VTArray | VString !Text | VInteger !Int64 | VFloat !Double | VBoolean !Bool | VDatetime !UTCTime - | VArray [Node] + | VArray !VArray deriving (Eq, Show) -- | To mark whether or not a 'Table' has been explicitly defined. @@ -74,7 +84,7 @@ return $ M.insert name (VTable r) ttbl _ -> commonInsertError node [name] Just (VTArray a) -> case node of - (VTArray na) -> return $ M.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 = @@ -88,11 +98,11 @@ r <- insert Implicit (ns, node) t when (isExplicit ex) $ updateExStateOrError fullName node return $ M.insert name (VTable r) ttbl - Just (VTArray []) -> - parserFail "FATAL: Call to 'insert' found impossibly empty VArray." - Just (VTArray a) -> do - r <- insert Implicit (ns, node) (last a) - return $ M.insert name (VTArray $ (init a) ++ [r]) ttbl + Just (VTArray a) -> + if V.null a + then parserFail "FATAL: Call to 'insert' found impossibly empty VArray." + else do r <- insert Implicit (ns, node) (V.last a) + return $ M.insert name (VTArray $ (V.init a) `V.snoc` r) ttbl Just _ -> commonInsertError node fullName @@ -173,12 +183,10 @@ class ToBsJSON a where toBsJSON :: a -> Value - --- | Provide a 'toBsJSON' instance to the 'NTArray'. -instance (ToBsJSON a) => ToBsJSON [a] where - toBsJSON = Array . V.fromList . map toBsJSON +-- | 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 diff --git a/test/Text/Toml/Parser/Spec.hs b/test/Text/Toml/Parser/Spec.hs --- a/test/Text/Toml/Parser/Spec.hs +++ b/test/Text/Toml/Parser/Spec.hs @@ -8,10 +8,18 @@ import Data.HashMap.Strict (fromList) import Data.Time.Calendar (Day (..)) import Data.Time.Clock (UTCTime (..)) +import qualified Data.Vector as V import Text.Toml.Parser +mkVTArray :: [Table] -> Node +mkVTArray = VTArray . V.fromList + +mkVArray :: [Node] -> Node +mkVArray = VArray . V.fromList + + tomlParserSpec :: IO TestTree tomlParserSpec = testSpec "Parser Hspec suite" $ do @@ -69,34 +77,34 @@ it "should parse a simple empty table array" $ testParser tomlDoc "[[a]]\n[[a]]" $ - fromList [("a", VTArray [ fromList [] - , fromList [] ] )] + fromList [("a", mkVTArray [ fromList [] + , fromList [] ] )] it "should parse a simple table array with content" $ testParser tomlDoc "[[a]]\na1=1\n[[a]]\na2=2" $ - fromList [("a", VTArray [ fromList [("a1", VInteger 1)] - , fromList [("a2", VInteger 2)] ] )] + fromList [("a", mkVTArray [ fromList [("a1", VInteger 1)] + , fromList [("a2", VInteger 2)] ] )] it "should not allow a simple table array to be inserted into a non table array" $ testParserFails tomlDoc "a = [1,2,3]\n[[a]]" it "should parse a simple empty nested table array" $ testParser tomlDoc "[[a.b]]\n[[a.b]]" $ - fromList [("a", VTable (fromList [("b", VTArray [ emptyTable - , emptyTable ] )] ) )] + fromList [("a", VTable (fromList [("b", mkVTArray [ emptyTable + , emptyTable ] )] ) ) ] it "should parse a simple non empty table array" $ testParser tomlDoc "[[a.b]]\na1=1\n[[a.b]]\na2=2" $ - fromList [("a", VTable (fromList [("b", VTArray [ fromList [("a1", VInteger 1)] - , fromList [("a2", VInteger 2)] - ] )] ) )] + fromList [("a", VTable (fromList [("b", mkVTArray [ fromList [("a1", VInteger 1)] + , fromList [("a2", VInteger 2)] + ] )] ) )] it "should parse redefined implicit table header" $ testParserFails tomlDoc "[[a.b]]\n[[a]]" it "should parse redefinition by implicit table header" $ testParser tomlDoc "[[a]]\n[[a.b]]" $ - fromList [("a", VTArray [ fromList [("b", VTArray [ fromList [] ])] ] )] + fromList [("a", mkVTArray [ fromList [("b", mkVTArray [ fromList [] ])] ] )] describe "Parser.tomlDoc (mixed named tables and tables arrays)" $ do @@ -112,26 +120,26 @@ it "should parse redefined implicit table header (array by table)" $ testParser tomlDoc "[[a.b]]\n[a]" $ - fromList [("a", VTable (fromList [("b", VTArray [ fromList [] ])] ) )] + fromList [("a", VTable (fromList [("b", mkVTArray [ fromList [] ])] ) )] it "should not parse redefined implicit table header (array by table), when keys collide" $ testParserFails tomlDoc "[[a.b]]\n[a]\nb=1" it "should insert sub-key of regular table in most recently defined table array" $ testParser tomlDoc "[[a]]\ni=0\n[[a]]\ni=1\n[a.b]" $ - fromList [("a", VTArray [ fromList [ ("i", VInteger 0) ] - , fromList [ ("b", VTable $ fromList [] ) - , ("i", VInteger 1) ] - ] )] + fromList [("a", mkVTArray [ fromList [ ("i", VInteger 0) ] + , fromList [ ("b", VTable $ fromList [] ) + , ("i", VInteger 1) ] + ] )] it "should insert sub-key of table array" $ testParser tomlDoc "[a]\n[[a.b]]" $ - fromList [("a", VTable (fromList [("b", VTArray [fromList []])] ) )] + fromList [("a", VTable (fromList [("b", mkVTArray [fromList []])] ) )] it "should insert sub-key (with content) of table array" $ testParser tomlDoc "[a]\nq=42\n[[a.b]]\ni=0" $ fromList [("a", VTable (fromList [ ("q", VInteger 42), - ("b", VTArray [ + ("b", mkVTArray [ fromList [("i", VInteger 0)] ]) ]) )] @@ -349,66 +357,66 @@ describe "Parser.tomlDoc arrays" $ do it "should parse an empty array" $ - testParser array "[]" $ VArray [] + testParser array "[]" $ mkVArray [] it "should parse an empty array with whitespace" $ - testParser array "[ ]" $ VArray [] + testParser array "[ ]" $ mkVArray [] it "should not parse an empty array with only a terminating comma" $ testParserFails array "[,]" it "should parse an empty array of empty arrays" $ - testParser array "[[],[]]" $ VArray [ VArray [], VArray [] ] + testParser array "[[],[]]" $ mkVArray [ mkVArray [], mkVArray [] ] it "should parse an empty array of empty arrays with whitespace" $ - testParser array "[ \n[ ]\n ,\n [ \n ] ,\n ]" $ VArray [ VArray [], VArray [] ] + testParser array "[ \n[ ]\n ,\n [ \n ] ,\n ]" $ mkVArray [ mkVArray [], mkVArray [] ] it "should parse nested arrays" $ testParser assignment "d = [ ['gamma', 'delta'], [1, 2] ]" - $ ("d", VArray [ VArray [ VString "gamma" - , VString "delta" ] - , VArray [ VInteger 1 - , VInteger 2 ] ]) + $ ("d", mkVArray [ mkVArray [ VString "gamma" + , VString "delta" ] + , mkVArray [ VInteger 1 + , VInteger 2 ] ]) it "should allow linebreaks in an array" $ testParser assignment "hosts = [\n'alpha',\n'omega'\n]" - $ ("hosts", VArray [VString "alpha", VString "omega"]) + $ ("hosts", mkVArray [VString "alpha", VString "omega"]) it "should allow some linebreaks in an array" $ testParser assignment "hosts = ['alpha' ,\n'omega']" - $ ("hosts", VArray [VString "alpha", VString "omega"]) + $ ("hosts", mkVArray [VString "alpha", VString "omega"]) it "should allow linebreaks in an array, with comments" $ testParser assignment "hosts = [\n\ \'alpha', # the first\n\ \'omega' # the last\n\ \]" - $ ("hosts", VArray [VString "alpha", VString "omega"]) + $ ("hosts", mkVArray [VString "alpha", VString "omega"]) it "should allow linebreaks in an array, with comments, and terminating comma" $ testParser assignment "hosts = [\n\ \'alpha', # the first\n\ \'omega', # the last\n\ \]" - $ ("hosts", VArray [VString "alpha", VString "omega"]) + $ ("hosts", mkVArray [VString "alpha", VString "omega"]) it "inside an array, all element should be of the same type" $ testParserFails array "[1, 2.0]" it "inside an array of arrays, this inner arrays may contain values of different types" $ testParser array "[[1], [2.0], ['a']]" $ - VArray [ VArray [VInteger 1], VArray [VFloat 2.0], VArray [VString "a"] ] + mkVArray [ mkVArray [VInteger 1], mkVArray [VFloat 2.0], mkVArray [VString "a"] ] it "all string variants are of the same type of the same type" $ testParser assignment "data = [\"a\", \"\"\"b\"\"\", 'c', '''d''']" $ - ("data", VArray [ VString "a", VString "b", - VString "c", VString "d" ]) + ("data", mkVArray [ VString "a", VString "b", + VString "c", VString "d" ]) it "should parse terminating commas in arrays" $ - testParser array "[1, 2, ]" $ VArray [ VInteger 1, VInteger 2 ] + testParser array "[1, 2, ]" $ mkVArray [ VInteger 1, VInteger 2 ] it "should parse terminating commas in arrays(2)" $ - testParser array "[1,2,]" $ VArray [ VInteger 1, VInteger 2 ] + testParser array "[1,2,]" $ mkVArray [ VInteger 1, VInteger 2 ] describe "Parser.tomlDoc inline tables" $ do @@ -416,7 +424,8 @@ testParser inlineTable "{}" $ VTable (fromList []) it "should parse simple inline tables" $ - testParser inlineTable "{ a = 8 , b = \"things\" }" $ VTable (fromList [ ("a" , VInteger 8) , ("b", VString "things") ]) + testParser inlineTable "{ a = 8 , b = \"things\" }" $ + VTable (fromList [ ("a" , VInteger 8) , ("b", VString "things") ]) it "should not parse simple inline tables with newline " $ testParserFails inlineTable "{ a = 8 , \n b = \"things\" }"