{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Dhall.Nix (
dhallToNix
, CompileError(..)
) where
import Control.Exception (Exception)
import Data.Fix (Fix (..))
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Data.Traversable (for)
import Data.Typeable (Typeable)
import Data.Void (Void, absurd)
import Lens.Family (toListOf)
import Dhall.Core
( Binding (..)
, Chunks (..)
, DhallDouble (..)
, Expr (..)
, FieldSelection (..)
, FunctionBinding (..)
, MultiLet (..)
, PreferAnnotation (..)
, Var (..)
, WithComponent (..)
)
import Nix.Expr
( Antiquoted (..)
, NExpr
, NExprF (NStr, NSet)
, NRecordType (NNonRecursive)
, Binding (NamedVar)
, NKeyName (..)
, NString (..)
, Params (Param)
, ($!=)
, ($&&)
, ($*)
, ($+)
, ($++)
, ($-)
, ($/)
, ($//)
, ($<)
, ($<=)
, ($==)
, ($==)
, ($||)
, (==>)
, (@.)
, (@@)
)
import qualified Data.Text
import qualified Dhall.Core
import qualified Dhall.Map
import qualified Dhall.Optics
import qualified Dhall.Pretty
import qualified NeatInterpolation
import qualified Nix
data CompileError
= CannotReferenceShadowedVariable Var
| CannotProjectByType
| CannotShowConstructor
deriving (Typeable)
instance Show CompileError where
show :: CompileError -> String
show (CannotReferenceShadowedVariable Var
v) =
Text -> String
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot reference shadowed variable
Explanation: Whenever you introduce two variables of the same name, the latter
variable takes precedence:
This ❰x❱ ...
⇩
┌───────────────────────────────┐
│ λ(x : Text) → λ(x : Text) → x │
└───────────────────────────────┘
⇧
... refers to this ❰x❱
The former variable is "shadowed":
┌───────────────────────────────┐
│ λ(x : Text) → λ(x : Text) → x │
└───────────────────────────────┘
⇧
This ❰x❱ is shadowed
... and Dhall lets you reference shadowed variables using the ❰@❱ notation:
This ❰x❱ ...
⇩
┌─────────────────────────────────┐
│ λ(x : Text) → λ(x : Text) → x@1 │
└─────────────────────────────────┘
⇧
... now refers to this ❰x❱
However, the Nix language does not let you reference shadowed variables and
there is nothing analogous to ❰@❱ in Nix
Your code contains the following expression:
↳ $txt
... which references a shadowed variable and therefore cannot be translated to
Nix
|]
where
txt :: Text
txt = Var -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Var
v
show CompileError
CannotProjectByType =
Text -> String
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot project by type
The ❰dhall-to-nix❱ compiler does not support projecting out a subset of a record
by the expected type (i.e. ❰someRecord.(someType)❱
|]
show CompileError
CannotShowConstructor =
Text -> String
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot translate the ❰showConstructor❱ keyword
The ❰dhall-to-nix❱ compiler does not support the ❰showConstructor❱ keyword.
In theory this keyword shouldn't need to be translated anyway since the keyword
doesn't survive β-normalization, so if you see this error message there might be
an internal error in ❰dhall-to-nix❱ that you should report.
|]
_ERROR :: Data.Text.Text
_ERROR :: Text
_ERROR = Text
"\ESC[1;31mError\ESC[0m"
instance Exception CompileError
dhallToNix :: Expr s Void -> Either CompileError NExpr
dhallToNix :: Expr s Void -> Either CompileError NExpr
dhallToNix Expr s Void
e =
Expr Any Void -> Either CompileError NExpr
forall s. Expr s Void -> Either CompileError NExpr
loop (Expr Any Void -> Expr Any Void
forall s. Expr s Void -> Expr s Void
rewriteShadowed (Expr s Void -> Expr Any Void
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr s Void
e))
where
untranslatable :: NExpr
untranslatable = [(Text, NExpr)] -> NExpr
Nix.attrsE []
maximumDepth :: Var -> Expr s Void -> Maybe Int
maximumDepth :: Var -> Expr s Void -> Maybe Int
maximumDepth v :: Var
v@(V Text
x Int
n) (Lam Maybe CharacterSet
_ FunctionBinding {functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x', functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr s Void
a} Expr s Void
b)
| Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' =
Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth Var
v Expr s Void
a) ((Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Expr s Void
b))
maximumDepth v :: Var
v@(V Text
x Int
n) (Pi Maybe CharacterSet
_ Text
x' Expr s Void
a Expr s Void
b)
| Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' =
Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth Var
v Expr s Void
a) ((Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Expr s Void
b))
maximumDepth (V Text
x Int
n) (Let (Binding { variable :: forall s a. Binding s a -> Text
variable = Text
x' }) Expr s Void
a)
| Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Expr s Void
a)
maximumDepth Var
v (Var Var
v')
| Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
v' = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
maximumDepth Var
v Expr s Void
expression =
(Maybe Int -> Maybe Int -> Maybe Int)
-> Maybe Int -> [Maybe Int] -> Maybe Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max Maybe Int
forall a. Maybe a
Nothing
((Expr s Void -> Maybe Int) -> [Expr s Void] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map
(Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth Var
v)
(FoldLike
[Expr s Void]
(Expr s Void)
(Expr s Void)
(Expr s Void)
(Expr s Void)
-> Expr s Void -> [Expr s Void]
forall a s t b. FoldLike [a] s t a b -> s -> [a]
toListOf FoldLike
[Expr s Void]
(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)
Dhall.Core.subExpressions Expr s Void
expression)
)
rename :: (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename :: (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
expression) =
case Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x Int
0) Expr s Void
expression of
Maybe Int
Nothing ->
Maybe (Text, Expr s Void)
forall a. Maybe a
Nothing
Just Int
0 ->
Maybe (Text, Expr s Void)
forall a. Maybe a
Nothing
Just Int
n ->
(Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall a. a -> Maybe a
Just
( Text
x'
, Var -> Expr s Void -> Expr s Void -> Expr s Void
forall s a. Var -> Expr s a -> Expr s a -> Expr s a
Dhall.Core.subst (Text -> Int -> Var
V Text
x Int
0) (Var -> Expr s Void
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x' Int
0)) (Int -> Var -> Expr s Void -> Expr s Void
forall s a. Int -> Var -> Expr s a -> Expr s a
Dhall.Core.shift Int
1 (Text -> Int -> Var
V Text
x' Int
0) Expr s Void
expression)
)
where
x' :: Text
x' = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Data.Text.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
renameShadowed :: Expr s Void -> Maybe (Expr s Void)
renameShadowed :: Expr s Void -> Maybe (Expr s Void)
renameShadowed (Lam Maybe CharacterSet
cs FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x, functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr s Void
a} Expr s Void
b) = do
(Text
x', Expr s Void
b') <- (Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall s. (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
b)
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> FunctionBinding s Void -> Expr s Void -> Expr s Void
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
cs (Text -> Expr s Void -> FunctionBinding s Void
forall s a. Text -> Expr s a -> FunctionBinding s a
Dhall.Core.makeFunctionBinding Text
x' Expr s Void
a) Expr s Void
b')
renameShadowed (Pi Maybe CharacterSet
cs Text
x Expr s Void
a Expr s Void
b) = do
(Text
x', Expr s Void
b') <- (Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall s. (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
b)
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> Text -> Expr s Void -> Expr s Void -> Expr s Void
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
cs Text
x' Expr s Void
a Expr s Void
b')
renameShadowed (Let Binding{ variable :: forall s a. Binding s a -> Text
variable = Text
x, Maybe s
Maybe (Maybe s, Expr s Void)
Expr s Void
bindingSrc0 :: forall s a. Binding s a -> Maybe s
bindingSrc1 :: forall s a. Binding s a -> Maybe s
annotation :: forall s a. Binding s a -> Maybe (Maybe s, Expr s a)
bindingSrc2 :: forall s a. Binding s a -> Maybe s
value :: forall s a. Binding s a -> Expr s a
value :: Expr s Void
bindingSrc2 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc1 :: Maybe s
bindingSrc0 :: Maybe s
.. } Expr s Void
a) = do
(Text
x' , Expr s Void
a') <- (Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall s. (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
a)
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Binding s Void -> Expr s Void -> Expr s Void
forall s a. Binding s a -> Expr s a -> Expr s a
Let Binding :: forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding{ variable :: Text
variable = Text
x', Maybe s
Maybe (Maybe s, Expr s Void)
Expr s Void
bindingSrc0 :: Maybe s
bindingSrc1 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc2 :: Maybe s
value :: Expr s Void
value :: Expr s Void
bindingSrc2 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc1 :: Maybe s
bindingSrc0 :: Maybe s
.. } Expr s Void
a')
renameShadowed Expr s Void
_ =
Maybe (Expr s Void)
forall a. Maybe a
Nothing
rewriteShadowed :: Expr s Void -> Expr s Void
rewriteShadowed =
ASetter (Expr s Void) (Expr s Void) (Expr s Void) (Expr s Void)
-> (Expr s Void -> Maybe (Expr s Void))
-> Expr s Void
-> Expr s Void
forall a b. ASetter a b a b -> (b -> Maybe a) -> a -> b
Dhall.Optics.rewriteOf ASetter (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)
Dhall.Core.subExpressions Expr s Void -> Maybe (Expr s Void)
forall s. Expr s Void -> Maybe (Expr s Void)
renameShadowed
loop :: Expr s Void -> Either CompileError NExpr
loop (Const Const
_) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (Var (V Text
a Int
0)) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> NExpr
Nix.mkSym Text
a)
loop (Var Var
a ) = CompileError -> Either CompileError NExpr
forall a b. a -> Either a b
Left (Var -> CompileError
CannotReferenceShadowedVariable Var
a)
loop (Lam Maybe CharacterSet
_ FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
a } Expr s Void
c) = do
NExpr
c' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
c
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Params NExpr
forall r. Text -> Params r
Param Text
a Params NExpr -> NExpr -> NExpr
==> NExpr
c')
loop (Pi Maybe CharacterSet
_ Text
_ Expr s Void
_ Expr s Void
_) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (App Expr s Void
None Expr s Void
_) =
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
Nix.mkNull
loop (App (Field (Union Map Text (Maybe (Expr s Void))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Dhall.Core.fieldSelectionLabel -> Text
k)) Expr s Void
v) = do
NExpr
v' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
v
let e0 :: [(Text, Maybe NExpr)]
e0 = do
Text
k' <- Map Text (Maybe (Expr s Void)) -> [Text]
forall k v. Map k v -> [k]
Dhall.Map.keys Map Text (Maybe (Expr s Void))
kts
(Text, Maybe NExpr) -> [(Text, Maybe NExpr)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k', Maybe NExpr
forall a. Maybe a
Nothing)
let e2 :: NExpr
e2 = Text -> NExpr
Nix.mkSym Text
k NExpr -> NExpr -> NExpr
@@ NExpr
v'
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Maybe NExpr)] -> Bool -> Params NExpr
Nix.mkParamset [(Text, Maybe NExpr)]
e0 Bool
False Params NExpr -> NExpr -> NExpr
==> NExpr
e2)
loop (App Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
@@ NExpr
b')
loop (Let Binding s Void
a0 Expr s Void
b0) = do
let MultiLet NonEmpty (Binding s Void)
bindings Expr s Void
b = Binding s Void -> Expr s Void -> MultiLet s Void
forall s a. Binding s a -> Expr s a -> MultiLet s a
Dhall.Core.multiLet Binding s Void
a0 Expr s Void
b0
NonEmpty (Text, NExpr)
bindings' <- NonEmpty (Binding s Void)
-> (Binding s Void -> Either CompileError (Text, NExpr))
-> Either CompileError (NonEmpty (Text, NExpr))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NonEmpty (Binding s Void)
bindings ((Binding s Void -> Either CompileError (Text, NExpr))
-> Either CompileError (NonEmpty (Text, NExpr)))
-> (Binding s Void -> Either CompileError (Text, NExpr))
-> Either CompileError (NonEmpty (Text, NExpr))
forall a b. (a -> b) -> a -> b
$ \Binding{ Text
variable :: Text
variable :: forall s a. Binding s a -> Text
variable, Expr s Void
value :: Expr s Void
value :: forall s a. Binding s a -> Expr s a
value } -> do
NExpr
value' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
value
(Text, NExpr) -> Either CompileError (Text, NExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
variable, NExpr
value')
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, NExpr)] -> NExpr -> NExpr
Nix.letsE (NonEmpty (Text, NExpr) -> [(Text, NExpr)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Text, NExpr)
bindings') NExpr
b')
loop (Annot Expr s Void
a Expr s Void
_) = Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
loop Expr s Void
Bool = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (BoolLit Bool
b) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> NExpr
Nix.mkBool Bool
b)
loop (BoolAnd Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$&& NExpr
b')
loop (BoolOr Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$|| NExpr
b')
loop (BoolEQ Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$== NExpr
b')
loop (BoolNE Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$!= NExpr
b')
loop (BoolIf Expr s Void
a Expr s Void
b Expr s Void
c) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr
c' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
c
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf NExpr
a' NExpr
b' NExpr
c')
loop Expr s Void
Natural = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (NaturalLit Natural
n) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> NExpr
Nix.mkInt (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n))
loop Expr s Void
NaturalFold = do
let naturalFold :: NExpr
naturalFold =
Params NExpr
"n"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"succ"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"zero"
Params NExpr -> NExpr -> NExpr
==> NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (NExpr
"n" NExpr -> NExpr -> NExpr
$<= Integer -> NExpr
Nix.mkInt Integer
0)
NExpr
"zero"
( NExpr
"succ"
NExpr -> NExpr -> NExpr
@@ ( NExpr
"naturalFold"
NExpr -> NExpr -> NExpr
@@ (NExpr
"n" NExpr -> NExpr -> NExpr
$- Integer -> NExpr
Nix.mkInt Integer
1)
NExpr -> NExpr -> NExpr
@@ NExpr
"t"
NExpr -> NExpr -> NExpr
@@ NExpr
"succ"
NExpr -> NExpr -> NExpr
@@ NExpr
"zero"
)
)
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, NExpr)] -> NExpr -> NExpr
Nix.letsE [ (Text
"naturalFold", NExpr
naturalFold) ] NExpr
"naturalFold")
loop Expr s Void
NaturalBuild = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"k"
Params NExpr -> NExpr -> NExpr
==> ( NExpr
"k"
NExpr -> NExpr -> NExpr
@@ NExpr
untranslatable
NExpr -> NExpr -> NExpr
@@ (Params NExpr
"n" Params NExpr -> NExpr -> NExpr
==> (NExpr
"n" NExpr -> NExpr -> NExpr
$+ Integer -> NExpr
Nix.mkInt Integer
1))
NExpr -> NExpr -> NExpr
@@ Integer -> NExpr
Nix.mkInt Integer
0
)
)
loop Expr s Void
NaturalIsZero = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"n" Params NExpr -> NExpr -> NExpr
==> (NExpr
"n" NExpr -> NExpr -> NExpr
$== Integer -> NExpr
Nix.mkInt Integer
0))
loop Expr s Void
NaturalEven = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"n" Params NExpr -> NExpr -> NExpr
==> (NExpr
"n" NExpr -> NExpr -> NExpr
$/ Integer -> NExpr
Nix.mkInt Integer
2) NExpr -> NExpr -> NExpr
$* Integer -> NExpr
Nix.mkInt Integer
2 NExpr -> NExpr -> NExpr
$== NExpr
"n")
loop Expr s Void
NaturalOdd = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"n" Params NExpr -> NExpr -> NExpr
==> (NExpr
"n" NExpr -> NExpr -> NExpr
$/ Integer -> NExpr
Nix.mkInt Integer
2) NExpr -> NExpr -> NExpr
$* Integer -> NExpr
Nix.mkInt Integer
2 NExpr -> NExpr -> NExpr
$!= NExpr
"n")
loop Expr s Void
NaturalShow =
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
"toString"
loop Expr s Void
NaturalSubtract = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"x"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"y"
Params NExpr -> NExpr -> NExpr
==> Text -> NExpr -> NExpr -> NExpr
Nix.letE Text
"z" (NExpr
"y" NExpr -> NExpr -> NExpr
$- NExpr
"x")
(NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (NExpr
"z" NExpr -> NExpr -> NExpr
$< Integer -> NExpr
Nix.mkInt Integer
0) (Integer -> NExpr
Nix.mkInt Integer
0) NExpr
"z")
)
loop Expr s Void
NaturalToInteger =
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"n" Params NExpr -> NExpr -> NExpr
==> NExpr
"n")
loop (NaturalPlus Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$+ NExpr
b')
loop (NaturalTimes Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$* NExpr
b')
loop Expr s Void
Integer = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (IntegerLit Integer
n) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> NExpr
Nix.mkInt Integer
n)
loop Expr s Void
IntegerClamp = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"x" Params NExpr -> NExpr -> NExpr
==> NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (Integer -> NExpr
Nix.mkInt Integer
0 NExpr -> NExpr -> NExpr
$<= NExpr
"x") NExpr
"x" (Integer -> NExpr
Nix.mkInt Integer
0))
loop Expr s Void
IntegerNegate = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"x" Params NExpr -> NExpr -> NExpr
==> (Integer -> NExpr
Nix.mkInt Integer
0 NExpr -> NExpr -> NExpr
$- NExpr
"x"))
loop Expr s Void
IntegerShow = do
let e0 :: NExpr
e0 = NExpr
"toString" NExpr -> NExpr -> NExpr
@@ NExpr
"x"
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"x" Params NExpr -> NExpr -> NExpr
==> NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (Integer -> NExpr
Nix.mkInt Integer
0 NExpr -> NExpr -> NExpr
$<= NExpr
"x") (Text -> NExpr
Nix.mkStr Text
"+" NExpr -> NExpr -> NExpr
$+ NExpr
e0) NExpr
e0)
loop Expr s Void
IntegerToDouble =
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"x" Params NExpr -> NExpr -> NExpr
==> NExpr
"x")
loop Expr s Void
Double = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (DoubleLit (DhallDouble Double
n)) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> NExpr
Nix.mkFloat (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n))
loop Expr s Void
DoubleShow =
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
"toString"
loop Expr s Void
Text = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (TextLit (Chunks [(Text, Expr s Void)]
abs_ Text
c)) = do
let process :: (Text, Expr s Void) -> Either CompileError [Antiquoted Text NExpr]
process (Text
a, Expr s Void
b) = do
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
[Antiquoted Text NExpr]
-> Either CompileError [Antiquoted Text NExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
a, NExpr -> Antiquoted Text NExpr
forall v r. r -> Antiquoted v r
Antiquoted NExpr
b']
[[Antiquoted Text NExpr]]
abs' <- ((Text, Expr s Void)
-> Either CompileError [Antiquoted Text NExpr])
-> [(Text, Expr s Void)]
-> Either CompileError [[Antiquoted Text NExpr]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Expr s Void) -> Either CompileError [Antiquoted Text NExpr]
process [(Text, Expr s Void)]
abs_
let chunks :: [Antiquoted Text NExpr]
chunks = [[Antiquoted Text NExpr]] -> [Antiquoted Text NExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Antiquoted Text NExpr]]
abs' [Antiquoted Text NExpr]
-> [Antiquoted Text NExpr] -> [Antiquoted Text NExpr]
forall a. [a] -> [a] -> [a]
++ [Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
c]
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NString NExpr -> NExprF NExpr
forall r. NString r -> NExprF r
NStr ([Antiquoted Text NExpr] -> NString NExpr
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Antiquoted Text NExpr]
chunks)))
loop (TextAppend Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$+ NExpr
b')
loop Expr s Void
TextReplace = do
let from :: NExpr
from = [NExpr] -> NExpr
Nix.mkList [ Item [NExpr]
"needle" ]
let to :: NExpr
to = [NExpr] -> NExpr
Nix.mkList [ Item [NExpr]
"replacement" ]
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"needle"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"replacement"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"haystack"
Params NExpr -> NExpr -> NExpr
==> (NExpr
"builtins" NExpr -> Text -> NExpr
@. Text
"replaceStrings" NExpr -> NExpr -> NExpr
@@ NExpr
from NExpr -> NExpr -> NExpr
@@ NExpr
to NExpr -> NExpr -> NExpr
@@ NExpr
"haystack")
)
loop Expr s Void
TextShow = do
let from :: NExpr
from =
[NExpr] -> NExpr
Nix.mkList
[ Text -> NExpr
Nix.mkStr Text
"\""
, Text -> NExpr
Nix.mkStr Text
"$"
, Text -> NExpr
Nix.mkStr Text
"\\"
, Text -> NExpr
Nix.mkStr Text
"\n"
, Text -> NExpr
Nix.mkStr Text
"\r"
, Text -> NExpr
Nix.mkStr Text
"\t"
]
let to :: NExpr
to =
[NExpr] -> NExpr
Nix.mkList
[ Text -> NExpr
Nix.mkStr Text
"\\\""
, Text -> NExpr
Nix.mkStr Text
"\\u0024"
, Text -> NExpr
Nix.mkStr Text
"\\\\"
, Text -> NExpr
Nix.mkStr Text
"\\n"
, Text -> NExpr
Nix.mkStr Text
"\\r"
, Text -> NExpr
Nix.mkStr Text
"\\t"
]
let replaced :: NExpr
replaced = NExpr
"builtins" NExpr -> Text -> NExpr
@. Text
"replaceStrings" NExpr -> NExpr -> NExpr
@@ NExpr
from NExpr -> NExpr -> NExpr
@@ NExpr
to NExpr -> NExpr -> NExpr
@@ NExpr
"t"
let quoted :: NExpr
quoted = Text -> NExpr
Nix.mkStr Text
"\"" NExpr -> NExpr -> NExpr
$+ NExpr
replaced NExpr -> NExpr -> NExpr
$+ Text -> NExpr
Nix.mkStr Text
"\""
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"t" Params NExpr -> NExpr -> NExpr
==> NExpr
quoted)
loop Expr s Void
Date = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop Expr s Void
Time = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop Expr s Void
TimeZone = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop Expr s Void
List = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"t" Params NExpr -> NExpr -> NExpr
==> NExpr
untranslatable)
loop (ListAppend Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$++ NExpr
b')
loop (ListLit Maybe (Expr s Void)
_ Seq (Expr s Void)
bs) = do
[NExpr]
bs' <- (Expr s Void -> Either CompileError NExpr)
-> [Expr s Void] -> Either CompileError [NExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr s Void -> Either CompileError NExpr
loop (Seq (Expr s Void) -> [Expr s Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr s Void)
bs)
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return ([NExpr] -> NExpr
Nix.mkList [NExpr]
bs')
loop Expr s Void
ListBuild = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"k"
Params NExpr -> NExpr -> NExpr
==> ( NExpr
"k"
NExpr -> NExpr -> NExpr
@@ NExpr
untranslatable
NExpr -> NExpr -> NExpr
@@ (Params NExpr
"x" Params NExpr -> NExpr -> NExpr
==> Params NExpr
"xs" Params NExpr -> NExpr -> NExpr
==> ([NExpr] -> NExpr
Nix.mkList [Item [NExpr]
"x"] NExpr -> NExpr -> NExpr
$++ NExpr
"xs"))
NExpr -> NExpr -> NExpr
@@ [NExpr] -> NExpr
Nix.mkList []
)
)
loop Expr s Void
ListFold = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"xs"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"cons"
Params NExpr -> NExpr -> NExpr
==> ( NExpr
"builtins.foldl'"
NExpr -> NExpr -> NExpr
@@ ( Params NExpr
"f"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"y"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"ys"
Params NExpr -> NExpr -> NExpr
==> (NExpr
"f" NExpr -> NExpr -> NExpr
@@ (NExpr
"cons" NExpr -> NExpr -> NExpr
@@ NExpr
"y" NExpr -> NExpr -> NExpr
@@ NExpr
"ys"))
)
NExpr -> NExpr -> NExpr
@@ (Params NExpr
"ys" Params NExpr -> NExpr -> NExpr
==> NExpr
"ys")
NExpr -> NExpr -> NExpr
@@ NExpr
"xs"
)
)
loop Expr s Void
ListLength = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"t" Params NExpr -> NExpr -> NExpr
==> NExpr
"builtins.length")
loop Expr s Void
ListHead = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"xs"
Params NExpr -> NExpr -> NExpr
==> NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (NExpr
"xs" NExpr -> NExpr -> NExpr
$== [NExpr] -> NExpr
Nix.mkList [])
NExpr
Nix.mkNull
(NExpr
"builtins.head" NExpr -> NExpr -> NExpr
@@ NExpr
"xs")
)
loop Expr s Void
ListLast = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"xs"
Params NExpr -> NExpr -> NExpr
==> NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (NExpr
"xs" NExpr -> NExpr -> NExpr
$== [NExpr] -> NExpr
Nix.mkList [])
NExpr
Nix.mkNull
( NExpr
"builtins.elemAt"
NExpr -> NExpr -> NExpr
@@ NExpr
"xs"
NExpr -> NExpr -> NExpr
@@ ((NExpr
"builtins.length" NExpr -> NExpr -> NExpr
@@ NExpr
"xs") NExpr -> NExpr -> NExpr
$- Integer -> NExpr
Nix.mkInt Integer
1)
)
)
loop Expr s Void
ListIndexed = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"xs"
Params NExpr -> NExpr -> NExpr
==> ( NExpr
"builtins.genList"
NExpr -> NExpr -> NExpr
@@ ( Params NExpr
"i"
Params NExpr -> NExpr -> NExpr
==> [(Text, NExpr)] -> NExpr
Nix.attrsE
[ (Text
"index", NExpr
"i")
, (Text
"value", NExpr
"builtins.elemAt" NExpr -> NExpr -> NExpr
@@ NExpr
"xs" NExpr -> NExpr -> NExpr
@@ NExpr
"i")
]
)
NExpr -> NExpr -> NExpr
@@ (NExpr
"builtins.length" NExpr -> NExpr -> NExpr
@@ NExpr
"xs")
)
)
loop Expr s Void
ListReverse = do
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params NExpr
"t"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"xs"
Params NExpr -> NExpr -> NExpr
==> Text -> NExpr -> NExpr -> NExpr
Nix.letE Text
"n" (NExpr
"builtins.length" NExpr -> NExpr -> NExpr
@@ NExpr
"xs")
( NExpr
"builtins.genList"
NExpr -> NExpr -> NExpr
@@ ( Params NExpr
"i"
Params NExpr -> NExpr -> NExpr
==> ( NExpr
"builtins.elemAt"
NExpr -> NExpr -> NExpr
@@ NExpr
"xs"
NExpr -> NExpr -> NExpr
@@ (NExpr
"n" NExpr -> NExpr -> NExpr
$- NExpr
"i" NExpr -> NExpr -> NExpr
$- Integer -> NExpr
Nix.mkInt Integer
1)
)
)
NExpr -> NExpr -> NExpr
@@ NExpr
"n"
)
)
loop Expr s Void
Optional = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"t" Params NExpr -> NExpr -> NExpr
==> NExpr
untranslatable)
loop (Some Expr s Void
a) = Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
loop Expr s Void
None = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"t" Params NExpr -> NExpr -> NExpr
==> NExpr
Nix.mkNull)
loop Expr s Void
t
| Just Text
text <- Expr s Void -> Maybe Text
forall a s. Pretty a => Expr s a -> Maybe Text
Dhall.Pretty.temporalToText Expr s Void
t = do
Expr s Void -> Either CompileError NExpr
loop (Chunks s Void -> Expr s Void
forall s a. Chunks s a -> Expr s a
Dhall.Core.TextLit ([(Text, Expr s Void)] -> Text -> Chunks s Void
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Dhall.Core.Chunks [] Text
text))
loop DateLiteral{} = Either CompileError NExpr
forall a. HasCallStack => a
undefined
loop TimeLiteral{} = Either CompileError NExpr
forall a. HasCallStack => a
undefined
loop TimeZoneLiteral{} = Either CompileError NExpr
forall a. HasCallStack => a
undefined
loop (Record Map Text (RecordField s Void)
_) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (RecordLit Map Text (RecordField s Void)
a) = do
Map Text NExpr
a' <- (RecordField s Void -> Either CompileError NExpr)
-> Map Text (RecordField s Void)
-> Either CompileError (Map Text NExpr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Expr s Void -> Either CompileError NExpr
loop (Expr s Void -> Either CompileError NExpr)
-> (RecordField s Void -> Expr s Void)
-> RecordField s Void
-> Either CompileError NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField s Void -> Expr s Void
forall s a. RecordField s a -> Expr s a
Dhall.Core.recordFieldValue) Map Text (RecordField s Void)
a
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, NExpr)] -> NExpr
nixAttrs (Map Text NExpr -> [(Text, NExpr)]
forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList Map Text NExpr
a'))
where
nixAttrs :: [(Text, NExpr)] -> NExpr
nixAttrs [(Text, NExpr)]
pairs =
NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ NRecordType -> [Binding NExpr] -> NExprF NExpr
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive ([Binding NExpr] -> NExprF NExpr)
-> [Binding NExpr] -> NExprF NExpr
forall a b. (a -> b) -> a -> b
$
(\(Text
key, NExpr
val) -> NAttrPath NExpr -> NExpr -> SourcePos -> Binding NExpr
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar (Antiquoted (NString NExpr) NExpr -> NKeyName NExpr
forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (NString NExpr -> Antiquoted (NString NExpr) NExpr
forall v r. v -> Antiquoted v r
Plain ([Antiquoted Text NExpr] -> NString NExpr
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
key])) NKeyName NExpr -> [NKeyName NExpr] -> NAttrPath NExpr
forall a. a -> [a] -> NonEmpty a
:| []) NExpr
val SourcePos
Nix.nullPos)
((Text, NExpr) -> Binding NExpr)
-> [(Text, NExpr)] -> [Binding NExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, NExpr)]
pairs
loop (Union Map Text (Maybe (Expr s Void))
_) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (Combine Maybe CharacterSet
_ Maybe Text
_ Expr s Void
a Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
let defL :: NExpr
defL = NExpr
"builtins.hasAttr" NExpr -> NExpr -> NExpr
@@ NExpr
"k" NExpr -> NExpr -> NExpr
@@ NExpr
"kvsL"
let defR :: NExpr
defR = NExpr
"builtins.hasAttr" NExpr -> NExpr -> NExpr
@@ NExpr
"k" NExpr -> NExpr -> NExpr
@@ NExpr
"kvsR"
let valL :: NExpr
valL = NExpr
"builtins.getAttr" NExpr -> NExpr -> NExpr
@@ NExpr
"k" NExpr -> NExpr -> NExpr
@@ NExpr
"kvsL"
let valR :: NExpr
valR = NExpr
"builtins.getAttr" NExpr -> NExpr -> NExpr
@@ NExpr
"k" NExpr -> NExpr -> NExpr
@@ NExpr
"kvsR"
let toNameValue :: NExpr -> NExpr
toNameValue NExpr
v =
[NExpr] -> NExpr
Nix.mkList [ [(Text, NExpr)] -> NExpr
Nix.attrsE [ (Text
"name", NExpr
"k"), (Text
"value", NExpr
v) ] ]
let toKeyVals :: NExpr
toKeyVals =
Params NExpr
"k"
Params NExpr -> NExpr -> NExpr
==> NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf NExpr
defL
(NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf NExpr
defR
(NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf
( (NExpr
"builtins.isAttrs" NExpr -> NExpr -> NExpr
@@ NExpr
valL)
NExpr -> NExpr -> NExpr
$&& (NExpr
"builtins.isAttrs" NExpr -> NExpr -> NExpr
@@ NExpr
valR)
)
(NExpr -> NExpr
toNameValue (NExpr
"combine" NExpr -> NExpr -> NExpr
@@ NExpr
valL NExpr -> NExpr -> NExpr
@@ NExpr
valR))
(NExpr -> NExpr
toNameValue NExpr
valR)
)
(NExpr -> NExpr
toNameValue NExpr
valL)
)
(NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf NExpr
defR
(NExpr -> NExpr
toNameValue NExpr
valR)
([NExpr] -> NExpr
Nix.mkList [])
)
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
(Text -> NExpr -> NExpr -> NExpr
Nix.letE Text
"combine"
( Params NExpr
"kvsL"
Params NExpr -> NExpr -> NExpr
==> Params NExpr
"kvsR"
Params NExpr -> NExpr -> NExpr
==> [(Text, NExpr)] -> NExpr -> NExpr
Nix.letsE
[ ( Text
"ks"
, (NExpr
"builtins.attrNames" NExpr -> NExpr -> NExpr
@@ NExpr
"kvsL")
NExpr -> NExpr -> NExpr
$++ (NExpr
"builtins.attrNames" NExpr -> NExpr -> NExpr
@@ NExpr
"kvsR")
)
, (Text
"toKeyVals", NExpr
toKeyVals)
]
( NExpr
"builtins.listToAttrs"
NExpr -> NExpr -> NExpr
@@ ( NExpr
"builtins.concatLists"
NExpr -> NExpr -> NExpr
@@ (NExpr
"map" NExpr -> NExpr -> NExpr
@@ NExpr
"toKeyVals" NExpr -> NExpr -> NExpr
@@ NExpr
"ks")
)
)
)
(NExpr
"combine" NExpr -> NExpr -> NExpr
@@ NExpr
a' NExpr -> NExpr -> NExpr
@@ NExpr
b')
)
loop (CombineTypes Maybe CharacterSet
_ Expr s Void
_ Expr s Void
_) = NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (Merge Expr s Void
a Expr s Void
b Maybe (Expr s Void)
_) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
b' NExpr -> NExpr -> NExpr
@@ NExpr
a')
loop (ToMap Expr s Void
a Maybe (Expr s Void)
_) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return
(Text -> NExpr -> NExpr -> NExpr
Nix.letE Text
"kvs" NExpr
a'
( NExpr
"map"
NExpr -> NExpr -> NExpr
@@ ( Params NExpr
"k"
Params NExpr -> NExpr -> NExpr
==> [(Text, NExpr)] -> NExpr
Nix.attrsE
[ (Text
"mapKey", NExpr
"k")
, (Text
"mapValue", NExpr
"builtins.getAttr" NExpr -> NExpr -> NExpr
@@ NExpr
"k" NExpr -> NExpr -> NExpr
@@ NExpr
"kvs")
]
)
NExpr -> NExpr -> NExpr
@@ (NExpr
"builtins.attrNames" NExpr -> NExpr -> NExpr
@@ NExpr
"kvs")
)
)
loop (ShowConstructor Expr s Void
_) = do
CompileError -> Either CompileError NExpr
forall a b. a -> Either a b
Left CompileError
CannotShowConstructor
loop (Prefer Maybe CharacterSet
_ PreferAnnotation s Void
_ Expr s Void
b Expr s Void
c) = do
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr
c' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
c
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
b' NExpr -> NExpr -> NExpr
$// NExpr
c')
loop (RecordCompletion Expr s Void
a Expr s Void
b) =
Expr s Void -> Either CompileError NExpr
loop (Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot (Maybe CharacterSet
-> PreferAnnotation s Void
-> Expr s Void
-> Expr s Void
-> Expr s Void
forall s a.
Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
forall a. Monoid a => a
mempty PreferAnnotation s Void
forall s a. PreferAnnotation s a
PreferFromCompletion (Expr s Void -> FieldSelection s -> Expr s Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s Void
a FieldSelection s
forall s. FieldSelection s
def) Expr s Void
b) (Expr s Void -> FieldSelection s -> Expr s Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s Void
a FieldSelection s
forall s. FieldSelection s
typ))
where
def :: FieldSelection s
def = Text -> FieldSelection s
forall s. Text -> FieldSelection s
Dhall.Core.makeFieldSelection Text
"default"
typ :: FieldSelection s
typ = Text -> FieldSelection s
forall s. Text -> FieldSelection s
Dhall.Core.makeFieldSelection Text
"Type"
loop (Field (Union Map Text (Maybe (Expr s Void))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Dhall.Core.fieldSelectionLabel -> Text
k)) =
case Text
-> Map Text (Maybe (Expr s Void)) -> Maybe (Maybe (Expr s Void))
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
k Map Text (Maybe (Expr s Void))
kts of
Just (Just Expr s Void
_) -> do
let e0 :: [(Text, Maybe NExpr)]
e0 = do
Text
k' <- Map Text (Maybe (Expr s Void)) -> [Text]
forall k v. Map k v -> [k]
Dhall.Map.keys Map Text (Maybe (Expr s Void))
kts
(Text, Maybe NExpr) -> [(Text, Maybe NExpr)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k', Maybe NExpr
forall a. Maybe a
Nothing)
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Params NExpr
"x" Params NExpr -> NExpr -> NExpr
==> [(Text, Maybe NExpr)] -> Bool -> Params NExpr
Nix.mkParamset [(Text, Maybe NExpr)]
e0 Bool
False Params NExpr -> NExpr -> NExpr
==> (Text -> NExpr
Nix.mkSym Text
k NExpr -> NExpr -> NExpr
@@ NExpr
"x"))
Maybe (Maybe (Expr s Void))
_ -> do
let e0 :: [(Text, Maybe NExpr)]
e0 = do
Text
k' <- Map Text (Maybe (Expr s Void)) -> [Text]
forall k v. Map k v -> [k]
Dhall.Map.keys Map Text (Maybe (Expr s Void))
kts
(Text, Maybe NExpr) -> [(Text, Maybe NExpr)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k', Maybe NExpr
forall a. Maybe a
Nothing)
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Maybe NExpr)] -> Bool -> Params NExpr
Nix.mkParamset [(Text, Maybe NExpr)]
e0 Bool
False Params NExpr -> NExpr -> NExpr
==> Text -> NExpr
Nix.mkSym Text
k)
loop (Field Expr s Void
a (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Dhall.Core.fieldSelectionLabel -> Text
b)) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> Text -> NExpr
@. Text
b)
loop (Project Expr s Void
a (Left [Text]
b)) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
let b' :: [NKeyName NExpr]
b' = (Text -> NKeyName NExpr) -> [Text] -> [NKeyName NExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> NKeyName NExpr
forall r. Text -> NKeyName r
StaticKey ([Text] -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Text]
b)
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding NExpr] -> NExpr
Nix.mkNonRecSet [ NExpr -> [NKeyName NExpr] -> SourcePos -> Binding NExpr
forall e. e -> [NKeyName e] -> SourcePos -> Binding e
Nix.inheritFrom NExpr
a' [NKeyName NExpr]
b' SourcePos
Nix.nullPos ])
loop (Project Expr s Void
_ (Right Expr s Void
_)) =
CompileError -> Either CompileError NExpr
forall a b. a -> Either a b
Left CompileError
CannotProjectByType
loop (Assert Expr s Void
_) =
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (Equivalent Maybe CharacterSet
_ Expr s Void
_ Expr s Void
_) =
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return NExpr
untranslatable
loop (With Expr s Void
a (WithLabel Text
k :| []) Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr
a' NExpr -> NExpr -> NExpr
$// [(Text, NExpr)] -> NExpr
Nix.attrsE [(Text
k, NExpr
b')])
loop (With Expr s Void
a (WithLabel Text
k :| WithComponent
k' : [WithComponent]
ks) Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop (Expr s Void -> NonEmpty WithComponent -> Expr s Void -> Expr s Void
forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With (Expr s Void -> FieldSelection s -> Expr s Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s Void
"_" (Maybe s -> Text -> Maybe s -> FieldSelection s
forall s. Maybe s -> Text -> Maybe s -> FieldSelection s
FieldSelection Maybe s
forall a. Maybe a
Nothing Text
k Maybe s
forall a. Maybe a
Nothing)) (WithComponent
k' WithComponent -> [WithComponent] -> NonEmpty WithComponent
forall a. a -> [a] -> NonEmpty a
:| [WithComponent]
ks) (Int -> Var -> Expr s Void -> Expr s Void
forall s a. Int -> Var -> Expr s a -> Expr s a
Dhall.Core.shift Int
1 Var
"_" Expr s Void
b))
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> NExpr -> NExpr -> NExpr
Nix.letE Text
"_" NExpr
a' (NExpr
"_" NExpr -> NExpr -> NExpr
$// [(Text, NExpr)] -> NExpr
Nix.attrsE [(Text
k, NExpr
b')]))
loop (With Expr s Void
a (WithComponent
WithQuestion :| []) Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (NExpr
a' NExpr -> NExpr -> NExpr
$== NExpr
Nix.mkNull) NExpr
Nix.mkNull NExpr
b')
loop (With Expr s Void
a (WithComponent
WithQuestion :| WithComponent
k : [WithComponent]
ks) Expr s Void
b) = do
NExpr
a' <- Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
NExpr
b' <- Expr s Void -> Either CompileError NExpr
loop (Expr s Void -> NonEmpty WithComponent -> Expr s Void -> Expr s Void
forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With Expr s Void
"_" (WithComponent
k WithComponent -> [WithComponent] -> NonEmpty WithComponent
forall a. a -> [a] -> NonEmpty a
:| [WithComponent]
ks) (Int -> Var -> Expr s Void -> Expr s Void
forall s a. Int -> Var -> Expr s a -> Expr s a
Dhall.Core.shift Int
1 Var
"_" Expr s Void
b))
NExpr -> Either CompileError NExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> NExpr -> NExpr -> NExpr
Nix.letE Text
"_" NExpr
a' (NExpr -> NExpr -> NExpr -> NExpr
Nix.mkIf (NExpr
a' NExpr -> NExpr -> NExpr
$== NExpr
Nix.mkNull) NExpr
Nix.mkNull NExpr
b'))
loop (ImportAlt Expr s Void
a Expr s Void
_) = Expr s Void -> Either CompileError NExpr
loop Expr s Void
a
loop (Note s
_ Expr s Void
b) = Expr s Void -> Either CompileError NExpr
loop Expr s Void
b
loop (Embed Void
x) = Void -> Either CompileError NExpr
forall a. Void -> a
absurd Void
x