From abb1ecfacdd338cb5088ef23739f0940f15c79b0 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 6 Jun 2022 20:08:07 -0700 Subject: [PATCH 1/6] Update README --- README.md | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 78 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 17fae2e..2039e60 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,32 @@ # toml-reader -TOML format parser compliant with v1.0.0. +[![](https://img.shields.io/github/workflow/status/brandonchinn178/toml-reader/CI/main)](https://github.com/brandonchinn178/toml-reader/actions) +[![](https://img.shields.io/codecov/c/gh/brandonchinn178/toml-reader)](https://app.codecov.io/gh/brandonchinn178/toml-reader) +[![](https://img.shields.io/hackage/v/toml-reader)](https://hackage.haskell.org/package/toml-reader) + +TOML format parser compliant with [v1.0.0](https://toml.io/en/v1.0.0) (verified with the [`toml-test`](https://github.com/BurntSushi/toml-test) tool). ## Usage -TODO +```hs +data MyConfig = MyConfig + { field1 :: Int + , field2 :: Bool + } + +instance DecodeTOML MyConfig where + tomlDecoder = + MyConfig + <$> getField "field1" + <*> getField "field2" + +main :: IO () +main = do + result <- decodeFile "config.toml" + case result of + Right cfg -> print (cfg :: MyConfig) + Left e -> print e +``` ## Design decisions @@ -26,3 +48,57 @@ TODO Since reading/writing isn't an idempotent operation, this library won't even pretend to provide `DecodeTOML`/`EncodeTOML` typeclasses that imply that they're inverses of each other. Hopefully some other `toml-writer` library may come along to make it easy to specify how to format your data in TOML (e.g. a combinator for `table` vs `inlineTable`), or you could use [`tomland`](https://github.com/kowainik/tomland). + +* This library defines `DecodeTOML` with an opaque `Decoder a` as opposed to a `Value -> DecodeM a` function, like `aeson` does. In my opinion, this makes the common case of decoding config files much more straightforward, especially around nested fields, which are much more common in TOML than JSON. e.g. + + ```hs + -- aeson-like + instance DecodeTOML MyConfig where + decodeTOML :: Value -> DecodeM MyConfig + decodeTOML = withObject "MyConfig" $ \o -> + MyConfig + <$> o .: "field1" + <*> (o .: "field2" >>= (.: "field3")) + ``` + + ```hs + -- with toml-parser + instance DecodeTOML MyConfig where + tomlDecoder :: Decoder MyConfig + tomlDecoder = + MyConfig + <$> getField "field1" + <*> getFields ["field2", "field3"] + ``` + + It also makes it easy to define ad-hoc decoders: + + ```hs + instance DecodeTOML MyConfig where + tomlDecoder = ... + + alternativeDecoder :: Decoder MyConfig + alternativeDecoder = ... + + -- uses tomlDecoder + decode "a = 1" + + -- uses explicit decoder + decodeWith alternativeDecoder "a = 1" + ``` + + As a bonus, it also makes for a less point-free interface when defining a decoder based on another decoder, which is kinda cool: + + ```hs + -- aeson-like + instance DecodeTOML MyString where + decodeTOML = fmap toMyString . decodeTOML + ``` + + ```hs + -- with toml-parser + instance DecodeTOML MyString where + tomlDecoder = toMyString <$> tomlDecoder + ``` + + Ultimately, `Decoder` is just a newtype around `Value -> DecodeM a`, so we could always go back to it. Originally, I wanted to do something like [`jordan`](https://hackage.haskell.org/package/jordan), where this interface is required due to the way it parses and deserializes at the same time, but this isn't possible with TOML due to the way TOML needs to be normalized. From 219c25ffefde114727307f1c7a5fc1a54580313e Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 6 Jun 2022 20:19:34 -0700 Subject: [PATCH 2/6] Update CI to allow forks --- .github/workflows/ci.yml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index ef1bc71..24442e3 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,5 +1,9 @@ name: CI -on: push +on: + pull_request: + push: + branches: + - main jobs: build_and_test: From 3642de09395800faedaa3d94d60dc1a3e352f555 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 6 Jun 2022 20:37:41 -0700 Subject: [PATCH 3/6] Add CHANGELOG --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 CHANGELOG.md diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..7da78a4 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## v0.1.0.0 + +Initial release From 906c2d773673682fda1c629b1976022bfb3697ca Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 6 Jun 2022 20:38:00 -0700 Subject: [PATCH 4/6] Add release workflow --- .github/workflows/ci.yml | 16 ++++ .github/workflows/release.yml | 42 +++++++++++ scripts/.gitignore | 1 + scripts/GetVersion.hs | 21 ++++++ scripts/make-release.sh | 11 +++ scripts/make_release.py | 133 ++++++++++++++++++++++++++++++++++ 6 files changed, 224 insertions(+) create mode 100644 .github/workflows/release.yml create mode 100644 scripts/.gitignore create mode 100755 scripts/GetVersion.hs create mode 100755 scripts/make-release.sh create mode 100644 scripts/make_release.py diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 24442e3..d851ac7 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -4,6 +4,7 @@ on: push: branches: - main + workflow_call: jobs: build_and_test: @@ -71,3 +72,18 @@ jobs: chmod +x /usr/local/bin/fourmolu - name: Run fourmolu run: fourmolu -m check $(git ls-files '*.hs') + + check_sdist: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - uses: actions/cache@v3 + with: + path: ~/.stack + key: ${{ runner.os }}-check_sdist-${{ hashFiles('stack.yaml') }} + - name: Create sdist bundle + run: stack sdist --test-tarball --tar-dir . + - uses: actions/upload-artifact@v3 + with: + name: toml-reader-sdist + path: toml-reader-*.tar.gz diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml new file mode 100644 index 0000000..1929511 --- /dev/null +++ b/.github/workflows/release.yml @@ -0,0 +1,42 @@ +name: Release +on: workflow_dispatch + +jobs: + ci: + uses: ./.github/workflows/ci.yml + + release: + runs-on: ubuntu-latest + needs: + - ci + + steps: + - uses: actions/checkout@v2 + with: + ref: main + + - uses: actions/download-artifact@v3 + with: + name: toml-reader-sdist + path: ./sdist/ + + - name: Load package version + run: scripts/GetVersion.hs + id: version_info + + - name: Load Hackage token secret name + run: | + import re + username = "${{ github.actor }}" + secret_name = "HACKAGE_TOKEN_" + re.sub(r"\W+", "_", username).upper() + print(f"::set-output name=secret_name::{secret_name}") + shell: python + id: hackage_token_secret + + - name: Make release + run: scripts/make-release.sh + env: + gh_token: ${{ secrets.GITHUB_TOKEN }} + hackage_token: ${{ secrets[steps.hackage_token_secret.outputs.secret_name] }} + version: ${{ steps.version_info.outputs.version }} + sdistdir: ./sdist/ diff --git a/scripts/.gitignore b/scripts/.gitignore new file mode 100644 index 0000000..1d17dae --- /dev/null +++ b/scripts/.gitignore @@ -0,0 +1 @@ +.venv diff --git a/scripts/GetVersion.hs b/scripts/GetVersion.hs new file mode 100755 index 0000000..27c2eb6 --- /dev/null +++ b/scripts/GetVersion.hs @@ -0,0 +1,21 @@ +#!/usr/bin/env stack +{- stack runghc --package Cabal -} + +import Data.List (intercalate) +import Distribution.Package (packageVersion) +import Distribution.PackageDescription.Parsec (readGenericPackageDescription) +import qualified Distribution.Verbosity as Verbosity +import Distribution.Version (versionNumbers) + +main :: IO () +main = do + packageDesc <- readGenericPackageDescription Verbosity.silent "toml-reader.cabal" + let version = intercalate "." . map show . versionNumbers . packageVersion $ packageDesc + setOutput "version" version + +{- | +Set output for a GitHub action. +https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions#setting-an-output-parameter +-} +setOutput :: String -> String -> IO () +setOutput name value = putStrLn $ "::set-output name=" ++ name ++ "::" ++ value diff --git a/scripts/make-release.sh b/scripts/make-release.sh new file mode 100755 index 0000000..705b833 --- /dev/null +++ b/scripts/make-release.sh @@ -0,0 +1,11 @@ +#!/usr/bin/env bash + +set -euxo pipefail +HERE="$(builtin cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" + +if [[ ! -d "${HERE}/.venv" ]]; then + python3 -m venv "${HERE}/.venv" + "${HERE}/.venv/bin/pip" install requests +fi + +exec "${HERE}/.venv/bin/python3" "${HERE}/make_release.py" "$@" diff --git a/scripts/make_release.py b/scripts/make_release.py new file mode 100644 index 0000000..e1d8d52 --- /dev/null +++ b/scripts/make_release.py @@ -0,0 +1,133 @@ +# pyright: strict, reportUnknownMemberType=false + +from __future__ import annotations + +import itertools +import json +import logging +import os +import requests +from pathlib import Path +from typing import Any + +logger = logging.getLogger(__name__) +logging.basicConfig(level=logging.DEBUG) + + +def main(): + gh_token = os.environ["gh_token"] + hackage_token = os.environ["hackage_token"] + version = os.environ["version"] + sdistdir = os.environ["sdistdir"] + repo = os.environ["GITHUB_REPOSITORY"] + sha = os.environ["GITHUB_SHA"] + + version_name = f"v{version}" + + # check inputs + if not hackage_token: + raise Exception( + "Hackage token is not provided (did you add a Secret of the form HACKAGE_TOKEN_?)" + ) + + # ensure release files exist + sdist_archive = Path(sdistdir) / f"toml-reader-{version}.tar.gz" + if not sdist_archive.exists(): + raise Exception(f"File does not exist: {sdist_archive}") + + logger.info(f"Creating release {version_name}") + + # check + parse CHANGELOG + changelog = Path("CHANGELOG.md").read_text() + if not changelog.startswith(f"## {version_name}"): + raise Exception("CHANGELOG doesn't look updated") + version_changes = get_version_changes(changelog) + + create_github_release( + repo=repo, + token=gh_token, + sha=sha, + version_name=version_name, + version_changes=version_changes, + ) + + # uploading as candidate because uploads are irreversible, unlike + # GitHub releases, so just to be extra sure, we'll upload this as + # a candidate and manually confirm uploading the package on Hackage + upload_hackage_candidate( + token=hackage_token, + archive=sdist_archive, + ) + + logger.info(f"Released toml-reader {version_name}!") + + +def get_version_changes(changelog: str) -> str: + lines = changelog.split("\n") + + # skip initial '## vX.Y.Z' line + lines = lines[1:] + + # take lines until the next '## vX.Y.Z' line + lines = itertools.takewhile(lambda line: not line.startswith("## v"), lines) + + return "\n".join(lines) + + +def create_github_release( + *, + repo: str, + token: str, + sha: str, + version_name: str, + version_changes: str, +): + session = init_session() + session.headers["Accept"] = "application/vnd.github.v3+json" + session.headers["Authorization"] = f"token {token}" + session.headers["User-Agent"] = repo + + payload = { + "tag_name": version_name, + "target_commitish": sha, + "name": version_name, + "body": version_changes, + } + logger.debug(f"Creating release with: {json.dumps(payload)}") + + session.post( + f"https://api.github.com/repos/{repo}/releases", + json=payload, + ) + + +def upload_hackage_candidate( + *, + token: str, + archive: Path, +): + session = init_session() + with archive.open("rb") as f: + session.post( + "https://hackage.haskell.org/packages/candidates", + headers={"Authorization": f"X-ApiKey {token}"}, + files={"package": f}, + ) + + +def init_session() -> requests.Session: + session = requests.Session() + + def _check_status(r: requests.Response, *args: Any, **kwargs: Any): + r.raise_for_status() + + # https://github.com/python/typeshed/issues/7776 + session.hooks["response"].append( # pyright: ignore[reportFunctionMemberAccess] + _check_status, + ) + + return session + + +if __name__ == "__main__": + main() From 6c0e23c62573f85d41d411f6ded4bc81ed5cf8aa Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 6 Jun 2022 21:48:23 -0700 Subject: [PATCH 5/6] Move TODOs to GitHub issues --- test/tasty/Main.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/tasty/Main.hs b/test/tasty/Main.hs index d097e0f..70ab887 100644 --- a/test/tasty/Main.hs +++ b/test/tasty/Main.hs @@ -9,8 +9,6 @@ main :: IO () main = defaultMain $ testGroup "toml-reader" $ - -- TODO: test megaparsec error messages - -- TODO: test normalize error messages [ TOML.Utils.MapTest.test , TOML.Utils.NonEmptyTest.test , TOML.ErrorTest.test From 3d09ec9b72db229c60e2cafa3cc32225f744504d Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 6 Jun 2022 22:44:56 -0700 Subject: [PATCH 6/6] Update Haddocks --- src/TOML.hs | 1 - src/TOML/Decode.hs | 153 ++++++++++++++++++++++++++++++++++++++++++--- src/TOML/Parser.hs | 8 ++- 3 files changed, 153 insertions(+), 9 deletions(-) diff --git a/src/TOML.hs b/src/TOML.hs index 0e0d7f2..531b1e2 100644 --- a/src/TOML.hs +++ b/src/TOML.hs @@ -24,7 +24,6 @@ module TOML ( invalidValue, typeMismatch, decodeFail, - decodeError, -- * TOML types Value (..), diff --git a/src/TOML/Decode.hs b/src/TOML/Decode.hs index bccac4f..3008489 100644 --- a/src/TOML/Decode.hs +++ b/src/TOML/Decode.hs @@ -33,6 +33,7 @@ module TOML.Decode ( DecodeM (..), makeDecoder, runDecoder, + addContextItem, invalidValue, typeMismatch, decodeFail, @@ -89,6 +90,32 @@ import TOML.Value (Value (..)) {--- Decoder ---} +{- | +A @Decoder a@ represents a function for decoding a TOML value to a value of type @a@. + +Generally, you'd only need to chain the @getField*@ functions together, like + +@ +decoder = + MyConfig + \<$> getField "a" + \<*> getField "b" + \<*> getField "c" +@ + +or use interfaces like 'Monad' and 'Alternative': + +@ +decoder = do + cfgType <- getField "type" + case cfgType of + "int" -> MyIntValue \<$> (getField "int" \<|> getField "integer") + "bool" -> MyBoolValue \<$> getField "bool" + _ -> fail $ "Invalid type: " <> cfgType +@ + +but you can also manually implement a 'Decoder' with 'makeDecoder'. +-} newtype Decoder a = Decoder {unDecoder :: Value -> DecodeM a} instance Functor Decoder where @@ -115,12 +142,14 @@ instance MonadFail.MonadFail Decoder where fail msg = Decoder $ \_ -> decodeFail $ Text.pack msg #endif +-- | Manually implement a 'Decoder' with the given function. makeDecoder :: (Value -> DecodeM a) -> Decoder a makeDecoder = Decoder decoderToEither :: Decoder a -> Value -> DecodeContext -> Either (DecodeContext, DecodeError) a decoderToEither decoder v ctx = unDecodeM (unDecoder decoder v) ctx +-- | The underlying decoding monad that either returns a value of type @a@ or returns an error. newtype DecodeM a = DecodeM {unDecodeM :: DecodeContext -> Either (DecodeContext, DecodeError) a} instance Functor DecodeM where @@ -150,18 +179,62 @@ instance MonadFail.MonadFail DecodeM where fail = decodeFail . Text.pack #endif +{- | +Run a 'Decoder' with the given 'Value'. + +@ +makeDecoder $ \\v -> do + a <- runDecoder decoder1 v + b <- runDecoder decoder2 v + return (a, b) +@ + +Satisfies + +@ +makeDecoder . runDecoder === id +runDecoder . makeDecoder === id +@ +-} runDecoder :: Decoder a -> Value -> DecodeM a runDecoder decoder v = DecodeM (decoderToEither decoder v) +{- | +Throw an error indicating that the given 'Value' is invalid. + +@ +makeDecoder $ \\v -> + case v of + Integer 42 -> invalidValue "We don't like this number" v + _ -> runDecoder tomlDecoder v + +-- or alternatively, +tomlDecoder >>= \case + 42 -> makeDecoder $ invalidValue "We don't like this number" + v -> pure v +@ +-} invalidValue :: Text -> Value -> DecodeM a invalidValue msg v = decodeError $ InvalidValue msg v +{- | +Throw an error indicating that the given 'Value' isn't the correct type of value. + +@ +makeDecoder $ \\v -> + case v of + String s -> ... + _ -> typeMismatch v +@ +-} typeMismatch :: Value -> DecodeM a typeMismatch v = decodeError $ TypeMismatch v +-- | Throw a generic failure message. decodeFail :: Text -> DecodeM a decodeFail msg = decodeError $ OtherDecodeError msg +-- | Throw the given 'DecodeError'. decodeError :: DecodeError -> DecodeM a decodeError e = DecodeM $ \ctx -> Left (ctx, e) @@ -170,11 +243,11 @@ addContextItem p m = DecodeM $ \ctx -> unDecodeM m (ctx <> [p]) {--- Decoding ---} --- | Decode the given TOML input using the given DecodeTOML instance. +-- | Decode the given TOML input. decode :: DecodeTOML a => Text -> Either TOMLError a decode = decodeWith tomlDecoder --- | Decode the given TOML input using the given Decoder. +-- | Decode the given TOML input using the given 'Decoder'. decodeWith :: Decoder a -> Text -> Either TOMLError a decodeWith decoder = decodeWithOpts decoder "" @@ -183,7 +256,7 @@ decodeWithOpts decoder filename input = do v <- parseTOML filename input first (uncurry DecodeError) $ decoderToEither decoder v [] --- | A helper for decoding a file at the given file path. +-- | Decode a TOML file at the given file path. decodeFile :: DecodeTOML a => FilePath -> IO (Either TOMLError a) decodeFile fp = decodeWithOpts tomlDecoder fp <$> Text.readFile fp @@ -192,26 +265,56 @@ decodeFile fp = decodeWithOpts tomlDecoder fp <$> Text.readFile fp {- | Decode a field in a TOML Value. Equivalent to 'getFields' with a single-element list. + +@ +a = 1 +b = 'asdf' +@ + +@ +-- MyConfig 1 "asdf" +MyConfig \<$> getField "a" \<*> getField "b" +@ -} getField :: DecodeTOML a => Text -> Decoder a getField = getFieldWith tomlDecoder --- | Same as 'getField', except with the provided 'Decoder'. +-- | Same as 'getField', except with the given 'Decoder'. getFieldWith :: Decoder a -> Text -> Decoder a getFieldWith decoder key = getFieldsWith decoder [key] {- | Decode a field in a TOML Value, or Nothing if the field doesn't exist. Equivalent to 'getFieldsOpt' with a single-element list. + +@ +a = 1 +@ + +@ +-- MyConfig (Just 1) Nothing +MyConfig \<$> getFieldOpt "a" \<*> getFieldOpt "b" +@ -} getFieldOpt :: DecodeTOML a => Text -> Decoder (Maybe a) getFieldOpt = getFieldOptWith tomlDecoder --- | Same as 'getFieldOpt', except with the provided 'Decoder'. +-- | Same as 'getFieldOpt', except with the given 'Decoder'. getFieldOptWith :: Decoder a -> Text -> Decoder (Maybe a) getFieldOptWith decoder key = getFieldsOptWith decoder [key] --- | Decode a nested field in a TOML Value. +{- | +Decode a nested field in a TOML Value. + +@ +a.b = 1 +@ + +@ +-- MyConfig 1 +MyConfig \<$> getFields ["a", "b"] +@ +-} getFields :: DecodeTOML a => [Text] -> Decoder a getFields = getFieldsWith tomlDecoder @@ -229,7 +332,21 @@ getFieldsWith decoder = makeDecoder . go Nothing -> decodeError MissingField _ -> typeMismatch v --- | Decode a nested field in a TOML Value, or Nothing if any of the fields don't exist. +{- | +Decode a nested field in a TOML Value, or 'Nothing' if any of the fields don't exist. + +@ +a.b = 1 +@ + +@ +-- MyConfig (Just 1) Nothing Nothing +MyConfig + \<$> getFieldsOpt ["a", "b"] + \<*> getFieldsOpt ["a", "c"] + \<*> getFieldsOpt ["b", "c"] +@ +-} getFieldsOpt :: DecodeTOML a => [Text] -> Decoder (Maybe a) getFieldsOpt = getFieldsOptWith tomlDecoder @@ -243,6 +360,23 @@ getFieldsOptWith decoder keys = Left (ctx', e) -> Left (ctx', e) Right x -> Right $ Just x +{- | +Decode a list of values using the given 'Decoder'. + +@ +[[a]] +b = 1 + +[[a]] +b = 2 +@ + +@ +-- MyConfig [1, 2] +MyConfig + \<$> getFieldWith (getArrayOf (getField "b")) "a" +@ +-} getArrayOf :: Decoder a -> Decoder [a] getArrayOf decoder = makeDecoder $ \case @@ -251,6 +385,11 @@ getArrayOf decoder = {--- DecodeTOML ---} +{- | +A type class containing the default 'Decoder' for the given type. + +See the docs for 'Decoder' for examples. +-} class DecodeTOML a where tomlDecoder :: Decoder a diff --git a/src/TOML/Parser.hs b/src/TOML/Parser.hs index 9cc9c0a..c43bf03 100644 --- a/src/TOML/Parser.hs +++ b/src/TOML/Parser.hs @@ -9,6 +9,7 @@ Parse a TOML document. References: + * https://toml.io/en/v1.0.0 * https://github.com/toml-lang/toml/blob/1.0.0/toml.abnf -} @@ -42,7 +43,12 @@ import TOML.Error (NormalizeError (..), TOMLError (..)) import TOML.Utils.Map (getPathLens) import TOML.Value (Table, Value (..)) -parseTOML :: String -> Text -> Either TOMLError Value +parseTOML :: + -- | Name of file (for error messages) + String -> + -- | Input + Text -> + Either TOMLError Value parseTOML filename input = case runParser parseTOMLDocument filename input of Left e -> Left $ ParseError $ Text.pack $ errorBundlePretty e