{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.JSON (
dhallToJSON
, omitNull
, omitEmpty
, parsePreservationAndOmission
, Conversion(..)
, defaultConversion
, convertToHomogeneousMaps
, parseConversion
, SpecialDoubleMode(..)
, handleSpecialDoubles
, codeToValue
, CompileError(..)
) where
import Control.Applicative (empty, (<|>))
import Control.Monad (guard)
import Control.Exception (Exception, throwIO)
import Data.Aeson (Value(..), ToJSON(..))
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>), mempty)
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Pretty)
import Data.Void (Void)
import Dhall.Core (Binding(..), DhallDouble(..), Expr)
import Dhall.Import (SemanticCacheMode(..))
import Dhall.Map (Map)
import Dhall.JSON.Util (pattern V)
import Options.Applicative (Parser)
import Prelude hiding (getContents)
import qualified Data.Aeson as Aeson
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List
import qualified Data.Map
import qualified Data.Ord
import qualified Data.Text
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
import qualified Data.Vector as Vector
import qualified Dhall.Core as Core
import qualified Dhall.Import
import qualified Dhall.Map
import qualified Dhall.Optics
import qualified Dhall.Parser
import qualified Dhall.Pretty
import qualified Dhall.TypeCheck
import qualified Dhall.Util
import qualified Options.Applicative
import qualified System.FilePath
data CompileError
= Unsupported (Expr Void Void)
| SpecialDouble Double
| BareNone
| InvalidInlineContents (Expr Void Void) (Expr Void Void)
instance Show CompileError where
show :: CompileError -> String
show BareNone =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": ❰None❱ is not valid on its own \n\
\ \n\
\Explanation: The conversion to JSON/YAML does not accept ❰None❱ in isolation as \n\
\a valid way to represent ❰null❱. In Dhall, ❰None❱ is a function whose input is \n\
\a type and whose output is an ❰Optional❱ of that type. \n\
\ \n\
\For example: \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────┐ ❰None❱ is a function whose result is \n\
\ │ None : ∀(a : Type) → Optional a │ an ❰Optional❱ value, but the function \n\
\ └─────────────────────────────────┘ itself is not a valid ❰Optional❱ value \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────┐ ❰None Natural❱ is a valid ❰Optional❱ \n\
\ │ None Natural : Optional Natural │ value (an absent ❰Natural❱ number in \n\
\ └─────────────────────────────────┘ this case) \n\
\ \n\
\ \n\
\ \n\
\The conversion to JSON/YAML only translates the fully applied form to ❰null❱. "
show (SpecialDouble n :: Double
n) =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
special Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " disallowed in JSON \n\
\ \n\
\Explanation: The JSON standard does not define a canonical way to encode \n\
\❰NaN❱/❰Infinity❱/❰-Infinity❱. You can fix this error by either: \n\
\ \n\
\● Using ❰dhall-to-yaml❱ instead of ❰dhall-to-json❱, since YAML does support \n\
\ ❰NaN❱/❰Infinity❱/❰-Infinity❱ \n\
\ \n\
\● Enabling the ❰--approximate-special-doubles❱ flag which will encode ❰NaN❱ as \n\
\ ❰null❱, ❰Infinity❱ as the maximum ❰Double❱, and ❰-Infinity❱ as the minimum \n\
\❰Double❱ \n\
\ \n\
\● See if there is a way to remove ❰NaN❱/❰Infinity❱/❰-Infinity❱ from the \n\
\ expression that you are converting to JSON "
where
special :: Text
special = String -> Text
Data.Text.pack (Double -> String
forall a. Show a => a -> String
show Double
n)
show (Unsupported e :: Expr Void Void
e) =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": Cannot translate to JSON \n\
\ \n\
\Explanation: Only primitive values, records, unions, ❰List❱s, and ❰Optional❱ \n\
\values can be translated from Dhall to JSON \n\
\ \n\
\The following Dhall expression could not be translated to JSON: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert Expr Void Void
e
show (InvalidInlineContents record :: Expr Void Void
record alternativeContents :: Expr Void Void
alternativeContents) =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": Union value is not compatible with ❰Inline❱ nesting. \n\
\ \n\
\Explanation: You can use the ❰Inline❱ nesting to compactly encode a union while \n\
\preserving the name of the alternative. However the alternative must either be \n\
\empty or contain a record value. \n\
\ \n\
\For example: \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────────────────────┐ \n\
\ │ let Example = < Empty | Record : { x : Bool } > │ \n\
\ │ │ \n\
\ │ let Nesting = < Inline | Nested : Text > │ \n\
\ │ │ \n\
\ │ in { field = \"name\" │ \n\
\ │ , nesting = Nesting.Inline │ \n\
\ │ , contents = Example.Empty │ An empty alternative \n\
\ │ } │ is ok. \n\
\ └─────────────────────────────────────────────────┘ \n\
\ \n\
\ \n\
\... is converted to this JSON: \n\
\ \n\
\ \n\
\ ┌─────────────────────┐ \n\
\ │ { \"name\": \"Empty\" } │ \n\
\ └─────────────────────┘ \n\
\ \n\
\ \n\
\ ┌──────────────────────────────────────────────┐ \n\
\ │ ... │ \n\
\ │ │ \n\
\ │ in { field = \"name\" │ \n\
\ │ , nesting = Nesting.Inline │ \n\
\ │ , contents = Example.Record { x = True } │ An alternative containing \n\
\ │ } │ a record value is ok. \n\
\ └──────────────────────────────────────────────┘ \n\
\ \n\
\ \n\
\... is converted to this JSON: \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────┐ \n\
\ │ { \"name\": \"Record\", \"x\": true } │ \n\
\ └─────────────────────────────────┘ \n\
\ \n\
\ \n\
\This isn't valid: \n\
\ \n\
\ \n\
\ ┌──────────────────────────────────────────┐ \n\
\ │ let Example = < Foo : Bool > │ \n\
\ │ │ \n\
\ │ let Nesting = < Inline | Nested : Text > │ \n\
\ │ │ \n\
\ │ in { field = \"name\" │ \n\
\ │ , nesting = Nesting.Inline │ \n\
\ │ , contents = Example.Foo True │ ❰True❱ is not a record \n\
\ │ } │ \n\
\ └──────────────────────────────────────────┘ \n\
\ \n\
\ \n\
\The following Dhall expression could not be translated to JSON: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert Expr Void Void
record Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " \n\
\ \n\
\... because \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert Expr Void Void
alternativeContents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " \n\
\ \n\
\... is not a record."
_ERROR :: Data.Text.Text
_ERROR :: Text
_ERROR = Text
forall string. IsString string => string
Dhall.Util._ERROR
insert :: Pretty a => a -> Text
insert :: a -> Text
insert = 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
instance Exception CompileError
dhallToJSON
:: Expr s Void
-> Either CompileError Value
dhallToJSON :: Expr s Void -> Either CompileError Value
dhallToJSON e0 :: Expr s Void
e0 = Expr Void Void -> Either CompileError Value
loop (Expr Void Void -> Expr Void Void
forall s a. Expr s a -> Expr s a
Core.alphaNormalize (Expr s Void -> Expr Void Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s Void
e0))
where
loop :: Expr Void Void -> Either CompileError Value
loop e :: Expr Void Void
e = case Expr Void Void
e of
Core.BoolLit a :: Bool
a -> Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
a)
Core.NaturalLit a :: Natural
a -> Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
a)
Core.IntegerLit a :: Integer
a -> Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
a)
Core.DoubleLit (DhallDouble a :: Double
a) -> Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
a)
Core.TextLit (Core.Chunks [] a :: Text
a) -> do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
a)
Core.ListLit _ a :: Seq (Expr Void Void)
a -> do
Seq Value
a' <- (Expr Void Void -> Either CompileError Value)
-> Seq (Expr Void Void) -> Either CompileError (Seq Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Void Void -> Either CompileError Value
loop Seq (Expr Void Void)
a
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Value -> Value
forall a. ToJSON a => a -> Value
toJSON Seq Value
a')
Core.Some a :: Expr Void Void
a -> do
Value
a' <- Expr Void Void -> Either CompileError Value
loop Expr Void Void
a
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
a')
Core.App Core.None _ -> do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
Core.None -> do
CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left CompileError
BareNone
Core.RecordLit a :: Map Text (Expr Void Void)
a ->
case Map Text (Expr Void Void) -> [(Text, Expr Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
toOrderedList Map Text (Expr Void Void)
a of
[ ( "contents"
, contents
)
, ( "field"
, Core.TextLit
(Core.Chunks [] field)
)
, ( "nesting"
, Core.App
(Core.Field
(Core.Union
[ ("Inline", mInlineType)
, ("Nested", Just Core.Text)
]
)
"Nested"
)
(Core.TextLit
(Core.Chunks [] nestedField)
)
)
] | (Expr Void Void -> Bool) -> Maybe (Expr Void Void) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Expr Void Void -> Expr Void Void -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text (Expr Void Void) -> Expr Void Void
forall s a. Map Text (Expr s a) -> Expr s a
Core.Record []) Maybe (Expr Void Void)
mInlineType
, Just (alternativeName :: Text
alternativeName, mExpr :: Maybe (Expr Void Void)
mExpr) <- Expr Void Void -> Maybe (Text, Maybe (Expr Void Void))
forall s. Expr s Void -> Maybe (Text, Maybe (Expr s Void))
getContents Expr Void Void
contents -> do
Value
contents' <- case Maybe (Expr Void Void)
mExpr of
Just expr :: Expr Void Void
expr -> Expr Void Void -> Either CompileError Value
loop Expr Void Void
expr
Nothing -> Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
let taggedValue :: Map Text Value
taggedValue =
[(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
[ ( Text
field
, Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
alternativeName
)
, ( Text
nestedField
, Value
contents'
)
]
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text Value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Map Text Value
taggedValue)
[ ( "contents"
, contents
)
, ( "field"
, Core.TextLit
(Core.Chunks [] field)
)
, ( "nesting"
, nesting
)
] | Expr Void Void -> Bool
forall s. Expr s Void -> Bool
isInlineNesting Expr Void Void
nesting
, Just (alternativeName :: Text
alternativeName, mExpr :: Maybe (Expr Void Void)
mExpr) <- Expr Void Void -> Maybe (Text, Maybe (Expr Void Void))
forall s. Expr s Void -> Maybe (Text, Maybe (Expr s Void))
getContents Expr Void Void
contents -> do
Map Text (Expr Void Void)
kvs0 <- case Maybe (Expr Void Void)
mExpr of
Just (Core.RecordLit kvs :: Map Text (Expr Void Void)
kvs) -> Map Text (Expr Void Void)
-> Either CompileError (Map Text (Expr Void Void))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Expr Void Void)
kvs
Just alternativeContents :: Expr Void Void
alternativeContents ->
CompileError -> Either CompileError (Map Text (Expr Void Void))
forall a b. a -> Either a b
Left (Expr Void Void -> Expr Void Void -> CompileError
InvalidInlineContents Expr Void Void
e Expr Void Void
alternativeContents)
Nothing -> Map Text (Expr Void Void)
-> Either CompileError (Map Text (Expr Void Void))
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (Expr Void Void)
forall a. Monoid a => a
mempty
let name :: Expr s a
name = Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
Core.TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [] Text
alternativeName)
let kvs1 :: Map Text (Expr Void Void)
kvs1 = Text
-> Expr Void Void
-> Map Text (Expr Void Void)
-> Map Text (Expr Void Void)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
field Expr Void Void
forall s a. Expr s a
name Map Text (Expr Void Void)
kvs0
Expr Void Void -> Either CompileError Value
loop (Map Text (Expr Void Void) -> Expr Void Void
forall s a. Map Text (Expr s a) -> Expr s a
Core.RecordLit Map Text (Expr Void Void)
kvs1)
_ -> do
Map Text Value
a' <- (Expr Void Void -> Either CompileError Value)
-> Map Text (Expr Void Void)
-> Either CompileError (Map Text Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Void Void -> Either CompileError Value
loop Map Text (Expr Void Void)
a
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text Value -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Map Text Value -> Map Text Value
forall k v. Map k v -> Map k v
Dhall.Map.toMap Map Text Value
a'))
Core.App (Core.Field (Core.Union _) _) b :: Expr Void Void
b -> Expr Void Void -> Either CompileError Value
loop Expr Void Void
b
Core.Field (Core.Union _) k :: Text
k -> Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
k)
Core.Lam _ (Core.Const Core.Type)
(Core.Lam _
(Core.Record
[ ("array" , Core.Pi _ (Core.App Core.List (V 0)) (V 1))
, ("bool" , Core.Pi _ Core.Bool (V 1))
, ("null" , V 0)
, ("number", Core.Pi _ Core.Double (V 1))
, ("object", Core.Pi _ (Core.App Core.List (Core.Record [ ("mapKey", Core.Text), ("mapValue", V 0)])) (V 1))
, ("string", Core.Pi _ Core.Text (V 1))
]
)
value :: Expr Void Void
value
) -> do
let outer :: Expr s a -> Either CompileError Value
outer (Core.Field (V 0) "null") = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
outer (Core.App (Core.Field (V 0) "bool") (Core.BoolLit b :: Bool
b)) = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value
Aeson.Bool Bool
b)
outer (Core.App (Core.Field (V 0) "array") (Core.ListLit _ xs :: Seq (Expr s a)
xs)) = do
[Value]
ys <- (Expr s a -> Either CompileError Value)
-> [Expr s a] -> Either CompileError [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> Either CompileError Value
outer (Seq (Expr s a) -> [Expr s a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Value
Aeson.Array ([Value] -> Array
forall a. [a] -> Vector a
Vector.fromList [Value]
ys))
outer (Core.App (Core.Field (V 0) "object") (Core.ListLit _ xs :: Seq (Expr s a)
xs)) = do
let inner :: Expr s a -> Either CompileError (Text, Value)
inner (Core.RecordLit [("mapKey", Core.TextLit (Core.Chunks [] mapKey)), ("mapValue", mapExpression)]) = do
Value
mapValue <- Expr s a -> Either CompileError Value
outer Expr s a
mapExpression
(Text, Value) -> Either CompileError (Text, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mapKey, Value
mapValue)
inner _ = CompileError -> Either CompileError (Text, Value)
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
Unsupported Expr Void Void
e)
[(Text, Value)]
ys <- (Expr s a -> Either CompileError (Text, Value))
-> [Expr s a] -> Either CompileError [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> Either CompileError (Text, Value)
inner (Seq (Expr s a) -> [Expr s a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Aeson.Object ([(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Value)]
ys))
outer (Core.App (Core.Field (V 0) "number") (Core.DoubleLit (DhallDouble n :: Double
n))) = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Double
n)
outer (Core.App (Core.Field (V 0) "string") (Core.TextLit (Core.Chunks [] text :: Text
text))) = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
text)
outer _ = CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
Unsupported Expr Void Void
e)
Expr Void Void -> Either CompileError Value
forall s a. Expr s a -> Either CompileError Value
outer Expr Void Void
value
Core.Lam _ (Core.Const Core.Type)
(Core.Lam _
(Core.Record
[ ("array" , Core.Pi _ (Core.App Core.List (V 0)) (V 1))
, ("bool" , Core.Pi _ Core.Bool (V 1))
, ("double", Core.Pi _ Core.Double (V 1))
, ("integer", Core.Pi _ Core.Integer (V 1))
, ("null" , V 0)
, ("object", Core.Pi _ (Core.App Core.List (Core.Record [ ("mapKey", Core.Text), ("mapValue", V 0)])) (V 1))
, ("string", Core.Pi _ Core.Text (V 1))
]
)
value :: Expr Void Void
value
) -> do
let outer :: Expr s a -> Either CompileError Value
outer (Core.Field (V 0) "null") = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
outer (Core.App (Core.Field (V 0) "bool") (Core.BoolLit b :: Bool
b)) = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value
Aeson.Bool Bool
b)
outer (Core.App (Core.Field (V 0) "array") (Core.ListLit _ xs :: Seq (Expr s a)
xs)) = do
[Value]
ys <- (Expr s a -> Either CompileError Value)
-> [Expr s a] -> Either CompileError [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> Either CompileError Value
outer (Seq (Expr s a) -> [Expr s a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Value
Aeson.Array ([Value] -> Array
forall a. [a] -> Vector a
Vector.fromList [Value]
ys))
outer (Core.App (Core.Field (V 0) "object") (Core.ListLit _ xs :: Seq (Expr s a)
xs)) = do
let inner :: Expr s a -> Either CompileError (Text, Value)
inner (Core.RecordLit [("mapKey", Core.TextLit (Core.Chunks [] mapKey)), ("mapValue", mapExpression)]) = do
Value
mapValue <- Expr s a -> Either CompileError Value
outer Expr s a
mapExpression
(Text, Value) -> Either CompileError (Text, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mapKey, Value
mapValue)
inner _ = CompileError -> Either CompileError (Text, Value)
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
Unsupported Expr Void Void
e)
[(Text, Value)]
ys <- (Expr s a -> Either CompileError (Text, Value))
-> [Expr s a] -> Either CompileError [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> Either CompileError (Text, Value)
inner (Seq (Expr s a) -> [Expr s a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Aeson.Object ([(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Value)]
ys))
outer (Core.App (Core.Field (V 0) "double") (Core.DoubleLit (DhallDouble n :: Double
n))) = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Double
n)
outer (Core.App (Core.Field (V 0) "integer") (Core.IntegerLit n :: Integer
n)) = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Integer
n)
outer (Core.App (Core.Field (V 0) "string") (Core.TextLit (Core.Chunks [] text :: Text
text))) = do
Value -> Either CompileError Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
text)
outer _ = CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
Unsupported Expr Void Void
e)
Expr Void Void -> Either CompileError Value
forall s a. Expr s a -> Either CompileError Value
outer Expr Void Void
value
_ -> CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
Unsupported Expr Void Void
e)
getContents :: Expr s Void -> Maybe (Text, Maybe (Expr s Void))
getContents :: Expr s Void -> Maybe (Text, Maybe (Expr s Void))
getContents (Core.App
(Core.Field
_
alternativeName :: Text
alternativeName
)
expression :: Expr s Void
expression
) = (Text, Maybe (Expr s Void)) -> Maybe (Text, Maybe (Expr s Void))
forall a. a -> Maybe a
Just (Text
alternativeName, Expr s Void -> Maybe (Expr s Void)
forall a. a -> Maybe a
Just Expr s Void
expression)
getContents (Core.Field _ alternativeName :: Text
alternativeName) = (Text, Maybe (Expr s Void)) -> Maybe (Text, Maybe (Expr s Void))
forall a. a -> Maybe a
Just (Text
alternativeName, Maybe (Expr s Void)
forall a. Maybe a
Nothing)
getContents _ = Maybe (Text, Maybe (Expr s Void))
forall a. Maybe a
Nothing
isInlineNesting :: Expr s Void -> Bool
isInlineNesting :: Expr s Void -> Bool
isInlineNesting (Core.App
(Core.Field
(Core.Union
[ ("Inline", Just (Core.Record []))
, ("Nested", Just Core.Text)
]
)
"Inline"
)
(Core.RecordLit [])
) = Bool
True
isInlineNesting (Core.Field
(Core.Union
[ ("Inline", Nothing)
, ("Nested", Just Core.Text)
]
)
"Inline"
) = Bool
True
isInlineNesting _ = Bool
False
toOrderedList :: Ord k => Map k v -> [(k, v)]
toOrderedList :: Map k v -> [(k, v)]
toOrderedList =
((k, v) -> (k, v) -> Ordering) -> [(k, v)] -> [(k, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
Data.List.sortBy (((k, v) -> k) -> (k, v) -> (k, v) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Data.Ord.comparing (k, v) -> k
forall a b. (a, b) -> a
fst)
([(k, v)] -> [(k, v)])
-> (Map k v -> [(k, v)]) -> Map k v -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList
omitNull :: Value -> Value
omitNull :: Value -> Value
omitNull (Object object :: Object
object) = Object -> Value
Object Object
fields
where
fields :: Object
fields =(Value -> Bool) -> Object -> Object
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) ((Value -> Value) -> Object -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitNull Object
object)
omitNull (Array array :: Array
array) =
Array -> Value
Array ((Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitNull Array
array)
omitNull (String string :: Text
string) =
Text -> Value
String Text
string
omitNull (Number number :: Scientific
number) =
Scientific -> Value
Number Scientific
number
omitNull (Bool bool :: Bool
bool) =
Bool -> Value
Bool Bool
bool
omitNull Null =
Value
Null
omitEmpty :: Value -> Value
omitEmpty :: Value -> Value
omitEmpty (Object object :: Object
object) =
if Object -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Object
fields then Value
Null else Object -> Value
Object Object
fields
where
fields :: Object
fields = (Value -> Bool) -> Object -> Object
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) ((Value -> Value) -> Object -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitEmpty Object
object)
omitEmpty (Array array :: Array
array) =
if Array -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
elems then Value
Null else Array -> Value
Array Array
elems
where
elems :: Array
elems = (Value -> Bool) -> Array -> Array
forall a. (a -> Bool) -> Vector a -> Vector a
Vector.filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) ((Value -> Value) -> Array -> Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitEmpty Array
array)
omitEmpty (String string :: Text
string) =
Text -> Value
String Text
string
omitEmpty (Number number :: Scientific
number) =
Scientific -> Value
Number Scientific
number
omitEmpty (Bool bool :: Bool
bool) =
Bool -> Value
Bool Bool
bool
omitEmpty Null =
Value
Null
parseOmission :: Parser (Value -> Value)
parseOmission :: Parser (Value -> Value)
parseOmission =
(Value -> Value)
-> Mod FlagFields (Value -> Value) -> Parser (Value -> Value)
forall a. a -> Mod FlagFields a -> Parser a
Options.Applicative.flag'
Value -> Value
omitEmpty
( String -> Mod FlagFields (Value -> Value)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.Applicative.long "omit-empty"
Mod FlagFields (Value -> Value)
-> Mod FlagFields (Value -> Value)
-> Mod FlagFields (Value -> Value)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Value -> Value)
forall (f :: * -> *) a. String -> Mod f a
Options.Applicative.help "Omit record fields that are null or empty records"
)
parseNullPreservation :: Parser (Value -> Value)
parseNullPreservation :: Parser (Value -> Value)
parseNullPreservation =
(Value -> Value)
-> (Value -> Value)
-> Mod FlagFields (Value -> Value)
-> Parser (Value -> Value)
forall a. a -> a -> Mod FlagFields a -> Parser a
Options.Applicative.flag
Value -> Value
omitNull
Value -> Value
forall a. a -> a
id
( String -> Mod FlagFields (Value -> Value)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.Applicative.long "preserve-null"
Mod FlagFields (Value -> Value)
-> Mod FlagFields (Value -> Value)
-> Mod FlagFields (Value -> Value)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Value -> Value)
forall (f :: * -> *) a. String -> Mod f a
Options.Applicative.help "Preserve record fields that are null"
)
parsePreservationAndOmission :: Parser (Value -> Value)
parsePreservationAndOmission :: Parser (Value -> Value)
parsePreservationAndOmission = Parser (Value -> Value)
parseOmission Parser (Value -> Value)
-> Parser (Value -> Value) -> Parser (Value -> Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Value -> Value)
parseNullPreservation
data Conversion
= NoConversion
| Conversion { Conversion -> Text
mapKey :: Text, Conversion -> Text
mapValue :: Text }
defaultConversion :: Conversion
defaultConversion :: Conversion
defaultConversion = Conversion :: Text -> Text -> Conversion
Conversion
{ mapKey :: Text
mapKey = "mapKey"
, mapValue :: Text
mapValue = "mapValue"
}
convertToHomogeneousMaps :: Conversion -> Expr s Void -> Expr s Void
convertToHomogeneousMaps :: Conversion -> Expr s Void -> Expr s Void
convertToHomogeneousMaps NoConversion e0 :: Expr s Void
e0 = Expr s Void
e0
convertToHomogeneousMaps (Conversion {..}) e0 :: Expr s Void
e0 = Expr s Void -> Expr s Void
forall s. Expr s Void -> Expr s Void
loop (Expr s Void -> Expr s Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s Void
e0)
where
loop :: Expr s Void -> Expr s Void
loop e :: Expr s Void
e = case Expr s Void
e of
Core.Const a :: Const
a ->
Const -> Expr s Void
forall s a. Const -> Expr s a
Core.Const Const
a
Core.Var v :: Var
v ->
Var -> Expr s Void
forall s a. Var -> Expr s a
Core.Var Var
v
Core.Lam a :: Text
a b :: Expr s Void
b c :: Expr s Void
c ->
Text -> Expr s Void -> Expr s Void -> Expr s Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Core.Lam Text
a Expr s Void
b Expr s Void
c
Core.Pi a :: Text
a b :: Expr s Void
b c :: Expr s Void
c ->
Text -> Expr s Void -> Expr s Void -> Expr s Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Core.Pi Text
a Expr s Void
b' Expr s Void
c'
where
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
c' :: Expr s Void
c' = Expr s Void -> Expr s Void
loop Expr s Void
c
Core.App a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.Let (Binding src0 :: Maybe s
src0 a :: Text
a src1 :: Maybe s
src1 b :: Maybe (Maybe s, Expr s Void)
b src2 :: Maybe s
src2 c :: Expr s Void
c) d :: Expr s Void
d ->
Binding s Void -> Expr s Void -> Expr s Void
forall s a. Binding s a -> Expr s a -> Expr s a
Core.Let (Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s Void)
-> Maybe s
-> Expr s Void
-> Binding s Void
forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding Maybe s
src0 Text
a Maybe s
src1 Maybe (Maybe s, Expr s Void)
b' Maybe s
src2 Expr s Void
c') Expr s Void
d'
where
b' :: Maybe (Maybe s, Expr s Void)
b' = ((Maybe s, Expr s Void) -> (Maybe s, Expr s Void))
-> Maybe (Maybe s, Expr s Void) -> Maybe (Maybe s, Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s Void -> Expr s Void)
-> (Maybe s, Expr s Void) -> (Maybe s, Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop) Maybe (Maybe s, Expr s Void)
b
c' :: Expr s Void
c' = Expr s Void -> Expr s Void
loop Expr s Void
c
d' :: Expr s Void
d' = Expr s Void -> Expr s Void
loop Expr s Void
d
Core.Annot a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.Annot Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.Bool ->
Expr s Void
forall s a. Expr s a
Core.Bool
Core.BoolLit a :: Bool
a ->
Bool -> Expr s Void
forall s a. Bool -> Expr s a
Core.BoolLit Bool
a
Core.BoolAnd a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolAnd Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.BoolOr a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolOr Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.BoolEQ a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolEQ Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.BoolNE a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolNE Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.BoolIf a :: Expr s Void
a b :: Expr s Void
b c :: Expr s Void
c ->
Expr s Void -> Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
Core.BoolIf Expr s Void
a' Expr s Void
b' Expr s Void
c'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
c' :: Expr s Void
c' = Expr s Void -> Expr s Void
loop Expr s Void
c
Core.Natural ->
Expr s Void
forall s a. Expr s a
Core.Natural
Core.NaturalLit a :: Natural
a ->
Natural -> Expr s Void
forall s a. Natural -> Expr s a
Core.NaturalLit Natural
a
Core.NaturalFold ->
Expr s Void
forall s a. Expr s a
Core.NaturalFold
Core.NaturalBuild ->
Expr s Void
forall s a. Expr s a
Core.NaturalBuild
Core.NaturalIsZero ->
Expr s Void
forall s a. Expr s a
Core.NaturalIsZero
Core.NaturalEven ->
Expr s Void
forall s a. Expr s a
Core.NaturalEven
Core.NaturalOdd ->
Expr s Void
forall s a. Expr s a
Core.NaturalOdd
Core.NaturalToInteger ->
Expr s Void
forall s a. Expr s a
Core.NaturalToInteger
Core.NaturalShow ->
Expr s Void
forall s a. Expr s a
Core.NaturalShow
Core.NaturalSubtract ->
Expr s Void
forall s a. Expr s a
Core.NaturalSubtract
Core.NaturalPlus a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.NaturalPlus Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.NaturalTimes a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.NaturalTimes Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.Integer ->
Expr s Void
forall s a. Expr s a
Core.Integer
Core.IntegerLit a :: Integer
a ->
Integer -> Expr s Void
forall s a. Integer -> Expr s a
Core.IntegerLit Integer
a
Core.IntegerClamp ->
Expr s Void
forall s a. Expr s a
Core.IntegerClamp
Core.IntegerNegate ->
Expr s Void
forall s a. Expr s a
Core.IntegerNegate
Core.IntegerShow ->
Expr s Void
forall s a. Expr s a
Core.IntegerShow
Core.IntegerToDouble ->
Expr s Void
forall s a. Expr s a
Core.IntegerToDouble
Core.Double ->
Expr s Void
forall s a. Expr s a
Core.Double
Core.DoubleLit a :: DhallDouble
a ->
DhallDouble -> Expr s Void
forall s a. DhallDouble -> Expr s a
Core.DoubleLit DhallDouble
a
Core.DoubleShow ->
Expr s Void
forall s a. Expr s a
Core.DoubleShow
Core.Text ->
Expr s Void
forall s a. Expr s a
Core.Text
Core.TextLit (Core.Chunks a :: [(Text, Expr s Void)]
a b :: Text
b) ->
Chunks s Void -> Expr s Void
forall s a. Chunks s a -> Expr s a
Core.TextLit ([(Text, Expr s Void)] -> Text -> Chunks s Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [(Text, Expr s Void)]
a' Text
b)
where
a' :: [(Text, Expr s Void)]
a' = ((Text, Expr s Void) -> (Text, Expr s Void))
-> [(Text, Expr s Void)] -> [(Text, Expr s Void)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s Void -> Expr s Void)
-> (Text, Expr s Void) -> (Text, Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop) [(Text, Expr s Void)]
a
Core.TextAppend a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.TextAppend Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.TextShow ->
Expr s Void
forall s a. Expr s a
Core.TextShow
Core.List ->
Expr s Void
forall s a. Expr s a
Core.List
Core.ListLit a :: Maybe (Expr s Void)
a b :: Seq (Expr s Void)
b ->
case Maybe (Expr s Void)
transform of
Just c :: Expr s Void
c -> Expr s Void -> Expr s Void
loop Expr s Void
c
Nothing -> Maybe (Expr s Void) -> Seq (Expr s Void) -> Expr s Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit Maybe (Expr s Void)
a' Seq (Expr s Void)
b'
where
elements :: [Expr s Void]
elements = Seq (Expr s Void) -> [Expr s Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s Void)
b
toKeyValue :: Expr s Void -> Maybe (Text, Expr s Void)
toKeyValue :: Expr s Void -> Maybe (Text, Expr s Void)
toKeyValue (Core.RecordLit m :: Map Text (Expr s Void)
m) = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Map Text (Expr s Void) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length Map Text (Expr s Void)
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2)
Expr s Void
key <- Text -> Map Text (Expr s Void) -> Maybe (Expr s Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
mapKey Map Text (Expr s Void)
m
Expr s Void
value <- Text -> Map Text (Expr s Void) -> Maybe (Expr s Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
mapValue Map Text (Expr s Void)
m
Text
keyText <- case Expr s Void
key of
Core.TextLit (Core.Chunks [] keyText :: Text
keyText) ->
Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
keyText
Core.Field (Core.Union _) keyText :: Text
keyText ->
Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
keyText
_ ->
Maybe Text
forall (f :: * -> *) a. Alternative f => f a
empty
(Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
keyText, Expr s Void
value)
toKeyValue _ = do
Maybe (Text, Expr s Void)
forall (f :: * -> *) a. Alternative f => f a
empty
transform :: Maybe (Expr s Void)
transform =
case [Expr s Void]
elements of
[] ->
case Maybe (Expr s Void)
a of
Just (Core.App Core.List (Core.Record m :: Map Text (Expr s Void)
m)) -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Map Text (Expr s Void) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length Map Text (Expr s Void)
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Map Text (Expr s Void) -> Bool
forall k v. Ord k => k -> Map k v -> Bool
Dhall.Map.member Text
mapKey Map Text (Expr s Void)
m)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Map Text (Expr s Void) -> Bool
forall k v. Ord k => k -> Map k v -> Bool
Dhall.Map.member Text
mapValue Map Text (Expr s Void)
m)
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Expr s Void) -> Expr s Void
forall s a. Map Text (Expr s a) -> Expr s a
Core.RecordLit Map Text (Expr s Void)
forall a. Monoid a => a
mempty)
_ -> do
Maybe (Expr s Void)
forall (f :: * -> *) a. Alternative f => f a
empty
_ -> do
[(Text, Expr s Void)]
keyValues <- (Expr s Void -> Maybe (Text, Expr s Void))
-> [Expr s Void] -> Maybe [(Text, Expr s Void)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s Void -> Maybe (Text, Expr s Void)
forall s. Expr s Void -> Maybe (Text, Expr s Void)
toKeyValue [Expr s Void]
elements
let recordLiteral :: Map Text (Expr s Void)
recordLiteral =
[(Text, Expr s Void)] -> Map Text (Expr s Void)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, Expr s Void)]
keyValues
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Expr s Void) -> Expr s Void
forall s a. Map Text (Expr s a) -> Expr s a
Core.RecordLit Map Text (Expr s Void)
recordLiteral)
a' :: Maybe (Expr s Void)
a' = (Expr s Void -> Expr s Void)
-> Maybe (Expr s Void) -> Maybe (Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop Maybe (Expr s Void)
a
b' :: Seq (Expr s Void)
b' = (Expr s Void -> Expr s Void)
-> Seq (Expr s Void) -> Seq (Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop Seq (Expr s Void)
b
Core.ListAppend a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.ListAppend Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.ListBuild ->
Expr s Void
forall s a. Expr s a
Core.ListBuild
Core.ListFold ->
Expr s Void
forall s a. Expr s a
Core.ListFold
Core.ListLength ->
Expr s Void
forall s a. Expr s a
Core.ListLength
Core.ListHead ->
Expr s Void
forall s a. Expr s a
Core.ListHead
Core.ListLast ->
Expr s Void
forall s a. Expr s a
Core.ListLast
Core.ListIndexed ->
Expr s Void
forall s a. Expr s a
Core.ListIndexed
Core.ListReverse ->
Expr s Void
forall s a. Expr s a
Core.ListReverse
Core.Optional ->
Expr s Void
forall s a. Expr s a
Core.Optional
Core.Some a :: Expr s Void
a ->
Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a
Core.Some Expr s Void
a'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
Core.None ->
Expr s Void
forall s a. Expr s a
Core.None
Core.OptionalFold ->
Expr s Void
forall s a. Expr s a
Core.OptionalFold
Core.OptionalBuild ->
Expr s Void
forall s a. Expr s a
Core.OptionalBuild
Core.Record a :: Map Text (Expr s Void)
a ->
Map Text (Expr s Void) -> Expr s Void
forall s a. Map Text (Expr s a) -> Expr s a
Core.Record Map Text (Expr s Void)
a'
where
a' :: Map Text (Expr s Void)
a' = (Expr s Void -> Expr s Void)
-> Map Text (Expr s Void) -> Map Text (Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop Map Text (Expr s Void)
a
Core.RecordLit a :: Map Text (Expr s Void)
a ->
Map Text (Expr s Void) -> Expr s Void
forall s a. Map Text (Expr s a) -> Expr s a
Core.RecordLit Map Text (Expr s Void)
a'
where
a' :: Map Text (Expr s Void)
a' = (Expr s Void -> Expr s Void)
-> Map Text (Expr s Void) -> Map Text (Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop Map Text (Expr s Void)
a
Core.Union a :: Map Text (Maybe (Expr s Void))
a ->
Map Text (Maybe (Expr s Void)) -> Expr s Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Core.Union Map Text (Maybe (Expr s Void))
a'
where
a' :: Map Text (Maybe (Expr s Void))
a' = (Maybe (Expr s Void) -> Maybe (Expr s Void))
-> Map Text (Maybe (Expr s Void)) -> Map Text (Maybe (Expr s Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s Void -> Expr s Void)
-> Maybe (Expr s Void) -> Maybe (Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop) Map Text (Maybe (Expr s Void))
a
Core.Combine a :: Maybe Text
a b :: Expr s Void
b c :: Expr s Void
c ->
Maybe Text -> Expr s Void -> Expr s Void -> Expr s Void
forall s a. Maybe Text -> Expr s a -> Expr s a -> Expr s a
Core.Combine Maybe Text
a Expr s Void
b' Expr s Void
c'
where
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
c' :: Expr s Void
c' = Expr s Void -> Expr s Void
loop Expr s Void
c
Core.CombineTypes a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.CombineTypes Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.Prefer a :: PreferAnnotation s Void
a b :: Expr s Void
b c :: Expr s Void
c ->
PreferAnnotation s Void
-> Expr s Void -> Expr s Void -> Expr s Void
forall s a.
PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Core.Prefer PreferAnnotation s Void
a Expr s Void
b' Expr s Void
c'
where
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
c' :: Expr s Void
c' = Expr s Void -> Expr s Void
loop Expr s Void
c
Core.RecordCompletion a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.RecordCompletion Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.Merge a :: Expr s Void
a b :: Expr s Void
b c :: Maybe (Expr s Void)
c ->
Expr s Void -> Expr s Void -> Maybe (Expr s Void) -> Expr s Void
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Core.Merge Expr s Void
a' Expr s Void
b' Maybe (Expr s Void)
c'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
c' :: Maybe (Expr s Void)
c' = (Expr s Void -> Expr s Void)
-> Maybe (Expr s Void) -> Maybe (Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop Maybe (Expr s Void)
c
Core.ToMap a :: Expr s Void
a b :: Maybe (Expr s Void)
b ->
Expr s Void -> Maybe (Expr s Void) -> Expr s Void
forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
Core.ToMap Expr s Void
a' Maybe (Expr s Void)
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Maybe (Expr s Void)
b' = (Expr s Void -> Expr s Void)
-> Maybe (Expr s Void) -> Maybe (Expr s Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s Void -> Expr s Void
loop Maybe (Expr s Void)
b
Core.Field a :: Expr s Void
a b :: Text
b ->
Expr s Void -> Text -> Expr s Void
forall s a. Expr s a -> Text -> Expr s a
Core.Field Expr s Void
a' Text
b
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
Core.Project a :: Expr s Void
a b :: Either (Set Text) (Expr s Void)
b ->
Expr s Void -> Either (Set Text) (Expr s Void) -> Expr s Void
forall s a. Expr s a -> Either (Set Text) (Expr s a) -> Expr s a
Core.Project Expr s Void
a' Either (Set Text) (Expr s Void)
b
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
Core.Assert a :: Expr s Void
a ->
Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a
Core.Assert Expr s Void
a'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
Core.Equivalent a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.Equivalent Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.With a :: Expr s Void
a b :: NonEmpty Text
b c :: Expr s Void
c ->
Expr s Void -> NonEmpty Text -> Expr s Void -> Expr s Void
forall s a. Expr s a -> NonEmpty Text -> Expr s a -> Expr s a
Core.With Expr s Void
a' NonEmpty Text
b Expr s Void
c'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
c' :: Expr s Void
c' = Expr s Void -> Expr s Void
loop Expr s Void
c
Core.ImportAlt a :: Expr s Void
a b :: Expr s Void
b ->
Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Core.ImportAlt Expr s Void
a' Expr s Void
b'
where
a' :: Expr s Void
a' = Expr s Void -> Expr s Void
loop Expr s Void
a
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.Note a :: s
a b :: Expr s Void
b ->
s -> Expr s Void -> Expr s Void
forall s a. s -> Expr s a -> Expr s a
Core.Note s
a Expr s Void
b'
where
b' :: Expr s Void
b' = Expr s Void -> Expr s Void
loop Expr s Void
b
Core.Embed a :: Void
a ->
Void -> Expr s Void
forall s a. a -> Expr s a
Core.Embed Void
a
parseConversion :: Parser Conversion
parseConversion :: Parser Conversion
parseConversion =
Parser Conversion
conversion
Parser Conversion -> Parser Conversion -> Parser Conversion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Conversion
noConversion
where
conversion :: Parser Conversion
conversion = Text -> Text -> Conversion
Conversion (Text -> Text -> Conversion)
-> Parser Text -> Parser (Text -> Conversion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parseKeyField Parser (Text -> Conversion) -> Parser Text -> Parser Conversion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
parseValueField
where
parseKeyField :: Parser Text
parseKeyField =
Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.Applicative.long "key"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Options.Applicative.help "Reserved key field name for association lists"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Text -> Mod OptionFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Options.Applicative.value "mapKey"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> (Text -> String) -> Mod OptionFields Text
forall a (f :: * -> *). (a -> String) -> Mod f a
Options.Applicative.showDefaultWith Text -> String
Data.Text.unpack
)
parseValueField :: Parser Text
parseValueField =
Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.Applicative.long "value"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Options.Applicative.help "Reserved value field name for association lists"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Text -> Mod OptionFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Options.Applicative.value "mapValue"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> (Text -> String) -> Mod OptionFields Text
forall a (f :: * -> *). (a -> String) -> Mod f a
Options.Applicative.showDefaultWith Text -> String
Data.Text.unpack
)
noConversion :: Parser Conversion
noConversion =
Conversion -> Mod FlagFields Conversion -> Parser Conversion
forall a. a -> Mod FlagFields a -> Parser a
Options.Applicative.flag'
Conversion
NoConversion
( String -> Mod FlagFields Conversion
forall (f :: * -> *) a. HasName f => String -> Mod f a
Options.Applicative.long "no-maps"
Mod FlagFields Conversion
-> Mod FlagFields Conversion -> Mod FlagFields Conversion
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Conversion
forall (f :: * -> *) a. String -> Mod f a
Options.Applicative.help "Disable conversion of association lists to homogeneous maps"
)
data SpecialDoubleMode
= UseYAMLEncoding
| ForbidWithinJSON
| ApproximateWithinJSON
handleSpecialDoubles
:: SpecialDoubleMode -> Expr s Void -> Either CompileError (Expr s Void)
handleSpecialDoubles :: SpecialDoubleMode
-> Expr s Void -> Either CompileError (Expr s Void)
handleSpecialDoubles specialDoubleMode :: SpecialDoubleMode
specialDoubleMode =
LensLike
(WrappedMonad (Either CompileError))
(Expr s Void)
(Expr s Void)
(Expr s Void)
(Expr s Void)
-> (Expr s Void -> Either CompileError (Maybe (Expr s Void)))
-> Expr s Void
-> Either CompileError (Expr s Void)
forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b
Dhall.Optics.rewriteMOf LensLike
(WrappedMonad (Either CompileError))
(Expr s Void)
(Expr s Void)
(Expr s Void)
(Expr s Void)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Core.subExpressions Expr s Void -> Either CompileError (Maybe (Expr s Void))
forall s a s a. Expr s a -> Either CompileError (Maybe (Expr s a))
rewrite
where
rewrite :: Expr s a -> Either CompileError (Maybe (Expr s a))
rewrite =
case SpecialDoubleMode
specialDoubleMode of
UseYAMLEncoding -> Expr s a -> Either CompileError (Maybe (Expr s a))
forall (m :: * -> *) s a s a.
Monad m =>
Expr s a -> m (Maybe (Expr s a))
useYAMLEncoding
ForbidWithinJSON -> Expr s a -> Either CompileError (Maybe (Expr s a))
forall s a a. Expr s a -> Either CompileError (Maybe a)
forbidWithinJSON
ApproximateWithinJSON -> Expr s a -> Either CompileError (Maybe (Expr s a))
forall (m :: * -> *) s a s a.
Monad m =>
Expr s a -> m (Maybe (Expr s a))
approximateWithinJSON
useYAMLEncoding :: Expr s a -> m (Maybe (Expr s a))
useYAMLEncoding (Core.DoubleLit (DhallDouble n :: Double
n))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
n Bool -> Bool -> Bool
&& 0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
n =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
Core.TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [] "inf")))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
n Bool -> Bool -> Bool
&& Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0 =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
Core.TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [] "-inf")))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
n =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
Core.TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [] "nan")))
useYAMLEncoding _ =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Expr s a)
forall a. Maybe a
Nothing
forbidWithinJSON :: Expr s a -> Either CompileError (Maybe a)
forbidWithinJSON (Core.DoubleLit (DhallDouble n :: Double
n))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
n Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
n =
CompileError -> Either CompileError (Maybe a)
forall a b. a -> Either a b
Left (Double -> CompileError
SpecialDouble Double
n)
forbidWithinJSON _ =
Maybe a -> Either CompileError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
approximateWithinJSON :: Expr s a -> m (Maybe (Expr s a))
approximateWithinJSON (Core.DoubleLit (DhallDouble n :: Double
n))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
n Bool -> Bool -> Bool
&& Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
Core.DoubleLit (Double -> DhallDouble
DhallDouble 1.7976931348623157e308)))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
n Bool -> Bool -> Bool
&& Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0 =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
Core.DoubleLit (Double -> DhallDouble
DhallDouble (-1.7976931348623157e308))))
approximateWithinJSON _ =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Expr s a)
forall a. Maybe a
Nothing
codeToValue
:: Conversion
-> SpecialDoubleMode
-> Maybe FilePath
-> Text
-> IO Value
codeToValue :: Conversion -> SpecialDoubleMode -> Maybe String -> Text -> IO Value
codeToValue conversion :: Conversion
conversion specialDoubleMode :: SpecialDoubleMode
specialDoubleMode mFilePath :: Maybe String
mFilePath code :: Text
code = do
Expr Src Import
parsedExpression <- Either ParseError (Expr Src Import) -> IO (Expr Src Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (String -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "(input)" Maybe String
mFilePath) Text
code)
let rootDirectory :: String
rootDirectory = case Maybe String
mFilePath of
Nothing -> "."
Just fp :: String
fp -> ShowS
System.FilePath.takeDirectory String
fp
Expr Src Void
resolvedExpression <- String
-> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void)
Dhall.Import.loadRelativeTo String
rootDirectory SemanticCacheMode
UseSemanticCache Expr Src Import
parsedExpression
Expr Src Void
_ <- Either (TypeError Src Void) (Expr Src Void) -> IO (Expr Src Void)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
Dhall.TypeCheck.typeOf Expr Src Void
resolvedExpression)
let convertedExpression :: Expr Src Void
convertedExpression =
Conversion -> Expr Src Void -> Expr Src Void
forall s. Conversion -> Expr s Void -> Expr s Void
convertToHomogeneousMaps Conversion
conversion Expr Src Void
resolvedExpression
Expr Src Void
specialDoubleExpression <- Either CompileError (Expr Src Void) -> IO (Expr Src Void)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (SpecialDoubleMode
-> Expr Src Void -> Either CompileError (Expr Src Void)
forall s.
SpecialDoubleMode
-> Expr s Void -> Either CompileError (Expr s Void)
handleSpecialDoubles SpecialDoubleMode
specialDoubleMode Expr Src Void
convertedExpression)
case Expr Src Void -> Either CompileError Value
forall s. Expr s Void -> Either CompileError Value
dhallToJSON Expr Src Void
specialDoubleExpression of
Left err :: CompileError
err -> CompileError -> IO Value
forall e a. Exception e => e -> IO a
Control.Exception.throwIO CompileError
err
Right json :: Value
json -> Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
json