diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright (c) 2023 Eric Mertens + +Permission to use, copy, modify, and/or distribute this software for any purpose +with or without fee is hereby granted, provided that the above copyright notice +and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH +REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, +INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER +TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF +THIS SOFTWARE. diff --git a/decoder/Main.hs b/decoder/Main.hs new file mode 100644 --- /dev/null +++ b/decoder/Main.hs @@ -0,0 +1,47 @@ +{-# Language OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-| +Module : Main +Description : Decoder driver for BurntSushi TOML test suite +Copyright : (c) Eric Mertens, 2023 +License : ISC +Maintainer : emertens@gmail.com + +Decode TOML into JSON for use with + +-} +module Main (main) where + +import Data.Aeson qualified as Aeson +import Data.ByteString.Lazy qualified as BS +import Data.Text qualified as Text +import Data.Text.IO qualified as Text +import Toml (Value(..), Value'(..), parse, Table'(..)) +import Toml.Pretty (prettyValue) + +main :: IO () +main = + do txt <- Text.getContents + case parse txt of + Left e -> fail e + Right t -> BS.putStr (Aeson.encode t) + +simple :: Aeson.Key -> String -> Aeson.Value +simple ty value = Aeson.object ["type" Aeson..= ty, "value" Aeson..= value] + +instance Aeson.ToJSON (Toml.Value' a) where + toJSON v = + case v of + Table' _ t -> Aeson.toJSON t + List' _ a -> Aeson.toJSON a + Text' _ s -> simple "string" (Text.unpack s) + Integer' _ _ -> simple "integer" (show (prettyValue v)) + Double' _ _ -> simple "float" (show (prettyValue v)) + Bool' _ _ -> simple "bool" (show (prettyValue v)) + TimeOfDay' _ _ -> simple "time-local" (show (prettyValue v)) + ZonedTime' _ _ -> simple "datetime" (show (prettyValue v)) + LocalTime' _ _ -> simple "datetime-local" (show (prettyValue v)) + Day' _ _ -> simple "date-local" (show (prettyValue v)) + +instance Aeson.ToJSON (Table' a) where + toJSON (MkTable t) = Aeson.toJSON (fmap snd t) diff --git a/encoder/Main.hs b/encoder/Main.hs new file mode 100644 --- /dev/null +++ b/encoder/Main.hs @@ -0,0 +1,61 @@ +{-# Language OverloadedStrings, TypeOperators, TypeFamilies #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-| +Module : Main +Description : Encoder driver for BurntSushi TOML test suite +Copyright : (c) Eric Mertens, 2023 +License : ISC +Maintainer : emertens@gmail.com + +Encode TOML into JSON for use with + +-} +module Main (main) where + +import Control.Applicative (empty) +import Data.Aeson qualified as Aeson +import Data.Aeson.Types qualified as Aeson +import Data.ByteString.Lazy qualified as BS +import Data.Foldable (toList) +import Data.Map qualified as Map +import Data.Text (Text) +import Data.Text qualified as Text +import System.Exit (exitFailure) +import Toml (prettyToml, Value(..), Value'(..), Table) +import Toml.Syntax.Lexer (lexValue, Token(..)) +import Toml.Schema (toValue) + +main :: IO () +main = + do txt <- BS.getContents + case Aeson.decode txt of + Just (Toml.Table t) -> putStr (show (prettyToml t)) + Nothing -> exitFailure + +instance a ~ () => Aeson.FromJSON (Toml.Value' a) where + parseJSON = + mconcat [ + Aeson.withArray "array" \xs -> + Toml.List <$> traverse Aeson.parseJSON (toList xs), + Aeson.withObject "value" \o -> + do ty <- o Aeson..: "type" + vl <- o Aeson..: "value" + decodeValue ty vl, + fmap (toValue :: Map.Map String Value -> Value) . Aeson.parseJSON + ] + +decodeValue :: String -> Text -> Aeson.Parser Toml.Value +decodeValue "string" x = pure (Toml.Text x) +decodeValue "bool" (lexValue -> Right TokTrue ) = pure (Toml.Bool True) +decodeValue "bool" (lexValue -> Right TokFalse ) = pure (Toml.Bool False) +decodeValue "integer" (lexValue -> Right (TokInteger x)) = pure (Toml.Integer x) +decodeValue "time-local" (lexValue -> Right (TokLocalTime x)) = pure (Toml.TimeOfDay x) +decodeValue "datetime" (lexValue -> Right (TokOffsetDateTime x)) = pure (Toml.ZonedTime x) +decodeValue "datetime-local" (lexValue -> Right (TokLocalDateTime x)) = pure (Toml.LocalTime x) +decodeValue "date-local" (lexValue -> Right (TokLocalDate x)) = pure (Toml.Day x) +decodeValue "float" (lexValue -> Right (TokFloat x)) = pure (Toml.Double x) +decodeValue "float" (lexValue -> Right (TokInteger x)) = pure (Toml.Double (fromInteger x)) +-- extra infinities as toml-tests are inconsistent +decodeValue "float" "+Inf" = pure (Toml.Double (1/0)) +decodeValue "float" "-Inf" = pure (Toml.Double (-1/0)) +decodeValue _ _ = empty diff --git a/highlighter/Main.hs b/highlighter/Main.hs new file mode 100644 --- /dev/null +++ b/highlighter/Main.hs @@ -0,0 +1,38 @@ +{-| +Module : Main +Description : Decoder driver for BurntSushi TOML test suite +Copyright : (c) Eric Mertens, 2023 +License : ISC +Maintainer : emertens@gmail.com + +Decode TOML into JSON for use with + +-} +module Main (main) where + +import Data.Text.IO qualified as Text +import Prettyprinter.Render.Terminal +import Toml +import Toml.Pretty (prettyLocated, prettyTomlOrdered) +import Toml.Syntax (parseRawToml) +import Toml.Semantics (semantics) +import Toml.Semantics.Ordered (extractTableOrder, projectKey) + +main :: IO () +main = + do txt <- Text.getContents + case parseRawToml txt of + Left e -> fail (prettyLocated e) + Right exprs -> + let to = extractTableOrder exprs in + case semantics exprs of + Left e -> fail (prettySemanticError e) + Right toml -> putDoc (style <$> prettyTomlOrdered (projectKey to) toml) + +style :: DocClass -> AnsiStyle +style TableClass = colorDull Yellow <> bold +style NumberClass = colorDull Cyan +style DateClass = colorDull Green +style StringClass = colorDull Red +style KeyClass = colorDull Blue +style BoolClass = colorDull Magenta diff --git a/toml-test-drivers.cabal b/toml-test-drivers.cabal new file mode 100644 --- /dev/null +++ b/toml-test-drivers.cabal @@ -0,0 +1,61 @@ +cabal-version: 3.0 +name: toml-test-drivers +version: 1.0.0.0 +synopsis: toml-parser test drivers +description: + Test executables for the toml-parser library. +license: ISC +license-file: LICENSE +author: Eric Mertens +maintainer: emertens@gmail.com +copyright: 2023 Eric Mertens +category: Text +build-type: Simple +tested-with: GHC == {8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.4, 9.8.1} + +source-repository head + type: git + location: https://github.com/glguy/toml-parser + tag: main + +common shared + default-language: Haskell2010 + default-extensions: + BlockArguments + DeriveTraversable + GeneralizedNewtypeDeriving + ImportQualifiedPost + LambdaCase + ScopedTypeVariables + ViewPatterns + build-depends: + base ^>= {4.14, 4.15, 4.16, 4.17, 4.18, 4.19}, + toml-parser ^>= 2.0.0.0, + +executable TomlDecoder + import: shared + hs-source-dirs: decoder + main-is: Main.hs + build-depends: + aeson ^>= {2.1, 2.2}, + bytestring ^>= {0.10, 0.11, 0.12}, + text, + +executable TomlEncoder + import: shared + hs-source-dirs: encoder + main-is: Main.hs + build-depends: + aeson ^>= {2.1, 2.2}, + bytestring ^>= {0.10, 0.11, 0.12}, + containers ^>= {0.5, 0.6}, + text, + +executable TomlHighlighter + import: shared + hs-source-dirs: highlighter + main-is: Main.hs + build-depends: + prettyprinter ^>= 1.7.1, + prettyprinter-ansi-terminal ^>= 1.1.3, + text,