dhall-toml (empty) → 1.0.0
raw patch · 46 files changed
+1196/−0 lines, 46 filesdep +basedep +containersdep +dhall
Dependencies added: base, containers, dhall, dhall-toml, directory, doctest, filepath, prettyprinter, tasty, tasty-hunit, text, tomland, unordered-containers
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- README.md +31/−0
- dhall-to-toml/Main.hs +6/−0
- dhall-toml.cabal +94/−0
- doctest/Main.hs +14/−0
- src/Dhall/DhallToToml.hs +364/−0
- src/Dhall/Toml/Utils.hs +43/−0
- src/Dhall/TomlToDhall.hs +314/−0
- tasty/Main.hs +113/−0
- tasty/data/adjacent-tables-schema.dhall +13/−0
- tasty/data/adjacent-tables.dhall +12/−0
- tasty/data/adjacent-tables.toml +9/−0
- tasty/data/empty-schema.dhall +1/−0
- tasty/data/empty.dhall +1/−0
- tasty/data/empty.toml +0/−0
- tasty/data/float-schema.dhall +3/−0
- tasty/data/float.dhall +3/−0
- tasty/data/float.toml +1/−0
- tasty/data/inline-list-schema.dhall +11/−0
- tasty/data/inline-list.dhall +11/−0
- tasty/data/inline-list.toml +10/−0
- tasty/data/multiple-fields-schema.dhall +5/−0
- tasty/data/multiple-fields.dhall +5/−0
- tasty/data/multiple-fields.toml +3/−0
- tasty/data/natural-schema.dhall +1/−0
- tasty/data/natural.dhall +1/−0
- tasty/data/natural.toml +1/−0
- tasty/data/nested-tables-schema.dhall +11/−0
- tasty/data/nested-tables.dhall +11/−0
- tasty/data/nested-tables.toml +9/−0
- tasty/data/optional-schema.dhall +3/−0
- tasty/data/optional.dhall +3/−0
- tasty/data/optional.toml +1/−0
- tasty/data/record-list-schema.dhall +4/−0
- tasty/data/record-list.dhall +13/−0
- tasty/data/record-list.toml +17/−0
- tasty/data/union-empty-schema.dhall +1/−0
- tasty/data/union-empty.dhall +1/−0
- tasty/data/union-empty.toml +1/−0
- tasty/data/union-nested.dhall +5/−0
- tasty/data/union-nested.toml +4/−0
- tasty/data/union-typed-schema.dhall +1/−0
- tasty/data/union-typed.dhall +1/−0
- tasty/data/union-typed.toml +1/−0
- toml-to-dhall/Main.hs +6/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2021, ear7h++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of ear7h nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,31 @@+# `dhall-toml`++**NOTE:** this package has not been completed see the+[roadmap section](#roadmap)++For installation or development instructions, see:++* [`dhall-haskell` - `README`](https://github.com/dhall-lang/dhall-haskell/blob/master/README.md)++Full documentation here:++* [`dhall-toml` instructions](https://hackage.haskell.org/package/dhall-toml/docs/Dhall-Toml.html)++## Introduction++This `dhall-toml` package provides a Dhall to TOML compiler.++## Example++```bash+$ dhall-to-toml <<< "{ foo = 1, bar = True }"+foo = 1+bar = true+```++## Roadmap+* [x] - minimal `dhall-to-toml`+* [ ] - schema inference for `toml-to-dhall`+* [x] - minimal `toml-to-dhall`+* [ ] - documentation in docs.dhall-lang.org+
+ dhall-to-toml/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Dhall.DhallToToml (dhallToTomlMain)++main :: IO ()+main = dhallToTomlMain
+ dhall-toml.cabal view
@@ -0,0 +1,94 @@+Name: dhall-toml+Version: 1.0.0+Cabal-Version: >=1.10+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: 2021 ear7h+Author: ear7h+Maintainer: Gabriel439@gmail.com+Bug-Reports: https://github.com/dhall-lang/dhall-haskell/issues+Synopsis: Convert between Dhall and TOML+Description:+ Use this package if you want to convert between dhall expressions and TOML.+ You can use this package as a library or an executable:+ .+ * See "Dhall.DhallToToml" or "Dhall.TomlToDhall" modules if you want to use this+ package as a library+ * Use @dhall-to-toml@, @toml-to-dhall@ programs from this package if you+ want an executable.+ .+ The "Dhall.DhallToToml" and "Dhall.TomlToDhall" modules also contains instructions+ for how to use this package+Category: Compiler+Extra-Source-Files:+ README.md+ CHANGELOG.md+ tasty/data/*.dhall+ tasty/data/*.toml++Source-Repository head+ Type: git+ Location: https://github.com/dhall-lang/dhall-haskell/tree/master/dhall-toml++Library+ Hs-Source-Dirs: src+ Build-Depends:+ base >= 4.12 && < 5 ,+ dhall >= 1.39.0 && < 1.41 ,+ tomland >= 1.3.2.0 && < 1.4 ,+ text >= 0.11.1.0 && < 1.3 ,+ containers >= 0.5.9 && < 0.7 ,+ unordered-containers >= 0.2 && < 0.3 ,+ prettyprinter >= 1.5.1 && < 1.8+ Exposed-Modules:+ Dhall.DhallToToml+ Dhall.TomlToDhall+ Dhall.Toml.Utils+ GHC-Options: -Wall+ Default-Language: Haskell2010++Executable dhall-to-toml+ Hs-Source-Dirs: dhall-to-toml+ Main-Is: Main.hs+ Build-Depends:+ base ,+ dhall-toml+ GHC-Options: -Wall+ Default-Language: Haskell2010++Executable toml-to-dhall+ Hs-Source-Dirs: toml-to-dhall+ Main-Is: Main.hs+ Build-Depends:+ base ,+ dhall-toml+ GHC-Options: -Wall+ Default-Language: Haskell2010++Test-Suite dhall-toml-test+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: tasty+ Main-Is: Main.hs+ Build-Depends:+ base ,+ dhall ,+ dhall-toml ,+ tasty < 1.5 ,+ tasty-hunit >= 0.2 ,+ text ,+ tomland+ GHC-Options: -Wall+ Default-Language: Haskell2010++Test-Suite doctest+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: doctest+ Main-Is: Main.hs+ Build-Depends:+ base ,+ directory ,+ filepath ,+ doctest+ GHC-Options: -Wall+ Default-Language: Haskell2010
+ doctest/Main.hs view
@@ -0,0 +1,14 @@+module Main where++import System.FilePath ((</>))++import qualified System.Directory+import qualified Test.DocTest++main :: IO ()+main = do+ pwd <- System.Directory.getCurrentDirectory+ prefix <- System.Directory.makeAbsolute pwd+ let src = prefix </> "src"+ Test.DocTest.doctest [ "--fast", "-i" <> src, src ]+
+ src/Dhall/DhallToToml.hs view
@@ -0,0 +1,364 @@+{-# LANGUAGE PatternSynonyms #-}++{-| This module exports the `dhallToToml` function for translating a+ Dhall syntax tree to a TOML syntax tree (`TOML`) for the @tomland@+ library.++ For converting source code into a Dhall syntax tree see the @dhall@+ package, and for converting the TOML syntax tree to source code see+ the @tomland@ package.++ This module also exports `dhallToTomlMain` which implements the+ @dhall-to-toml@ command which converts Dhall source directly into+ TOML source.++ Not all Dhall expressions can be converted to TOML since TOML is not a+ programming language. The only things you can convert are:++ * @Bool@s+ * @Natural@s+ * @Integer@s+ * @Double@s+ * @Text@ values+ * @List@s+ * @Optional@ values+ * unions+ * records++ Additionally the Dhall top-level value being converted **must be a record**+ since TOML cannot represent bare values (ex. a single boolean or integer)++ Dhall @Bool@s translates to TOML bools:++> $ dhall-to-toml <<< ' { t = True, f = False }'+> f = false+> t = true++ Dhall numbers translate to TOML numbers:++> $ dhall-to-toml <<< '{ i = 1, d = 1.2 }'+> d = 1.2+> i = 1++ Dhall @Text@ translates to TOML text:++> $ dhall-to-toml <<< '{ t = "Hello!" }'+> t = "Hello!"++ Dhall @List@s of records translates to TOML array of tables:++> $ dhall-to-toml <<< '{ l = [ { a = 1 } , { a = 2 }] }'+> [[l]]+> a = 1+>+> [[l]]+> a = 2++ All other @List@s are translated to TOML inline lists:++> $ dhall-to-toml <<< '{ l1 = [1, 2, 3], l2 = [[1, 1], [2, 2]] }'+> l1 = [1, 2, 3]+> l2 = [[1, 1], [2, 2]]++ Note, [lists of lists of objects are currently not supported](https://github.com/kowainik/tomland/issues/373), for example, @[[{a = 1}]]@ will not be converted.++ Dhall @Optional@ values are ignored if @None@ or the unwraped value if @Some@++> $ dhall-to-toml <<< '{ n = None Natural, s = Some 1 }'+> s = 1++ Dhall records translate to TOML tables:++> $ dhall-to-toml <<< '{ v = 1, r1 = { a = 1, b = 2, nested = { a = 3 } } }'+> v = 1+>+> [r]+> a = 1+> b = 2+>+> [r.nested]+> c = 3++ Dhall unions translate to the wrapped value, or a string if the alternative is empty:++> $ dhall-to-toml <<< '{ u = < A | B >.A }'+> u = "A"+> $ dhall-to-toml <<< '{ u = < A : Natural | B >.A 10}'+> u = 10++ Also, all Dhall expressions are normalized before translation:++> $ dhall-to-toml <<< ' { b = True == False }'+> b = false++-}++module Dhall.DhallToToml+ ( -- * Dhall To TOML+ dhallToToml+ , dhallToTomlMain+ -- * Exceptions+ , CompileError+ ) where++import Control.Monad (foldM)+import Control.Exception (Exception, throwIO)+import Data.Foldable (toList)+import Data.List.NonEmpty (NonEmpty((:|)))+import Data.Text (Text)+import Data.Text.Prettyprint.Doc (Pretty)+import Data.Void (Void)+import Dhall.Core (Expr, DhallDouble(..))+import Dhall.Toml.Utils (inputToDhall)+import Toml.Type.TOML (TOML)+import Toml.Type.Key (Piece(Piece), Key(Key, unKey))+import Toml.Type.Printer (pretty)++import qualified Data.Bifunctor as Bifunctor+import qualified Data.Sequence as Seq+import qualified Data.Text as Text+import qualified Data.Text.IO as Text.IO+import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty+import qualified Dhall.Core as Core+import qualified Dhall.Map as Map+import qualified Dhall.Pretty+import qualified Dhall.Util+import qualified Toml.Type.TOML as Toml.TOML+import qualified Toml.Type.Value as Toml.Value+import qualified Toml.Type.AnyValue as Toml.AnyValue+++data CompileError+ = Unsupported (Expr Void Void)+ -- | tomland does not support records in multi-dimensional arrays, though it+ -- is allowed by the spec+ | UnsupportedArray (Expr Void Void)+ | NotARecord (Expr Void Void)+ -- | the latest TOML spec, v1.0.0 allows this but tomland has not+ -- implemented it yet+ -- NOTE: the only way to get this error is through unions+ | HeterogeneousArray (Expr Void Void)++instance Show CompileError where+ show (Unsupported e) =+ _ERROR <> ": Cannot translate to TOML \n\+ \ \n\+ \ \n\+ \Explanation: Only primitive values, records, unions, ❰List❱s, and ❰Optional❱ \n\+ \values can be translated from Dhall to TOML \n\+ \ \n\+ \The following Dhall expression could not be translated to TOML: \n\+ \ \n\+ \" <> insert e++ show (UnsupportedArray e) =+ _ERROR <> ": Records cannot be nested in multi-dimentional arrays \n\+ \ \n\+ \Explanation: The tomland library cannot handle records in nested arrays. You \n\+ \can check the status of this feature at: \n\+ \ https://github.com/kowainik/tomland/issues/385 \n\+ \ \n\+ \For example: \n\+ \ ┌─────────────────────────┐ \n\+ \ | { x = [[ { a = 1 } ]] } | \n\+ \ └─────────────────────────┘ \n\+ \ \n\+ \" <> insert e++ show (NotARecord e) =+ _ERROR <> ": The root object converted to TOML must be a record \n\+ \ \n\+ \Explanation: A TOML file must represent a table, so primitive values and \n\+ \❰List❱s cannot be converted by themselves. Consider nesting the value in a \n\+ \record with arbitrary fields. \n\+ \ \n\+ \For example, from: \n\+ \ ┌────┐ \n\+ \ | 42 | \n\+ \ └────┘ \n\+ \into \n\+ \ ┌────────────────────────┐ \n\+ \ | { meaningOfLife = 42 } | \n\+ \ └────────────────────────┘ \n\+ \ \n\+ \" <> insert e++ show (HeterogeneousArray e) =+ _ERROR <> ": Heterogeneous arrays are not currently supported \n\+ \ \n\+ \Explanation: The tomland library cannot handle arrays with elements of \n\+ \ different types. You can check the status of this feature at: \n\+ \ https://github.com/kowainik/tomland/issues/373 \n\+ \ \n\+ \For example: \n\+ \ ┌────────────────────────────────────┐ \n\+ \ | let X = < A : Natural | B : Bool > | \n\+ \ | in { x = [ X.A 10, X.B false ] } | \n\+ \ └────────────────────────────────────┘ \n\+ \ \n\+ \" <> insert e++instance Exception CompileError+++_ERROR :: String+_ERROR = Text.unpack $ Dhall.Util._ERROR++insert :: Pretty a => a -> String+insert = Text.unpack . Pretty.renderStrict . Dhall.Pretty.layout . Dhall.Util.insert++{-| Converts a Dhall expression into a @tomland@ TOML expression++>>> :set -XOverloadedStrings+>>> :set -XOverloadedLists+>>> import Dhall.Core+>>> import Toml.Type.Printer+>>> f = makeRecordField+>>> let toml = dhallToToml $ RecordLit [("foo", f $ NaturalLit 1), ("bar", f $ TextLit "ABC")]+>>> toml+Right (TOML {tomlPairs = fromList [("foo" :| [],Integer 1),("bar" :| [],Text "ABC")], tomlTables = fromList [], tomlTableArrays = fromList []})+>>> fmap Toml.Type.Printer.pretty toml+Right "bar = \"ABC\"\nfoo = 1\n"+-}+dhallToToml :: Expr s Void -> Either CompileError TOML+dhallToToml e0 = do+ r <- assertRecordLit (Core.normalize e0)+ toTomlTable r++-- empty union alternative like < A | B >.A+pattern UnionEmpty :: Text -> Expr s a+pattern UnionEmpty x <- Core.Field (Core.Union _) (Core.FieldSelection _ x _)+-- union alternative with type like < A : Natural | B>.A 1+pattern UnionApp :: Expr s a -> Expr s a+pattern UnionApp x <- Core.App (Core.Field (Core.Union _) _) x++assertRecordLit :: Expr Void Void -> Either CompileError (Map.Map Text (Core.RecordField Void Void))+assertRecordLit (Core.RecordLit r) = Right r+assertRecordLit (UnionApp x) = assertRecordLit x+assertRecordLit e = Left $ NotARecord e++toTomlTable :: Map.Map Text (Core.RecordField Void Void) -> Either CompileError TOML+toTomlTable r = foldM (toTomlRecordFold []) (mempty :: TOML) (Map.toList r)++toTomlRecordFold :: [Piece] -> TOML -> (Text, Core.RecordField Void Void) -> Either CompileError TOML+toTomlRecordFold curKey toml' (key', val) = toToml toml' newKey (Core.recordFieldValue val)+ where+ append :: [Piece] -> Piece -> NonEmpty Piece+ append [] y = y :| []+ append (x:xs) y = x :| xs ++ [y]+ newKey = Key $ append curKey $ Piece key'++++toToml :: TOML -> Key -> Expr Void Void -> Either CompileError TOML+toToml toml key expr = case expr of+ Core.BoolLit a -> return $ insertPrim (Toml.Value.Bool a)+ Core.NaturalLit a -> return $ insertPrim (Toml.Value.Integer $ toInteger a)+ Core.DoubleLit (DhallDouble a) -> return $ insertPrim (Toml.Value.Double a)+ Core.TextLit (Core.Chunks [] a) -> return $ insertPrim (Toml.Value.Text a)+ Core.App Core.None _ -> return toml+ Core.Some a -> toToml toml key a+ UnionEmpty a -> return $ insertPrim (Toml.Value.Text a)+ UnionApp a -> toToml toml key a+ Core.ListLit _ a -> case toList a of+ -- empty array+ [] -> return $ insertPrim (Toml.Value.Array [])+ -- TODO: unions need to be handled here as well, it's a bit tricky+ -- because they also have to be probed for being a "simple"+ -- array of table+ union@(UnionApp (Core.RecordLit _)) : unions -> do+ tables' <- case mapM assertRecordLit (union :| unions) of+ Right x -> mapM toTomlTable x+ Left (NotARecord e) -> Left (HeterogeneousArray e)+ Left x -> Left x+ return $ Toml.TOML.insertTableArrays key tables' toml++ record@(Core.RecordLit _) : records -> do+ tables' <- case mapM assertRecordLit (record :| records) of+ Right x -> mapM toTomlTable x+ Left (NotARecord e) -> Left (HeterogeneousArray e)+ Left x -> Left x+ return $ Toml.TOML.insertTableArrays key tables' toml+ -- inline array+ a' -> do+ anyList <- mapM toAny a'+ let arrayEither = Toml.AnyValue.toMArray anyList+ array <- Bifunctor.first (const $ HeterogeneousArray expr) arrayEither+ return $ insertPrim array+ Core.RecordLit r ->+ let+ (inline, nested) = Map.partition (isInline . Core.recordFieldValue) r+ in+ if null inline+ -- if the table doesn't have inline elements, don't register+ -- the table, only its non-inlined children. Ex:+ -- [a] # bad+ -- [b]+ -- c = 1+ -- [a.b] # good+ -- c = 1+ then foldM (toTomlRecordFold $ toList $ unKey key) toml (Map.toList nested)+ else do+ -- the order here is important, at least for testing, because+ -- the PrefixMap inside TOML is dependent on insert order+ inlinePairs <- foldM (toTomlRecordFold []) mempty (Map.toList inline)+ nestedPairs <- foldM (toTomlRecordFold []) inlinePairs (Map.toList nested)+ return $ Toml.TOML.insertTable key nestedPairs toml+ _ -> Left $ Unsupported expr+ where+ insertPrim :: Toml.Value.Value a -> TOML+ insertPrim val = Toml.TOML.insertKeyVal key val toml++ -- checks if the value should be represented as an inline key/value+ -- pair. Elements that are inlined are those that do not have a+ -- [header] or [[header]]. One edge case is tables within multiple+ -- arrays, though not currently supported by tomland, can only+ -- be represented as inline tables.+ isInline v = case v of+ Core.BoolLit _ -> True+ Core.NaturalLit _ -> True+ Core.DoubleLit _ -> True+ Core.TextLit _ -> True+ Core.ListLit _ s -> case Seq.lookup 0 s of+ Nothing -> True+ Just (Core.BoolLit _) -> True+ Just (Core.NaturalLit _) -> True+ Just (Core.DoubleLit _) -> True+ Just (Core.TextLit _) -> True+ Just (Core.ListLit _ _) -> True+ _ -> False+ _ -> False++ rightAny = Right . Toml.AnyValue.AnyValue++ -- toAny is a helper function for making lists so it returns a list+ -- specific error, in particular tomland's inability to represent+ -- tables in multi-dimensional arrays+ toAny :: Expr Void Void -> Either CompileError Toml.AnyValue.AnyValue+ toAny e = case e of+ Core.BoolLit x -> rightAny $ Toml.Value.Bool x+ Core.NaturalLit x -> rightAny $ Toml.Value.Integer $ toInteger x+ Core.DoubleLit (DhallDouble x) -> rightAny $ Toml.Value.Double x+ Core.TextLit (Core.Chunks [] x) -> rightAny $ Toml.Value.Text x+ UnionEmpty x -> rightAny $ Toml.Value.Text x+ UnionApp x -> toAny x+ Core.ListLit _ x -> do+ anyList <- mapM toAny $ toList x+ case Toml.AnyValue.toMArray anyList of+ Right x' -> rightAny x'+ Left _ -> Left $ HeterogeneousArray expr+ Core.RecordLit _ -> Left $ UnsupportedArray e+ _ -> Left $ Unsupported e+++{-| Runs the @dhall-to-toml@ command+-}+dhallToTomlMain :: IO ()+dhallToTomlMain = do+ resolvedExpression <- inputToDhall+ toml <- case dhallToToml resolvedExpression of+ Left err -> throwIO err+ Right toml -> return toml+ Text.IO.putStrLn $ pretty toml++
+ src/Dhall/Toml/Utils.hs view
@@ -0,0 +1,43 @@+{-| This library provides utilities for converting Dhall source code into a+ normalized AST+-}++module Dhall.Toml.Utils+ ( fileToDhall+ , inputToDhall+ , textToDhall+ ) where++import Data.Text (Text)+import Dhall.Parser (Src)+import Data.Void (Void)++import qualified Data.Text.IO as Text.IO+import qualified Dhall.Core as Core+import qualified Dhall.Import+import qualified Dhall.Parser+import qualified Dhall.TypeCheck++-- | Read the file fileName and return the normalized Dhall AST+fileToDhall :: String -> IO (Core.Expr Src Void)+fileToDhall fileName = do+ text <- Text.IO.readFile fileName+ textToDhall fileName text++-- | Read from STDIN and return the normalized Dhall AST. The file name+-- is set to "(input)"+inputToDhall :: IO (Core.Expr Src Void)+inputToDhall = do+ text <- Text.IO.getContents+ textToDhall "(input)" text++-- | Parse text and return the normalized Dhall AST. A file name is required+-- by the parser for generating error messages.+textToDhall :: String -> Text -> IO (Core.Expr Src Void)+textToDhall fileName text = do+ parsedExpression <-+ Core.throws (Dhall.Parser.exprFromText fileName text)+ resolvedExpression <- Dhall.Import.load parsedExpression+ _ <- Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)+ return resolvedExpression+
+ src/Dhall/TomlToDhall.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedLists #-}++{-| This module exports the `tomlToDhall` function for translating a+ TOML syntax tree from @tomland@ to a Dhall syntax tree. For now,+ this package does not have type inference so a Dhall type is needed.++ For converting source code into a Dhall syntax tree see the @dhall@+ package, and for converting the TOML syntax tree to source code see+ the @tomland@ package.++ This module also exports `tomlToDhallMain` which implements the+ @toml-to-dhall@ command which converts TOML source directly into+ Dhall source.++ In theory all TOML objects should be converted but there are some known+ failure cases:+ * Arrays of arrays of objects - not supported by @tomland@+ * Arrays of heterogeneous primitive types - not supported by @tomland@+ * Arrays of objects of different types are allowed (note that this+ requires conversion to a Dhall union)++ TOML bools translate to Dhall @Bool@s:++> $ cat schema.dhall+> { b : Bool }+> $ toml-to-dhall schema.dhall <<< 'b = true'+> { b = True }++ TOML numbers translate to Dhall numbers:++> $ cat schema.dhall+> { n : Natural, d : Double }+> $ toml-to-dhall schema.dhall << EOF+> n = 1+> d = 3.14+> EOF+> { d = 3.14, n = 1}++ TOML text translates to Dhall @Text@:++> $ cat schema.dhall+> { t : Text }+> $ toml-to-dhall schema.dhall << EOF+> t = "Hello!"+> EOF+> { t = "Hello!" }++ TOML arrays and table arrays translate to Dhall @List@:++> $ cat schema.dhall+> { nums : List Natural, tables : List { a : Natural, b : Text } }+> $ toml-to-dhall schema.dhall << EOF+> nums = [1, 2, 3]+>+> [[tables]]+> a = 1+> b = "Hello,"+> [[tables]]+> a = 2+> b = " World!"+> EOF+> { nums = [ 1, 2, 3 ]+> , tables = [ { a = 1, b = "Hello," }, { a = 2, b = " World!" } ]+> }++ Note, [lists of lists of objects](https://github.com/kowainik/tomland/issues/373)+ and [heterogeneous lists](https://github.com/kowainik/tomland/issues/373) are not+ supported by @tomland@ so a paraser error will be returned:++> $ cat schema.dhall+> { list : List (<a : Natural | b : Bool>) }+> $ toml-to-dhall schema.dhall << EOF+> list = [1, true]+> EOF+> toml-to-dhall: invalid TOML:+> 1:12:+> |+> 1 | list = [1, true]+> | ^+> unexpected 't'+> expecting ',', ']', or integer++ Because of this, unions have limited use in lists, but can be used fully+ in tables:++> $ cat schema.dhall+> { list : List (<a : Natural | b : Bool>), item : <a : Natural | b : Bool> }+> $ toml-to-dhall schema.dhall << EOF+> list = [1, 2]+> item = true+> EOF+> { item = < a : Natural | b : Bool >.b True+> , list = [ < a : Natural | b : Bool >.a 1, < a : Natural | b : Bool >.a 2 ]+> }++ TOML tables translate to Dhall records:++> $ cat schema.dhall+> { num : Natural, table : { num1 : Natural, table1 : { num2 : Natural } } }+> $ toml-to-dhall schema.dhall << EOF+> num = 0+>+> [table]+> num1 = 1+>+> [table.table1]+> num2 = 2+> EOF+> { num = 0, table = { num1 = 1, table1.num2 = 2 } }++-}+module Dhall.TomlToDhall+ ( tomlToDhall+ , tomlToDhallMain+ , CompileError+ ) where++import Control.Exception (Exception, throwIO)+import Data.Either (rights)+import Data.Foldable (toList, foldl')+import Data.List.NonEmpty (NonEmpty((:|)))+import Data.Text (Text)+import Data.Void (Void)+import Dhall.Core (Expr, DhallDouble(..))+import Dhall.Toml.Utils (fileToDhall)+import Dhall.Parser (Src)+import Toml.Parser (TomlParseError)+import Toml.Type.AnyValue (AnyValue(AnyValue))+import Toml.Type.Value (Value)+import Toml.Type.TOML (TOML)+import Toml.Type.Key (Piece(Piece), Key(Key))+import Toml.Type.PrefixTree (PrefixTree)++import qualified Data.HashMap.Strict as HashMap+import qualified Data.Sequence as Seq+import qualified Data.Text+import qualified Data.Text.IO as Text.IO+import qualified Dhall.Map as Map+import qualified Dhall.Core as Core+import qualified Toml.Parser+import qualified Toml.Type.TOML as Toml.TOML+import qualified Toml.Type.PrefixTree as Toml.PrefixTree+import qualified Toml.Type.Value as Value+import qualified Toml.Type.AnyValue as Toml.AnyValue+import qualified System.Environment++data CompileError+ = Unimplemented String+ | Incompatible (Expr Src Void) Object+ | InvalidToml TomlParseError+ | InternalError String+ | MissingKey String++instance Show CompileError where+ show (Unimplemented s) = "unimplemented: " ++ s+ show (Incompatible e toml) = "incompatible: " ++ (show e) ++ " with " ++ (show toml)+ show (InvalidToml e) = "invalid TOML:\n" ++ (Data.Text.unpack $ Toml.Parser.unTomlParseError e)+ show (InternalError e) = "internal error: " ++ show e+ show (MissingKey e) = "missing key: " ++ show e++instance Exception CompileError++tomlToDhall :: Expr Src Void -> TOML -> Either CompileError (Expr Src Void)+tomlToDhall schema toml = toDhall (Core.normalize schema) (tomlToObject toml)++tomlValueToDhall :: Expr Src Void -> Value t -> Either CompileError (Expr Src Void)+tomlValueToDhall exprType v = case (exprType, v) of+ (Core.Bool , Value.Bool a ) -> Right $ Core.BoolLit a+ (Core.Natural , Value.Integer a) -> Right $ Core.NaturalLit $ fromInteger a+ (Core.Double , Value.Double a ) -> Right $ Core.DoubleLit $ DhallDouble a+ (Core.Text , Value.Text a ) -> Right $ Core.TextLit $ Core.Chunks [] a+ (_ , Value.Zoned _ ) -> Left $ Unimplemented "toml time values"+ (_ , Value.Local _ ) -> Left $ Unimplemented "toml time values"+ (_ , Value.Day _ ) -> Left $ Unimplemented "toml time values"+ (t@(Core.App Core.List _) , Value.Array [] ) -> Right $ Core.ListLit (Just t) []+ (Core.App Core.Optional t , a ) -> do+ o <- tomlValueToDhall t a+ return $ Core.Some o+ (Core.App Core.List t , Value.Array a ) -> do+ l <- mapM (tomlValueToDhall t) a+ return $ Core.ListLit Nothing (Seq.fromList l)++ -- TODO: allow different types of matching (ex. first, strict, none)+ -- currently we just pick the first enum that matches+ (Core.Union m , _) -> let+ f key maybeType = case maybeType of+ Just ty -> do+ expr <- tomlValueToDhall ty v+ return $ Core.App (Core.Field exprType $ Core.makeFieldSelection key) expr+ Nothing -> case v of+ Value.Text a | a == key ->+ return $ Core.Field exprType (Core.makeFieldSelection a)+ _ -> Left $ Incompatible exprType (Prim (AnyValue v))++ in case rights (toList (Map.mapWithKey f m)) of+ [] -> Left $ Incompatible exprType (Prim (AnyValue v))+ x:_ -> Right $ x++ _ -> Left $ Incompatible exprType (Prim (AnyValue v))++-- TODO: keep track of the path for more helpful error messages+toDhall :: Expr Src Void -> Object -> Either CompileError (Expr Src Void)+toDhall exprType value = case (exprType, value) of+ (_, Invalid) -> Left $ InternalError "invalid object"++ -- TODO: allow different types of matching (ex. first, strict, none)+ -- currently we just pick the first enum that matches+ (Core.Union m , _) -> let+ f key maybeType = case maybeType of+ Just ty -> do+ expr <- toDhall ty value+ return $ Core.App (Core.Field exprType $ Core.makeFieldSelection key) expr+ Nothing -> case value of+ Prim (AnyValue (Value.Text a)) | a == key ->+ return $ Core.Field exprType (Core.makeFieldSelection a)+ _ -> Left $ Incompatible exprType value++ in case rights (toList (Map.mapWithKey f m)) of+ [] -> Left $ Incompatible exprType value+ x:_ -> Right $ x++ (Core.App Core.List t, Array []) -> Right $ Core.ListLit (Just t) []++ (Core.App Core.List t, Array a) -> do+ l <- mapM (toDhall t) a+ return $ Core.ListLit Nothing (Seq.fromList l)++ (Core.Record r, Table t) -> let+ f :: Text -> (Expr Src Void) -> Either CompileError (Expr Src Void)+ f k ty | Just val <- HashMap.lookup (Piece k) t = toDhall ty val+ | Core.App Core.Optional ty' <- ty = Right $ (Core.App Core.None ty')+ | Core.App Core.List _ <- ty = Right $ Core.ListLit (Just ty) []+ | otherwise = Left $ MissingKey $ Data.Text.unpack k+ in do+ values <- Map.traverseWithKey f (Core.recordFieldValue <$> r)+ return $ Core.RecordLit (Core.makeRecordField <$> values)++ (_, Prim (AnyValue v)) -> tomlValueToDhall exprType v++ (ty, obj) -> Left $ Incompatible ty obj+++-- | An intermediate object created from a 'TOML' before an 'Expr'.+-- It does two things, firstly joining the tomlPairs, tomlTables,+-- and tomlTableArrays parts of the TOML. Second, it turns the dense+-- paths (ex. a.b.c = 1) into sparse paths (ex. a = { b = { c = 1 }}).+data Object+ = Prim Toml.AnyValue.AnyValue+ | Array [Object]+ | Table (HashMap.HashMap Piece Object)+ | Invalid+ deriving (Show)++instance Semigroup Object where+ (Table ls) <> (Table rs) = Table (ls <> rs)+ -- this shouldn't happen because tomland has already verified correctness+ -- of the toml object+ _ <> _ = Invalid++-- | Creates an arbitrarily nested object+sparseObject :: Key -> Object -> Object+sparseObject (Key (piece :| [])) value = Table $ HashMap.singleton piece value+sparseObject (Key (piece :| rest:rest')) value+ = Table $ HashMap.singleton piece (sparseObject (Key $ rest :| rest') value)++pairsToObject :: HashMap.HashMap Key Toml.AnyValue.AnyValue -> Object+pairsToObject pairs+ = foldl' (<>) (Table HashMap.empty)+ $ HashMap.mapWithKey sparseObject+ $ fmap Prim pairs++tablesToObject :: Toml.PrefixTree.PrefixMap TOML -> Object+tablesToObject tables+ = foldl' (<>) (Table HashMap.empty)+ $ map prefixTreeToObject+ $ HashMap.elems tables++prefixTreeToObject :: PrefixTree TOML -> Object+prefixTreeToObject (Toml.PrefixTree.Leaf key toml)+ = sparseObject key (tomlToObject toml)+prefixTreeToObject (Toml.PrefixTree.Branch prefix _ toml)+ = sparseObject prefix (tablesToObject toml)++tableArraysToObject :: HashMap.HashMap Key (NonEmpty TOML) -> Object+tableArraysToObject arrays+ = foldl' (<>) (Table HashMap.empty)+ $ HashMap.mapWithKey sparseObject+ $ fmap (Array . fmap tomlToObject . toList) arrays++tomlToObject :: TOML -> Object+tomlToObject toml = pairs <> tables <> tableArrays+ where+ pairs = pairsToObject $ Toml.TOML.tomlPairs toml+ tables = tablesToObject $ Toml.TOML.tomlTables toml+ tableArrays = tableArraysToObject $ Toml.TOML.tomlTableArrays toml++tomlToDhallMain :: IO ()+tomlToDhallMain = do+ text <- Text.IO.getContents+ toml <- case Toml.Parser.parse text of+ Left tomlErr -> throwIO (InvalidToml tomlErr)+ Right toml -> return toml+ args <- System.Environment.getArgs+ schemaFile <- case args of+ [] -> fail "schema not provided"+ schemaFile:[] -> return schemaFile+ _ -> fail "too many agrgs"+ schema <- fileToDhall schemaFile+ dhall <- case tomlToDhall schema toml of+ Left err -> throwIO err+ Right dhall -> return dhall+ Text.IO.putStrLn $ Core.pretty dhall+
+ tasty/Main.hs view
@@ -0,0 +1,113 @@+module Main where++import Control.Monad (unless)+import Data.Text (unpack)+import Data.Void (Void)+import Dhall.DhallToToml (dhallToToml)+import Dhall.TomlToDhall (tomlToDhall)+import Dhall.Toml.Utils (fileToDhall)+import Dhall.Parser (Src)+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (HasCallStack, Assertion, assertFailure)+import Toml.Type.TOML (TOML, tomlDiff)+import Toml.Type.Printer (pretty)++import qualified Toml.Parser+import qualified Data.Text.IO+import qualified Dhall.Core as Core+import qualified GHC.IO.Encoding+import qualified Test.Tasty+import qualified Test.Tasty.HUnit++main :: IO ()+main = do+ GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8++ Test.Tasty.defaultMain testTree+++testTree :: TestTree+testTree =+ Test.Tasty.testGroup "dhall-toml"+ [ Test.Tasty.testGroup "dhall-to-toml" dhallToTomlTests+ , Test.Tasty.testGroup "toml-to-dhall" tomlToDhallTests+ ]+ where+ dhallToTomlTests = map testDhallToToml+ [ "./tasty/data/empty"+ , "./tasty/data/natural"+ , "./tasty/data/float"+ , "./tasty/data/multiple-fields"+ , "./tasty/data/nested-tables"+ , "./tasty/data/adjacent-tables"+ , "./tasty/data/inline-list"+ , "./tasty/data/record-list"+ , "./tasty/data/union-empty"+ , "./tasty/data/union-typed"+ , "./tasty/data/union-nested"+ , "./tasty/data/optional"+ ]+ tomlToDhallTests = map testTomlToDhall+ [ "./tasty/data/empty"+ , "./tasty/data/natural"+ , "./tasty/data/float"+ , "./tasty/data/multiple-fields"+ , "./tasty/data/nested-tables"+ , "./tasty/data/adjacent-tables"+ , "./tasty/data/inline-list"+ , "./tasty/data/record-list"+ , "./tasty/data/union-empty"+ , "./tasty/data/union-typed"+ , "./tasty/data/optional"+ ]++testDhallToToml :: String -> TestTree+testDhallToToml prefix = Test.Tasty.HUnit.testCase prefix $ do+ let inputFile = prefix ++ ".dhall"+ let outputFile = prefix ++ ".toml"+ resolvedExpression <- fileToDhall inputFile+ actualValue <-+ Core.throws (dhallToToml resolvedExpression)+ inputText <- Data.Text.IO.readFile outputFile+ expectedValue <- case Toml.Parser.parse inputText of+ Left tomlErr -> fail $ show tomlErr+ Right expectedValue -> return expectedValue+ let message = "Conversion to TOML did not generate the expected output"+ assertTomlEq message expectedValue actualValue+++testTomlToDhall :: String -> TestTree+testTomlToDhall prefix = Test.Tasty.HUnit.testCase prefix $ do+ let inputFile = prefix ++ ".toml"+ let schemaFile = prefix ++ "-schema.dhall"+ let outputFile = prefix ++ ".dhall"+ inputText <- Data.Text.IO.readFile inputFile+ toml <- case Toml.Parser.parse inputText of+ Left tomlErr -> fail $ show tomlErr+ Right toml -> return toml+ schema <- fileToDhall schemaFile+ actualValue <- case tomlToDhall schema toml of+ Left err -> fail $ show err+ Right val -> return val+ expectedValue <- fileToDhall outputFile+ let message = "Conversion to Dhall did not generate the expected output"+ assertDhallEq message (Core.normalize expectedValue) actualValue+++assertTomlEq :: HasCallStack => String -> TOML -> TOML -> Assertion+assertTomlEq prefix expected actual = unless (expected == actual) (assertFailure msg)+ where+ pretty' = unpack . pretty+ msg = prefix ++ "\nExpected:\n" ++ pretty' expected ++ "\nActual:\n" ++ pretty' actual +++ "Diff:\nMissing:\n" ++ pretty' (tomlDiff expected actual) +++ "\nExtra:\n" ++ pretty' (tomlDiff actual expected) +++ "AST:\nExpected:\n" ++ show expected ++ "\nActual:\n" ++ show actual++assertDhallEq :: HasCallStack => String -> Core.Expr Src Void -> Core.Expr Src Void -> Assertion+assertDhallEq prefix expected actual = unless (expected == actual) (assertFailure msg)+ where+ pretty' = unpack . Core.pretty+ msg = prefix ++ "\nExpected:\n" ++ pretty' expected ++ "\nActual:\n" ++ pretty' actual +++ "AST:\nExpected:\n" ++ show expected ++ "\nActual:\n" ++ show actual++
+ tasty/data/adjacent-tables-schema.dhall view
@@ -0,0 +1,13 @@+{+ a : {+ a1 : Natural,+ a2 : Bool,+ a3 : Text,+ },+ b : {+ b1 : Natural,+ b2 : Bool,+ b3 : Text,+ },+}+
+ tasty/data/adjacent-tables.dhall view
@@ -0,0 +1,12 @@+{+ a = {+ a1 = 1,+ a2 = True,+ a3 = "hello"+ },+ b = {+ b1 = 2,+ b2 = False,+ b3 = "world"+ }+}
+ tasty/data/adjacent-tables.toml view
@@ -0,0 +1,9 @@+[a]+ a1 = 1+ a2 = true+ a3 = "hello"++[b]+ b1 = 2+ b2 = false+ b3 = "world"
+ tasty/data/empty-schema.dhall view
@@ -0,0 +1,1 @@+{}
+ tasty/data/empty.dhall view
@@ -0,0 +1,1 @@+{=}
+ tasty/data/empty.toml view
+ tasty/data/float-schema.dhall view
@@ -0,0 +1,3 @@+{+ pi : Double+}
+ tasty/data/float.dhall view
@@ -0,0 +1,3 @@+{+ pi = 3.141592653589793+}
+ tasty/data/float.toml view
@@ -0,0 +1,1 @@+pi = 3.141592653589793
+ tasty/data/inline-list-schema.dhall view
@@ -0,0 +1,11 @@+{ nats : List Natural+, bools : List Bool+, lists : List (List Natural)+, nested :+ { floats : List Double+ , moreLists : List (List Natural)+ }+, nested1 :+ { evenMoreLists : List (List Natural)+ }+}
+ tasty/data/inline-list.dhall view
@@ -0,0 +1,11 @@+{ nats = [1, 2, 3]+, bools = [True, False, False, False, True, False, True]+, lists = [[1, 2], [3, 4], [] : List Natural]+, nested =+ { floats = [1.1, 2.2]+ , moreLists = [[1, 2], [3, 4], [] : List Natural]+ }+, nested1 =+ { evenMoreLists = [[1, 2], [3, 4], [] : List Natural]+ }+}
+ tasty/data/inline-list.toml view
@@ -0,0 +1,10 @@+nats = [1, 2, 3]+bools = [true, false, false, false, true, false, true]+lists = [[1, 2], [3, 4], []]++[nested]+floats = [1.1, 2.2]+moreLists = [[1, 2], [3, 4], []]++[nested1]+evenMoreLists = [[1, 2], [3, 4], []]
+ tasty/data/multiple-fields-schema.dhall view
@@ -0,0 +1,5 @@+{+ a : Text,+ b : Natural,+ c : Bool,+}
+ tasty/data/multiple-fields.dhall view
@@ -0,0 +1,5 @@+{+ a = "hello",+ b = 42,+ c = True+}
+ tasty/data/multiple-fields.toml view
@@ -0,0 +1,3 @@+a = "hello"+b = 42+c = true
+ tasty/data/natural-schema.dhall view
@@ -0,0 +1,1 @@+{ someKey : Natural }
+ tasty/data/natural.dhall view
@@ -0,0 +1,1 @@+{ someKey = 42 }
+ tasty/data/natural.toml view
@@ -0,0 +1,1 @@+someKey = 42
+ tasty/data/nested-tables-schema.dhall view
@@ -0,0 +1,11 @@+{+ a1 : {+ b1 : Text,+ b2 : Text,+ b3 : {+ c1 : Text,+ c2 : Natural,+ },+ },+ a2 : Bool,+}
+ tasty/data/nested-tables.dhall view
@@ -0,0 +1,11 @@+{+ a1 = {+ b1 = "hello",+ b2 = "world",+ b3 = {+ c1 = "!",+ c2 = 42,+ },+ },+ a2 = True+}
+ tasty/data/nested-tables.toml view
@@ -0,0 +1,9 @@+a2 = true++[a1]+ b1 = "hello"+ b2 = "world"++ [a1.b3]+ c1 = "!"+ c2 = 42
+ tasty/data/optional-schema.dhall view
@@ -0,0 +1,3 @@+{ yes : Optional Natural+, no : Optional Natural+}
+ tasty/data/optional.dhall view
@@ -0,0 +1,3 @@+{ yes = Some 10+, no = None Natural+}
+ tasty/data/optional.toml view
@@ -0,0 +1,1 @@+yes = 10
+ tasty/data/record-list-schema.dhall view
@@ -0,0 +1,4 @@+{ records : List { a : Natural }+, nested :+ { records : List { a : Natural } }+}
+ tasty/data/record-list.dhall view
@@ -0,0 +1,13 @@+{ records =+ [ { a = 1 }+ , { a = 2 }+ , { a = 3 }+ ]+, nested =+ { records =+ [ { a = 1 }+ , { a = 2 }+ , { a = 3 }+ ]+ }+}
+ tasty/data/record-list.toml view
@@ -0,0 +1,17 @@+[[records]]+ a = 1++[[records]]+ a = 2++[[records]]+ a = 3++[[nested.records]]+ a = 1++[[nested.records]]+ a = 2++[[nested.records]]+ a = 3
+ tasty/data/union-empty-schema.dhall view
@@ -0,0 +1,1 @@+{ value : <A | B> }
+ tasty/data/union-empty.dhall view
@@ -0,0 +1,1 @@+{ value = < A | B >.A }
+ tasty/data/union-empty.toml view
@@ -0,0 +1,1 @@+value = "A"
+ tasty/data/union-nested.dhall view
@@ -0,0 +1,5 @@+let U = <A : {} | B : Natural >+in+ { recs = [ U.A {=} ]+ , nats = [ U.B 1 ]+ }
+ tasty/data/union-nested.toml view
@@ -0,0 +1,4 @@+nats = [ 1 ]++[[recs]]+
+ tasty/data/union-typed-schema.dhall view
@@ -0,0 +1,1 @@+{ value : < A : Natural | B> }
+ tasty/data/union-typed.dhall view
@@ -0,0 +1,1 @@+{ value = < A : Natural | B >.A 10 }
+ tasty/data/union-typed.toml view
@@ -0,0 +1,1 @@+value = 10
+ toml-to-dhall/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Dhall.TomlToDhall (tomlToDhallMain)++main :: IO ()+main = tomlToDhallMain