{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
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)
(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))
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"
(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
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)
Object
_ <> Object
_ = Object
Invalid
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