dhall-nix 1.1.6 → 1.1.7

raw patch · 2 files changed

+94/−39 lines, 2 filesdep −insert-ordered-containersdep ~containersdep ~dhalldep ~hnixPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: insert-ordered-containers

Dependency ranges changed: containers, dhall, hnix

API changes (from Hackage documentation)

Files

• dhall-nix.cabal +4/−5
• src/Dhall/Nix.hs +90/−34

@@ -1,5 +1,5 @@ Name: dhall-nix-Version: 1.1.6+Version: 1.1.7 Cabal-Version: >=1.8.0.2 Build-Type: Simple Tested-With: GHC == 8.0.1@@ -28,11 +28,10 @@     Hs-Source-Dirs: src     Build-Depends:         base                      >= 4.8.0.0 && < 5   ,-        containers                              < 0.6 ,+        containers                              < 0.7 ,         data-fix                                < 0.3 ,-        dhall                     >= 1.15    && < 1.18,-        hnix                      >= 0.5     && < 0.6 ,-        insert-ordered-containers >= 0.1.0.1 && < 0.3 ,+        dhall                     >= 1.25    && < 1.26,+        hnix                      >= 0.6.1   && < 0.7 ,         neat-interpolation                      < 0.4 ,         text                      >= 0.8.0.0 && < 1.3     Exposed-Modules:

@@ -45,10 +45,10 @@     `Optional` values translate to @null@ if missing or the unwrapped value if     present: -> $ dhall-to-nix <<< "[] : Optional Integer"+> $ dhall-to-nix <<< "None Natural" > null -> $ dhall-to-nix <<< "[1] : Optional Integer"+> $ dhall-to-nix <<< "Some 1" > 1      Unions are Church-encoded:@@ -56,9 +56,6 @@ > $ dhall-to-nix <<< "< Left = True | Right : Natural >" > { Left, Right }: Left true -    `Dhall.Core.Double`s cannot be translated to Nix at all since Nix does not-    support floating point values.-     Also, all Dhall expressions are normalized before translation to Nix:  > $ dhall-to-nix <<< "True == False"@@ -93,10 +90,10 @@     , CompileError(..)     ) where -import Control.Applicative (empty) import Control.Exception (Exception) import Data.Foldable (toList) import Data.Fix (Fix(..))+import Data.Traversable (for) import Data.Typeable (Typeable) import Dhall.Core (Chunks(..), Const(..), Expr(..), Var(..)) import Dhall.TypeCheck (X(..))@@ -109,11 +106,14 @@     , NKeyName(..)     , NString(..)     , Params(..)+    , (@@)+    , (==>)+    , ($+)     ) -import qualified Data.HashMap.Strict.InsOrd import qualified Data.Text import qualified Dhall.Core+import qualified Dhall.Map import qualified NeatInterpolation import qualified Nix @@ -123,8 +123,8 @@ data CompileError     = CannotReferenceShadowedVariable Var     -- ^ Nix does not provide a way to reference a shadowed variable-    | UnexpectedConstructorsKeyword-    -- ^ The @constructors@ keyword is not yet supported+    | CannotProjectByType+    -- ^ We currently do not support threading around type information     deriving (Typeable)  instance Show CompileError where@@ -180,19 +180,14 @@       where         txt = Dhall.Core.pretty v -    show UnexpectedConstructorsKeyword =+    show CannotProjectByType =         Data.Text.unpack [NeatInterpolation.text|-$_ERROR: Unexpected ❰constructors❱ keyword+$_ERROR: Cannot project by type -Explanation: The dhallToNix Haskell API function has a precondition that the-Dhall expression to translate to Nix must have already been type-checked.  This-precondition ensures that the normalized expression will have no remaining-❰constructors❱ keywords.+The ❰dhall-to-nix❱ compiler does not support projecting out a subset of a record+by the expected type (i.e. ❰someRecord.(someType)❱ +    |] -However, the dhallToNix Haskell API function was called with a Dhall expression-that still had a ❰constructors❱ keyword, which indicates that the expression had-not yet been type-checked.-|]  _ERROR :: Data.Text.Text _ERROR = "\ESC[1;31mError\ESC[0m"@@ -220,14 +215,26 @@         c' <- loop c         return (Fix (NAbs (Param a) c'))     loop (Pi _ _ _) = return (Fix (NSet []))+    -- None needs a type to convert to an Optional+    loop (App None _) = do+      return (Fix (NConstant NNull))+    loop (App (Field (Union kts) k) v) = do+        v' <- loop v+        let e0 = do+                k' <- Dhall.Map.keys kts+                return (k', Nothing)+        let e2 = Fix (NBinary NApp (Fix (NSym k)) v')+        return (Fix (NAbs (ParamSet e0 False Nothing) e2))     loop (App a b) = do         a' <- loop a         b' <- loop b         return (Fix (NBinary NApp a' b'))-    loop (Let a _ c d) = do-        c' <- loop c-        d' <- loop d-        return (Fix (NLet [NamedVar [StaticKey a] c' Nix.nullPos] d'))+    loop (Let as b) = do+        as' <- for as $ \a -> do+          val <- loop $ Dhall.Core.value a+          pure $ NamedVar [StaticKey $ Dhall.Core.variable a] val Nix.nullPos+        b' <- loop b+        return (Fix (NLet (toList as') b'))     loop (Annot a _) = loop a     loop Bool = return (Fix (NSet []))     loop (BoolLit b) = return (Fix (NConstant (NBool b)))@@ -330,6 +337,37 @@         a' <- loop a         b' <- loop b         return (Fix (NBinary NPlus a' b'))+    loop TextShow = do+        let from =+                Nix.mkList+                    [ Nix.mkStr "\""+                    , Nix.mkStr "$"+                    , Nix.mkStr "\\"+                 -- Nix doesn't support \b and \f+                 -- , Nix.mkStr "\b"+                 -- , Nix.mkStr "\f"+                    , Nix.mkStr "\n"+                    , Nix.mkStr "\r"+                    , Nix.mkStr "\t"+                    ]++        let to =+                Nix.mkList+                    [ Nix.mkStr "\\\""+                    , Nix.mkStr "\\u0024"+                    , Nix.mkStr "\\\\"+                 -- , Nix.mkStr "\\b"+                 -- , Nix.mkStr "\\f"+                    , Nix.mkStr "\\n"+                    , Nix.mkStr "\\r"+                    , Nix.mkStr "\\t"+                    ]++        let replaced = "builtins.replaceStrings" @@ from @@ to @@ "t"++        let quoted = Nix.mkStr "\"" $+ replaced $+ Nix.mkStr "\""++        return ("t" ==> quoted)     loop List = return (Fix (NAbs "t" (Fix (NSet []))))     loop (ListAppend a b) = do         a' <- loop a@@ -383,10 +421,8 @@         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 (OptionalLit _ b) =-        case b of-            Nothing -> return (Fix (NConstant NNull))-            Just c  -> loop c+    loop (Some a) = loop a+    loop None = return (Fix (NConstant NNull))     loop OptionalFold = do         let e0 = Fix (NBinary NEq "x" (Fix (NConstant NNull)))         let e1 = Fix (NIf e0 "nothing" (Fix (NBinary NApp "just" "x")))@@ -396,22 +432,22 @@         let e0 = Pi "nothing" "optional" "optional"         let e1 = Pi "just" (Pi "_" "a" "optional") e0         let e2 = Pi "optional" (Const Type) e1-        let e3 = OptionalLit "a" empty-        let e4 = Lam "x" "a" (OptionalLit "a" (pure "x"))+        let e3 = App None "a"+        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 (RecordLit a) = do         a' <- traverse loop a         let a'' = do-                (k, v) <- Data.HashMap.Strict.InsOrd.toList a'+                (k, v) <- Dhall.Map.toList a'                 return (NamedVar [StaticKey k] v Nix.nullPos)         return (Fix (NSet a''))     loop (Union _) = return (Fix (NSet []))     loop (UnionLit k v kts) = do         v' <- loop v         let e0 = do-                k' <- k : Data.HashMap.Strict.InsOrd.keys kts+                k' <- k : Dhall.Map.keys kts                 return (k', Nothing)         let e2 = Fix (NBinary NApp (Fix (NSym k)) v')         return (Fix (NAbs (ParamSet e0 False Nothing) e2))@@ -461,19 +497,39 @@         a' <- loop a         b' <- loop b         return (Fix (NBinary NApp b' a'))-    loop (Constructors _) = do-        Left UnexpectedConstructorsKeyword     loop (Prefer a b) = do         a' <- loop a         b' <- loop b         return (Fix (NBinary NUpdate a' b'))+    loop (Field (Union kts) k) =+        case Dhall.Map.lookup k 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 _ ) -> do+                let e0 = do+                        k' <- Dhall.Map.keys kts+                        return (k', Nothing)+                let e2 = Fix (NBinary NApp (Fix (NSym k)) (Fix (NSym "x")))+                return (Fix (NAbs (Param "x") (Fix (NAbs (ParamSet e0 False Nothing) e2))))++            _ -> do+                let e0 = do+                        k' <- Dhall.Map.keys kts+                        return (k', Nothing)+                let e2 = Fix (NSym k)+                return (Fix (NAbs (ParamSet e0 False Nothing) e2))     loop (Field a b) = do         a' <- loop a         return (Fix (NSelect a' [StaticKey b] Nothing))-    loop (Project a b) = do+    loop (Project a (Left b)) = do         a' <- loop a         let b' = fmap StaticKey (toList b)         return (Fix (NSet [Inherit (Just a') b' Nix.nullPos]))+    loop (Project _ (Right _)) = do+        Left CannotProjectByType     loop (ImportAlt a _) = loop a     loop (Note _ b) = loop b     loop (Embed (X x)) = x