{-# 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 (CompileError -> CompileError -> Bool
(CompileError -> CompileError -> Bool)
-> (CompileError -> CompileError -> Bool) -> Eq CompileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompileError -> CompileError -> Bool
$c/= :: CompileError -> CompileError -> Bool
== :: CompileError -> CompileError -> Bool
$c== :: CompileError -> CompileError -> Bool
Eq)

instance Show CompileError where
    show :: CompileError -> String
show (Unsupported Expr Void Void
e) =
        String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": 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\
        \" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e

    show (UnsupportedArray Expr Void Void
e) =
        String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": 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\
        \" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e

    show (NotARecord Expr Void Void
e) =
        String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": 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\
        \" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e

    show (HeterogeneousArray Expr Void Void
e) =
        String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": 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\
        \" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e

instance Exception CompileError


_ERROR :: String
_ERROR :: String
_ERROR = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
forall string. IsString string => string
Dhall.Util._ERROR

insert :: Pretty a => a -> String
insert :: a -> String
insert = Text -> String
Text.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.renderStrict (SimpleDocStream Ann -> Text)
-> (a -> SimpleDocStream Ann) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout (Doc Ann -> SimpleDocStream Ann)
-> (a -> Doc Ann) -> a -> SimpleDocStream Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
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 :: Expr s Void -> Either CompileError TOML
dhallToToml Expr s Void
e0 = do
    Map Text (RecordField Void Void)
r <- Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Expr s Void -> Expr Void Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s Void
e0)
    Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable Map Text (RecordField Void Void)
r

-- empty union alternative like < A | B >.A
pattern UnionEmpty :: Text -> Expr s a
pattern $mUnionEmpty :: forall r s a. Expr s a -> (Text -> r) -> (Void# -> r) -> r
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 $mUnionApp :: forall r s a. Expr s a -> (Expr s a -> r) -> (Void# -> r) -> r
UnionApp x <- Core.App (Core.Field (Core.Union _) _) x

assertRecordLit :: Expr Void Void -> Either CompileError (Map.Map Text (Core.RecordField Void Void))
assertRecordLit :: Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Core.RecordLit Map Text (RecordField Void Void)
r) = Map Text (RecordField Void Void)
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. b -> Either a b
Right Map Text (RecordField Void Void)
r
assertRecordLit (UnionApp Expr Void Void
x)       = Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit Expr Void Void
x
assertRecordLit Expr Void Void
e                  = CompileError
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. a -> Either a b
Left (CompileError
 -> Either CompileError (Map Text (RecordField Void Void)))
-> CompileError
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
NotARecord Expr Void Void
e

toTomlTable :: Map.Map Text (Core.RecordField Void Void) -> Either CompileError TOML
toTomlTable :: Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable Map Text (RecordField Void Void)
r = (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold []) (TOML
forall a. Monoid a => a
mempty :: TOML) (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
r)

toTomlRecordFold :: [Piece] -> TOML -> (Text, Core.RecordField Void Void) -> Either CompileError TOML
toTomlRecordFold :: [Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold [Piece]
curKey TOML
toml' (Text
key', RecordField Void Void
val) = TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml' Key
newKey (RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue RecordField Void Void
val)
    where
        append :: [Piece] -> Piece -> NonEmpty Piece
        append :: [Piece] -> Piece -> NonEmpty Piece
append []     Piece
y = Piece
y Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| []
        append (Piece
x:[Piece]
xs) Piece
y = Piece
x Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| [Piece]
xs [Piece] -> [Piece] -> [Piece]
forall a. [a] -> [a] -> [a]
++ [Piece
y]
        newKey :: Key
newKey = NonEmpty Piece -> Key
Key (NonEmpty Piece -> Key) -> NonEmpty Piece -> Key
forall a b. (a -> b) -> a -> b
$ [Piece] -> Piece -> NonEmpty Piece
append [Piece]
curKey (Piece -> NonEmpty Piece) -> Piece -> NonEmpty Piece
forall a b. (a -> b) -> a -> b
$ Text -> Piece
Piece Text
key'



toToml :: TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml :: TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml Key
key Expr Void Void
expr  = case Expr Void Void
expr of
    Core.BoolLit Bool
a -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TBool -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Bool -> Value 'TBool
Toml.Value.Bool Bool
a)
    Core.NaturalLit Natural
a -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TInteger -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Integer -> Value 'TInteger
Toml.Value.Integer (Integer -> Value 'TInteger) -> Integer -> Value 'TInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
a)
    Core.DoubleLit (DhallDouble Double
a) -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TDouble -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Double -> Value 'TDouble
Toml.Value.Double Double
a)
    Core.TextLit (Core.Chunks [] Text
a) -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TText -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Text -> Value 'TText
Toml.Value.Text Text
a)
    Core.App Expr Void Void
Core.None Expr Void Void
_ -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return TOML
toml
    Core.Some Expr Void Void
a -> TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml Key
key Expr Void Void
a
    UnionEmpty Text
a -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TText -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Text -> Value 'TText
Toml.Value.Text Text
a)
    UnionApp Expr Void Void
a -> TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml Key
key Expr Void Void
a
    Core.ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
a -> case Seq (Expr Void Void) -> [Expr Void Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr Void Void)
a of
        -- empty array
        [] -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TArray -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim ([Value Any] -> Value 'TArray
forall (t1 :: TValue). [Value t1] -> Value 'TArray
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 :: Expr Void Void
union@(UnionApp (Core.RecordLit Map Text (RecordField Void Void)
_)) : [Expr Void Void]
unions -> do
            NonEmpty TOML
tables' <- case (Expr Void Void
 -> Either CompileError (Map Text (RecordField Void Void)))
-> NonEmpty (Expr Void Void)
-> Either
     CompileError (NonEmpty (Map Text (RecordField Void Void)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Expr Void Void
union Expr Void Void -> [Expr Void Void] -> NonEmpty (Expr Void Void)
forall a. a -> [a] -> NonEmpty a
:| [Expr Void Void]
unions) of
                Right NonEmpty (Map Text (RecordField Void Void))
x -> (Map Text (RecordField Void Void) -> Either CompileError TOML)
-> NonEmpty (Map Text (RecordField Void Void))
-> Either CompileError (NonEmpty TOML)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable NonEmpty (Map Text (RecordField Void Void))
x
                Left (NotARecord Expr Void Void
e) -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
e)
                Left CompileError
x -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left CompileError
x
            return $ Key -> NonEmpty TOML -> TOML -> TOML
Toml.TOML.insertTableArrays Key
key NonEmpty TOML
tables' TOML
toml

        record :: Expr Void Void
record@(Core.RecordLit Map Text (RecordField Void Void)
_) : [Expr Void Void]
records -> do
            NonEmpty TOML
tables' <- case (Expr Void Void
 -> Either CompileError (Map Text (RecordField Void Void)))
-> NonEmpty (Expr Void Void)
-> Either
     CompileError (NonEmpty (Map Text (RecordField Void Void)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Expr Void Void
record Expr Void Void -> [Expr Void Void] -> NonEmpty (Expr Void Void)
forall a. a -> [a] -> NonEmpty a
:| [Expr Void Void]
records)  of
                Right NonEmpty (Map Text (RecordField Void Void))
x -> (Map Text (RecordField Void Void) -> Either CompileError TOML)
-> NonEmpty (Map Text (RecordField Void Void))
-> Either CompileError (NonEmpty TOML)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable NonEmpty (Map Text (RecordField Void Void))
x
                Left (NotARecord Expr Void Void
e) -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
e)
                Left CompileError
x -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left CompileError
x
            return $ Key -> NonEmpty TOML -> TOML -> TOML
Toml.TOML.insertTableArrays Key
key NonEmpty TOML
tables' TOML
toml
        -- inline array
        [Expr Void Void]
a' -> do
            [AnyValue]
anyList <- (Expr Void Void -> Either CompileError AnyValue)
-> [Expr Void Void] -> Either CompileError [AnyValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void -> Either CompileError AnyValue
toAny [Expr Void Void]
a'
            let arrayEither :: Either MatchError (Value 'TArray)
arrayEither = [AnyValue] -> Either MatchError (Value 'TArray)
Toml.AnyValue.toMArray [AnyValue]
anyList
            Value 'TArray
array <- (MatchError -> CompileError)
-> Either MatchError (Value 'TArray)
-> Either CompileError (Value 'TArray)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first (CompileError -> MatchError -> CompileError
forall a b. a -> b -> a
const (CompileError -> MatchError -> CompileError)
-> CompileError -> MatchError -> CompileError
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
expr) Either MatchError (Value 'TArray)
arrayEither
            return $ Value 'TArray -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim Value 'TArray
array
    Core.RecordLit Map Text (RecordField Void Void)
r ->
        let
            (Map Text (RecordField Void Void)
inline, Map Text (RecordField Void Void)
nested) = (RecordField Void Void -> Bool)
-> Map Text (RecordField Void Void)
-> (Map Text (RecordField Void Void),
    Map Text (RecordField Void Void))
forall k a. Ord k => (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition (Expr Void Void -> Bool
forall s a. Expr s a -> Bool
isInline (Expr Void Void -> Bool)
-> (RecordField Void Void -> Expr Void Void)
-> RecordField Void Void
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue) Map Text (RecordField Void Void)
r
        in
            if Map Text (RecordField Void Void) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (RecordField Void Void)
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 (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold ([Piece]
 -> TOML
 -> (Text, RecordField Void Void)
 -> Either CompileError TOML)
-> [Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ NonEmpty Piece -> [Piece]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Piece -> [Piece]) -> NonEmpty Piece -> [Piece]
forall a b. (a -> b) -> a -> b
$ Key -> NonEmpty Piece
unKey Key
key) TOML
toml (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
nested)
            else do
                -- the order here is important, at least for testing, because
                -- the PrefixMap inside TOML is dependent on insert order
                TOML
inlinePairs <- (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold []) TOML
forall a. Monoid a => a
mempty      (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
inline)
                TOML
nestedPairs <- (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold []) TOML
inlinePairs (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
nested)
                return $ Key -> TOML -> TOML -> TOML
Toml.TOML.insertTable Key
key TOML
nestedPairs TOML
toml
    Expr Void Void
_ -> CompileError -> Either CompileError TOML
forall a b. a -> Either a b
Left (CompileError -> Either CompileError TOML)
-> CompileError -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
Unsupported Expr Void Void
expr
    where
        insertPrim :: Toml.Value.Value a -> TOML
        insertPrim :: Value a -> TOML
insertPrim Value a
val = Key -> Value a -> TOML -> TOML
forall (a :: TValue). Key -> Value a -> TOML -> TOML
Toml.TOML.insertKeyVal Key
key Value a
val TOML
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 :: Expr s a -> Bool
isInline Expr s a
v = case Expr s a
v of
            Core.BoolLit Bool
_    -> Bool
True
            Core.NaturalLit Natural
_ -> Bool
True
            Core.DoubleLit DhallDouble
_  -> Bool
True
            Core.TextLit Chunks s a
_    -> Bool
True
            Core.ListLit Maybe (Expr s a)
_ Seq (Expr s a)
s  -> case Int -> Seq (Expr s a) -> Maybe (Expr s a)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq (Expr s a)
s of
                Maybe (Expr s a)
Nothing                  -> Bool
True
                Just (Core.BoolLit Bool
_)    -> Bool
True
                Just (Core.NaturalLit Natural
_) -> Bool
True
                Just (Core.DoubleLit DhallDouble
_)  -> Bool
True
                Just (Core.TextLit Chunks s a
_)    -> Bool
True
                Just (Core.ListLit Maybe (Expr s a)
_ Seq (Expr s a)
_)  -> Bool
True
                Maybe (Expr s a)
_                        -> Bool
False
            Expr s a
_ -> Bool
False

        rightAny :: Value t -> Either a AnyValue
rightAny = AnyValue -> Either a AnyValue
forall a b. b -> Either a b
Right (AnyValue -> Either a AnyValue)
-> (Value t -> AnyValue) -> Value t -> Either a AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
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 :: Expr Void Void -> Either CompileError AnyValue
toAny Expr Void Void
e = case Expr Void Void
e of
            Core.BoolLit Bool
x                  -> Value 'TBool -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TBool -> Either CompileError AnyValue)
-> Value 'TBool -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Bool -> Value 'TBool
Toml.Value.Bool Bool
x
            Core.NaturalLit Natural
x               -> Value 'TInteger -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TInteger -> Either CompileError AnyValue)
-> Value 'TInteger -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Integer -> Value 'TInteger
Toml.Value.Integer (Integer -> Value 'TInteger) -> Integer -> Value 'TInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x
            Core.DoubleLit (DhallDouble Double
x)  -> Value 'TDouble -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TDouble -> Either CompileError AnyValue)
-> Value 'TDouble -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Double -> Value 'TDouble
Toml.Value.Double Double
x
            Core.TextLit (Core.Chunks [] Text
x) -> Value 'TText -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TText -> Either CompileError AnyValue)
-> Value 'TText -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Text -> Value 'TText
Toml.Value.Text Text
x
            UnionEmpty Text
x                    -> Value 'TText -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TText -> Either CompileError AnyValue)
-> Value 'TText -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Text -> Value 'TText
Toml.Value.Text Text
x
            UnionApp Expr Void Void
x                      -> Expr Void Void -> Either CompileError AnyValue
toAny Expr Void Void
x
            Core.ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
x                -> do
                [AnyValue]
anyList <- (Expr Void Void -> Either CompileError AnyValue)
-> [Expr Void Void] -> Either CompileError [AnyValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void -> Either CompileError AnyValue
toAny ([Expr Void Void] -> Either CompileError [AnyValue])
-> [Expr Void Void] -> Either CompileError [AnyValue]
forall a b. (a -> b) -> a -> b
$ Seq (Expr Void Void) -> [Expr Void Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr Void Void)
x
                case [AnyValue] -> Either MatchError (Value 'TArray)
Toml.AnyValue.toMArray [AnyValue]
anyList of
                    Right Value 'TArray
x' -> Value 'TArray -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny Value 'TArray
x'
                    Left MatchError
_ -> CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (CompileError -> Either CompileError AnyValue)
-> CompileError -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
expr
            Core.RecordLit Map Text (RecordField Void Void)
_ -> CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (CompileError -> Either CompileError AnyValue)
-> CompileError -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
UnsupportedArray Expr Void Void
e
            Expr Void Void
_ -> CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (CompileError -> Either CompileError AnyValue)
-> CompileError -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
Unsupported Expr Void Void
e

data Options = Options
    { Options -> Maybe String
input :: Maybe FilePath
    , Options -> Maybe String
output :: Maybe FilePath
    }

parserInfo :: OA.ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
    (Parser ((Options -> Options) -> Options -> Options)
forall a. Parser (a -> a)
OA.helper Parser ((Options -> Options) -> Options -> Options)
-> Parser (Options -> Options) -> Parser (Options -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Options -> Options)
forall a. Parser (a -> a)
versionOption Parser (Options -> Options) -> Parser Options -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
optionsParser)
    (InfoMod Options
forall a. InfoMod a
OA.fullDesc InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
OA.progDesc String
"Convert Dhall to TOML")
  where
    versionOption :: Parser (a -> a)
versionOption = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
OA.infoOption (Version -> String
showVersion Version
Meta.version) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
        String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Display version"
    optionsParser :: Parser Options
optionsParser = do
        Maybe String
input <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
               String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"file"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Read Dhall from file instead of standard input"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a. Mod OptionFields a
fileOpts
        Maybe String
output <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
               String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"output"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Write TOML to a file instead of standard output"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a. Mod OptionFields a
fileOpts
        pure Options :: Maybe String -> Maybe String -> Options
Options {Maybe String
output :: Maybe String
input :: Maybe String
output :: Maybe String
input :: Maybe String
..}
    fileOpts :: Mod OptionFields a
fileOpts = String -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"FILE" Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields a
forall (f :: * -> *) a. HasCompleter f => String -> Mod f a
OA.action String
"file"

{-| Runs the @dhall-to-toml@ command
-}
dhallToTomlMain :: IO ()
dhallToTomlMain :: IO ()
dhallToTomlMain = do
    Options {Maybe String
output :: Maybe String
input :: Maybe String
output :: Options -> Maybe String
input :: Options -> Maybe String
..} <- ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
OA.execParser ParserInfo Options
parserInfo
    Expr Src Void
resolvedExpression <- IO (Expr Src Void)
-> (String -> IO (Expr Src Void))
-> Maybe String
-> IO (Expr Src Void)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Expr Src Void)
inputToDhall String -> IO (Expr Src Void)
fileToDhall Maybe String
input
    TOML
toml <- case Expr Src Void -> Either CompileError TOML
forall s. Expr s Void -> Either CompileError TOML
dhallToToml Expr Src Void
resolvedExpression of
        Left CompileError
err -> CompileError -> IO TOML
forall e a. Exception e => e -> IO a
throwIO CompileError
err
        Right TOML
toml -> TOML -> IO TOML
forall (m :: * -> *) a. Monad m => a -> m a
return TOML
toml
    (Text -> IO ())
-> (String -> Text -> IO ()) -> Maybe String -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
Text.IO.putStrLn String -> Text -> IO ()
Text.IO.writeFile Maybe String
output (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ TOML -> Text
pretty TOML
toml