{-# 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 qualified  Data.Text as Text
import Data.Traversable (for)
import Data.Typeable (Typeable)
import Data.Void (Void, absurd)
import Lens.Family (toListOf)
import Numeric (showHex)
import Data.Char (ord, isDigit, isAsciiLower, isAsciiUpper)

import Dhall.Core
    ( Binding (..)
    , Chunks (..)
    , DhallDouble (..)
    , Expr (..)
    , FieldSelection (..)
    , FunctionBinding (..)
    , MultiLet (..)
    , PreferAnnotation (..)
    , Var (..)
    , WithComponent (..)
    )

import Nix.Expr
    ( Antiquoted (..)
    , NExpr
    , NExprF (NStr, NSet)
    , Recursivity (NonRecursive)
    , Binding (NamedVar)
    , NKeyName (..)
    , NString (..)
    , Params (Param)
    , VarName(..)
    , ($!=)
    , ($&&)
    , ($*)
    , ($+)
    , ($++)
    , ($-)
    , ($/)
    , ($//)
    , ($<)
    , ($<=)
    , ($==)
    , ($==)
    , ($||)
    , (==>)
    , (@.)
    , (@@)
    )

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
    | BytesUnsupported
    -- ^ The Nix language does not support arbitrary bytes (most notably: null
    --   bytes)
    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.
    |]

    show CompileError
BytesUnsupported =
        Text -> String
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot translate ❰Bytes❱ to Nix

Explanation: The Nix language does not support bytes literals
    |]

_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 :: forall s. Expr s Void -> Either CompileError (Fix NExprF)
dhallToNix Expr s Void
e =
    Expr Any Void -> Either CompileError (Fix NExprF)
forall s. Expr s Void -> Either CompileError (Fix NExprF)
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 :: Fix NExprF
untranslatable = [(Text, Fix NExprF)] -> Fix NExprF
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 :: forall s. 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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b -> b) -> b -> [a] -> b
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 :: forall s. (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 :: forall s. 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 a. a -> Maybe a
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 a. a -> Maybe a
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 :: Maybe s
bindingSrc1 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc2 :: Maybe s
value :: 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
.. } 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 a. a -> Maybe a
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{ 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
bindingSrc0 :: Maybe s
bindingSrc1 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc2 :: Maybe s
value :: Expr s Void
.. } 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 (Fix NExprF)
loop (Const Const
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (Var (V Text
a Int
0)) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Fix NExprF
Nix.mkSym (Text -> Text
zEncodeSymbol Text
a))
    loop (Var  Var
a     ) = CompileError -> Either CompileError (Fix NExprF)
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
        Fix NExprF
c' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
c
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName -> Params (Fix NExprF)
forall r. VarName -> Params r
Param (Text -> VarName
VarName (Text -> VarName) -> Text -> VarName
forall a b. (a -> b) -> a -> b
$ Text -> Text
zEncodeSymbol Text
a) Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
c')
    loop (Pi Maybe CharacterSet
_ Text
_ Expr s Void
_ Expr s Void
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (App Expr s Void
None Expr s Void
_) =
      Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
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
        Fix NExprF
v' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
v
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName -> Maybe (Fix NExprF) -> Fix NExprF
unionChoice (Text -> VarName
VarName Text
k) (Fix NExprF -> Maybe (Fix NExprF)
forall a. a -> Maybe a
Just Fix NExprF
v'))
    loop (App Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
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, Fix NExprF)
bindings' <- NonEmpty (Binding s Void)
-> (Binding s Void -> Either CompileError (Text, Fix NExprF))
-> Either CompileError (NonEmpty (Text, Fix NExprF))
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, Fix NExprF))
 -> Either CompileError (NonEmpty (Text, Fix NExprF)))
-> (Binding s Void -> Either CompileError (Text, Fix NExprF))
-> Either CompileError (NonEmpty (Text, Fix NExprF))
forall a b. (a -> b) -> a -> b
$ \Binding{ Text
variable :: forall s a. Binding s a -> Text
variable :: Text
variable, Expr s Void
value :: forall s a. Binding s a -> Expr s a
value :: Expr s Void
value } -> do
          Fix NExprF
value' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
value
          (Text, Fix NExprF) -> Either CompileError (Text, Fix NExprF)
forall a. a -> Either CompileError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text
zEncodeSymbol Text
variable, Fix NExprF
value')
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Fix NExprF)] -> Fix NExprF -> Fix NExprF
Nix.letsE (NonEmpty (Text, Fix NExprF) -> [(Text, Fix NExprF)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Text, Fix NExprF)
bindings') Fix NExprF
b')
    loop (Annot Expr s Void
a Expr s Void
_) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
    loop Expr s Void
Bool = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (BoolLit Bool
b) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Fix NExprF
Nix.mkBool Bool
b)
    loop (BoolAnd Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$&& Fix NExprF
b')
    loop (BoolOr Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$|| Fix NExprF
b')
    loop (BoolEQ Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$== Fix NExprF
b')
    loop (BoolNE Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$!= Fix NExprF
b')
    loop (BoolIf Expr s Void
a Expr s Void
b Expr s Void
c) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF
c' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
c
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf Fix NExprF
a' Fix NExprF
b' Fix NExprF
c')
    loop Expr s Void
Bytes = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (BytesLit ByteString
_) = do
        CompileError -> Either CompileError (Fix NExprF)
forall a b. a -> Either a b
Left CompileError
BytesUnsupported
    loop Expr s Void
Natural = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (NaturalLit Natural
n) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Fix NExprF
Nix.mkInt (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n))
    loop Expr s Void
NaturalFold = do
        let naturalFold :: Fix NExprF
naturalFold =
                    Params (Fix NExprF)
"n"
                Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"t"
                Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"succ"
                Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"zero"
                Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Fix NExprF
"n" Fix NExprF -> Fix NExprF -> Fix NExprF
$<= Integer -> Fix NExprF
Nix.mkInt Integer
0)
                        Fix NExprF
"zero"
                        (   Fix NExprF
"succ"
                        Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (   Fix NExprF
"naturalFold"
                            Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Fix NExprF
"n" Fix NExprF -> Fix NExprF -> Fix NExprF
$- Integer -> Fix NExprF
Nix.mkInt Integer
1)
                            Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
"t"
                            Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
"succ"
                            Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
"zero"
                            )
                        )
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Fix NExprF)] -> Fix NExprF -> Fix NExprF
Nix.letsE [ (Text
"naturalFold", Fix NExprF
naturalFold) ] Fix NExprF
"naturalFold")
    loop Expr s Void
NaturalBuild = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"k"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (   Fix NExprF
"k"
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
untranslatable
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Params (Fix NExprF)
"n" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Fix NExprF
"n" Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Integer -> Fix NExprF
Nix.mkInt Integer
1))
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Integer -> Fix NExprF
Nix.mkInt Integer
0
                )
            )
    loop Expr s Void
NaturalIsZero = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"n" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Fix NExprF
"n" Fix NExprF -> Fix NExprF -> Fix NExprF
$== Integer -> Fix NExprF
Nix.mkInt Integer
0))
    loop Expr s Void
NaturalEven = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"n" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Fix NExprF
"n" Fix NExprF -> Fix NExprF -> Fix NExprF
$/ Integer -> Fix NExprF
Nix.mkInt Integer
2) Fix NExprF -> Fix NExprF -> Fix NExprF
$* Integer -> Fix NExprF
Nix.mkInt Integer
2 Fix NExprF -> Fix NExprF -> Fix NExprF
$== Fix NExprF
"n")
    loop Expr s Void
NaturalOdd = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"n" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Fix NExprF
"n" Fix NExprF -> Fix NExprF -> Fix NExprF
$/ Integer -> Fix NExprF
Nix.mkInt Integer
2) Fix NExprF -> Fix NExprF -> Fix NExprF
$* Integer -> Fix NExprF
Nix.mkInt Integer
2 Fix NExprF -> Fix NExprF -> Fix NExprF
$!= Fix NExprF
"n")
    loop Expr s Void
NaturalShow =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
"toString"
    loop Expr s Void
NaturalSubtract = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"x"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"y"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Text -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.letE Text
"z" (Fix NExprF
"y" Fix NExprF -> Fix NExprF -> Fix NExprF
$- Fix NExprF
"x")
                    (Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Fix NExprF
"z" Fix NExprF -> Fix NExprF -> Fix NExprF
$< Integer -> Fix NExprF
Nix.mkInt Integer
0) (Integer -> Fix NExprF
Nix.mkInt Integer
0) Fix NExprF
"z")
            )
    loop Expr s Void
NaturalToInteger =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"n" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
"n")
    loop (NaturalPlus Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Fix NExprF
b')
    loop (NaturalTimes Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$* Fix NExprF
b')
    loop Expr s Void
Integer = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (IntegerLit Integer
n) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Fix NExprF
Nix.mkInt Integer
n)
    loop Expr s Void
IntegerClamp = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"x" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Integer -> Fix NExprF
Nix.mkInt Integer
0 Fix NExprF -> Fix NExprF -> Fix NExprF
$<= Fix NExprF
"x") Fix NExprF
"x" (Integer -> Fix NExprF
Nix.mkInt Integer
0))
    loop Expr s Void
IntegerNegate = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"x" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Integer -> Fix NExprF
Nix.mkInt Integer
0 Fix NExprF -> Fix NExprF -> Fix NExprF
$- Fix NExprF
"x"))
    loop Expr s Void
IntegerShow = do
        let e0 :: Fix NExprF
e0 = Fix NExprF
"toString" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"x"
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"x" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Integer -> Fix NExprF
Nix.mkInt Integer
0 Fix NExprF -> Fix NExprF -> Fix NExprF
$<= Fix NExprF
"x") (Text -> Fix NExprF
Nix.mkStr Text
"+" Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Fix NExprF
e0) Fix NExprF
e0)
    loop Expr s Void
IntegerToDouble =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"x" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
"x")
    loop Expr s Void
Double = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (DoubleLit (DhallDouble Double
n)) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Fix NExprF
Nix.mkFloat (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n))
    loop Expr s Void
DoubleShow =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
"toString"
    loop Expr s Void
Text = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (TextLit (Chunks [(Text, Expr s Void)]
abs_ Text
c)) = do
        let process :: (Text, Expr s Void)
-> Either CompileError [Antiquoted Text (Fix NExprF)]
process (Text
a, Expr s Void
b) = do
                Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
                [Antiquoted Text (Fix NExprF)]
-> Either CompileError [Antiquoted Text (Fix NExprF)]
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Antiquoted Text (Fix NExprF)
forall v r. v -> Antiquoted v r
Plain Text
a, Fix NExprF -> Antiquoted Text (Fix NExprF)
forall v r. r -> Antiquoted v r
Antiquoted Fix NExprF
b']
        [[Antiquoted Text (Fix NExprF)]]
abs' <- ((Text, Expr s Void)
 -> Either CompileError [Antiquoted Text (Fix NExprF)])
-> [(Text, Expr s Void)]
-> Either CompileError [[Antiquoted Text (Fix NExprF)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Expr s Void)
-> Either CompileError [Antiquoted Text (Fix NExprF)]
process [(Text, Expr s Void)]
abs_

        let chunks :: [Antiquoted Text (Fix NExprF)]
chunks = [[Antiquoted Text (Fix NExprF)]] -> [Antiquoted Text (Fix NExprF)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Antiquoted Text (Fix NExprF)]]
abs' [Antiquoted Text (Fix NExprF)]
-> [Antiquoted Text (Fix NExprF)] -> [Antiquoted Text (Fix NExprF)]
forall a. [a] -> [a] -> [a]
++ [Text -> Antiquoted Text (Fix NExprF)
forall v r. v -> Antiquoted v r
Plain Text
c]
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NString (Fix NExprF) -> NExprF (Fix NExprF)
forall r. NString r -> NExprF r
NStr ([Antiquoted Text (Fix NExprF)] -> NString (Fix NExprF)
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Antiquoted Text (Fix NExprF)]
chunks)))
    loop (TextAppend Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Fix NExprF
b')
    loop Expr s Void
TextReplace = do
        let from :: Fix NExprF
from = [Fix NExprF] -> Fix NExprF
Nix.mkList [ Item [Fix NExprF]
Fix NExprF
"needle" ]

        let to :: Fix NExprF
to = [Fix NExprF] -> Fix NExprF
Nix.mkList [ Item [Fix NExprF]
Fix NExprF
"replacement" ]

        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"needle"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"replacement"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"haystack"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Fix NExprF
"builtins" Fix NExprF -> Text -> Fix NExprF
@. Text
"replaceStrings" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
from Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
to Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"haystack")
            )
    loop Expr s Void
TextShow = do
        let from :: Fix NExprF
from =
                [Fix NExprF] -> Fix NExprF
Nix.mkList
                    [ Text -> Fix NExprF
Nix.mkStr Text
"\""
                    , Text -> Fix NExprF
Nix.mkStr Text
"$"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\\"
                 -- Nix doesn't support \b and \f
                 -- , Nix.mkStr "\b"
                 -- , Nix.mkStr "\f"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\n"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\r"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\t"
                    ]

        let to :: Fix NExprF
to =
                [Fix NExprF] -> Fix NExprF
Nix.mkList
                    [ Text -> Fix NExprF
Nix.mkStr Text
"\\\""
                    , Text -> Fix NExprF
Nix.mkStr Text
"\\u0024"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\\\\"
                 -- , Nix.mkStr "\\b"
                 -- , Nix.mkStr "\\f"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\\n"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\\r"
                    , Text -> Fix NExprF
Nix.mkStr Text
"\\t"
                    ]

        let replaced :: Fix NExprF
replaced = Fix NExprF
"builtins" Fix NExprF -> Text -> Fix NExprF
@. Text
"replaceStrings" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
from Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
to Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"t"

        let quoted :: Fix NExprF
quoted = Text -> Fix NExprF
Nix.mkStr Text
"\"" Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Fix NExprF
replaced Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Text -> Fix NExprF
Nix.mkStr Text
"\""

        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"t" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
quoted)
    loop Expr s Void
Date = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop Expr s Void
Time = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop Expr s Void
TimeZone = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop Expr s Void
List = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"t" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
untranslatable)
    loop (ListAppend Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$++ Fix NExprF
b')
    loop (ListLit Maybe (Expr s Void)
_ Seq (Expr s Void)
bs) = do
        [Fix NExprF]
bs' <- (Expr s Void -> Either CompileError (Fix NExprF))
-> [Expr s Void] -> Either CompileError [Fix NExprF]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Expr s Void -> Either CompileError (Fix NExprF)
loop (Seq (Expr s Void) -> [Expr s Void]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr s Void)
bs)
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Fix NExprF] -> Fix NExprF
Nix.mkList [Fix NExprF]
bs')
    loop Expr s Void
ListBuild = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"t"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"k"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (   Fix NExprF
"k"
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
untranslatable
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Params (Fix NExprF)
"x" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"xs" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> ([Fix NExprF] -> Fix NExprF
Nix.mkList [Item [Fix NExprF]
Fix NExprF
"x"] Fix NExprF -> Fix NExprF -> Fix NExprF
$++ Fix NExprF
"xs"))
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  [Fix NExprF] -> Fix NExprF
Nix.mkList []
                )
            )
    loop Expr s Void
ListFold = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"t"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"xs"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"t"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"cons"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (   Fix NExprF
"builtins.foldl'"
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (   Params (Fix NExprF)
"f"
                    Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"y"
                    Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"ys"
                    Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Fix NExprF
"f" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ (Fix NExprF
"cons" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"y" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"ys"))
                    )
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Params (Fix NExprF)
"ys" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
"ys")
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
"xs"
                )
            )
    loop Expr s Void
ListLength = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"t" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
"builtins.length")
    loop Expr s Void
ListHead = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"t"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"xs"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Fix NExprF
"xs" Fix NExprF -> Fix NExprF -> Fix NExprF
$== [Fix NExprF] -> Fix NExprF
Nix.mkList [])
                    Fix NExprF
Nix.mkNull
                    (Fix NExprF
"builtins.head" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"xs")
            )
    loop Expr s Void
ListLast = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"t"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"xs"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Fix NExprF
"xs" Fix NExprF -> Fix NExprF -> Fix NExprF
$== [Fix NExprF] -> Fix NExprF
Nix.mkList [])
                    Fix NExprF
Nix.mkNull
                    (   Fix NExprF
"builtins.elemAt"
                    Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"xs"
                    Fix NExprF -> Fix NExprF -> Fix NExprF
@@ ((Fix NExprF
"builtins.length" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"xs") Fix NExprF -> Fix NExprF -> Fix NExprF
$- Integer -> Fix NExprF
Nix.mkInt Integer
1)
                    )
            )
    loop Expr s Void
ListIndexed = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"t"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"xs"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (   Fix NExprF
"builtins.genList"
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (   Params (Fix NExprF)
"i"
                    Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> [(Text, Fix NExprF)] -> Fix NExprF
Nix.attrsE
                            [ (Text
"index", Fix NExprF
"i")
                            , (Text
"value", Fix NExprF
"builtins.elemAt" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"xs" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"i")
                            ]
                    )
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Fix NExprF
"builtins.length" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"xs")
                )
            )
    loop Expr s Void
ListReverse = do
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (   Params (Fix NExprF)
"t"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"xs"
            Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Text -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.letE Text
"n" (Fix NExprF
"builtins.length" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"xs")
                    (   Fix NExprF
"builtins.genList"
                    Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (   Params (Fix NExprF)
"i"
                        Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (   Fix NExprF
"builtins.elemAt"
                            Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
"xs"
                            Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Fix NExprF
"n" Fix NExprF -> Fix NExprF -> Fix NExprF
$- Fix NExprF
"i" Fix NExprF -> Fix NExprF -> Fix NExprF
$- Integer -> Fix NExprF
Nix.mkInt Integer
1)
                            )
                        )
                    Fix NExprF -> Fix NExprF -> Fix NExprF
@@  Fix NExprF
"n"
                    )
            )
    loop Expr s Void
Optional = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"t" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
untranslatable)
    loop (Some Expr s Void
a) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
    loop Expr s Void
None = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"t" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
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 (Fix NExprF)
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 (Fix NExprF)
forall a. HasCallStack => a
undefined
    loop TimeLiteral{} = Either CompileError (Fix NExprF)
forall a. HasCallStack => a
undefined
    loop TimeZoneLiteral{} = Either CompileError (Fix NExprF)
forall a. HasCallStack => a
undefined
    -- We currently model `Date`/`Time`/`TimeZone` literals as strings in Nix,
    -- so the corresponding show functions are the identity function
    loop Expr s Void
DateShow =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"date" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
"date")
    loop Expr s Void
TimeShow =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"time" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
"time")
    loop Expr s Void
TimeZoneShow =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"timeZone" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
"timeZone")
    loop (Record Map Text (RecordField s Void)
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (RecordLit Map Text (RecordField s Void)
a) = do
        Map Text (Fix NExprF)
a' <- (RecordField s Void -> Either CompileError (Fix NExprF))
-> Map Text (RecordField s Void)
-> Either CompileError (Map Text (Fix NExprF))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Text a -> f (Map Text b)
traverse (Expr s Void -> Either CompileError (Fix NExprF)
loop (Expr s Void -> Either CompileError (Fix NExprF))
-> (RecordField s Void -> Expr s Void)
-> RecordField s Void
-> Either CompileError (Fix NExprF)
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
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Fix NExprF)] -> Fix NExprF
nixAttrs (Map Text (Fix NExprF) -> [(Text, Fix NExprF)]
forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList Map Text (Fix NExprF)
a'))
      where
        -- nonrecursive attrset that uses correctly quoted keys
        -- see https://github.com/dhall-lang/dhall-haskell/issues/2414
        nixAttrs :: [(Text, Fix NExprF)] -> Fix NExprF
nixAttrs [(Text, Fix NExprF)]
pairs =
          NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF (Fix NExprF) -> Fix NExprF)
-> NExprF (Fix NExprF) -> Fix NExprF
forall a b. (a -> b) -> a -> b
$ Recursivity -> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall r. Recursivity -> [Binding r] -> NExprF r
NSet Recursivity
NonRecursive ([Binding (Fix NExprF)] -> NExprF (Fix NExprF))
-> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall a b. (a -> b) -> a -> b
$
          (\(Text
key, Fix NExprF
val) -> NAttrPath (Fix NExprF)
-> Fix NExprF -> NSourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> NSourcePos -> Binding r
NamedVar ((VarName -> NKeyName (Fix NExprF)
forall r. VarName -> NKeyName r
mkDoubleQuotedIfNecessary (Text -> VarName
VarName Text
key)) NKeyName (Fix NExprF)
-> [NKeyName (Fix NExprF)] -> NAttrPath (Fix NExprF)
forall a. a -> [a] -> NonEmpty a
:| []) Fix NExprF
val NSourcePos
Nix.nullPos)
          ((Text, Fix NExprF) -> Binding (Fix NExprF))
-> [(Text, Fix NExprF)] -> [Binding (Fix NExprF)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Fix NExprF)]
pairs
    loop (Union Map Text (Maybe (Expr s Void))
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (Combine Maybe CharacterSet
_ Maybe Text
_ Expr s Void
a Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b

        let defL :: Fix NExprF
defL = Fix NExprF
"builtins.hasAttr" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"k" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvsL"
        let defR :: Fix NExprF
defR = Fix NExprF
"builtins.hasAttr" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"k" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvsR"
        let valL :: Fix NExprF
valL = Fix NExprF
"builtins.getAttr" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"k" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvsL"
        let valR :: Fix NExprF
valR = Fix NExprF
"builtins.getAttr" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"k" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvsR"

        let toNameValue :: Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
v =
                [Fix NExprF] -> Fix NExprF
Nix.mkList [ [(Text, Fix NExprF)] -> Fix NExprF
Nix.attrsE [ (Text
"name", Fix NExprF
"k"), (Text
"value", Fix NExprF
v) ] ]

        let toKeyVals :: Fix NExprF
toKeyVals =
                    Params (Fix NExprF)
"k"
                Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf Fix NExprF
defL
                        (Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf Fix NExprF
defR
                            (Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf
                                (   (Fix NExprF
"builtins.isAttrs" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
valL)
                                Fix NExprF -> Fix NExprF -> Fix NExprF
$&& (Fix NExprF
"builtins.isAttrs" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
valR)
                                )
                                (Fix NExprF -> Fix NExprF
toNameValue (Fix NExprF
"combine" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
valL Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
valR))
                                (Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
valR)
                            )
                            (Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
valL)
                        )
                        (Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf Fix NExprF
defR
                            (Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
valR)
                            ([Fix NExprF] -> Fix NExprF
Nix.mkList [])
                        )

        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Text -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.letE Text
"combine"
                (   Params (Fix NExprF)
"kvsL"
                Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"kvsR"
                Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> [(Text, Fix NExprF)] -> Fix NExprF -> Fix NExprF
Nix.letsE
                        [ ( Text
"ks"
                          ,     (Fix NExprF
"builtins.attrNames" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvsL")
                            Fix NExprF -> Fix NExprF -> Fix NExprF
$++ (Fix NExprF
"builtins.attrNames" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvsR")
                          )
                        , (Text
"toKeyVals", Fix NExprF
toKeyVals)
                        ]
                        (   Fix NExprF
"builtins.listToAttrs"
                        Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (   Fix NExprF
"builtins.concatLists"
                            Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Fix NExprF
"map" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"toKeyVals" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"ks")
                            )
                        )
                )
                (Fix NExprF
"combine" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
b')
            )
    loop (CombineTypes Maybe CharacterSet
_ Expr s Void
_ Expr s Void
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (Merge Expr s Void
a Expr s Void
b Maybe (Expr s Void)
_) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
b' Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
a')
    loop (ToMap Expr s Void
a Maybe (Expr s Void)
_) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Text -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.letE Text
"kvs" Fix NExprF
a'
                (   Fix NExprF
"map"
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (   Params (Fix NExprF)
"k"
                    Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> [(Text, Fix NExprF)] -> Fix NExprF
Nix.attrsE
                            [ (Text
"mapKey", Fix NExprF
"k")
                            , (Text
"mapValue", Fix NExprF
"builtins.getAttr" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"k" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvs")
                            ]
                    )
                Fix NExprF -> Fix NExprF -> Fix NExprF
@@  (Fix NExprF
"builtins.attrNames" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"kvs")
                )
            )
    loop (ShowConstructor Expr s Void
_) = do
        CompileError -> Either CompileError (Fix NExprF)
forall a b. a -> Either a b
Left CompileError
CannotShowConstructor
    loop (Prefer Maybe CharacterSet
_ PreferAnnotation
_ Expr s Void
b Expr s Void
c) = do
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF
c' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
c
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
b' Fix NExprF -> Fix NExprF -> Fix NExprF
$// Fix NExprF
c')
    loop (RecordCompletion Expr s Void
a Expr s Void
b) =
        Expr s Void -> Either CompileError (Fix NExprF)
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 -> Expr s Void -> Expr s Void -> Expr s Void
forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
forall a. Monoid a => a
mempty PreferAnnotation
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
_) -> Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"x" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (VarName -> Maybe (Fix NExprF) -> Fix NExprF
unionChoice (Text -> VarName
VarName Text
k) (Fix NExprF -> Maybe (Fix NExprF)
forall a. a -> Maybe a
Just Fix NExprF
"x")))
            Maybe (Maybe (Expr s Void))
_ -> Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName -> Maybe (Fix NExprF) -> Fix NExprF
unionChoice (Text -> VarName
VarName Text
k) Maybe (Fix NExprF)
forall a. Maybe a
Nothing)
    loop (Field Expr s Void
a (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Dhall.Core.fieldSelectionLabel -> Text
b)) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Maybe (Fix NExprF)
-> Fix NExprF -> NAttrPath (Fix NExprF) -> NExprF (Fix NExprF)
forall r. Maybe r -> r -> NAttrPath r -> NExprF r
Nix.NSelect Maybe (Fix NExprF)
forall a. Maybe a
Nothing Fix NExprF
a' (VarName -> NKeyName (Fix NExprF)
forall r. VarName -> NKeyName r
mkDoubleQuotedIfNecessary (Text -> VarName
VarName Text
b) NKeyName (Fix NExprF)
-> [NKeyName (Fix NExprF)] -> NAttrPath (Fix NExprF)
forall a. a -> [a] -> NonEmpty a
:| [])))
    loop (Project Expr s Void
a (Left [Text]
b)) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding (Fix NExprF)] -> Fix NExprF
Nix.mkNonRecSet [ Fix NExprF -> [VarName] -> Binding (Fix NExprF)
forall e. e -> [VarName] -> Binding e
Nix.inheritFrom Fix NExprF
a' ((Text -> VarName) -> [Text] -> [VarName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> VarName
VarName [Text]
b) ])
    loop (Project Expr s Void
_ (Right Expr s Void
_)) =
        CompileError -> Either CompileError (Fix NExprF)
forall a b. a -> Either a b
Left CompileError
CannotProjectByType
    loop (Assert Expr s Void
_) =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (Equivalent Maybe CharacterSet
_ Expr s Void
_ Expr s Void
_) =
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
    loop (With Expr s Void
a (WithLabel Text
k :| []) Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b

        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$// [(Text, Fix NExprF)] -> Fix NExprF
Nix.attrsE [(Text
k, Fix NExprF
b')])
    loop (With Expr s Void
a (WithLabel Text
k :| WithComponent
k' : [WithComponent]
ks) Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
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))

        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.letE Text
"_" Fix NExprF
a' (Fix NExprF
"_" Fix NExprF -> Fix NExprF -> Fix NExprF
$// [(Text, Fix NExprF)] -> Fix NExprF
Nix.attrsE [(Text
k, Fix NExprF
b')]))
    loop (With Expr s Void
a (WithComponent
WithQuestion :| []) Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$== Fix NExprF
Nix.mkNull) Fix NExprF
Nix.mkNull Fix NExprF
b')
    loop (With Expr s Void
a (WithComponent
WithQuestion :| WithComponent
k : [WithComponent]
ks) Expr s Void
b) = do
        Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
        Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
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))
        Fix NExprF -> Either CompileError (Fix NExprF)
forall a. a -> Either CompileError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.letE Text
"_" Fix NExprF
a' (Fix NExprF -> Fix NExprF -> Fix NExprF -> Fix NExprF
Nix.mkIf (Fix NExprF
a' Fix NExprF -> Fix NExprF -> Fix NExprF
$== Fix NExprF
Nix.mkNull) Fix NExprF
Nix.mkNull Fix NExprF
b'))
    loop (ImportAlt Expr s Void
a Expr s Void
_) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
    loop (Note s
_ Expr s Void
b) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
    loop (Embed Void
x) = Void -> Either CompileError (Fix NExprF)
forall a. Void -> a
absurd Void
x

-- | Previously we turned @<Foo | Bar>.Foo@ into @{ Foo, Bar }: Foo@,
-- but this would not work with <Frob/Baz>.Frob/Baz (cause the slash is not a valid symbol char in nix)
-- so we generate @union: union."Frob/Baz"@ instead.
--
-- If passArgument is @Just@, pass the argument to the union selector.
unionChoice :: VarName -> Maybe NExpr -> NExpr
unionChoice :: VarName -> Maybe (Fix NExprF) -> Fix NExprF
unionChoice VarName
chosenKey Maybe (Fix NExprF)
passArgument =
  let selector :: Fix NExprF
selector = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Maybe (Fix NExprF)
-> Fix NExprF -> NAttrPath (Fix NExprF) -> NExprF (Fix NExprF)
forall r. Maybe r -> r -> NAttrPath r -> NExprF r
Nix.NSelect Maybe (Fix NExprF)
forall a. Maybe a
Nothing (Text -> Fix NExprF
Nix.mkSym Text
"u") (VarName -> NKeyName (Fix NExprF)
forall r. VarName -> NKeyName r
mkDoubleQuotedIfNecessary VarName
chosenKey NKeyName (Fix NExprF)
-> [NKeyName (Fix NExprF)] -> NAttrPath (Fix NExprF)
forall a. a -> [a] -> NonEmpty a
:| []))
  in VarName -> Params (Fix NExprF)
forall r. VarName -> Params r
Nix.Param VarName
"u" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==>
     case Maybe (Fix NExprF)
passArgument of
       Maybe (Fix NExprF)
Nothing -> Fix NExprF
selector
       Just Fix NExprF
arg -> Fix NExprF
selector Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
arg


-- | Double-quote a field name (record or union). This makes sure it’s recognized as a valid name by nix, e.g. in
--
--  @{ "foo/bar" = 42; }."foo/bar" }@
--
-- where
--
-- @{ foo/bar = 42; }.foo/bar@ is not syntactically valid nix.
--
-- This is only done if necessary (where “necessary” is not super defined right now).
mkDoubleQuotedIfNecessary :: VarName -> NKeyName r
mkDoubleQuotedIfNecessary :: forall r. VarName -> NKeyName r
mkDoubleQuotedIfNecessary key :: VarName
key@(VarName Text
keyName) =
    if (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
simpleChar Text
keyName
    then VarName -> NKeyName r
forall r. VarName -> NKeyName r
StaticKey VarName
key
    else Antiquoted (NString r) r -> NKeyName r
forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (NString r -> Antiquoted (NString r) r
forall v r. v -> Antiquoted v r
Plain ([Antiquoted Text r] -> NString r
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text r
forall v r. v -> Antiquoted v r
Plain Text
keyName]))
    where
        simpleChar :: Char -> Bool
simpleChar Char
c = Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c


-- | Nix does not support symbols like @foo/bar@, but they are allowed in dhall.
-- So if they happen, we need to encode them with an ASCII escaping scheme.
--
-- This is copied/inspired by the Z-Encoding scheme from GHC, see
-- https://hackage.haskell.org/package/zenc-0.1.2/docs/Text-Encoding-Z.html
--
-- Original Source is BSD-3-Clause, Copyright (c)2011, Jason Dagit
zEncodeSymbol :: Text -> Text
zEncodeSymbol :: Text -> Text
zEncodeSymbol = Text -> Text
zEncodeString

-- | The basic encoding scheme is this:

--   * Alphabetic characters (upper and lower) and digits
--         all translate to themselves;
--         except 'Z', which translates to 'ZZ'
--         and    'z', which translates to 'zz'
--
--   * Most other printable characters translate to 'zx' or 'Zx' for some
--         alphabetic character x
--
--   * The others translate as 'znnnU' where 'nnn' is the decimal number
--         of the character
--
-- @
--         Before          After
--         --------------------------
--         Trak            Trak
--         foo-wib         foozmwib
--         \>               zg
--         \>1              zg1
--         foo\#            foozh
--         foo\#\#           foozhzh
--         foo\#\#1          foozhzh1
--         fooZ            fooZZ
--         :+              ZCzp
-- @
zEncodeString :: Text -> Text
zEncodeString :: Text -> Text
zEncodeString Text
cs = case Text -> Maybe (Char, Text)
Text.uncons Text
cs of
    Maybe (Char, Text)
Nothing -> Text
Text.empty
    Just (Char
c, Text
cs') ->
        Char -> Text
encodeDigitChar Char
c
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
encodeChar Text
cs'

-- | Whether the given characters needs to be z-encoded.
needsEncoding :: Char -> Bool
needsEncoding :: Char -> Bool
needsEncoding Char
'Z' = Bool
True
needsEncoding Char
'z' = Bool
True
needsEncoding Char
c   = Bool -> Bool
not
                  ( Char -> Bool
isAsciiLower Char
c
                  Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c
                  Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c )

-- If a digit is at the start of a symbol then we need to encode it.
encodeDigitChar :: Char -> Text
encodeDigitChar :: Char -> Text
encodeDigitChar Char
c | Char -> Bool
isDigit Char
c = Char -> Text
encodeAsUnicodeChar Char
c
encodeDigitChar Char
c             = Char -> Text
encodeChar Char
c

encodeChar :: Char -> Text
encodeChar :: Char -> Text
encodeChar Char
c | Bool -> Bool
not (Char -> Bool
needsEncoding Char
c) = [Char
Item Text
c]     -- Common case first

encodeChar Char
'('  = Text
"ZL"
encodeChar Char
')'  = Text
"ZR"
encodeChar Char
'['  = Text
"ZM"
encodeChar Char
']'  = Text
"ZN"
encodeChar Char
':'  = Text
"ZC"
encodeChar Char
'Z'  = Text
"ZZ"
encodeChar Char
'z'  = Text
"zz"
encodeChar Char
'&'  = Text
"za"
encodeChar Char
'|'  = Text
"zb"
encodeChar Char
'^'  = Text
"zc"
encodeChar Char
'$'  = Text
"zd"
encodeChar Char
'='  = Text
"ze"
encodeChar Char
'>'  = Text
"zg"
encodeChar Char
'#'  = Text
"zh"
encodeChar Char
'.'  = Text
"zi"
encodeChar Char
'<'  = Text
"zl"
-- we can’t allow @-@, because it is not valid at the start of a symbol
encodeChar Char
'-'  = Text
"zm"
encodeChar Char
'!'  = Text
"zn"
encodeChar Char
'+'  = Text
"zp"
encodeChar Char
'\'' = Text
"zq"
encodeChar Char
'\\' = Text
"zr"
encodeChar Char
'/'  = Text
"zs"
encodeChar Char
'*'  = Text
"zt"
-- We can allow @_@ because it can appear anywhere in a symbol
-- encodeChar '_'  = "zu"
encodeChar Char
'%'  = Text
"zv"
encodeChar Char
c    = Char -> Text
encodeAsUnicodeChar Char
c

encodeAsUnicodeChar :: Char -> Text
encodeAsUnicodeChar :: Char -> Text
encodeAsUnicodeChar Char
c = Char
'z' Char -> Text -> Text
`Text.cons` if Char -> Bool
isDigit (HasCallStack => Text -> Char
Text -> Char
Text.head Text
hex_str) then Text
hex_str
                                                           else Char
'0' Char -> Text -> Text
`Text.cons` Text
hex_str
  where hex_str :: Text
hex_str = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
c) String
"U"