tomland: Bidirectional TOML serialization

[ configuration, library, mpl, text, toml ] [ Propose Tags ]

Implementation of bidirectional TOML serialization. Simple codecs look like this:

data User = User
    { userName :: Text
    , userAge  :: Int
    }

userCodec :: TomlCodec User
userCodec = User
    <$> Toml.text "name" .= userName
    <*> Toml.int  "age"  .= userAge

The following blog post has more details about library design:


[Skip to Readme]

Downloads

Note: This package has metadata revisions in the cabal description newer than included in the tarball. To unpack the package including the revisions, use 'cabal get'.

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

Versions [RSS] 0.0.0, 0.1.0, 0.2.0, 0.2.1, 0.3, 0.3.1, 0.4.0, 0.5.0, 1.0.0, 1.0.1.0, 1.1.0.0, 1.1.0.1, 1.2.0.0, 1.2.1.0, 1.3.0.0, 1.3.1.0, 1.3.2.0, 1.3.3.0, 1.3.3.1, 1.3.3.2
Change log CHANGELOG.md
Dependencies base (>=4.10 && <4.13), bytestring (>=0.10 && <0.11), containers (>=0.5.7 && <0.7), deepseq (>=1.4 && <1.5), hashable (>=1.2 && <1.3), megaparsec (>=7.0.1 && <7.1), mtl (>=2.2 && <2.3), parser-combinators, text (>=1.2 && <1.3), time (>=1.8 && <1.10), tomland, transformers (>=0.5 && <0.6), unordered-containers (>=0.2.7 && <0.3) [details]
License MPL-2.0
Copyright 2018-2019 Kowainik
Author Kowainik
Maintainer xrom.xkov@gmail.com
Revised Revision 1 made by shersh at 2019-01-22T07:53:47Z
Category TOML, Text, Configuration
Home page https://github.com/kowainik/tomland
Bug tracker https://github.com/kowainik/tomland/issues
Source repo head: git clone https://github.com/kowainik/tomland.git
Uploaded by shersh at 2019-01-14T15:05:34Z
Distributions Arch:1.3.3.2, NixOS:1.3.3.2
Reverse Dependencies 13 direct, 3 indirect [details]
Executables play-tomland, readme
Downloads 13674 total (149 in the last 30 days)
Rating 2.5 (votes: 4) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs uploaded by user [build log]
All reported builds failed as of 2019-01-14 [all 3 reports]

Readme for tomland-1.0.0

[back to package description]

tomland

palm Build status Hackage Stackage LTS Stackage Nightly MPL-2.0 license

“A library is like an island in the middle of a vast sea of ignorance, particularly if the library is very tall and the surrounding area has been flooded.”

― Lemony Snicket, Horseradish

Bidirectional TOML serialization. The following blog post has more details about library design:

This README contains a basic usage example of the tomland library. All code below can be compiled and run with the following command:

cabal new-run readme

Preamble: imports and language extensions

Since this is a literate haskell file, we need to specify all our language extensions and imports up front.

{-# OPTIONS -Wno-unused-top-binds #-}

{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative ((<|>))
import Control.Category ((>>>))
import Data.Text (Text)
import Toml (TomlBiMap, TomlCodec, (.=))

import qualified Data.Text.IO as TIO
import qualified Toml

tomland is mostly designed for qualified imports and intended to be imported as follows:

import Toml (TomlCodec, (.=))  -- add 'TomlBiMap' and 'Key' here optionally
import qualified Toml

Data type: parsing and printing

We're going to parse TOML configuration from examples/readme.toml file.

This static configuration is captured by the following Haskell data type:

data Settings = Settings
    { settingsPort        :: !Port
    , settingsDescription :: !Text
    , settingsCodes       :: [Int]
    , settingsMail        :: !Mail
    , settingsUsers       :: ![User]
    }

data Mail = Mail
    { mailHost           :: !Host
    , mailSendIfInactive :: !Bool
    }

data User
    = Admin  Integer  -- id of admin
    | Client Text     -- name of the client
    deriving (Show)

newtype Port = Port Int
newtype Host = Host Text

Using tomland library, you can write bidirectional converters for these types using the following guidelines and helper functions:

  1. If your fields are some simple basic types like Int or Text you can just use standard codecs like Toml.int and Toml.text.
  2. If you want to parse newtypes, use Toml.diwrap to wrap parsers for underlying newtype representation.
  3. For parsing nested data types, use Toml.table. But this requires to specify this data type as TOML table in .toml file.
  4. If you have lists of custom data types, use Toml.list. Such lists are represented as array of tables in TOML. If you have lists of primitive types like Int, Bool, Double, Text or time types, that you can use Toml.arrayOf and parse arrays of values.
  5. tomland separates conversion between Haskell types and TOML values from matching values by keys. Converters between types and values have type TomlBiMap and are named with capital letter started with underscore. Main type for TOML codecs is called TomlCodec. To lift TomlBiMap to TomlCodec you need to use Toml.match function.
settingsCodec :: TomlCodec Settings
settingsCodec = Settings
    <$> Toml.diwrap (Toml.int  "server.port")       .= settingsPort
    <*> Toml.text              "server.description" .= settingsDescription
    <*> Toml.arrayOf Toml._Int "server.codes"       .= settingsCodes
    <*> Toml.table mailCodec   "mail"               .= settingsMail
    <*> Toml.list  userCodec   "user"               .= settingsUsers

mailCodec :: TomlCodec Mail
mailCodec = Mail
    <$> Toml.diwrap (Toml.text "host") .= mailHost
    <*> Toml.bool "send-if-inactive"   .= mailSendIfInactive

_Admin :: TomlBiMap User Integer
_Admin = Toml.prism Admin $ \case
    Admin i -> Right i
    other   -> Toml.wrongConstructor "Admin" other

_Client :: TomlBiMap User Text
_Client = Toml.prism Client $ \case
    Client n -> Right n
    other    -> Toml.wrongConstructor "Client" other

userCodec :: TomlCodec User
userCodec =
        Toml.match (_Admin >>> Toml._Integer) "id"
    <|> Toml.match (_Client >>> Toml._Text) "name"

And now we're ready to parse our TOML and print the result back to see whether everything is okay.

main :: IO ()
main = do
    tomlExample <- TIO.readFile "examples/readme.toml"
    let res = Toml.decode settingsCodec tomlExample
    case res of
        Left err -> print err
        Right settings -> TIO.putStrLn $ Toml.encode settingsCodec settings

Benchmarks and comparison with other libraries

tomland is compared with other libraries. Since it uses 2-step approach with converting text to intermediate AST and only then decoding Haskell type from this AST, benchmarks are also implemented in a way to reflect this difference.

Library parse :: Text -> AST transform :: AST -> Haskell
tomland 387.5 μs 1.313 μs
htoml 801.2 μs 32.54 μs
htoml-megaparsec 318.7 μs 34.74 μs
toml-parser 157.2 μs 1.156 μs

You may see that tomland is not the fastest one (though still very fast). But performance hasn’t been optimized so far and:

  1. toml-parser doesn’t support the array of tables and because of that it’s hardly possible to specify the list of custom data types in TOML with this library.
  2. tomland supports latest TOML spec while htoml and htoml-megaparsec don’t have support for all types, values and formats.
  3. tomland is the only library that has pretty-printing.
  4. toml-parser doesn’t have ways to convert TOML AST to custom Haskell types and htoml* libraries use typeclasses-based approach via aeson library.
  5. tomland is bidirectional 🙂

Acknowledgement

Icons made by Freepik from www.flaticon.com is licensed by CC 3.0 BY.