diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2017 Gabriel Gonzalez +Copyright (c) 2020 Gabriel Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification, diff --git a/dhall-nix.cabal b/dhall-nix.cabal --- a/dhall-nix.cabal +++ b/dhall-nix.cabal @@ -1,5 +1,5 @@ Name: dhall-nix -Version: 1.1.12 +Version: 1.1.13 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 8.0.1 @@ -30,8 +30,8 @@ base >= 4.8.0.0 && < 5 , containers < 0.7 , data-fix < 0.3 , - dhall >= 1.28 && < 1.31, - hnix >= 0.6.1 && < 0.7 , + dhall >= 1.31 && < 1.32, + hnix >= 0.7 && < 0.8 , neat-interpolation < 0.5 , text >= 0.8.0.0 && < 1.3 Exposed-Modules: diff --git a/src/Dhall/Nix.hs b/src/Dhall/Nix.hs --- a/src/Dhall/Nix.hs +++ b/src/Dhall/Nix.hs @@ -96,7 +96,15 @@ import Data.Traversable (for) import Data.Typeable (Typeable) import Data.Void (Void, absurd) -import Dhall.Core (Chunks(..), Const(..), DhallDouble(..), Expr(..), MultiLet(..), Var(..)) +import Dhall.Core + ( Chunks(..) + , Const(..) + , DhallDouble(..) + , Expr(..) + , MultiLet(..) + , PreferAnnotation(..) + , Var(..) + ) import Nix.Atoms (NAtom(..)) import Nix.Expr ( Antiquoted(..) @@ -104,6 +112,7 @@ , NBinaryOp(..) , NExprF(..) , NKeyName(..) + , NRecordType(..) , NString(..) , Params(..) , (@@) @@ -208,13 +217,15 @@ dhallToNix :: Expr s Void -> Either CompileError (Fix NExprF) dhallToNix e = loop (Dhall.Core.normalize e) where - loop (Const _) = return (Fix (NSet [])) + untranslatable = Fix (NSet NNonRecursive []) + + loop (Const _) = return untranslatable loop (Var (V a 0)) = return (Fix (NSym a)) loop (Var a ) = Left (CannotReferenceShadowedVariable a) loop (Lam a _ c) = do c' <- loop c return (Fix (NAbs (Param a) c')) - loop (Pi _ _ _) = return (Fix (NSet [])) + loop (Pi _ _ _) = return untranslatable -- None needs a type to convert to an Optional loop (App None _) = do return (Fix (NConstant NNull)) @@ -237,7 +248,7 @@ b' <- loop b return (Fix (NLet (toList as') b')) loop (Annot a _) = loop a - loop Bool = return (Fix (NSet [])) + loop Bool = return untranslatable loop (BoolLit b) = return (Fix (NConstant (NBool b))) loop (BoolAnd a b) = do a' <- loop a @@ -260,7 +271,7 @@ b' <- loop b c' <- loop c return (Fix (NIf a' b' c')) - loop Natural = return (Fix (NSet [])) + loop Natural = return untranslatable loop (NaturalLit n) = return (Fix (NConstant (NInt (fromIntegral n)))) loop NaturalFold = do let e0 = Fix (NBinary NMinus "n" (Fix (NConstant (NInt 1)))) @@ -272,7 +283,7 @@ return (Fix (NLet [NamedVar ["naturalFold"] e5 Nix.nullPos] "naturalFold")) loop NaturalBuild = do let e0 = Fix (NBinary NPlus "n" (Fix (NConstant (NInt 1)))) - let e1 = Fix (NBinary NApp (Fix (NBinary NApp "k" (Fix (NSet [])))) (Fix (NAbs "n" e0))) + let e1 = Fix (NBinary NApp (Fix (NBinary NApp "k" untranslatable)) (Fix (NAbs "n" e0))) return (Fix (NAbs "k" (Fix (NBinary NApp e1 (Fix (NConstant (NInt 0))))))) loop NaturalIsZero = do let e0 = Fix (NBinary NEq "n" (Fix (NConstant (NInt 0)))) @@ -319,7 +330,7 @@ a' <- loop a b' <- loop b return (Fix (NBinary NMult a' b')) - loop Integer = return (Fix (NSet [])) + loop Integer = return untranslatable loop (IntegerLit n) = return (Fix (NConstant (NInt (fromIntegral n)))) loop IntegerClamp = do let e0 = Fix (NConstant (NInt 0)) @@ -338,11 +349,11 @@ return e3 loop IntegerToDouble = do return (Fix (NAbs "x" "x")) - loop Double = return (Fix (NSet [])) + loop Double = return untranslatable loop (DoubleLit (DhallDouble n)) = return (Fix (NConstant (NFloat (realToFrac n)))) loop DoubleShow = do return "toString" - loop Text = return (Fix (NSet [])) + loop Text = return untranslatable loop (TextLit (Chunks abs_ c)) = do let process (a, b) = do b' <- loop b @@ -386,7 +397,7 @@ let quoted = Nix.mkStr "\"" $+ replaced $+ Nix.mkStr "\"" return ("t" ==> quoted) - loop List = return (Fix (NAbs "t" (Fix (NSet [])))) + loop List = return (Fix (NAbs "t" untranslatable)) loop (ListAppend a b) = do a' <- loop a b' <- loop b @@ -395,7 +406,7 @@ bs' <- mapM loop (toList bs) return (Fix (NList bs')) loop ListBuild = do - let e0 = Fix (NBinary NApp "k" (Fix (NSet []))) + let e0 = Fix (NBinary NApp "k" untranslatable) let e1 = Fix (NBinary NConcat (Fix (NList ["x"])) "xs") let e2 = Fix (NBinary NApp e0 (Fix (NAbs "x" (Fix (NAbs "xs" e1))))) let e3 = Fix (NAbs "k" (Fix (NBinary NApp e2 (Fix (NList []))))) @@ -427,7 +438,7 @@ [ NamedVar ["index"] "i" Nix.nullPos , NamedVar ["value"] e1 Nix.nullPos ] - let e3 = Fix (NBinary NApp "builtins.genList" (Fix (NAbs "i" (Fix (NSet e2))))) + let e3 = Fix (NBinary NApp "builtins.genList" (Fix (NAbs "i" (Fix (NSet NNonRecursive e2))))) return (Fix (NAbs "t" (Fix (NAbs "xs" (Fix (NBinary NApp e3 e0)))))) loop ListReverse = do let e0 = Fix (NBinary NMinus "n" "i") @@ -438,7 +449,7 @@ let e5 = Fix (NBinary NApp "builtins.length" "xs") let e6 = Fix (NAbs "xs" (Fix (NLet [NamedVar ["n"] e5 Nix.nullPos] e4))) return (Fix (NAbs "t" e6)) - loop Optional = return (Fix (NAbs "t" (Fix (NSet [])))) + loop Optional = return (Fix (NAbs "t" untranslatable)) loop (Some a) = loop a loop None = return (Fix (NConstant NNull)) loop OptionalFold = do @@ -454,14 +465,14 @@ let e4 = Lam "x" "a" (Some "x") let e5 = App (App (App "f" (App Optional "a")) e4) e3 loop (Lam "a" (Const Type) (Lam "f" e2 e5)) - loop (Record _) = return (Fix (NSet [])) + loop (Record _) = return untranslatable loop (RecordLit a) = do a' <- traverse loop a let a'' = do (k, v) <- Dhall.Map.toList a' return (NamedVar [StaticKey k] v Nix.nullPos) - return (Fix (NSet a'')) - loop (Union _) = return (Fix (NSet [])) + return (Fix (NSet NNonRecursive a'')) + loop (Union _) = return untranslatable loop (Combine _ a b) = do a' <- loop a b' <- loop b @@ -480,7 +491,7 @@ [ NamedVar ["name" ] "k" Nix.nullPos , NamedVar ["value"] v Nix.nullPos ] - in Fix (NList [Fix (NSet bindings)]) + in Fix (NList [Fix (NSet NNonRecursive bindings)]) let e3 = Fix (NBinary NApp (Fix (NBinary NApp "combine" valL)) valR) let e4 = Fix (NBinary NApp "builtins.isAttrs" valL) @@ -503,7 +514,7 @@ let e11 = Fix (NBinary NApp (Fix (NBinary NApp "combine" a')) b') return (Fix (NLet [NamedVar ["combine"] combine Nix.nullPos] e11)) - loop (CombineTypes _ _) = return (Fix (NSet [])) + loop (CombineTypes _ _) = return untranslatable loop (Merge a b _) = do a' <- loop a b' <- loop b @@ -516,15 +527,15 @@ [ NamedVar [StaticKey "mapKey"] "k" Nix.nullPos , NamedVar [StaticKey "mapValue"] v Nix.nullPos ] - let map_ = Fix (NBinary NApp "map" (Fix (NAbs "k" (Fix (NSet setBindings))))) + let map_ = Fix (NBinary NApp "map" (Fix (NAbs "k" (Fix (NSet NNonRecursive setBindings))))) let toMap = Fix (NAbs "kvs" (Fix (NBinary NApp map_ ks))) return (Fix (NBinary NApp toMap a')) - loop (Prefer a b) = do - a' <- loop a + loop (Prefer _ b c) = do b' <- loop b - return (Fix (NBinary NUpdate a' b')) + c' <- loop c + return (Fix (NBinary NUpdate b' c')) loop (RecordCompletion a b) = do - loop (Annot (Prefer (Field a "default") b) (Field a "Type")) + loop (Annot (Prefer PreferFromCompletion (Field a "default") b) (Field a "Type")) loop (Field (Union kts) k) = case Dhall.Map.lookup k kts of -- If the selected alternative has an associated payload, then we @@ -551,13 +562,15 @@ loop (Project a (Left b)) = do a' <- loop a let b' = fmap StaticKey (toList b) - return (Fix (NSet [Inherit (Just a') b' Nix.nullPos])) + return (Fix (NSet NNonRecursive [Inherit (Just a') b' Nix.nullPos])) loop (Project _ (Right _)) = do Left CannotProjectByType loop (Assert _) = do - return (Fix (NSet [])) + return untranslatable loop (Equivalent _ _) = do - return (Fix (NSet [])) + return untranslatable + loop a@With{} = do + loop (Dhall.Core.desugarWith a) loop (ImportAlt a _) = loop a loop (Note _ b) = loop b loop (Embed x) = absurd x