dhall-toml-1.0.2: src/Dhall/DhallToToml.hs
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-| 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.Exception (Exception, throwIO)
import Control.Monad (foldM)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import Data.Version (showVersion)
import Data.Void (Void)
import Dhall.Core (DhallDouble (..), Expr)
import Dhall.Toml.Utils (fileToDhall, inputToDhall)
import Prettyprinter (Pretty)
import Toml.Type.Key (Key (Key, unKey), Piece (Piece))
import Toml.Type.Printer (pretty)
import Toml.Type.TOML (TOML)
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 Dhall.Core as Core
import qualified Dhall.Map as Map
import qualified Dhall.Pretty
import qualified Dhall.Util
import qualified Options.Applicative as OA
import qualified Paths_dhall_toml as Meta
import qualified Prettyprinter.Render.Text as Pretty
import qualified Toml.Type.AnyValue as Toml.AnyValue
import qualified Toml.Type.TOML as Toml.TOML
import qualified Toml.Type.Value as Toml.Value
-- $setup
--
-- >>> import Toml.Type.TOML (TOML(..))
-- >>> import Toml.Type.AnyValue (AnyValue(..))
-- >>> import qualified Data.HashMap.Strict as HashMap
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)
deriving (Eq)
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 = HashMap.fromList [("foo",AnyValue (Toml.Value.Integer 1)),("bar",AnyValue (Toml.Value.Text "ABC"))], tomlTables = HashMap.fromList [], tomlTableArrays = HashMap.fromList []})
True
>>> 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
data Options = Options
{ input :: Maybe FilePath
, output :: Maybe FilePath
}
parserInfo :: OA.ParserInfo Options
parserInfo = OA.info
(OA.helper <*> versionOption <*> optionsParser)
(OA.fullDesc <> OA.progDesc "Convert Dhall to TOML")
where
versionOption = OA.infoOption (showVersion Meta.version) $
OA.long "version" <> OA.help "Display version"
optionsParser = do
input <- OA.optional . OA.strOption $
OA.long "file"
<> OA.help "Read Dhall from file instead of standard input"
<> fileOpts
output <- OA.optional . OA.strOption $
OA.long "output"
<> OA.help "Write TOML to a file instead of standard output"
<> fileOpts
pure Options {..}
fileOpts = OA.metavar "FILE" <> OA.action "file"
{-| Runs the @dhall-to-toml@ command
-}
dhallToTomlMain :: IO ()
dhallToTomlMain = do
Options {..} <- OA.execParser parserInfo
resolvedExpression <- maybe inputToDhall fileToDhall input
toml <- case dhallToToml resolvedExpression of
Left err -> throwIO err
Right toml -> return toml
maybe Text.IO.putStrLn Text.IO.writeFile output $ pretty toml