{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE OverloadedLists    #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE QuasiQuotes        #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE ViewPatterns       #-}

{-| This library only exports a single `dhallToNix` function for translating a
    Dhall syntax tree to a Nix syntax tree for the @hnix@ library

    See the @dhall@ package if you would like to transform Dhall source code
    into a Dhall syntax tree.  Similarly, see the @hnix@ package if you would
    like to translate a Nix syntax tree into Nix source code.

    This package also provides a @dhall-to-nix@ executable which you can use to
    compile Dhall source code directly to Nix source code for your convenience.

    Any Dhall expression can be converted into an equivalent Nix expression.
    For example, Dhall records can be converted into Nix records:

> $ dhall-to-nix <<< "{ foo = 1, bar = True }"
> { bar = true; foo = 1; }

    ... and you can also convert Dhall functions to Nix functions, too:

> $ dhall-to-nix <<< "λ(x : Bool) → x == False"
> x: x == false

    Many Dhall expressions have a straightforward translation to Nix expressions
    but there are some translations that are not as obvious.  The following
    section documents these trickier conversions:

    First, all Dhall types translate to an empty record:

> $ dhall-to-nix <<< "Integer"
> {}

    Polymorphic Dhall functions translate to Nix functions that ignore their
    type argument:

> $ dhall-to-nix <<< "List/head"
> t: xs: if xs == []
>       then null
>       else builtins.head xs

    `Optional` values translate to @null@ if missing or the unwrapped value if
    present:

> $ dhall-to-nix <<< "None Natural"
> null

> $ dhall-to-nix <<< "Some 1"
> 1

    Unions are Church-encoded:

> $ dhall-to-nix <<< "< Left : Bool | Right : Natural >.Left True"
> { Left, Right }: Left true

    Also, all Dhall expressions are normalized before translation to Nix:

> $ dhall-to-nix <<< "True == False"
> false

    You can use the @dhall-to-nix@ executable within Nix to assemble Nix
    expressions from Dhall expressions using the following @dhallToNix@ utility
    function:

> dhallToNix = code :
>   let
>     file = builtins.toFile "dhall-expr" code;
>
>     drv = pkgs.stdenv.mkDerivation {
>       name = "dhall-expr-as-nix";
>
>       buildCommand = ''
>         dhall-to-nix <<< "${file}" > $out
>       '';
>
>       buildInputs = [ pkgs.haskellPackages.dhall-nix ];
>     };
>   in
>     import "${drv}";
-}

module Dhall.Nix (
    -- * Dhall to Nix
      dhallToNix

    -- * Exceptions
    , 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

{-| This is the exception type for all possible errors that might arise when
    translating the Dhall syntax tree to the Nix syntax tree
-}
data CompileError
    = CannotReferenceShadowedVariable Var
    -- ^ Nix does not provide a way to reference a shadowed variable
    | CannotProjectByType
    -- ^ We currently do not support threading around type information
    | CannotShowConstructor
    -- ^ We currently do not support the `showConstructor` keyword
    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

{-| Convert a Dhall expression to the equivalent Nix expression

>>> :set -XOverloadedStrings
>>> dhallToNix (Lam "x" Natural (Lam "y" Natural (NaturalPlus "x" "y"))) 
Right (NAbs (Param "x") (NAbs (Param "y") (NBinary NPlus (NSym "x") (NSym "y"))))
>>> fmap Nix.Pretty.prettyNix it
Right x: y: x + y

    Precondition: You must first type-check the Dhall expression before passing
    the expression to `dhallToNix`
-}
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 []

    -- This is an intermediate utility used to remove all occurrences of
    -- shadowing (since Nix does not support references to shadowed variables)
    --
    -- This finds how many bound variables of the same name that we need to
    -- descend past to reach the "deepest" reference to the current bound
    -- variable.  In other words, the result is the "depth" of the deepest
    -- reference.
    --
    -- If `Nothing` then the current bound variable doesn't need to be renamed.
    -- If any other number, then rename the variable to include the maximum
    -- depth.
    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)
            )

    -- Higher-level utility that builds on top of `maximumDepth` to rename a
    -- variable if there are shadowed references to that variable
    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

    -- Even higher-level utility that renames all shadowed references
    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
"\\"
                 -- Nix doesn't support \b and \f
                 -- , Nix.mkStr "\b"
                 -- , Nix.mkStr "\f"
                    , 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
"\\\\"
                 -- , Nix.mkStr "\\b"
                 -- , Nix.mkStr "\\f"
                    , 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))
    -- The next three cases are not necessary, because they are handled by the
    -- previous case
    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
        -- nonrecursive attrset that uses correctly quoted keys
        -- see https://github.com/dhall-lang/dhall-haskell/issues/2414
        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
            -- If the selected alternative has an associated payload, then we
            -- need introduce the partial application through an extra abstraction
            -- (here "x").
            --
            -- This translates `< Foo : T >.Foo` to `x: { Foo }: Foo x`
            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