{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}

{-| 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

    … and @Prelude.Map.Type@ also translates to a TOML table:

> $ dhall-to-toml <<< '[ { mapKey = "foo", mapValue = 1 } ]'
> foo = 1

    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)
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.Map          (Map)
import Dhall.Toml.Utils   (fileToDhall, inputToDhall)
import Prettyprinter      (Pretty)
import Toml.Type.Key      (Key(..), Piece (Piece))
import Toml.Type.AnyValue (AnyValue(..))
import Toml.Type.TOML     (TOML)

import qualified Data.List.NonEmpty        as NonEmpty
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 Options
import qualified Paths_dhall_toml          as Meta
import qualified Prettyprinter.Render.Text as Pretty
import qualified Toml.Type.AnyValue        as AnyValue
import qualified Toml.Type.Printer         as Printer
import qualified Toml.Type.TOML            as TOML
import qualified Toml.Type.Value           as 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
$c== :: CompileError -> CompileError -> Bool
== :: CompileError -> CompileError -> Bool
$c/= :: CompileError -> CompileError -> Bool
/= :: 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 :: forall a. Pretty a => 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 (Value.Integer 1)),("bar",AnyValue (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 :: forall s. Expr s Void -> Either CompileError TOML
dhallToToml Expr s Void
expression = do
    Map Text (RecordField Void Void)
record <- 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
expression)
    Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable Map Text (RecordField Void Void)
record

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

assertRecordLit
    :: Expr Void Void
    -> Either CompileError (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 (Core.ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
expressions)
    | Just [(Text, RecordField Void Void)]
keyValues <- (Expr Void Void -> Maybe (Text, RecordField Void Void))
-> [Expr Void Void] -> Maybe [(Text, RecordField Void Void)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Expr Void Void -> Maybe (Text, RecordField Void Void)
forall {s} {a}. Expr s a -> Maybe (Text, RecordField s a)
toKeyValue (Seq (Expr Void Void) -> [Expr Void Void]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr Void Void)
expressions) =
        Map Text (RecordField Void Void)
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. b -> Either a b
Right ([(Text, RecordField Void Void)] -> Map Text (RecordField Void Void)
forall k v. Ord k => [(k, v)] -> Map k v
Map.fromList [(Text, RecordField Void Void)]
keyValues)
  where
    toKeyValue :: Expr s a -> Maybe (Text, RecordField s a)
toKeyValue
       (Core.RecordLit [ (Text
"mapKey", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.TextLit (Core.Chunks [] Text
key)), (Text
"mapValue", RecordField s a
value) ]) =
       (Text, RecordField s a) -> Maybe (Text, RecordField s a)
forall a. a -> Maybe a
Just (Text
key, RecordField s a
value)
    toKeyValue Expr s a
_ =
       Maybe (Text, RecordField s a)
forall a. Maybe a
Nothing
assertRecordLit Expr Void Void
e =
    CompileError
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
NotARecord Expr Void Void
e)

toTomlTable :: 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
-> NonEmpty Piece -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml (Text -> Piece
Piece Text
key Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| [Piece]
curKey) (RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue RecordField Void Void
val)

toToml :: TOML -> NonEmpty Piece -> Expr Void Void -> Either CompileError TOML
toToml :: TOML
-> NonEmpty Piece -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml NonEmpty Piece
pieces Expr Void Void
expr  = case Expr Void Void
expr of
    Core.BoolLit Bool
a ->
        Value 'TBool -> Either CompileError TOML
forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim (Bool -> Value 'TBool
Value.Bool Bool
a)

    Core.NaturalLit Natural
a ->
        Value 'TInteger -> Either CompileError TOML
forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim (Integer -> Value 'TInteger
Value.Integer (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
a))

    Core.IntegerLit Integer
a ->
        Value 'TInteger -> Either CompileError TOML
forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim (Integer -> Value 'TInteger
Value.Integer Integer
a)

    Core.DoubleLit (DhallDouble Double
a) ->
        Value 'TDouble -> Either CompileError TOML
forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim (Double -> Value 'TDouble
Value.Double Double
a)

    Core.TextLit (Core.Chunks [] Text
a) ->
        Value 'TText -> Either CompileError TOML
forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim (Text -> Value 'TText
Value.Text Text
a)

    UnionEmpty Text
a ->
        Value 'TText -> Either CompileError TOML
forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim (Text -> Value 'TText
Value.Text Text
a)

    UnionApp Expr Void Void
a ->
        TOML
-> NonEmpty Piece -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml NonEmpty Piece
pieces Expr Void Void
a

    Core.Some Expr Void Void
a ->
        TOML
-> NonEmpty Piece -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml NonEmpty Piece
pieces Expr Void Void
a

    Core.App Expr Void Void
Core.None Expr Void Void
_ ->
        TOML -> Either CompileError TOML
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return TOML
toml

    Core.RecordLit Map Text (RecordField Void Void)
r -> do
        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

        -- the order here is important, at least for testing, because the
        -- PrefixMap inside TOML is dependent on insert order
        let pairs :: [(Text, RecordField Void Void)]
pairs = 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 [(Text, RecordField Void Void)]
-> [(Text, RecordField Void Void)]
-> [(Text, RecordField Void Void)]
forall a. Semigroup a => a -> a -> a
<> 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

        if Map Text (RecordField Void Void) -> Bool
forall a. Map Text a -> 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 do
            (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 (NonEmpty Piece -> [Piece]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Piece
pieces)) TOML
toml [(Text, RecordField Void Void)]
pairs
        else do
            TOML
newPairs <- (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 [(Text, RecordField Void Void)]
pairs
            return (Key -> TOML -> TOML -> TOML
TOML.insertTable Key
key TOML
newPairs TOML
toml)

    Expr Void Void
_ | Right Map Text (RecordField Void Void)
keyValues <- Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit Expr Void Void
expr ->
        TOML
-> NonEmpty Piece -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml NonEmpty Piece
pieces (Map Text (RecordField Void Void) -> Expr Void Void
forall s a. Map Text (RecordField s a) -> Expr s a
Core.RecordLit Map Text (RecordField Void Void)
keyValues)

    Core.ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
a -> case Seq (Expr Void Void) -> [Expr Void Void]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr Void Void)
a of
        -- 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 (Expr Void Void) -> Either CompileError TOML
insertTables (Expr Void Void
union Expr Void Void -> [Expr Void Void] -> NonEmpty (Expr Void Void)
forall a. a -> [a] -> NonEmpty a
:| [Expr Void Void]
unions)

        record :: Expr Void Void
record@(Core.RecordLit Map Text (RecordField Void Void)
_) : [Expr Void Void]
records -> do
            NonEmpty (Expr Void Void) -> Either CompileError TOML
insertTables (Expr Void Void
record Expr Void Void -> [Expr Void Void] -> NonEmpty (Expr Void Void)
forall a. a -> [a] -> NonEmpty a
:| [Expr Void Void]
records)

        -- inline array
        [Expr Void Void]
expressions -> do
            [AnyValue]
anyValues <- (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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Expr Void Void -> Either CompileError AnyValue
toAnyValue [Expr Void Void]
expressions

            case [AnyValue] -> Either MatchError (Value 'TArray)
AnyValue.toMArray [AnyValue]
anyValues of
                Left MatchError
_ -> CompileError -> Either CompileError TOML
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
expr)
                Right Value 'TArray
array -> Value 'TArray -> Either CompileError TOML
forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim Value 'TArray
array

    Expr Void Void
_ ->
        CompileError -> Either CompileError TOML
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
Unsupported Expr Void Void
expr)
  where
    key :: Key
    key :: Key
key = NonEmpty Piece -> Key
Key (NonEmpty Piece -> NonEmpty Piece
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse NonEmpty Piece
pieces)

    insertPrim :: Value.Value a -> Either CompileError TOML
    insertPrim :: forall (a :: TValue). Value a -> Either CompileError TOML
insertPrim Value a
val = TOML -> Either CompileError TOML
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Key -> Value a -> TOML -> TOML
forall (a :: TValue). Key -> Value a -> TOML -> TOML
TOML.insertKeyVal Key
key Value a
val TOML
toml)

    insertTables :: NonEmpty (Expr Void Void) -> Either CompileError TOML
    insertTables :: NonEmpty (Expr Void Void) -> Either CompileError TOML
insertTables NonEmpty (Expr Void Void)
expressions = 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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit NonEmpty (Expr Void Void)
expressions 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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty 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.insertTableArrays Key
key NonEmpty TOML
tables 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.IntegerLit Integer
_ -> 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

    -- toAnyValue 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
    toAnyValue :: Expr Void Void -> Either CompileError AnyValue
    toAnyValue :: Expr Void Void -> Either CompileError AnyValue
toAnyValue Expr Void Void
expression = case Expr Void Void
expression of
        Core.BoolLit Bool
x ->
            AnyValue -> Either CompileError AnyValue
forall a b. b -> Either a b
Right (Value 'TBool -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Bool -> Value 'TBool
Value.Bool Bool
x))
        Core.IntegerLit Integer
x ->
            AnyValue -> Either CompileError AnyValue
forall a b. b -> Either a b
Right (Value 'TInteger -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Integer -> Value 'TInteger
Value.Integer Integer
x))
        Core.NaturalLit Natural
x ->
            AnyValue -> Either CompileError AnyValue
forall a b. b -> Either a b
Right (Value 'TInteger -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Integer -> Value 'TInteger
Value.Integer (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x)))
        Core.DoubleLit (DhallDouble Double
x) ->
            AnyValue -> Either CompileError AnyValue
forall a b. b -> Either a b
Right (Value 'TDouble -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Double -> Value 'TDouble
Value.Double Double
x))
        Core.TextLit (Core.Chunks [] Text
x) ->
            AnyValue -> Either CompileError AnyValue
forall a b. b -> Either a b
Right (Value 'TText -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Text -> Value 'TText
Value.Text Text
x))
        UnionEmpty Text
x ->
            AnyValue -> Either CompileError AnyValue
forall a b. b -> Either a b
Right (Value 'TText -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Text -> Value 'TText
Value.Text Text
x))
        UnionApp Expr Void Void
x ->
            Expr Void Void -> Either CompileError AnyValue
toAnyValue 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Expr Void Void -> Either CompileError AnyValue
toAnyValue (Seq (Expr Void Void) -> [Expr Void Void]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr Void Void)
x)
            case [AnyValue] -> Either MatchError (Value 'TArray)
AnyValue.toMArray [AnyValue]
anyList of
                Right Value 'TArray
x' -> AnyValue -> Either CompileError AnyValue
forall a b. b -> Either a b
Right (Value 'TArray -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue Value 'TArray
x')
                Left MatchError
_   -> CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (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 (Expr Void Void -> CompileError
UnsupportedArray Expr Void Void
expression)
        Expr Void Void
_ ->
            CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
Unsupported Expr Void Void
expression)

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

parserInfo :: Options.ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info
    (Parser ((Options -> Options) -> Options -> Options)
forall a. Parser (a -> a)
Options.helper Parser ((Options -> Options) -> Options -> Options)
-> Parser (Options -> Options) -> Parser (Options -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
optionsParser)
    (InfoMod Options
forall a. InfoMod a
Options.fullDesc InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
Options.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)
Options.infoOption (Version -> String
showVersion Version
Meta.version)
            (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.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
Options.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)
Options.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
Options.strOption)
            (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.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
Options.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
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar 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. HasCompleter f => String -> Mod f a
Options.action String
"file"
            )

        Maybe String
output <- (Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Options.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
Options.strOption)
            (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.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
Options.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
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Options.metavar 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. HasCompleter f => String -> Mod f a
Options.action String
"file"
            )

        pure Options{Maybe String
input :: Maybe String
output :: Maybe String
input :: Maybe String
output :: Maybe String
..}

{-| Runs the @dhall-to-toml@ command
-}
dhallToTomlMain :: IO ()
dhallToTomlMain :: IO ()
dhallToTomlMain = do
    Options{Maybe String
input :: Options -> Maybe String
output :: Options -> Maybe String
input :: Maybe String
output :: Maybe String
..} <- ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
Options.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 <- Either CompileError TOML -> IO TOML
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (Expr Src Void -> Either CompileError TOML
forall s. Expr s Void -> Either CompileError TOML
dhallToToml Expr Src Void
resolvedExpression)

    let text :: Text
text = TOML -> Text
Printer.pretty TOML
toml

    case Maybe String
output of
        Just String
file -> String -> Text -> IO ()
Text.IO.writeFile String
file Text
text
        Maybe String
Nothing   -> Text -> IO ()
Text.IO.putStrLn Text
text