{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Dhall.JSON (
dhallToJSON
, omitNull
, omitEmpty
, parsePreservationAndOmission
, Conversion(..)
, defaultConversion
, convertToHomogeneousMaps
, parseConversion
, SpecialDoubleMode(..)
, handleSpecialDoubles
, codeToValue
, codeToHeaderAndValue
, CompileError(..)
) where
import Control.Applicative (empty, (<|>))
import Control.Exception (Exception, throwIO)
import Control.Monad (guard)
import Data.Aeson (ToJSON (..), Value (..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Void (Void)
import Dhall.Core (Binding (..), DhallDouble (..), Expr)
import Dhall.Import (SemanticCacheMode (..))
import Dhall.JSON.Util (pattern FA, pattern V)
import Dhall.Map (Map)
import Dhall.Parser (Header(..))
import Options.Applicative (Parser)
import Prelude hiding (getContents)
import Prettyprinter (Pretty)
import qualified Data.Aeson as Aeson
import qualified Data.Foldable as Foldable
import qualified Data.List
import qualified Data.Map
import qualified Data.Ord
import qualified Data.Text
import qualified Data.Vector as Vector
import qualified Dhall.Core as Core
import qualified Dhall.Import
import qualified Dhall.JSON.Compat as JSON.Compat
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 Lens.Family as Lens
import qualified Options.Applicative
import qualified Prettyprinter.Render.Text as Pretty
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 CompileError
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
<> Text
": ❰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 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 -> Text
forall a. Semigroup a => a -> a -> a
<> Text
special Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 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 Expr X X
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
<> Text
": 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 X X -> Text
forall a. Pretty a => a -> Text
insert Expr X X
e
show (InvalidInlineContents Expr X X
record Expr X X
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
<> Text
": 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 X X -> Text
forall a. Pretty a => a -> Text
insert Expr X X
record Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \n\
\ \n\
\... because \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr X X -> Text
forall a. Pretty a => a -> Text
insert Expr X X
alternativeContents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \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 :: forall a. Pretty a => 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 :: forall s. Expr s X -> Either CompileError Value
dhallToJSON Expr s X
e0 = Expr X X -> Either CompileError Value
loop (Expr X X -> Expr X X
forall s a. Expr s a -> Expr s a
Core.alphaNormalize (Expr s X -> Expr X X
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s X
e0))
where
loop :: Expr X X -> Either CompileError Value
loop Expr X X
e = case Expr X X
e of
Core.BoolLit Bool
a -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
a)
Core.NaturalLit Natural
a -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
a)
Core.IntegerLit Integer
a -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
a)
Core.DoubleLit (DhallDouble Double
a) -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
a)
Core.TextLit (Core.Chunks [] Text
a) -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
a)
Core.ListLit Maybe (Expr X X)
_ Seq (Expr X X)
a -> do
Seq Value
a' <- (Expr X X -> Either CompileError Value)
-> Seq (Expr X X) -> Either CompileError (Seq Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse Expr X X -> Either CompileError Value
loop Seq (Expr X X)
a
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Value -> Value
forall a. ToJSON a => a -> Value
toJSON Seq Value
a')
Core.Some Expr X X
a -> do
Value
a' <- Expr X X -> Either CompileError Value
loop Expr X X
a
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
a')
Core.App Expr X X
Core.None Expr X X
_ -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
Expr X X
Core.None -> CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left CompileError
BareNone
Expr X X
_ | Just Text
text <- Expr X X -> Maybe Text
forall a s. Pretty a => Expr s a -> Maybe Text
Dhall.Pretty.temporalToText Expr X X
e ->
Expr X X -> Either CompileError Value
loop (Chunks X X -> Expr X X
forall s a. Chunks s a -> Expr s a
Core.TextLit ([(Text, Expr X X)] -> Text -> Chunks X X
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [] Text
text))
Core.RecordLit Map Text (RecordField X X)
a ->
case Map Text (RecordField X X) -> [(Text, RecordField X X)]
forall k v. Ord k => Map k v -> [(k, v)]
toOrderedList Map Text (RecordField X X)
a of
[ ( Text
"contents"
, RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Expr X X
contents
)
, ( Text
"field"
, RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.TextLit
(Core.Chunks [] Text
field)
)
, ( Text
"nesting"
, RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.App
(Core.Field
(Core.Union
[ (Text
"Inline", Maybe (Expr X X)
mInlineType)
, (Text
"Nested", Just Expr X X
Core.Text)
]
)
(FA Text
"Nested")
)
(Core.TextLit
(Core.Chunks [] Text
nestedField)
)
)
] | (Expr X X -> Bool) -> Maybe (Expr X X) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Expr X X -> Expr X X -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text (RecordField X X) -> Expr X X
forall s a. Map Text (RecordField s a) -> Expr s a
Core.Record []) Maybe (Expr X X)
mInlineType
, Just (Text
alternativeName, Maybe (Expr X X)
mExpr) <- Expr X X -> Maybe (Text, Maybe (Expr X X))
forall s. Expr s X -> Maybe (Text, Maybe (Expr s X))
getContents Expr X X
contents -> do
Value
contents' <- case Maybe (Expr X X)
mExpr of
Just Expr X X
expr -> Expr X X -> Either CompileError Value
loop Expr X X
expr
Maybe (Expr X X)
Nothing -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
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 a. a -> Either CompileError a
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)
[ ( Text
"contents"
, RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Expr X X
contents
)
, ( Text
"field"
, RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.TextLit
(Core.Chunks [] Text
field)
)
, ( Text
"nesting"
, RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Expr X X
nesting
)
] | Expr X X -> Bool
forall s. Expr s X -> Bool
isInlineNesting Expr X X
nesting
, Just (Text
alternativeName, Maybe (Expr X X)
mExpr) <- Expr X X -> Maybe (Text, Maybe (Expr X X))
forall s. Expr s X -> Maybe (Text, Maybe (Expr s X))
getContents Expr X X
contents -> do
Map Text (RecordField X X)
kvs0 <- case Maybe (Expr X X)
mExpr of
Just (Core.RecordLit Map Text (RecordField X X)
kvs) -> Map Text (RecordField X X)
-> Either CompileError (Map Text (RecordField X X))
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (RecordField X X)
kvs
Just Expr X X
alternativeContents ->
CompileError -> Either CompileError (Map Text (RecordField X X))
forall a b. a -> Either a b
Left (Expr X X -> Expr X X -> CompileError
InvalidInlineContents Expr X X
e Expr X X
alternativeContents)
Maybe (Expr X X)
Nothing -> Map Text (RecordField X X)
-> Either CompileError (Map Text (RecordField X X))
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (RecordField X X)
forall a. Monoid a => a
mempty
let name :: RecordField s a
name = Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr s a -> RecordField s a) -> Expr s a -> RecordField s a
forall a b. (a -> b) -> a -> b
$ 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 (RecordField X X)
kvs1 = Text
-> RecordField X X
-> Map Text (RecordField X X)
-> Map Text (RecordField X X)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
field RecordField X X
forall {s} {a}. RecordField s a
name Map Text (RecordField X X)
kvs0
Expr X X -> Either CompileError Value
loop (Map Text (RecordField X X) -> Expr X X
forall s a. Map Text (RecordField s a) -> Expr s a
Core.RecordLit Map Text (RecordField X X)
kvs1)
[(Text, RecordField X X)]
_ -> do
Map Text Value
a' <- (RecordField X X -> Either CompileError Value)
-> Map Text (RecordField X X)
-> Either CompileError (Map Text Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Text a -> f (Map Text b)
traverse (Expr X X -> Either CompileError Value
loop (Expr X X -> Either CompileError Value)
-> (RecordField X X -> Expr X X)
-> RecordField X X
-> Either CompileError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue) Map Text (RecordField X X)
a
Value -> Either CompileError Value
forall a. a -> Either CompileError a
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 Map Text (Maybe (Expr X X))
_) FieldSelection X
_) Expr X X
b -> Expr X X -> Either CompileError Value
loop Expr X X
b
Core.Field (Core.Union Map Text (Maybe (Expr X X))
_) (FA Text
k) -> Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
k)
Core.Lam Maybe CharacterSet
_ (FunctionBinding X X -> Expr X X
forall s a. FunctionBinding s a -> Expr s a
Core.functionBindingAnnotation -> Core.Const Const
Core.Type)
(Core.Lam Maybe CharacterSet
_ (FunctionBinding X X -> Expr X X
forall s a. FunctionBinding s a -> Expr s a
Core.functionBindingAnnotation ->
(Core.Record
[ (Text
"array" , RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ (Core.App Expr X X
Core.List (V Int
0)) (V Int
1))
, (Text
"bool" , RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ Expr X X
Core.Bool (V Int
1))
, (Text
"null" , RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> V Int
0)
, (Text
"number", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ Expr X X
Core.Double (V Int
1))
, (Text
"object", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue ->
Core.Pi Maybe CharacterSet
_ Text
_ (Core.App Expr X X
Core.List (Core.Record
[ (Text
"mapKey", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Expr X X
Core.Text)
, (Text
"mapValue", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> V Int
0)])) (V Int
1))
, (Text
"string", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ Expr X X
Core.Text (V Int
1))
]
))
Expr X X
value
) -> do
let outer :: Expr s a -> Either CompileError Value
outer (Core.Field (V Int
0) (FA Text
"null")) = Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
outer (Core.App (Core.Field (V Int
0) (FA Text
"bool")) (Core.BoolLit Bool
b)) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value
Aeson.Bool Bool
b)
outer (Core.App (Core.Field (V Int
0) (FA Text
"array")) (Core.ListLit Maybe (Expr s a)
_ 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Expr s a -> Either CompileError Value
outer (Seq (Expr s a) -> [Expr s a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall a. a -> Either CompileError a
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 Int
0) (FA Text
"object")) (Core.ListLit Maybe (Expr s a)
_ Seq (Expr s a)
xs)) = do
let inner :: Expr s a -> Either CompileError (Text, Value)
inner (Core.RecordLit
[ (Text
"mapKey", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.TextLit (Core.Chunks [] Text
mapKey))
, (Text
"mapValue", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Expr s a
mapExpression)]) = do
Value
mapValue <- Expr s a -> Either CompileError Value
outer Expr s a
mapExpression
(Text, Value) -> Either CompileError (Text, Value)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mapKey, Value
mapValue)
inner Expr s a
_ = CompileError -> Either CompileError (Text, Value)
forall a b. a -> Either a b
Left (Expr X X -> CompileError
Unsupported Expr X X
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Expr s a -> Either CompileError (Text, Value)
inner (Seq (Expr s a) -> [Expr s a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Aeson.Object ([(Text, Value)] -> Object
JSON.Compat.objectFromList [(Text, Value)]
ys))
outer (Core.App (Core.Field (V Int
0) (FA Text
"number")) (Core.DoubleLit (DhallDouble Double
n))) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
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 Int
0) (FA Text
"string")) (Core.TextLit (Core.Chunks [] Text
text))) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
text)
outer Expr s a
_ = CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left (Expr X X -> CompileError
Unsupported Expr X X
e)
Expr X X -> Either CompileError Value
forall {s} {a}. Expr s a -> Either CompileError Value
outer Expr X X
value
Core.Lam Maybe CharacterSet
_ (FunctionBinding X X -> Expr X X
forall s a. FunctionBinding s a -> Expr s a
Core.functionBindingAnnotation -> Core.Const Const
Core.Type)
(Core.Lam Maybe CharacterSet
_ (FunctionBinding X X -> Expr X X
forall s a. FunctionBinding s a -> Expr s a
Core.functionBindingAnnotation ->
(Core.Record
[ (Text
"array" , RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ (Core.App Expr X X
Core.List (V Int
0)) (V Int
1))
, (Text
"bool" , RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ Expr X X
Core.Bool (V Int
1))
, (Text
"double", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ Expr X X
Core.Double (V Int
1))
, (Text
"integer", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ Expr X X
Core.Integer (V Int
1))
, (Text
"null" , RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> V Int
0)
, (Text
"object", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue ->
Core.Pi Maybe CharacterSet
_ Text
_ (Core.App Expr X X
Core.List (Core.Record
[ (Text
"mapKey", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Expr X X
Core.Text)
, (Text
"mapValue", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> V Int
0)
])) (V Int
1))
, (Text
"string", RecordField X X -> Expr X X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.Pi Maybe CharacterSet
_ Text
_ Expr X X
Core.Text (V Int
1))
]
))
Expr X X
value
) -> do
let outer :: Expr s a -> Either CompileError Value
outer (Core.Field (V Int
0) (FA Text
"null")) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
Aeson.Null
outer (Core.App (Core.Field (V Int
0) (FA Text
"bool")) (Core.BoolLit Bool
b)) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value
Aeson.Bool Bool
b)
outer (Core.App (Core.Field (V Int
0) (FA Text
"array")) (Core.ListLit Maybe (Expr s a)
_ 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Expr s a -> Either CompileError Value
outer (Seq (Expr s a) -> [Expr s a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall a. a -> Either CompileError a
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 Int
0) (FA Text
"object")) (Core.ListLit Maybe (Expr s a)
_ Seq (Expr s a)
xs)) = do
let inner :: Expr s a -> Either CompileError (Text, Value)
inner (Core.RecordLit
[ (Text
"mapKey", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Core.TextLit (Core.Chunks [] Text
mapKey))
, (Text
"mapValue", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue -> Expr s a
mapExpression)]) = do
Value
mapValue <- Expr s a -> Either CompileError Value
outer Expr s a
mapExpression
(Text, Value) -> Either CompileError (Text, Value)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mapKey, Value
mapValue)
inner Expr s a
_ = CompileError -> Either CompileError (Text, Value)
forall a b. a -> Either a b
Left (Expr X X -> CompileError
Unsupported Expr X X
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Expr s a -> Either CompileError (Text, Value)
inner (Seq (Expr s a) -> [Expr s a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s a)
xs)
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Aeson.Object ([(Text, Value)] -> Object
JSON.Compat.objectFromList [(Text, Value)]
ys))
outer (Core.App (Core.Field (V Int
0) (FA Text
"double")) (Core.DoubleLit (DhallDouble Double
n))) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
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 Int
0) (FA Text
"integer")) (Core.IntegerLit Integer
n)) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
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 Int
0) (FA Text
"string")) (Core.TextLit (Core.Chunks [] Text
text))) =
Value -> Either CompileError Value
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
text)
outer Expr s a
_ = CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left (Expr X X -> CompileError
Unsupported Expr X X
e)
Expr X X -> Either CompileError Value
forall {s} {a}. Expr s a -> Either CompileError Value
outer Expr X X
value
Expr X X
_ -> CompileError -> Either CompileError Value
forall a b. a -> Either a b
Left (Expr X X -> CompileError
Unsupported Expr X X
e)
getContents :: Expr s Void -> Maybe (Text, Maybe (Expr s Void))
getContents :: forall s. Expr s X -> Maybe (Text, Maybe (Expr s X))
getContents (Core.App
(Core.Field
Expr s X
_
(FA Text
alternativeName)
)
Expr s X
expression
) = (Text, Maybe (Expr s X)) -> Maybe (Text, Maybe (Expr s X))
forall a. a -> Maybe a
Just (Text
alternativeName, Expr s X -> Maybe (Expr s X)
forall a. a -> Maybe a
Just Expr s X
expression)
getContents (Core.Field Expr s X
_ (FA Text
alternativeName)) = (Text, Maybe (Expr s X)) -> Maybe (Text, Maybe (Expr s X))
forall a. a -> Maybe a
Just (Text
alternativeName, Maybe (Expr s X)
forall a. Maybe a
Nothing)
getContents Expr s X
_ = Maybe (Text, Maybe (Expr s X))
forall a. Maybe a
Nothing
isInlineNesting :: Expr s Void -> Bool
isInlineNesting :: forall s. Expr s X -> Bool
isInlineNesting (Core.App
(Core.Field
(Core.Union
[ (Text
"Inline", Just (Core.Record []))
, (Text
"Nested", Just Expr s X
Core.Text)
]
)
(FA Text
"Inline")
)
(Core.RecordLit [])
) = Bool
True
isInlineNesting (Core.Field
(Core.Union
[ (Text
"Inline", Maybe (Expr s X)
Nothing)
, (Text
"Nested", Just Expr s X
Core.Text)
]
)
(FA Text
"Inline")
) = Bool
True
isInlineNesting Expr s X
_ = Bool
False
toOrderedList :: Ord k => Map k v -> [(k, v)]
toOrderedList :: forall k v. Ord k => 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 -> Value
Object Object
fields
where
fields :: Object
fields = (Value -> Bool) -> Object -> Object
JSON.Compat.filterObject (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) ((Value -> Value) -> Object -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitNull Object
object)
omitNull (Array Array
array) =
Array -> Value
Array ((Value -> Value) -> Array -> Array
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitNull Array
array)
omitNull (String Text
string) =
Text -> Value
String Text
string
omitNull (Number Scientific
number) =
Scientific -> Value
Number Scientific
number
omitNull (Bool Bool
bool) =
Bool -> Value
Bool Bool
bool
omitNull Value
Null =
Value
Null
omitEmpty :: Value -> Value
omitEmpty :: Value -> Value
omitEmpty (Object Object
object) =
if Object -> Bool
forall a. KeyMap a -> 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
JSON.Compat.filterObject (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) ((Value -> Value) -> Object -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitEmpty Object
object)
omitEmpty (Array Array
array) =
if Array -> Bool
forall a. Vector a -> 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 a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
omitEmpty Array
array)
omitEmpty (String Text
string) =
Text -> Value
String Text
string
omitEmpty (Number Scientific
number) =
Scientific -> Value
Number Scientific
number
omitEmpty (Bool Bool
bool) =
Bool -> Value
Bool Bool
bool
omitEmpty Value
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 String
"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 String
"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 String
"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 String
"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 a. Parser a -> Parser a -> Parser a
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
{ mapKey :: Text
mapKey = Text
"mapKey"
, mapValue :: Text
mapValue = Text
"mapValue"
}
convertToHomogeneousMaps :: Conversion -> Expr s Void -> Expr s Void
convertToHomogeneousMaps :: forall s. Conversion -> Expr s X -> Expr s X
convertToHomogeneousMaps Conversion
NoConversion Expr s X
e0 = Expr s X
e0
convertToHomogeneousMaps (Conversion {Text
mapKey :: Conversion -> Text
mapValue :: Conversion -> Text
mapKey :: Text
mapValue :: Text
..}) Expr s X
e0 = Expr s X -> Expr s X
forall {s}. Expr s X -> Expr s X
loop (Expr s X -> Expr s X
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s X
e0)
where
loop :: Expr s X -> Expr s X
loop Expr s X
e = case Expr s X
e of
Core.Const Const
a ->
Const -> Expr s X
forall s a. Const -> Expr s a
Core.Const Const
a
Core.Var Var
v ->
Var -> Expr s X
forall s a. Var -> Expr s a
Core.Var Var
v
Core.Lam Maybe CharacterSet
cs FunctionBinding s X
a Expr s X
b ->
Maybe CharacterSet -> FunctionBinding s X -> Expr s X -> Expr s X
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Core.Lam Maybe CharacterSet
cs FunctionBinding s X
a Expr s X
b
Core.Pi Maybe CharacterSet
cs Text
a Expr s X
b Expr s X
c ->
Maybe CharacterSet -> Text -> Expr s X -> Expr s X -> Expr s X
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Core.Pi Maybe CharacterSet
cs Text
a Expr s X
b' Expr s X
c'
where
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
c' :: Expr s X
c' = Expr s X -> Expr s X
loop Expr s X
c
Core.App Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.Let (Binding Maybe s
src0 Text
a Maybe s
src1 Maybe (Maybe s, Expr s X)
b Maybe s
src2 Expr s X
c) Expr s X
d ->
Binding s X -> Expr s X -> Expr s X
forall s a. Binding s a -> Expr s a -> Expr s a
Core.Let (Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s X)
-> Maybe s
-> Expr s X
-> Binding s X
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 X)
b' Maybe s
src2 Expr s X
c') Expr s X
d'
where
b' :: Maybe (Maybe s, Expr s X)
b' = ((Maybe s, Expr s X) -> (Maybe s, Expr s X))
-> Maybe (Maybe s, Expr s X) -> Maybe (Maybe s, Expr s X)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s X -> Expr s X)
-> (Maybe s, Expr s X) -> (Maybe s, Expr s X)
forall a b. (a -> b) -> (Maybe s, a) -> (Maybe s, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s X -> Expr s X
loop) Maybe (Maybe s, Expr s X)
b
c' :: Expr s X
c' = Expr s X -> Expr s X
loop Expr s X
c
d' :: Expr s X
d' = Expr s X -> Expr s X
loop Expr s X
d
Core.Annot Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.Annot Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Expr s X
Core.Bool ->
Expr s X
forall s a. Expr s a
Core.Bool
Core.BoolLit Bool
a ->
Bool -> Expr s X
forall s a. Bool -> Expr s a
Core.BoolLit Bool
a
Core.BoolAnd Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolAnd Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.BoolOr Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolOr Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.BoolEQ Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolEQ Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.BoolNE Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.BoolNE Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.BoolIf Expr s X
a Expr s X
b Expr s X
c ->
Expr s X -> Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
Core.BoolIf Expr s X
a' Expr s X
b' Expr s X
c'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
c' :: Expr s X
c' = Expr s X -> Expr s X
loop Expr s X
c
Expr s X
Core.Bytes ->
Expr s X
forall s a. Expr s a
Core.Bytes
Core.BytesLit ByteString
a ->
ByteString -> Expr s X
forall s a. ByteString -> Expr s a
Core.BytesLit ByteString
a
Expr s X
Core.Natural ->
Expr s X
forall s a. Expr s a
Core.Natural
Core.NaturalLit Natural
a ->
Natural -> Expr s X
forall s a. Natural -> Expr s a
Core.NaturalLit Natural
a
Expr s X
Core.NaturalFold ->
Expr s X
forall s a. Expr s a
Core.NaturalFold
Expr s X
Core.NaturalBuild ->
Expr s X
forall s a. Expr s a
Core.NaturalBuild
Expr s X
Core.NaturalIsZero ->
Expr s X
forall s a. Expr s a
Core.NaturalIsZero
Expr s X
Core.NaturalEven ->
Expr s X
forall s a. Expr s a
Core.NaturalEven
Expr s X
Core.NaturalOdd ->
Expr s X
forall s a. Expr s a
Core.NaturalOdd
Expr s X
Core.NaturalToInteger ->
Expr s X
forall s a. Expr s a
Core.NaturalToInteger
Expr s X
Core.NaturalShow ->
Expr s X
forall s a. Expr s a
Core.NaturalShow
Expr s X
Core.NaturalSubtract ->
Expr s X
forall s a. Expr s a
Core.NaturalSubtract
Core.NaturalPlus Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.NaturalPlus Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.NaturalTimes Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.NaturalTimes Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Expr s X
Core.Integer ->
Expr s X
forall s a. Expr s a
Core.Integer
Core.IntegerLit Integer
a ->
Integer -> Expr s X
forall s a. Integer -> Expr s a
Core.IntegerLit Integer
a
Expr s X
Core.IntegerClamp ->
Expr s X
forall s a. Expr s a
Core.IntegerClamp
Expr s X
Core.IntegerNegate ->
Expr s X
forall s a. Expr s a
Core.IntegerNegate
Expr s X
Core.IntegerShow ->
Expr s X
forall s a. Expr s a
Core.IntegerShow
Expr s X
Core.IntegerToDouble ->
Expr s X
forall s a. Expr s a
Core.IntegerToDouble
Expr s X
Core.Double ->
Expr s X
forall s a. Expr s a
Core.Double
Core.DoubleLit DhallDouble
a ->
DhallDouble -> Expr s X
forall s a. DhallDouble -> Expr s a
Core.DoubleLit DhallDouble
a
Expr s X
Core.DoubleShow ->
Expr s X
forall s a. Expr s a
Core.DoubleShow
Expr s X
Core.Text ->
Expr s X
forall s a. Expr s a
Core.Text
Core.TextLit (Core.Chunks [(Text, Expr s X)]
a Text
b) ->
Chunks s X -> Expr s X
forall s a. Chunks s a -> Expr s a
Core.TextLit ([(Text, Expr s X)] -> Text -> Chunks s X
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [(Text, Expr s X)]
a' Text
b)
where
a' :: [(Text, Expr s X)]
a' = ((Text, Expr s X) -> (Text, Expr s X))
-> [(Text, Expr s X)] -> [(Text, Expr s X)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s X -> Expr s X) -> (Text, Expr s X) -> (Text, Expr s X)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s X -> Expr s X
loop) [(Text, Expr s X)]
a
Core.TextAppend Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.TextAppend Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Expr s X
Core.TextReplace ->
Expr s X
forall s a. Expr s a
Core.TextReplace
Expr s X
Core.TextShow ->
Expr s X
forall s a. Expr s a
Core.TextShow
Expr s X
Core.Date ->
Expr s X
forall s a. Expr s a
Core.Date
Core.DateLiteral Day
d ->
Day -> Expr s X
forall s a. Day -> Expr s a
Core.DateLiteral Day
d
Expr s X
Core.DateShow ->
Expr s X
forall s a. Expr s a
Core.DateShow
Expr s X
Core.Time ->
Expr s X
forall s a. Expr s a
Core.Time
Core.TimeLiteral TimeOfDay
t Word
p ->
TimeOfDay -> Word -> Expr s X
forall s a. TimeOfDay -> Word -> Expr s a
Core.TimeLiteral TimeOfDay
t Word
p
Expr s X
Core.TimeShow ->
Expr s X
forall s a. Expr s a
Core.TimeShow
Expr s X
Core.TimeZone ->
Expr s X
forall s a. Expr s a
Core.TimeZone
Core.TimeZoneLiteral TimeZone
z ->
TimeZone -> Expr s X
forall s a. TimeZone -> Expr s a
Core.TimeZoneLiteral TimeZone
z
Expr s X
Core.TimeZoneShow ->
Expr s X
forall s a. Expr s a
Core.TimeZoneShow
Expr s X
Core.List ->
Expr s X
forall s a. Expr s a
Core.List
Core.ListLit Maybe (Expr s X)
a Seq (Expr s X)
b ->
case Maybe (Expr s X)
transform of
Just Expr s X
c -> Expr s X -> Expr s X
loop Expr s X
c
Maybe (Expr s X)
Nothing -> Maybe (Expr s X) -> Seq (Expr s X) -> Expr s X
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit Maybe (Expr s X)
a' Seq (Expr s X)
b'
where
elements :: [Expr s X]
elements = Seq (Expr s X) -> [Expr s X]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr s X)
b
toKeyValue :: Expr s Void -> Maybe (Text, Expr s Void)
toKeyValue :: forall s. Expr s X -> Maybe (Text, Expr s X)
toKeyValue (Core.RecordLit Map Text (RecordField s X)
m) = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Map Text (RecordField s X) -> Int
forall a. Map Text a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length Map Text (RecordField s X)
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2)
Expr s X
key <- RecordField s X -> Expr s X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField s X -> Expr s X)
-> Maybe (RecordField s X) -> Maybe (Expr s X)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text (RecordField s X) -> Maybe (RecordField s X)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
mapKey Map Text (RecordField s X)
m
Expr s X
value <- RecordField s X -> Expr s X
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField s X -> Expr s X)
-> Maybe (RecordField s X) -> Maybe (Expr s X)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Map Text (RecordField s X) -> Maybe (RecordField s X)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
mapValue Map Text (RecordField s X)
m
Text
keyText <- case Expr s X
key of
Core.TextLit (Core.Chunks [] Text
keyText) ->
Text -> Maybe Text
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
keyText
Core.Field (Core.Union Map Text (Maybe (Expr s X))
_) (FA Text
keyText) ->
Text -> Maybe Text
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
keyText
Expr s X
_ ->
Maybe Text
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty
(Text, Expr s X) -> Maybe (Text, Expr s X)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
keyText, Expr s X
value)
toKeyValue Expr s X
_ =
Maybe (Text, Expr s X)
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty
transform :: Maybe (Expr s X)
transform =
case [Expr s X]
elements of
[] ->
case Maybe (Expr s X)
a of
Just (Core.App Expr s X
Core.List (Core.Record Map Text (RecordField s X)
m)) -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Map Text (RecordField s X) -> Int
forall a. Map Text a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length Map Text (RecordField s X)
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Map Text (RecordField s X) -> Bool
forall k v. Ord k => k -> Map k v -> Bool
Dhall.Map.member Text
mapKey Map Text (RecordField s X)
m)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Map Text (RecordField s X) -> Bool
forall k v. Ord k => k -> Map k v -> Bool
Dhall.Map.member Text
mapValue Map Text (RecordField s X)
m)
Expr s X -> Maybe (Expr s X)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (RecordField s X) -> Expr s X
forall s a. Map Text (RecordField s a) -> Expr s a
Core.RecordLit Map Text (RecordField s X)
forall a. Monoid a => a
mempty)
Maybe (Expr s X)
_ -> Maybe (Expr s X)
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty
[Expr s X]
_ -> do
[(Text, Expr s X)]
keyValues <- (Expr s X -> Maybe (Text, Expr s X))
-> [Expr s X] -> Maybe [(Text, Expr s X)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Expr s X -> Maybe (Text, Expr s X)
forall s. Expr s X -> Maybe (Text, Expr s X)
toKeyValue [Expr s X]
elements
let recordLiteral :: Map Text (RecordField s X)
recordLiteral = Expr s X -> RecordField s X
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr s X -> RecordField s X)
-> Map Text (Expr s X) -> Map Text (RecordField s X)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[(Text, Expr s X)] -> Map Text (Expr s X)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, Expr s X)]
keyValues
Expr s X -> Maybe (Expr s X)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (RecordField s X) -> Expr s X
forall s a. Map Text (RecordField s a) -> Expr s a
Core.RecordLit Map Text (RecordField s X)
recordLiteral)
a' :: Maybe (Expr s X)
a' = (Expr s X -> Expr s X) -> Maybe (Expr s X) -> Maybe (Expr s X)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s X -> Expr s X
loop Maybe (Expr s X)
a
b' :: Seq (Expr s X)
b' = (Expr s X -> Expr s X) -> Seq (Expr s X) -> Seq (Expr s X)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s X -> Expr s X
loop Seq (Expr s X)
b
Core.ListAppend Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.ListAppend Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Expr s X
Core.ListBuild ->
Expr s X
forall s a. Expr s a
Core.ListBuild
Expr s X
Core.ListFold ->
Expr s X
forall s a. Expr s a
Core.ListFold
Expr s X
Core.ListLength ->
Expr s X
forall s a. Expr s a
Core.ListLength
Expr s X
Core.ListHead ->
Expr s X
forall s a. Expr s a
Core.ListHead
Expr s X
Core.ListLast ->
Expr s X
forall s a. Expr s a
Core.ListLast
Expr s X
Core.ListIndexed ->
Expr s X
forall s a. Expr s a
Core.ListIndexed
Expr s X
Core.ListReverse ->
Expr s X
forall s a. Expr s a
Core.ListReverse
Expr s X
Core.Optional ->
Expr s X
forall s a. Expr s a
Core.Optional
Core.Some Expr s X
a ->
Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a
Core.Some Expr s X
a'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
Expr s X
Core.None ->
Expr s X
forall s a. Expr s a
Core.None
Core.Record Map Text (RecordField s X)
a ->
Map Text (RecordField s X) -> Expr s X
forall s a. Map Text (RecordField s a) -> Expr s a
Core.Record Map Text (RecordField s X)
a'
where
a' :: Map Text (RecordField s X)
a' = ASetter (RecordField s X) (RecordField s X) (Expr s X) (Expr s X)
-> (Expr s X -> Expr s X) -> RecordField s X -> RecordField s X
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter (RecordField s X) (RecordField s X) (Expr s X) (Expr s X)
forall (f :: * -> *) s a b.
Applicative f =>
(Expr s a -> f (Expr s b))
-> RecordField s a -> f (RecordField s b)
Core.recordFieldExprs Expr s X -> Expr s X
loop (RecordField s X -> RecordField s X)
-> Map Text (RecordField s X) -> Map Text (RecordField s X)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s X)
a
Core.RecordLit Map Text (RecordField s X)
a ->
Map Text (RecordField s X) -> Expr s X
forall s a. Map Text (RecordField s a) -> Expr s a
Core.RecordLit Map Text (RecordField s X)
a'
where
a' :: Map Text (RecordField s X)
a' = ASetter (RecordField s X) (RecordField s X) (Expr s X) (Expr s X)
-> (Expr s X -> Expr s X) -> RecordField s X -> RecordField s X
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter (RecordField s X) (RecordField s X) (Expr s X) (Expr s X)
forall (f :: * -> *) s a b.
Applicative f =>
(Expr s a -> f (Expr s b))
-> RecordField s a -> f (RecordField s b)
Core.recordFieldExprs Expr s X -> Expr s X
loop (RecordField s X -> RecordField s X)
-> Map Text (RecordField s X) -> Map Text (RecordField s X)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s X)
a
Core.Union Map Text (Maybe (Expr s X))
a ->
Map Text (Maybe (Expr s X)) -> Expr s X
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Core.Union Map Text (Maybe (Expr s X))
a'
where
a' :: Map Text (Maybe (Expr s X))
a' = (Maybe (Expr s X) -> Maybe (Expr s X))
-> Map Text (Maybe (Expr s X)) -> Map Text (Maybe (Expr s X))
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s X -> Expr s X) -> Maybe (Expr s X) -> Maybe (Expr s X)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s X -> Expr s X
loop) Map Text (Maybe (Expr s X))
a
Core.Combine Maybe CharacterSet
cs Maybe Text
a Expr s X
b Expr s X
c ->
Maybe CharacterSet
-> Maybe Text -> Expr s X -> Expr s X -> Expr s X
forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Core.Combine Maybe CharacterSet
cs Maybe Text
a Expr s X
b' Expr s X
c'
where
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
c' :: Expr s X
c' = Expr s X -> Expr s X
loop Expr s X
c
Core.CombineTypes Maybe CharacterSet
cs Expr s X
a Expr s X
b ->
Maybe CharacterSet -> Expr s X -> Expr s X -> Expr s X
forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Core.CombineTypes Maybe CharacterSet
cs Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.Prefer Maybe CharacterSet
cs PreferAnnotation
a Expr s X
b Expr s X
c ->
Maybe CharacterSet
-> PreferAnnotation -> Expr s X -> Expr s X -> Expr s X
forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Core.Prefer Maybe CharacterSet
cs PreferAnnotation
a Expr s X
b' Expr s X
c'
where
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
c' :: Expr s X
c' = Expr s X -> Expr s X
loop Expr s X
c
Core.RecordCompletion Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.RecordCompletion Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.Merge Expr s X
a Expr s X
b Maybe (Expr s X)
c ->
Expr s X -> Expr s X -> Maybe (Expr s X) -> Expr s X
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Core.Merge Expr s X
a' Expr s X
b' Maybe (Expr s X)
c'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
c' :: Maybe (Expr s X)
c' = (Expr s X -> Expr s X) -> Maybe (Expr s X) -> Maybe (Expr s X)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s X -> Expr s X
loop Maybe (Expr s X)
c
Core.ToMap Expr s X
a Maybe (Expr s X)
b ->
Expr s X -> Maybe (Expr s X) -> Expr s X
forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
Core.ToMap Expr s X
a' Maybe (Expr s X)
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Maybe (Expr s X)
b' = (Expr s X -> Expr s X) -> Maybe (Expr s X) -> Maybe (Expr s X)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr s X -> Expr s X
loop Maybe (Expr s X)
b
Core.ShowConstructor Expr s X
a ->
Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a
Core.ShowConstructor Expr s X
a'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
Core.Field Expr s X
a FieldSelection s
b ->
Expr s X -> FieldSelection s -> Expr s X
forall s a. Expr s a -> FieldSelection s -> Expr s a
Core.Field Expr s X
a' FieldSelection s
b
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
Core.Project Expr s X
a Either [Text] (Expr s X)
b ->
Expr s X -> Either [Text] (Expr s X) -> Expr s X
forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Core.Project Expr s X
a' Either [Text] (Expr s X)
b
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
Core.Assert Expr s X
a ->
Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a
Core.Assert Expr s X
a'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
Core.Equivalent Maybe CharacterSet
cs Expr s X
a Expr s X
b ->
Maybe CharacterSet -> Expr s X -> Expr s X -> Expr s X
forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Core.Equivalent Maybe CharacterSet
cs Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.With Expr s X
a NonEmpty WithComponent
b Expr s X
c ->
Expr s X -> NonEmpty WithComponent -> Expr s X -> Expr s X
forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
Core.With Expr s X
a' NonEmpty WithComponent
b Expr s X
c'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
c' :: Expr s X
c' = Expr s X -> Expr s X
loop Expr s X
c
Core.ImportAlt Expr s X
a Expr s X
b ->
Expr s X -> Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a -> Expr s a
Core.ImportAlt Expr s X
a' Expr s X
b'
where
a' :: Expr s X
a' = Expr s X -> Expr s X
loop Expr s X
a
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.Note s
a Expr s X
b ->
s -> Expr s X -> Expr s X
forall s a. s -> Expr s a -> Expr s a
Core.Note s
a Expr s X
b'
where
b' :: Expr s X
b' = Expr s X -> Expr s X
loop Expr s X
b
Core.Embed X
a ->
X -> Expr s X
forall s a. a -> Expr s a
Core.Embed X
a
parseConversion :: Parser Conversion
parseConversion :: Parser Conversion
parseConversion =
Parser Conversion
conversion
Parser Conversion -> Parser Conversion -> Parser Conversion
forall a. Parser a -> Parser a -> Parser a
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 String
"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 String
"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 Text
"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 String
"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 String
"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 Text
"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 String
"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 String
"Disable conversion of association lists to homogeneous maps"
)
data SpecialDoubleMode
= UseYAMLEncoding
| ForbidWithinJSON
| ApproximateWithinJSON
handleSpecialDoubles
:: SpecialDoubleMode -> Expr s Void -> Either CompileError (Expr s Void)
handleSpecialDoubles :: forall s.
SpecialDoubleMode -> Expr s X -> Either CompileError (Expr s X)
handleSpecialDoubles SpecialDoubleMode
specialDoubleMode =
LensLike
(WrappedMonad (Either CompileError))
(Expr s X)
(Expr s X)
(Expr s X)
(Expr s X)
-> (Expr s X -> Either CompileError (Maybe (Expr s X)))
-> Expr s X
-> Either CompileError (Expr s X)
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 X)
(Expr s X)
(Expr s X)
(Expr s X)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Core.subExpressions Expr s X -> Either CompileError (Maybe (Expr s X))
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
SpecialDoubleMode
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
SpecialDoubleMode
ForbidWithinJSON -> Expr s a -> Either CompileError (Maybe (Expr s a))
forall {s} {a} {a}. Expr s a -> Either CompileError (Maybe a)
forbidWithinJSON
SpecialDoubleMode
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 Double
n))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
n Bool -> Bool -> Bool
&& Double
0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
n =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall a. a -> m 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 [] Text
"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
< Double
0 =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall a. a -> m 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 [] Text
"-inf")))
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
n =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall a. a -> m 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 [] Text
"nan")))
useYAMLEncoding Expr s a
_ =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall a. a -> m 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 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 Expr s a
_ =
Maybe a -> Either CompileError (Maybe a)
forall a. a -> Either CompileError 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 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
> Double
0 =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall a. a -> m 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 Double
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
< Double
0 =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall a. a -> m 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 (-Double
1.7976931348623157e308))))
approximateWithinJSON Expr s a
_ =
Maybe (Expr s a) -> m (Maybe (Expr s a))
forall a. a -> m 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 SpecialDoubleMode
specialDoubleMode Maybe String
mFilePath Text
code = do
((Header, Value) -> Value) -> IO (Header, Value) -> IO Value
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Header, Value) -> Value
forall a b. (a, b) -> b
snd (Conversion
-> SpecialDoubleMode -> Maybe String -> Text -> IO (Header, Value)
codeToHeaderAndValue Conversion
conversion SpecialDoubleMode
specialDoubleMode Maybe String
mFilePath Text
code)
codeToHeaderAndValue
:: Conversion
-> SpecialDoubleMode
-> Maybe FilePath
-> Text
-> IO (Header, Value)
codeToHeaderAndValue :: Conversion
-> SpecialDoubleMode -> Maybe String -> Text -> IO (Header, Value)
codeToHeaderAndValue Conversion
conversion SpecialDoubleMode
specialDoubleMode Maybe String
mFilePath Text
code = do
(Header Text
header, Expr Src Import
parsedExpression) <- Either ParseError (Header, Expr Src Import)
-> IO (Header, Expr Src Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (String -> Text -> Either ParseError (Header, Expr Src Import)
Dhall.Parser.exprAndHeaderFromText (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"(input)" Maybe String
mFilePath) Text
code)
let adapt :: Text -> Text
adapt Text
line =
case Text -> Text -> Maybe Text
Data.Text.stripPrefix Text
"--" Text
line of
Just Text
suffix -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
Maybe Text
Nothing -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line
let yamlHeader :: Text
yamlHeader = [Text] -> Text
Data.Text.unlines ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
adapt (Text -> [Text]
Data.Text.lines Text
header))
let rootDirectory :: String
rootDirectory = case Maybe String
mFilePath of
Maybe String
Nothing -> String
"."
Just String
fp -> ShowS
System.FilePath.takeDirectory String
fp
Expr Src X
resolvedExpression <- String -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X)
Dhall.Import.loadRelativeTo String
rootDirectory SemanticCacheMode
UseSemanticCache Expr Src Import
parsedExpression
Expr Src X
_ <- Either (TypeError Src X) (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (Expr Src X -> Either (TypeError Src X) (Expr Src X)
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf Expr Src X
resolvedExpression)
let convertedExpression :: Expr Src X
convertedExpression =
Conversion -> Expr Src X -> Expr Src X
forall s. Conversion -> Expr s X -> Expr s X
convertToHomogeneousMaps Conversion
conversion Expr Src X
resolvedExpression
Expr Src X
specialDoubleExpression <- Either CompileError (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (SpecialDoubleMode -> Expr Src X -> Either CompileError (Expr Src X)
forall s.
SpecialDoubleMode -> Expr s X -> Either CompileError (Expr s X)
handleSpecialDoubles SpecialDoubleMode
specialDoubleMode Expr Src X
convertedExpression)
case Expr Src X -> Either CompileError Value
forall s. Expr s X -> Either CompileError Value
dhallToJSON Expr Src X
specialDoubleExpression of
Left CompileError
err -> CompileError -> IO (Header, Value)
forall e a. Exception e => e -> IO a
Control.Exception.throwIO CompileError
err
Right Value
json -> (Header, Value) -> IO (Header, Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Header
Header Text
yamlHeader, Value
json)