htoml 0.2.0.1 → 1.0.0.0
raw patch · 6 files changed
+79/−58 lines, 6 files
Files
- CHANGES.md +3/−0
- README.md +1/−2
- htoml.cabal +1/−1
- src/Text/Toml/Parser.hs +5/−3
- src/Text/Toml/Types.hs +25/−17
- test/Text/Toml/Parser/Spec.hs +44/−35
CHANGES.md view
@@ -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)
README.md view
@@ -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
htoml.cabal view
@@ -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. .
src/Text/Toml/Parser.hs view
@@ -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
src/Text/Toml/Types.hs view
@@ -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
test/Text/Toml/Parser/Spec.hs view
@@ -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\" }"