{-# LANGUAGE ApplicativeDo   #-}
{-# LANGUAGE GADTs           #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}

{-| 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        (foldl', 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.Parser         (Src)
import Dhall.Toml.Utils     (fileToDhall)
import Toml.Parser          (TomlParseError)
import Toml.Type.AnyValue   (AnyValue (AnyValue))
import Toml.Type.Key        (Key (Key), Piece (Piece))
import Toml.Type.PrefixTree (PrefixTree)
import Toml.Type.TOML       (TOML)
import Toml.Type.Value      (Value)

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.Core           as Core
import qualified Dhall.Map            as Map
import qualified Options.Applicative  as OA
import qualified Paths_dhall_toml     as Meta
import qualified Toml.Parser
import qualified Toml.Type.AnyValue   as Toml.AnyValue
import qualified Toml.Type.PrefixTree as Toml.PrefixTree
import qualified Toml.Type.TOML       as Toml.TOML
import qualified Toml.Type.Value      as Value

data CompileError
    = Unimplemented String
    | Incompatible (Expr Src Void) Object
    | InvalidToml TomlParseError
    | InternalError String
    | MissingKey String

instance Show CompileError where
    show :: CompileError -> FilePath
show (Unimplemented FilePath
s) = FilePath
"unimplemented: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
s
    show (Incompatible Expr Src Void
e Object
toml) = FilePath
"incompatible: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Expr Src Void -> FilePath
forall a. Show a => a -> FilePath
show Expr Src Void
e) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" with " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Object -> FilePath
forall a. Show a => a -> FilePath
show Object
toml)
    show (InvalidToml TomlParseError
e) = FilePath
"invalid TOML:\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text -> FilePath
Data.Text.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ TomlParseError -> Text
Toml.Parser.unTomlParseError TomlParseError
e)
    show (InternalError FilePath
e) = FilePath
"internal error: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
e
    show (MissingKey FilePath
e) = FilePath
"missing key: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
e

instance Exception CompileError

tomlToDhall :: Expr Src Void -> TOML -> Either CompileError (Expr Src Void)
tomlToDhall :: Expr Src Void -> TOML -> Either CompileError (Expr Src Void)
tomlToDhall Expr Src Void
schema TOML
toml = Expr Src Void -> Object -> Either CompileError (Expr Src Void)
toDhall (Expr Src Void -> Expr Src Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr Src Void
schema) (TOML -> Object
tomlToObject TOML
toml)

tomlValueToDhall :: Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
tomlValueToDhall :: forall (t :: TValue).
Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
tomlValueToDhall Expr Src Void
exprType Value t
v = case (Expr Src Void
exprType, Value t
v) of
    (Expr Src Void
Core.Bool                , Value.Bool Bool
a   ) -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Bool -> Expr Src Void
forall s a. Bool -> Expr s a
Core.BoolLit Bool
a
    (Expr Src Void
Core.Integer             , Value.Integer Integer
a) -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Integer -> Expr Src Void
forall s a. Integer -> Expr s a
Core.IntegerLit Integer
a
    (Expr Src Void
Core.Natural             , Value.Integer Integer
a) -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Natural -> Expr Src Void
forall s a. Natural -> Expr s a
Core.NaturalLit (Natural -> Expr Src Void) -> Natural -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
a
    (Expr Src Void
Core.Double              , Value.Double Double
a ) -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ DhallDouble -> Expr Src Void
forall s a. DhallDouble -> Expr s a
Core.DoubleLit (DhallDouble -> Expr Src Void) -> DhallDouble -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Double -> DhallDouble
DhallDouble Double
a
    (Expr Src Void
Core.Text                , Value.Text Text
a   ) -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Chunks Src Void -> Expr Src Void
forall s a. Chunks s a -> Expr s a
Core.TextLit (Chunks Src Void -> Expr Src Void)
-> Chunks Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ [(Text, Expr Src Void)] -> Text -> Chunks Src Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [] Text
a
    (Expr Src Void
_                        , Value.Zoned ZonedTime
_  ) -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ FilePath -> CompileError
Unimplemented FilePath
"toml time values"
    (Expr Src Void
_                        , Value.Local LocalTime
_  ) -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ FilePath -> CompileError
Unimplemented FilePath
"toml time values"
    (Expr Src Void
_                        , Value.Day Day
_    ) -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ FilePath -> CompileError
Unimplemented FilePath
"toml time values"
    (t :: Expr Src Void
t@(Core.App Expr Src Void
Core.List Expr Src Void
_) , Value.Array [] ) -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit (Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
t) []
    (Core.App Expr Src Void
Core.Optional Expr Src Void
t , Value t
a              ) -> do
        Expr Src Void
o <- Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
forall (t :: TValue).
Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
tomlValueToDhall Expr Src Void
t Value t
a
        return $ Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a
Core.Some Expr Src Void
o
    (Core.App Expr Src Void
Core.List Expr Src Void
t     , Value.Array [Value t1]
a  ) -> do
        [Expr Src Void]
l <- (Value t1 -> Either CompileError (Expr Src Void))
-> [Value t1] -> Either CompileError [Expr Src 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) -> [a] -> m [b]
mapM (Expr Src Void -> Value t1 -> Either CompileError (Expr Src Void)
forall (t :: TValue).
Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
tomlValueToDhall Expr Src Void
t) [Value t1]
a
        return $ Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit Maybe (Expr Src Void)
forall a. Maybe a
Nothing ([Expr Src Void] -> Seq (Expr Src Void)
forall a. [a] -> Seq a
Seq.fromList [Expr Src Void]
l)

    -- TODO: allow different types of matching (ex. first, strict, none)
    -- currently we just pick the first enum that matches
    (Core.Union Map Text (Maybe (Expr Src Void))
m        , Value t
_)        -> let
        f :: Text
-> Maybe (Expr Src Void) -> Either CompileError (Expr Src Void)
f Text
key Maybe (Expr Src Void)
maybeType = case Maybe (Expr Src Void)
maybeType of
            Just Expr Src Void
ty -> do
                Expr Src Void
expr <- Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
forall (t :: TValue).
Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
tomlValueToDhall Expr Src Void
ty Value t
v
                return $ Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Core.Field Expr Src Void
exprType (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
key) Expr Src Void
expr
            Maybe (Expr Src Void)
Nothing -> case Value t
v of
                Value.Text Text
a | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key ->
                    Expr Src Void -> Either CompileError (Expr Src Void)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Core.Field Expr Src Void
exprType (Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
a)
                Value t
_ -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Object -> CompileError
Incompatible Expr Src Void
exprType (AnyValue -> Object
Prim (Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue Value t
v))

        in case [Either CompileError (Expr Src Void)] -> [Expr Src Void]
forall a b. [Either a b] -> [b]
rights (Map Text (Either CompileError (Expr Src Void))
-> [Either CompileError (Expr Src Void)]
forall a. Map Text a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((Text
 -> Maybe (Expr Src Void) -> Either CompileError (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Either CompileError (Expr Src Void))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Text
-> Maybe (Expr Src Void) -> Either CompileError (Expr Src Void)
f Map Text (Maybe (Expr Src Void))
m)) of
            []  -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Object -> CompileError
Incompatible Expr Src Void
exprType (AnyValue -> Object
Prim (Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue Value t
v))
            Expr Src Void
x:[Expr Src Void]
_ -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void
x

    (Expr Src Void, Value t)
_ -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Object -> CompileError
Incompatible Expr Src Void
exprType (AnyValue -> Object
Prim (Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue Value t
v))

-- TODO: keep track of the path for more helpful error messages
toDhall :: Expr Src Void -> Object -> Either CompileError (Expr Src Void)
toDhall :: Expr Src Void -> Object -> Either CompileError (Expr Src Void)
toDhall Expr Src Void
exprType Object
value = case (Expr Src Void
exprType, Object
value) of
    (Expr Src Void
_,                    Object
Invalid)  -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ FilePath -> CompileError
InternalError FilePath
"invalid object"

    -- TODO: allow different types of matching (ex. first, strict, none)
    -- currently we just pick the first enum that matches
    (Core.Union Map Text (Maybe (Expr Src Void))
m        , Object
_)        -> let
        f :: Text
-> Maybe (Expr Src Void) -> Either CompileError (Expr Src Void)
f Text
key Maybe (Expr Src Void)
maybeType = case Maybe (Expr Src Void)
maybeType of
            Just Expr Src Void
ty -> do
                Expr Src Void
expr <- Expr Src Void -> Object -> Either CompileError (Expr Src Void)
toDhall Expr Src Void
ty Object
value
                return $ Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Core.Field Expr Src Void
exprType (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
key) Expr Src Void
expr
            Maybe (Expr Src Void)
Nothing -> case Object
value of
                Prim (AnyValue (Value.Text Text
a)) | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key ->
                    Expr Src Void -> Either CompileError (Expr Src Void)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Core.Field Expr Src Void
exprType (Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
a)
                Object
_ -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Object -> CompileError
Incompatible Expr Src Void
exprType Object
value

        in case [Either CompileError (Expr Src Void)] -> [Expr Src Void]
forall a b. [Either a b] -> [b]
rights (Map Text (Either CompileError (Expr Src Void))
-> [Either CompileError (Expr Src Void)]
forall a. Map Text a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((Text
 -> Maybe (Expr Src Void) -> Either CompileError (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Either CompileError (Expr Src Void))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Text
-> Maybe (Expr Src Void) -> Either CompileError (Expr Src Void)
f Map Text (Maybe (Expr Src Void))
m)) of
            []  -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Object -> CompileError
Incompatible Expr Src Void
exprType Object
value
            Expr Src Void
x:[Expr Src Void]
_ -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void
x

    (Core.App Expr Src Void
Core.List Expr Src Void
t, Array []) -> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit (Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
t) []

    (Core.App Expr Src Void
Core.List Expr Src Void
t, Array [Object]
a) -> do
        [Expr Src Void]
l <- (Object -> Either CompileError (Expr Src Void))
-> [Object] -> Either CompileError [Expr Src 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) -> [a] -> m [b]
mapM (Expr Src Void -> Object -> Either CompileError (Expr Src Void)
toDhall Expr Src Void
t) [Object]
a
        return $ Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit Maybe (Expr Src Void)
forall a. Maybe a
Nothing ([Expr Src Void] -> Seq (Expr Src Void)
forall a. [a] -> Seq a
Seq.fromList [Expr Src Void]
l)

    (Core.Record Map Text (RecordField Src Void)
r, Table HashMap Piece Object
t) -> let
        f :: Text -> (Expr Src Void) -> Either CompileError (Expr Src Void)
        f :: Text -> Expr Src Void -> Either CompileError (Expr Src Void)
f Text
k Expr Src Void
ty | Just Object
val <- Piece -> HashMap Piece Object -> Maybe Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Piece
Piece Text
k) HashMap Piece Object
t = Expr Src Void -> Object -> Either CompileError (Expr Src Void)
toDhall Expr Src Void
ty Object
val
               | Core.App Expr Src Void
Core.Optional Expr Src Void
ty' <- Expr Src Void
ty = Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App Expr Src Void
forall s a. Expr s a
Core.None Expr Src Void
ty')
               | Core.App Expr Src Void
Core.List Expr Src Void
_ <- Expr Src Void
ty = Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. b -> Either a b
Right (Expr Src Void -> Either CompileError (Expr Src Void))
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit (Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
ty) []
               | Bool
otherwise = CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ FilePath -> CompileError
MissingKey (FilePath -> CompileError) -> FilePath -> CompileError
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Data.Text.unpack Text
k
        in do
            Map Text (Expr Src Void)
values <- (Text -> Expr Src Void -> Either CompileError (Expr Src Void))
-> Map Text (Expr Src Void)
-> Either CompileError (Map Text (Expr Src Void))
forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> Map k a -> f (Map k b)
Map.traverseWithKey Text -> Expr Src Void -> Either CompileError (Expr Src Void)
f (RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Map Text (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField Src Void)
r)
            return $ Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Core.RecordLit (Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Map Text (Expr Src Void) -> Map Text (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Expr Src Void)
values)

    (Expr Src Void
_, Prim (AnyValue Value t
v)) -> Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
forall (t :: TValue).
Expr Src Void -> Value t -> Either CompileError (Expr Src Void)
tomlValueToDhall Expr Src Void
exprType Value t
v

    (Expr Src Void
ty, Object
obj) -> CompileError -> Either CompileError (Expr Src Void)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Expr Src Void))
-> CompileError -> Either CompileError (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Object -> CompileError
Incompatible Expr Src Void
ty Object
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 (Int -> Object -> ShowS
[Object] -> ShowS
Object -> FilePath
(Int -> Object -> ShowS)
-> (Object -> FilePath) -> ([Object] -> ShowS) -> Show Object
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Object -> ShowS
showsPrec :: Int -> Object -> ShowS
$cshow :: Object -> FilePath
show :: Object -> FilePath
$cshowList :: [Object] -> ShowS
showList :: [Object] -> ShowS
Show)

instance Semigroup Object where
    (Table HashMap Piece Object
ls) <> :: Object -> Object -> Object
<> (Table HashMap Piece Object
rs) = HashMap Piece Object -> Object
Table (HashMap Piece Object
ls HashMap Piece Object
-> HashMap Piece Object -> HashMap Piece Object
forall a. Semigroup a => a -> a -> a
<> HashMap Piece Object
rs)
    -- this shouldn't happen because tomland has already verified correctness
    -- of the toml object
    Object
_ <> Object
_ = Object
Invalid

-- | Creates an arbitrarily nested object
sparseObject :: Key -> Object -> Object
sparseObject :: Key -> Object -> Object
sparseObject (Key (Piece
piece :| [])) Object
value = HashMap Piece Object -> Object
Table (HashMap Piece Object -> Object) -> HashMap Piece Object -> Object
forall a b. (a -> b) -> a -> b
$ Piece -> Object -> HashMap Piece Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Piece
piece Object
value
sparseObject (Key (Piece
piece :| Piece
rest:[Piece]
rest')) Object
value
    = HashMap Piece Object -> Object
Table (HashMap Piece Object -> Object) -> HashMap Piece Object -> Object
forall a b. (a -> b) -> a -> b
$ Piece -> Object -> HashMap Piece Object
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Piece
piece (Key -> Object -> Object
sparseObject (NonEmpty Piece -> Key
Key (NonEmpty Piece -> Key) -> NonEmpty Piece -> Key
forall a b. (a -> b) -> a -> b
$ Piece
rest Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| [Piece]
rest') Object
value)

pairsToObject :: HashMap.HashMap Key Toml.AnyValue.AnyValue -> Object
pairsToObject :: HashMap Key AnyValue -> Object
pairsToObject HashMap Key AnyValue
pairs
    = (Object -> Object -> Object)
-> Object -> HashMap Key Object -> Object
forall b a. (b -> a -> b) -> b -> HashMap Key a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
(<>) (HashMap Piece Object -> Object
Table HashMap Piece Object
forall k v. HashMap k v
HashMap.empty)
    (HashMap Key Object -> Object) -> HashMap Key Object -> Object
forall a b. (a -> b) -> a -> b
$ (Key -> Object -> Object)
-> HashMap Key Object -> HashMap Key Object
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapWithKey Key -> Object -> Object
sparseObject
    (HashMap Key Object -> HashMap Key Object)
-> HashMap Key Object -> HashMap Key Object
forall a b. (a -> b) -> a -> b
$ (AnyValue -> Object) -> HashMap Key AnyValue -> HashMap Key Object
forall a b. (a -> b) -> HashMap Key a -> HashMap Key b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyValue -> Object
Prim HashMap Key AnyValue
pairs

tablesToObject :: Toml.PrefixTree.PrefixMap TOML -> Object
tablesToObject :: PrefixMap TOML -> Object
tablesToObject PrefixMap TOML
tables
    = (Object -> Object -> Object) -> Object -> [Object] -> Object
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
(<>) (HashMap Piece Object -> Object
Table HashMap Piece Object
forall k v. HashMap k v
HashMap.empty)
    ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ (PrefixTree TOML -> Object) -> [PrefixTree TOML] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map PrefixTree TOML -> Object
prefixTreeToObject
    ([PrefixTree TOML] -> [Object]) -> [PrefixTree TOML] -> [Object]
forall a b. (a -> b) -> a -> b
$ PrefixMap TOML -> [PrefixTree TOML]
forall k v. HashMap k v -> [v]
HashMap.elems PrefixMap TOML
tables

prefixTreeToObject :: PrefixTree TOML -> Object
prefixTreeToObject :: PrefixTree TOML -> Object
prefixTreeToObject (Toml.PrefixTree.Leaf Key
key TOML
toml)
    = Key -> Object -> Object
sparseObject Key
key (TOML -> Object
tomlToObject TOML
toml)
prefixTreeToObject (Toml.PrefixTree.Branch Key
prefix Maybe TOML
_ PrefixMap TOML
toml)
    = Key -> Object -> Object
sparseObject Key
prefix (PrefixMap TOML -> Object
tablesToObject PrefixMap TOML
toml)

tableArraysToObject :: HashMap.HashMap Key (NonEmpty TOML) -> Object
tableArraysToObject :: HashMap Key (NonEmpty TOML) -> Object
tableArraysToObject HashMap Key (NonEmpty TOML)
arrays
    = (Object -> Object -> Object)
-> Object -> HashMap Key Object -> Object
forall b a. (b -> a -> b) -> b -> HashMap Key a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
(<>) (HashMap Piece Object -> Object
Table HashMap Piece Object
forall k v. HashMap k v
HashMap.empty)
    (HashMap Key Object -> Object) -> HashMap Key Object -> Object
forall a b. (a -> b) -> a -> b
$ (Key -> Object -> Object)
-> HashMap Key Object -> HashMap Key Object
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapWithKey Key -> Object -> Object
sparseObject
    (HashMap Key Object -> HashMap Key Object)
-> HashMap Key Object -> HashMap Key Object
forall a b. (a -> b) -> a -> b
$ (NonEmpty TOML -> Object)
-> HashMap Key (NonEmpty TOML) -> HashMap Key Object
forall a b. (a -> b) -> HashMap Key a -> HashMap Key b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Object] -> Object
Array ([Object] -> Object)
-> (NonEmpty TOML -> [Object]) -> NonEmpty TOML -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TOML -> Object) -> [TOML] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TOML -> Object
tomlToObject ([TOML] -> [Object])
-> (NonEmpty TOML -> [TOML]) -> NonEmpty TOML -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TOML -> [TOML]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)  HashMap Key (NonEmpty TOML)
arrays

tomlToObject :: TOML -> Object
tomlToObject :: TOML -> Object
tomlToObject TOML
toml = Object
pairs Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
tables Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
tableArrays
    where
        pairs :: Object
pairs = HashMap Key AnyValue -> Object
pairsToObject (HashMap Key AnyValue -> Object) -> HashMap Key AnyValue -> Object
forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key AnyValue
Toml.TOML.tomlPairs TOML
toml
        tables :: Object
tables = PrefixMap TOML -> Object
tablesToObject (PrefixMap TOML -> Object) -> PrefixMap TOML -> Object
forall a b. (a -> b) -> a -> b
$ TOML -> PrefixMap TOML
Toml.TOML.tomlTables TOML
toml
        tableArrays :: Object
tableArrays = HashMap Key (NonEmpty TOML) -> Object
tableArraysToObject (HashMap Key (NonEmpty TOML) -> Object)
-> HashMap Key (NonEmpty TOML) -> Object
forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key (NonEmpty TOML)
Toml.TOML.tomlTableArrays TOML
toml

data Options = Options
    { Options -> Maybe FilePath
input :: Maybe FilePath
    , Options -> Maybe FilePath
output :: Maybe FilePath
    , Options -> FilePath
schemaFile :: 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 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
OA.fullDesc InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Options
forall a. FilePath -> InfoMod a
OA.progDesc FilePath
"Convert TOML to Dhall")
  where
    versionOption :: Parser (a -> a)
versionOption = FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
OA.infoOption (Version -> FilePath
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
$
        FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Display version"
    optionsParser :: Parser Options
optionsParser = do
        Maybe FilePath
input <- Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
               FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"file"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Read TOML from file instead of standard input"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall {a}. Mod OptionFields a
fileOpts
        Maybe FilePath
output <- Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
               FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"output"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Write Dhall to a file instead of standard output"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall {a}. Mod OptionFields a
fileOpts
        FilePath
schemaFile <- Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
OA.strArgument (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
               FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Path to Dhall schema file"
            Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
OA.action FilePath
"file"
            Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
OA.metavar FilePath
"SCHEMA"
        pure Options {FilePath
Maybe FilePath
input :: Maybe FilePath
output :: Maybe FilePath
schemaFile :: FilePath
input :: Maybe FilePath
output :: Maybe FilePath
schemaFile :: FilePath
..}
    fileOpts :: Mod OptionFields a
fileOpts = FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
OA.metavar FilePath
"FILE" Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
OA.action FilePath
"file"

tomlToDhallMain :: IO ()
tomlToDhallMain :: IO ()
tomlToDhallMain = do
    Options {FilePath
Maybe FilePath
input :: Options -> Maybe FilePath
output :: Options -> Maybe FilePath
schemaFile :: Options -> FilePath
input :: Maybe FilePath
output :: Maybe FilePath
schemaFile :: FilePath
..} <- ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
OA.execParser ParserInfo Options
parserInfo
    Text
text <- IO Text -> (FilePath -> IO Text) -> Maybe FilePath -> IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Text
Text.IO.getContents FilePath -> IO Text
Text.IO.readFile Maybe FilePath
input
    TOML
toml <- case Text -> Either TomlParseError TOML
Toml.Parser.parse Text
text of
        Left TomlParseError
tomlErr -> CompileError -> IO TOML
forall e a. Exception e => e -> IO a
throwIO (TomlParseError -> CompileError
InvalidToml TomlParseError
tomlErr)
        Right TOML
toml -> TOML -> IO TOML
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TOML
toml
    Expr Src Void
schema <- FilePath -> IO (Expr Src Void)
fileToDhall FilePath
schemaFile
    Expr Src Void
dhall <- case Expr Src Void -> TOML -> Either CompileError (Expr Src Void)
tomlToDhall Expr Src Void
schema TOML
toml of
        Left CompileError
err -> CompileError -> IO (Expr Src Void)
forall e a. Exception e => e -> IO a
throwIO CompileError
err
        Right Expr Src Void
dhall -> Expr Src Void -> IO (Expr Src Void)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Void
dhall
    (Text -> IO ())
-> (FilePath -> Text -> IO ()) -> Maybe FilePath -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
Text.IO.putStrLn FilePath -> Text -> IO ()
Text.IO.writeFile Maybe FilePath
output (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Text
forall a. Pretty a => a -> Text
Core.pretty Expr Src Void
dhall