hnix 0.14.0.8 → 0.15.0

raw patch · 63 files changed

+5833/−4398 lines, 63 filesdep +unix-compatdep −unixdep ~basedep ~hashablePVP ok

version bump matches the API change (PVP)

Dependencies added: unix-compat

Dependencies removed: unix

Dependency ranges changed: base, hashable

API changes (from Hackage documentation)

Files

• ChangeLog.md +44/−1
• benchmarks/Main.hs +1/−1
• benchmarks/ParserBench.hs +2/−2
• hnix.cabal +16/−10
• main/Main.hs +119/−91
• main/Repl.hs +96/−80
• src/Nix.hs +20/−19
• src/Nix/Atoms.hs +3/−2
• src/Nix/Builtins.hs +306/−280
• src/Nix/Cache.hs +6/−6
• src/Nix/Cited.hs +3/−3
• src/Nix/Cited/Basic.hs +9/−13
• src/Nix/Context.hs +1/−1
• src/Nix/Convert.hs +95/−64
• src/Nix/Effects.hs +44/−50
• src/Nix/Effects/Basic.hs +139/−133
• src/Nix/Effects/Derivation.hs +48/−43
• src/Nix/Eval.hs +194/−188
• src/Nix/Exec.hs +75/−64
• src/Nix/Expr/Shorthands.hs +344/−148
• src/Nix/Expr/Strings.hs +9/−9
• src/Nix/Expr/Types.hs +178/−130
• src/Nix/Expr/Types/Annotated.hs +173/−119
• src/Nix/Frames.hs +7/−18
• src/Nix/Fresh.hs +7/−7
• src/Nix/Fresh/Basic.hs +3/−4
• src/Nix/Json.hs +27/−12
• src/Nix/Lint.hs +149/−120
• src/Nix/Normal.hs +10/−13
• src/Nix/Options.hs +9/−7
• src/Nix/Options/Parser.hs +3/−3
• src/Nix/Parser.hs +920/−773
• src/Nix/Pretty.hs +105/−94
• src/Nix/Reduce.hs +157/−151
• src/Nix/Render.hs +72/−71
• src/Nix/Render/Frame.hs +107/−95
• src/Nix/Scope.hs +25/−22
• src/Nix/Standard.hs +64/−41
• src/Nix/String.hs +20/−16
• src/Nix/String/Coerce.hs +11/−14
• src/Nix/TH.hs +66/−49
• src/Nix/Thunk.hs +3/−3
• src/Nix/Thunk/Basic.hs +3/−6
• src/Nix/Type/Assumption.hs +26/−26
• src/Nix/Type/Env.hs +21/−20
• src/Nix/Type/Infer.hs +220/−220
• src/Nix/Type/Type.hs +15/−19
• src/Nix/Unused.hs +82/−0
• src/Nix/Utils.hs +186/−136
• src/Nix/Utils/Fix1.hs +10/−6
• src/Nix/Value.hs +71/−80
• src/Nix/Value/Equal.hs +22/−25
• src/Nix/Var.hs +4/−5
• src/Nix/XML.hs +39/−46
• src/Prelude.hs +20/−0
• tests/EvalTests.hs +399/−258
• tests/Main.hs +28/−27
• tests/NixLanguageTests.hs +150/−98
• tests/ParserTests.hs +662/−317
• tests/PrettyParseTests.hs +118/−91
• tests/PrettyTests.hs +32/−13
• tests/ReduceExprTests.hs +4/−5
• tests/TestCommon.hs +31/−30

@@ -1,7 +1,50 @@  # ChangeLog -## [(diff)](https://github.com/haskell-nix/hnix/compare/0.13.1...0.14.0#files_bucket) 0.14.0+## [(diff)](https://github.com/haskell-nix/hnix/compare/0.14.0...0.15.0#files_bucket) 0.15.0++For support refere to: https://github.com/haskell-nix/hnix/issues/984++Partial log (for now):++* Breaking:++  * `Nix.Expr.Shorthands`:+    * `inherit{,From}`:+      * dropped second(/third) argument as irrelevant ([report](https://github.com/haskell-nix/hnix/issues/326))+      * bindings to inherit changed type from complex `[NKeyName]` (which is for static & dynamic keys) to `[VarName]` (`VarName` is newtype of `Text`).+      * So examples of use now are: `inherit ["a", "b"]`, `inheritFrom (var "a") ["b", "c"]`+    * `mkAssert`: fixed ([report](https://github.com/haskell-nix/hnix/issues/969)).+    * fx presedence between the operators:+        +        ```haskell+        (@@), (@.), (@./), ($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++), (==>)+        ```+        +        Now these shorthands can be used without sectioning & so represent the Nix expressions one to one.+        +        ```haskell+        nix = "           a/b   //            c/def   //           <g>  <             def/d"+        hask = mkRelPath "a/b" $// mkRelPath "c/def" $// mkEnvPath "g" $<  mkRelPath "def/d"+        ```++* Additional+  * `Nix.Expr.Shorthands`:+    * added:+      * `emptySet`+      * `emptyList`+      * `mkOp{,2}`+      * `mk{,Named,Variadic,General}ParamSet`+      * `mkNeg` - number negation.+      * `@.<|>` for Nix language `s.x or y` expession.+    * entered deprecation:+      * `mkOper{,2}` bacame `mkOp{,2}`.+      * `mkBinop` became `mkOp2`.+      * `mkParaset` supeceeded by `mk{,Named{,Variadic},Variadic,General}ParamSet`.+    * fixed:+      * `mkAssert` was creating `with`, now properly creates `assert`.++## [(diff)](https://github.com/haskell-nix/hnix/compare/0.13.1...0.14.0#files_bucket) 0.14.0 (2021-07-08)  * GHC 9.0 support. 

@@ -5,4 +5,4 @@ import qualified ParserBench  main :: IO ()-main = defaultMain [ParserBench.benchmarks]+main = defaultMain $ one ParserBench.benchmarks

@@ -4,8 +4,8 @@  import           Criterion -benchFile :: FilePath -> Benchmark-benchFile = bench <*> whnfIO . parseNixFile . ("data/" <>)+benchFile :: Path -> Benchmark+benchFile = bench . coerce <*> whnfIO . parseNixFile . ("data/" <>)  benchmarks :: Benchmark benchmarks = bgroup

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           hnix-version:        0.14.0.8+version:        0.15.0 synopsis:       Haskell implementation of the Nix language description:    Haskell implementation of the Nix language. category:       System, Data, Nix@@ -341,7 +341,9 @@  library   exposed-modules:+    Prelude     Nix+    Nix.Utils     Nix.Atoms     Nix.Builtins     Nix.Cache@@ -383,7 +385,6 @@     Nix.Type.Env     Nix.Type.Infer     Nix.Type.Type-    Nix.Utils     Nix.Utils.Fix1     Nix.Value     Nix.Value.Equal@@ -392,13 +393,13 @@     Nix.XML   other-modules:     Paths_hnix+    Nix.Unused   autogen-modules:     Paths_hnix   hs-source-dirs:     src   mixins:       base hiding (Prelude)-    , relude (Relude as Prelude)     , relude   ghc-options:     -Wall@@ -406,7 +407,7 @@   build-depends:       aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.1     , array >= 0.4 && < 0.6-    , base >= 4.12 && < 4.16+    , base >= 4.12 && < 5     , base16-bytestring >= 0.1.1 && < 1.1     , binary >= 0.8.5 && < 0.9     , bytestring >= 0.10.8 && < 0.12@@ -421,7 +422,7 @@     , filepath >= 1.4.2 && < 1.5     , free >= 5.1 && < 5.2     , gitrev >= 1.1.0 && < 1.4-    , hashable >= 1.2.5 && < 1.5+    , hashable >= 1.2.5 && < 1.4     , hashing >= 0.1.0 && < 0.2     , hnix-store-core >= 0.5.0 && < 0.6     , hnix-store-remote >= 0.5.0 && < 0.6@@ -463,7 +464,7 @@     , time >= 1.8.0 && < 1.9 || >= 1.9.3 && < 1.10     , transformers >= 0.5.5 && < 0.6     , transformers-base >= 0.4.5 && < 0.5-    , unix >= 2.7.2 && < 2.8+    , unix-compat >= 0.4.3 && < 0.6     , unordered-containers >= 0.2.9 && < 0.3     , vector >= 0.12.0 && < 0.13     , xml >= 1.3.14 && < 1.4@@ -477,6 +478,7 @@     , DeriveLift     , FlexibleContexts     , FlexibleInstances+    , ScopedTypeVariables     , StandaloneDeriving     , TypeApplications     , TypeSynonymInstances@@ -485,6 +487,7 @@     , TupleSections     , LambdaCase     , BangPatterns+    , ViewPatterns   if flag(optimize)     default-extensions:       ApplicativeDo@@ -531,7 +534,6 @@     , time   mixins:       base hiding (Prelude)-    , relude (Relude as Prelude)     , relude   default-extensions:       OverloadedStrings@@ -543,6 +545,7 @@     , DeriveLift     , FlexibleContexts     , FlexibleInstances+    , ScopedTypeVariables     , StandaloneDeriving     , TypeApplications     , TypeSynonymInstances@@ -551,6 +554,7 @@     , TupleSections     , LambdaCase     , BangPatterns+    , ViewPatterns   if flag(optimize)     default-extensions:       ApplicativeDo@@ -577,7 +581,6 @@     TestCommon   mixins:       base hiding (Prelude)-    , relude (Relude as Prelude)     , relude   hs-source-dirs:     tests@@ -610,7 +613,7 @@     , serialise     , template-haskell     , time-    , unix+    , unix-compat   default-extensions:       OverloadedStrings     , DeriveGeneric@@ -621,6 +624,7 @@     , DeriveLift     , FlexibleContexts     , FlexibleInstances+    , ScopedTypeVariables     , StandaloneDeriving     , TypeApplications     , TypeSynonymInstances@@ -629,6 +633,7 @@     , TupleSections     , LambdaCase     , BangPatterns+    , ViewPatterns   if flag(optimize)     default-extensions:       ApplicativeDo@@ -647,7 +652,6 @@     benchmarks   mixins:       base hiding (Prelude)-    , relude (Relude as Prelude)     , relude   ghc-options:     -Wall@@ -673,6 +677,7 @@     , DeriveLift     , FlexibleContexts     , FlexibleInstances+    , ScopedTypeVariables     , StandaloneDeriving     , TypeApplications     , TypeSynonymInstances@@ -681,6 +686,7 @@     , TupleSections     , LambdaCase     , BangPatterns+    , ViewPatterns   if flag(optimize)     default-extensions:       ApplicativeDo

@@ -1,29 +1,24 @@-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE RecordWildCards #-}+{-# language MultiWayIf #-}+{-# language TypeFamilies #-}+{-# language RecordWildCards #-}  module Main ( main ) where -import           Nix.Utils+import           Relude                        as Prelude ( force ) import           Control.Comonad                ( extract )-import qualified Control.DeepSeq               as Deep-import qualified Control.Exception             as Exc+import qualified Control.Exception             as Exception import           GHC.Err                        ( errorWithoutStackTrace ) import           Control.Monad.Free import           Control.Monad.Ref              ( MonadRef(readRef) ) import           Control.Monad.Catch-import           System.IO                      ( hPutStrLn, getContents )+import           System.IO                      ( hPutStrLn ) import qualified Data.HashMap.Lazy             as M import qualified Data.Map                      as Map-import           Data.Maybe                     ( fromJust )-import qualified Data.String                   as String import           Data.Time import qualified Data.Text.IO                  as Text-import           Nix+import           Text.Show.Pretty               ( ppShow )+import           Nix                     hiding ( force ) import           Nix.Convert-import qualified Nix.Eval                      as Eval import           Nix.Fresh.Basic import           Nix.Json import           Nix.Options.Parser@@ -35,11 +30,9 @@ import           Nix.Value.Monad import           Options.Applicative     hiding ( ParserResult(..) ) import           Prettyprinter           hiding ( list )-import           Prettyprinter.Render.Text+import           Prettyprinter.Render.Text      ( renderIO ) import qualified Repl-import           System.FilePath-import qualified Text.Show.Pretty              as PS-import           Nix.Utils.Fix1                 ( Fix1T )+import           Nix.Eval  main :: IO () main =@@ -50,45 +43,66 @@     main' opts  main' :: Options -> IO ()-main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl+main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl  where+  --  2021-07-15: NOTE: This logic should be weaved stronger through CLI options logic (OptParse-Applicative code)+  -- As this logic is not stated in the CLI documentation, for example. So user has no knowledge of these.+  execContentsFilesOrRepl :: StandardT (StdIdT IO) ()   execContentsFilesOrRepl =-    firstJust-      -- The `--read` option: load expression from a serialized file.-      [ readFrom <&> \path -> do-          let file = addExtension (dropExtension path) "nixc"-          process (Just file) =<< liftIO (readCache path)+    fromMaybe+      loadFromCliFilePathList+      ( loadBinaryCacheFile <|>+        loadLiteralExpression <|>+        loadExpressionFromFile+      )+   where+    -- | The base case: read expressions from the last CLI directive (@[FILE]@) listed on the command line.+    loadFromCliFilePathList =+      case filePaths of+        []     -> runRepl+        ["-"]  -> readExpressionFromStdin+        _paths -> processSeveralFiles (coerce _paths)+     where+      -- | Fall back to running the REPL+      runRepl = withEmptyNixContext Repl.main -      -- The `--expr` option: read expression from the argument string-      , expression <&> processText+      readExpressionFromStdin =+        do+          expr <- liftIO Text.getContents+          processExpr expr -      -- The `--file` argument: read expressions from the files listed in the argument file-      , fromFile <&> \x ->-          -- We can start use Text as in the base case, requires changing FilePath -> Text-          traverse_ processFile . String.lines =<< liftIO-            (case x of-              "-" -> getContents-              fp -> readFile fp-            )-      ]-    `orElse`-      -- The base case: read expressions from the files listed on the command line-      case filePaths of-        -- With no files, fall back to running the REPL-        [] -> withNixContext mempty Repl.main-        ["-"] -> processText =<< liftIO Text.getContents-        _paths -> traverse_ processFile _paths+    processSeveralFiles :: [Path] -> StandardT (StdIdT IO) ()+    processSeveralFiles = traverse_ processFile+     where+      processFile path = handleResult (pure path) =<< parseNixFileLoc path -  firstJust :: [Maybe a] -> Maybe a-  firstJust = asum+    -- |  The `--read` option: load expression from a serialized file.+    loadBinaryCacheFile =+      (\ (binaryCacheFile :: Path) ->+        do+          let file = replaceExtension binaryCacheFile "nixc"+          processCLIOptions (Just file) =<< liftIO (readCache binaryCacheFile)+      ) <$> readFrom -  orElse :: Maybe a -> a -> a-  orElse = flip fromMaybe+    -- | The `--expr` option: read expression from the argument string+    loadLiteralExpression = processExpr <$> expression -  processText text = handleResult Nothing     $   parseNixTextLoc text+    -- | The `--file` argument: read expressions from the files listed in the argument file+    loadExpressionFromFile =+      -- We can start use Text as in the base case, requires changing Path -> Text+      -- But that is a gradual process:+      -- https://github.com/haskell-nix/hnix/issues/912+      (processSeveralFiles . (coerce . toString <$>) . lines <=< liftIO) .+        (\case+          "-" -> Text.getContents+          _fp -> readFile _fp+        ) <$> fromFile -  processFile path = handleResult (Just path) =<< parseNixFileLoc path+  processExpr text = handleResult Nothing     $   parseNixTextLoc text +  withEmptyNixContext = withNixContext mempty++  --  2021-07-15: NOTE: @handleResult@ & @process@ - have atrocious size & compexity, they need to be decomposed & refactored.   handleResult mpath =     either       (\ err ->@@ -103,18 +117,18 @@         do           when check $             do-              expr' <- liftIO (reduceExpr mpath expr)+              expr' <- liftIO $ reduceExpr mpath expr               either-                (\ err -> errorWithoutStackTrace $ "Type error: " <> PS.ppShow err)-                (\ ty  -> liftIO $ putStrLn $ "Type of expression: " <> PS.ppShow-                  (fromJust $ Map.lookup "it" (coerce ty :: Map Text [Scheme]))+                (\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err)+                (\ ty  -> liftIO $ putStrLn $ "Type of expression: " <>+                  ppShow (maybeToMonoid $ Map.lookup @VarName @[Scheme] "it" $ coerce ty)                 )-                (HM.inferTop mempty [("it", stripAnnotation expr')])+                (HM.inferTop mempty (one ("it", stripAnnotation expr')))                  -- liftIO $ putStrLn $ runST $                 --     runLintM opts . renderSymbolic =<< lint opts expr -          catch (process mpath expr) $+          catch (processCLIOptions mpath expr) $             \case               NixException frames ->                 errorWithoutStackTrace . show =<<@@ -124,30 +138,32 @@                     frames            when repl $-            withNixContext mempty $+            withEmptyNixContext $               bool                 Repl.main                 (do-                  val <- Nix.nixEvalExprLoc mpath expr+                  val <- nixEvalExprLoc (coerce mpath) expr                   Repl.main' $ pure val                 )                 evaluate       ) -  process mpath expr+  --  2021-07-15: NOTE: Logic of CLI Option processing is scattered over several functions, needs to be consolicated.+  processCLIOptions :: Maybe Path -> NExprLoc -> StandardT (StdIdT IO) ()+  processCLIOptions mpath expr     | evaluate =       if-        | tracing                       -> evaluateExpression mpath Nix.nixTracingEvalExprLoc printer expr-        | Just path <- reduce           -> evaluateExpression mpath (reduction path) printer expr-        | not (null arg && null argstr) -> evaluateExpression mpath Nix.nixEvalExprLoc printer expr-        | otherwise                     -> processResult printer =<< Nix.nixEvalExprLoc mpath expr-    | xml                        =  fail "Rendering expression trees to XML is not yet implemented"-    | json                       =  fail "Rendering expression trees to JSON is not implemented"-    | verbose >= DebugInfo       =  liftIO $ putStr $ PS.ppShow $ stripAnnotation expr-    | cache , Just path <- mpath =  liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr-    | parseOnly                  =  void $ liftIO $ Exc.evaluate $ Deep.force expr+        | tracing                       -> evaluateExprWithEvaluator nixTracingEvalExprLoc expr+        | Just path <- reduce           -> evaluateExprWithEvaluator (reduction path . coerce) expr+        | null arg || null argstr       -> evaluateExprWithEvaluator nixEvalExprLoc expr+        | otherwise                     -> processResult printer <=< nixEvalExprLoc (coerce mpath) $ expr+    | xml                        = fail "Rendering expression trees to XML is not yet implemented"+    | json                       = fail "Rendering expression trees to JSON is not implemented"+    | verbose >= DebugInfo       =  liftIO . putStr . ppShow . stripAnnotation $ expr+    | cache , Just path <- mpath =  liftIO . writeCache (replaceExtension path "nixc") $ expr+    | parseOnly                  =  void . liftIO . Exception.evaluate . force $ expr     | otherwise                  =-      liftIO $+      liftIO .         renderIO           stdout           . layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)@@ -155,19 +171,31 @@           . stripAnnotation           $ expr    where+    evaluateExprWithEvaluator evaluator = evaluateExpression (coerce mpath) evaluator printer+     printer       | finder    = findAttrs <=< fromValue @(AttrSet (StdValue (StandardT (StdIdT IO))))-      | xml       = liftIO . Text.putStrLn . stringIgnoreContext . toXML <=< normalForm-      -- 2021-05-27: NOTE: With naive fix of the #941-      -- This is overall a naive printer implementation, as options should interact/respect one another.-      -- A nice question: "Should respect one another to what degree?": Go full combinator way, for which-      -- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),-      -- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.-      | json      = liftIO . Text.putStrLn . stringIgnoreContext         <=< nvalueToJSONNixString <=< normalForm-      | strict    = liftIO . print         . prettyNValue                <=< normalForm-      | values    = liftIO . print         . prettyNValueProv            <=< removeEffects-      | otherwise = liftIO . print         . prettyNValue                <=< removeEffects+      | otherwise = printer'      where+      printer'+        | xml       = go (stringIgnoreContext . toXML)                     normalForm+        -- 2021-05-27: NOTE: With naive fix of the #941+        -- This is overall a naive printer implementation, as options should interact/respect one another.+        -- A nice question: "Should respect one another to what degree?": Go full combinator way, for which+        -- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),+        -- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.+        | json      = go (stringIgnoreContext . mempty . nvalueToJSONNixString) normalForm+        | strict    = go (show . prettyNValue)                             normalForm+        | values    = go (show . prettyNValueProv)                         removeEffects+        | otherwise = go (show . prettyNValue)                             removeEffects+       where+        go+          :: (b -> Text)+          -> (a -> StandardT (StdIdT IO) b)+          -> a+          -> StandardT (StdIdT IO) ()+        go g f = liftIO . Text.putStrLn . g <=< f+       findAttrs         :: AttrSet (StdValue (StandardT (StdIdT IO)))         -> StandardT (StdIdT IO) ()@@ -200,7 +228,7 @@                     (pure . pure . Free)                     nv                 )-                (sortWith fst $ M.toList s)+                (sortWith fst $ M.toList $ M.mapKeys coerce s)             traverse_               (\ (k, mv) ->                 do@@ -212,10 +240,10 @@                       liftIO $ Text.putStrLn path                       when descend $                         maybe-                          pass+                          stub                           (\case-                            NVSet s' _ -> go (path <> ".") s'-                            _          -> pass+                            NVSet _ s' -> go (path <> ".") s'+                            _          -> stub                           )                           mv               )@@ -239,10 +267,10 @@             _                              -> (True , True )            forceEntry-            :: MonadValue a (Fix1T StandardTF (StdIdT IO))+            :: MonadValue a (StandardT (StdIdT IO))             => Text             -> a-            -> Fix1T StandardTF (StdIdT IO) (Maybe a)+            -> StandardT (StdIdT IO) (Maybe a)           forceEntry k v =             catch               (pure <$> demand v)@@ -259,24 +287,24 @@                   pure Nothing               ) -  reduction path mp x =+  reduction path mpathToContext annExpr =     do       eres <--        Nix.withNixContext-          mp-          (Nix.reducingEvalExpr-            Eval.evalContent-            mp-            x+        withNixContext+          mpathToContext+          (reducingEvalExpr+            evalContent+            mpathToContext+            annExpr           )       handleReduced path eres    handleReduced     :: (MonadThrow m, MonadIO m)-    => FilePath+    => Path     -> (NExprLoc, Either SomeException (NValue t f m))     -> m (NValue t f m)-  handleReduced path (expr', eres) =+  handleReduced (coerce -> path) (expr', eres) =     do       liftIO $         do

@@ -7,22 +7,19 @@    directory for more details. -} -{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# language MultiWayIf #-}  module Repl   ( main   , main'   ) where -import           Nix                     hiding ( exec-                                                , try-                                                )+import           Prelude                 hiding ( state )+import           Nix                     hiding ( exec ) import           Nix.Scope-import           Nix.Utils import           Nix.Value.Monad                ( demand ) -import qualified Data.HashMap.Lazy+import qualified Data.HashMap.Lazy           as M import           Data.Char                      ( isSpace ) import           Data.List                      ( dropWhileEnd ) import qualified Data.Text                   as Text@@ -71,7 +68,7 @@     evalStateT       (evalRepl         banner-        (cmd . toText)+        (cmd . fromString)         options         (pure commandPrefix)         (pure "paste")@@ -99,28 +96,28 @@    rcFile =     do-      f <- liftIO $ Text.readFile ".hnixrc" `catch` handleMissing+      f <- liftIO $ readFile ".hnixrc" `catch` handleMissing        traverse_         (\case           (prefixedCommand : xs) | Text.head prefixedCommand == commandPrefix ->             do               let-                arguments = Text.unwords xs+                arguments = unwords xs                 command = Text.tail prefixedCommand               optMatcher command options arguments-          x -> cmd $ Text.unwords x+          x -> cmd $ unwords x         )-        (Text.words <$> lines f)+        (words <$> lines f)    handleMissing e-    | Error.isDoesNotExistError e = pure ""-    | otherwise = throwIO e+    | Error.isDoesNotExistError e = pure mempty+    | otherwise = throwM e    -- Replicated and slightly adjusted `optMatcher` from `System.Console.Repline`   -- which doesn't export it.-  -- * @MonadIO m@ instead of @MonadHaskeline m@-  -- * @putStrLn@ instead of @outputStrLn@+  --  * @MonadIO m@ instead of @MonadHaskeline m@+  --  * @putStrLn@ instead of @outputStrLn@   optMatcher :: MonadIO m              => Text              -> Console.Options m@@ -128,16 +125,16 @@              -> m ()   optMatcher s [] _ = liftIO $ Text.putStrLn $ "No such command :" <> s   optMatcher s ((x, m) : xs) args-    | s `Text.isPrefixOf` toText x = m $ toString args+    | s `Text.isPrefixOf` fromString x = m $ toString args     | otherwise = optMatcher s xs args   -- * Types  data IState t f m = IState-  { replIt  :: Maybe NExprLoc          -- ^ Last expression entered-  , replCtx :: AttrSet (NValue t f m)  -- ^ Value environment-  , replCfg :: ReplConfig              -- ^ REPL configuration+  { replIt  :: Maybe NExprLoc        -- ^ Last expression entered+  , replCtx :: Scope (NValue t f m)  -- ^ Scope. Value environment.+  , replCfg :: ReplConfig            -- ^ REPL configuration   } deriving (Eq, Show)  data ReplConfig = ReplConfig@@ -159,14 +156,17 @@    builtins <- evalText "builtins" -  opts :: Nix.Options <- asks (view hasLens)+  let+    scope = coerce $+      M.fromList $+      ("builtins", builtins) : fmap ("input",) (maybeToList mIni) +  opts :: Nix.Options <- asks $ view hasLens+   pure $     IState       Nothing-      (Data.HashMap.Lazy.fromList $-        ("builtins", builtins) : fmap ("input",) (maybeToList mIni)-      )+      scope       defReplConfig         { cfgStrict = strict opts         , cfgValues = values opts@@ -192,9 +192,9 @@   -> Repl e t f m (Maybe (NValue t f m)) exec update source = do   -- Get the current interpreter state-  st <- get+  state <- get -  when (cfgDebug $ replCfg st) $ liftIO $ print st+  when (cfgDebug $ replCfg state) $ liftIO $ print state    -- Parser ( returns AST as `NExprLoc` )   case parseExprOrBinding source of@@ -211,7 +211,7 @@       -- let tyctx' = inferTop mempty [("repl", stripAnnotation expr)]       -- liftIO $ print tyctx' -      mVal <- lift $ lift $ try $ pushScope (replCtx st) (evalExprLoc expr)+      mVal <- lift $ lift $ try $ pushScope (replCtx state) (evalExprLoc expr)        either         (\ (NixException frames) -> do@@ -221,12 +221,12 @@           -- Update the interpreter state           when (update && isBinding) $ do             -- Set `replIt` to last entered expression-            put st { replIt = pure expr }+            put state { replIt = pure expr }              -- If the result value is a set, update our context with it             case val of-              NVSet xs _ -> put st { replCtx = xs <> replCtx st }-              _          -> pass+              NVSet _ (coerce -> scope) -> put state { replCtx = scope <> replCtx state }+              _          -> stub            pure $ pure val         )@@ -248,7 +248,7 @@         (parseNixTextLoc i)      toAttrSet i =-      "{" <> i <> bool ";" mempty (Text.isSuffixOf ";" i) <> "}"+      "{" <> i <> whenFalse ";" (Text.isSuffixOf ";" i) <> "}"  cmd   :: (MonadNix e t f m, MonadIO m)@@ -258,7 +258,7 @@   do     mVal <- exec True source     maybe-      pass+      stub       printValue       mVal @@ -267,11 +267,15 @@            -> Repl e t f m () printValue val = do   cfg <- replCfg <$> get+  let+    g :: MonadIO m => Doc ann0 -> m ()+    g = liftIO . print+   lift $ lift $     (if-      | cfgStrict cfg -> liftIO . print . prettyNValue     <=< normalForm-      | cfgValues cfg -> liftIO . print . prettyNValueProv <=< removeEffects-      | otherwise     -> liftIO . print . prettyNValue     <=< removeEffects+      | cfgStrict cfg -> g . prettyNValue     <=< normalForm+      | cfgValues cfg -> g . prettyNValueProv <=< removeEffects+      | otherwise     -> g . prettyNValue     <=< removeEffects     ) val  @@ -281,26 +285,31 @@ browse :: (MonadNix e t f m, MonadIO m)        => Text        -> Repl e t f m ()-browse _ = do-  st <- get-  for_ (Data.HashMap.Lazy.toList $ replCtx st) $ \(k, v) -> do-    liftIO $ Text.putStr $ k <> " = "-    printValue v+browse _ =+  do+    state <- get+    traverse_+      (\(k, v) ->+        do+          liftIO $ Text.putStr $ coerce k <> " = "+          printValue v+      )+      (M.toList $ coerce $ replCtx state)  -- | @:load@ command load   :: (MonadNix e t f m, MonadIO m)   -- This one does I String -> O String pretty fast, it is ugly to double marshall here.-  => String+  => Path   -> Repl e t f m ()-load args =+load path =   do-    contents <- liftIO $-      Text.readFile $-       trim args+    contents <- liftIO $ readFile $+       trim path     void $ exec True contents  where-  trim = dropWhileEnd isSpace . dropWhile isSpace+  trim :: Path -> Path+  trim = coerce . dropWhileEnd isSpace . dropWhile isSpace . coerce  -- | @:type@ command typeof@@ -308,12 +317,12 @@   => Text   -> Repl e t f m () typeof args = do-  st <- get+  state <- get   mVal <-     maybe       (exec False line)       (pure . pure)-      (Data.HashMap.Lazy.lookup line (replCtx st))+      (M.lookup (coerce line) (coerce $ replCtx state))    traverse_ printValueType mVal @@ -332,12 +341,14 @@ -- | @:set@ command setConfig :: (MonadNix e t f m, MonadIO m) => Text -> Repl e t f m () setConfig args =-  case Text.words args of-    []       -> liftIO $ Text.putStrLn "No option to set specified"-    (x:_xs)  ->+  list+    (liftIO $ Text.putStrLn "No option to set specified")+    (\ (x:_xs)  ->       case filter ((==x) . helpSetOptionName) helpSetOptions of         [opt] -> modify (\s -> s { replCfg = helpSetOptionFunction opt (replCfg s) })         _     -> liftIO $ Text.putStrLn "No such option"+    )+    $ words args   -- * Interactive Shell@@ -345,8 +356,7 @@ -- | Prefix tab completer defaultMatcher :: MonadIO m => [(String, CompletionFunc m)] defaultMatcher =-  [ (":load", Console.fileCompleter)-  ]+  one (":load", Console.fileCompleter)  completion   :: (MonadNix e t f m, MonadIO m)@@ -381,9 +391,9 @@     listFiles word    -- Attributes of sets in REPL context-  | var : subFields <- Text.split (== '.') (toText word) , not $ null subFields =+  | var : subFields <- Text.split (== '.') (fromString word) , not $ null subFields =     do-      s <- get+      state <- get       maybe         stub         (\ binding ->@@ -396,18 +406,24 @@                     candidates                   )         )-        (Data.HashMap.Lazy.lookup var (replCtx s))+        (M.lookup (coerce var) $ coerce $ replCtx state)    -- Builtins, context variables   | otherwise =     do-      s <- get-      let contextKeys = Data.HashMap.Lazy.keys (replCtx s)-          (Just (NVSet builtins _)) = Data.HashMap.Lazy.lookup "builtins" (replCtx s)-          shortBuiltins = Data.HashMap.Lazy.keys builtins+      state <- get+      let+          scopeHashMap :: HashMap VarName (NValue t f m)+          scopeHashMap = coerce $ replCtx state+          contextKeys :: [VarName]+          contextKeys = M.keys scopeHashMap+          builtins :: AttrSet (NValue t f m)+          (Just (NVSet _ builtins)) = M.lookup "builtins" scopeHashMap+          shortBuiltins :: [VarName]+          shortBuiltins = M.keys builtins        pure $ listCompletion $ toString <$>-        ["__includes"]+        one "__includes"           <> contextKeys           <> shortBuiltins @@ -423,7 +439,7 @@       -> m [Text]     algebraicComplete subFields val =       let-        keys = fmap ("." <>) . Data.HashMap.Lazy.keys+        keys = fmap ("." <>) . M.keys          withMap m =           case subFields of@@ -437,10 +453,10 @@                    (("." <> f) <>)                    . algebraicComplete fs <=< demand                 )-                (Data.HashMap.Lazy.lookup f m)+                (M.lookup (coerce f) m)       in       case val of-        NVSet xs _ -> withMap xs+        NVSet _ xs -> withMap (M.mapKeys coerce xs)         _          -> stub  -- | HelpOption inspired by Dhall Repl@@ -458,44 +474,44 @@ helpOptions =   [ HelpOption       "help"-      ""+      mempty       "Print help text"-      (help helpOptions . toText)+      (help helpOptions . fromString)   , HelpOption       "paste"-      ""+      mempty       "Enter multi-line mode"       (error "Unreachable")   , HelpOption       "load"       "FILENAME"       "Load .nix file into scope"-      load+      (load . fromString)   , HelpOption       "browse"-      ""+      mempty       "Browse bindings in interpreter context"-      (browse . toText)+      (browse . fromString)   , HelpOption       "type"       "EXPRESSION"       "Evaluate expression or binding from context and print the type of the result value"-      (typeof . toText)+      (typeof . fromString)   , HelpOption       "quit"-      ""+      mempty       "Quit interpreter"       quit   , HelpOption       "set"-      ""+      mempty       ("Set REPL option"         <> Prettyprinter.line         <> "Available options:"         <> Prettyprinter.line         <> renderSetOptions helpSetOptions       )-      (setConfig . toText)+      (setConfig . fromString)   ]  -- | Options for :set@@ -510,32 +526,32 @@ helpSetOptions =   [ HelpSetOption       "strict"-      ""+      mempty       "Enable strict evaluation of REPL expressions"       (\x -> x { cfgStrict = True})   , HelpSetOption       "lazy"-      ""+      mempty       "Disable strict evaluation of REPL expressions"       (\x -> x { cfgStrict = False})   , HelpSetOption       "values"-      ""+      mempty       "Enable printing of value provenance information"       (\x -> x { cfgValues = True})   , HelpSetOption       "novalues"-      ""+      mempty       "Disable printing of value provenance information"       (\x -> x { cfgValues = False})   , HelpSetOption       "debug"-      ""+      mempty       "Enable printing of REPL debug information"       (\x -> x { cfgDebug = True})   , HelpSetOption       "nodebug"-      ""+      mempty       "Disable REPL debugging"       (\x -> x { cfgDebug = False})   ]

@@ -1,10 +1,10 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}  module Nix   ( module Nix.Cache   , module Nix.Exec-  , module Nix.Expr+  , module Nix.Expr.Types+  , module Nix.Expr.Shorthands+  , module Nix.Expr.Types.Annotated   , module Nix.Frames   , module Nix.Render.Frame   , module Nix.Normal@@ -35,7 +35,9 @@ import           Nix.Cache import qualified Nix.Eval                      as Eval import           Nix.Exec-import           Nix.Expr+import           Nix.Expr.Types+import           Nix.Expr.Shorthands+import           Nix.Expr.Types.Annotated import           Nix.Frames import           Nix.String import           Nix.Normal@@ -45,7 +47,6 @@ import           Nix.Reduce import           Nix.Render.Frame import           Nix.Thunk-import           Nix.Utils import           Nix.Value import           Nix.Value.Monad import           Nix.XML@@ -57,7 +58,7 @@   :: (MonadNix e t f m, Has e Options, Functor g)   => Transform g (m a)   -> Alg g (m a)-  -> Maybe FilePath+  -> Maybe Path   -> Fix g   -> m a nixEval transform alg mpath = withNixContext mpath . adi transform alg@@ -65,7 +66,7 @@ -- | Evaluate a nix expression in the default context nixEvalExpr   :: (MonadNix e t f m, Has e Options)-  => Maybe FilePath+  => Maybe Path   -> NExpr   -> m (NValue t f m) nixEvalExpr = nixEval id Eval.eval@@ -74,7 +75,7 @@ nixEvalExprLoc   :: forall e t f m    . (MonadNix e t f m, Has e Options)-  => Maybe FilePath+  => Maybe Path   -> NExprLoc   -> m (NValue t f m) nixEvalExprLoc =@@ -89,22 +90,22 @@ --   context. nixTracingEvalExprLoc   :: (MonadNix e t f m, Has e Options, MonadIO m, Alternative m)-  => Maybe FilePath+  => Maybe Path   -> NExprLoc   -> m (NValue t f m) nixTracingEvalExprLoc mpath = withNixContext mpath . evalExprLoc  evaluateExpression   :: (MonadNix e t f m, Has e Options)-  => Maybe FilePath-  -> (Maybe FilePath -> NExprLoc -> m (NValue t f m))+  => Maybe Path+  -> (Maybe Path -> NExprLoc -> m (NValue t f m))   -> (NValue t f m -> m a)   -> NExprLoc   -> m a evaluateExpression mpath evaluator handler expr =   do     opts :: Options <- asks $ view hasLens-    args <-+    (coerce -> args) <-       (traverse . traverse)         eval'         $  (second parseArg <$> arg    opts)@@ -137,23 +138,23 @@   opts :: Options <- asks $ view hasLens   maybe     (h val)-    (\ (Text.splitOn "." -> keys) -> processKeys keys val)+    (\ (coerce . Text.splitOn "." -> keys) -> processKeys keys val)     (attr opts)  where-  processKeys :: [Text] -> NValue t f m -> m a+  processKeys :: [VarName] -> NValue t f m -> m a   processKeys kys v =     list       (h v)-      (\ (k : ks) ->+      (\ ((k : ks) :: [VarName]) ->         do           v' <- demand v           case (k, v') of-            (Text.decimal -> Right (n,""), NVList xs) -> processKeys ks $ xs !! n-            (_,         NVSet xs _) ->+            (Text.decimal . coerce -> Right (n,""), NVList xs) -> processKeys ks $ xs !! n+            (_,         NVSet _ xs) ->               maybe-                (errorWithoutStackTrace $ toString $ "Set does not contain key '" <> k <> "'")+                (errorWithoutStackTrace $ "Set does not contain key ''" <> show k <> "''.")                 (processKeys ks)                 (M.lookup k xs)-            (_, _) -> errorWithoutStackTrace $ toString $ "Expected a set or list for selector '" <> k <> "', but got: " <> show v+            (_, _) -> errorWithoutStackTrace $ "Expected a set or list for selector '" <> show k <> "', but got: " <> show v       )       kys

@@ -1,5 +1,5 @@-{-# LANGUAGE CPP            #-}-{-# LANGUAGE DeriveAnyClass #-}+{-# language CPP            #-}+{-# language DeriveAnyClass #-}  module Nix.Atoms where @@ -11,6 +11,7 @@ import           Data.Aeson.Types               ( FromJSON                                                 , ToJSON                                                 )+--  2021-08-01: NOTE: Check the order efficience of NAtom constructors.  -- | Atoms are values that evaluate to themselves. -- In other words - this is a constructors that are literals in Nix.

@@ -1,20 +1,17 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MonoLocalBinds #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE PartialTypeSignatures #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@+{-# language CPP #-}+{-# language AllowAmbiguousTypes #-}+{-# language ConstraintKinds #-}+{-# language FunctionalDependencies #-}+{-# language KindSignatures #-}+{-# language MonoLocalBinds #-}+{-# language MultiWayIf #-}+{-# language PartialTypeSignatures #-}+{-# language QuasiQuotes #-}+{-# language TemplateHaskell #-}+{-# language UndecidableInstances #-}+{-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@ -{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# options_ghc -fno-warn-name-shadowing #-}  -- | Code that implements Nix builtins. Lists the functions that are built into the Nix expression evaluator. Some built-ins (aka `derivation`), are always in the scope, so they can be accessed by the name. To keap the namespace clean, most built-ins are inside the `builtins` scope - a set that contains all what is a built-in. module Nix.Builtins@@ -24,8 +21,7 @@ where  -import           Prelude                 hiding ( traceM )-import           Nix.Utils+import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import           Control.Comonad                ( Comonad ) import           Control.Monad                  ( foldM ) import           Control.Monad.Catch            ( MonadCatch(catch) )@@ -53,9 +49,9 @@ import           Data.Scientific import qualified Data.Set                      as S import qualified Data.Text                     as Text-import qualified Data.Text.Lazy                as LazyText+import           Data.Text.Read                 ( decimal ) import qualified Data.Text.Lazy.Builder        as Builder-import           Data.These                     ( fromThese )+import           Data.These                     ( fromThese, These ) import qualified Data.Time.Clock.POSIX         as Time import qualified Data.Vector                   as V import           NeatInterpolation              ( text )@@ -65,7 +61,6 @@ import           Nix.Effects.Basic              ( fetchTarball ) import           Nix.Exec import           Nix.Expr.Types-import           Nix.Expr.Types.Annotated import qualified Nix.Eval                      as Eval import           Nix.Frames import           Nix.Json@@ -81,11 +76,11 @@ import           Nix.Value.Monad import           Nix.XML import           System.Nix.Base32             as Base32-import           System.FilePath-import           System.Posix.Files             ( isRegularFile+import           System.PosixCompat.Files       ( isRegularFile                                                 , isDirectory                                                 , isSymbolicLink                                                 )+import qualified Text.Show import           Text.Regex.TDFA                ( Regex                                                 , makeRegex                                                 , matchOnceText@@ -101,13 +96,13 @@  -- ** Nix Builtins Haskell type level -newtype Prim m a = Prim { runPrim :: m a }+newtype Prim m a = Prim (m a)  data BuiltinType = Normal | TopLevel data Builtin v =   Builtin     { _kind   :: BuiltinType-    , mapping :: (Text, v)+    , mapping :: (VarName, v)     }  -- *** @class ToBuiltin@ and its instances@@ -121,7 +116,7 @@   , ToValue a m (NValue t f m)   )   => ToBuiltin t f m (Prim m a) where-  toBuiltin _ p = toValue =<< runPrim p+  toBuiltin _ p = toValue @a @m =<< coerce p  instance   ( MonadNix e t f m@@ -130,7 +125,7 @@   )   => ToBuiltin t f m (a -> b) where   toBuiltin name f =-    pure $ nvBuiltin name $ toBuiltin name . f <=< fromValue . Deeper+    pure $ nvBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper  -- *** @WValue@ closure wrapper to have @Ord@ @@ -174,11 +169,28 @@   -> NValue t f m mkNVBool = nvConstant . NBool +data NixPathEntryType+  = PathEntryPath+  | PathEntryURI+ deriving (Show, Eq)++-- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon+-- (i.e. @https://...@)+uriAwareSplit :: Text -> [(Text, NixPathEntryType)]+uriAwareSplit txt =+  case Text.break (== ':') txt of+    (e1, e2)+      | Text.null e2                              -> one (e1, PathEntryPath)+      | "://" `Text.isPrefixOf` e2      ->+        let ((suffix, _) : path) = uriAwareSplit (Text.drop 3 e2) in+        (e1 <> "://" <> suffix, PathEntryURI) : path+      | otherwise                                 -> (e1, PathEntryPath) : uriAwareSplit (Text.drop 1 e2)+ foldNixPath   :: forall e t f m r    . MonadNix e t f m   => r-  -> (FilePath -> Maybe Text -> NixPathEntryType -> r -> m r)+  -> (Path -> Maybe Text -> NixPathEntryType -> r -> m r)   -> m r foldNixPath z f =   do@@ -193,36 +205,36 @@     dataDir  <-       maybe         getDataDir-        (pure . toString)+        (pure . coerce . toString)         mDataDir      foldrM       go       z       $ (fromInclude . stringIgnoreContext <$> dirs)-        <> maybe-            mempty-            uriAwareSplit-            mPath-        <> [ fromInclude $ "nix=" <> toText dataDir <> "/nix/corepkgs" ]+        <> uriAwareSplit `whenJust` mPath+        <> one (fromInclude $ "nix=" <> fromString (coerce dataDir) <> "/nix/corepkgs")  where -  fromInclude x = (x, ) $-    bool-      PathEntryPath-      PathEntryURI-      ("://" `Text.isInfixOf` x)+  fromInclude :: Text -> (Text, NixPathEntryType)+  fromInclude x =+    (x, ) $+      bool+        PathEntryPath+        PathEntryURI+        ("://" `Text.isInfixOf` x) +  go :: (Text, NixPathEntryType) -> r -> m r   go (x, ty) rest =     case Text.splitOn "=" x of-      [p] -> f (toString p) mempty ty rest-      [n, p] -> f (toString p) (pure n) ty rest+      [p] -> f (coerce $ toString p) mempty ty rest+      [n, p] -> f (coerce $ toString p) (pure n) ty rest       _ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " <> show x -attrsetGet :: MonadNix e t f m => Text -> AttrSet (NValue t f m) -> m (NValue t f m)+attrsetGet :: MonadNix e t f m => VarName -> AttrSet (NValue t f m) -> m (NValue t f m) attrsetGet k s =   maybe-    (throwError $ ErrorCall $ "Attribute '" <> toString k <> "' required")+    (throwError $ ErrorCall $ toString @Text $ "Attribute '" <> coerce k <> "' required")     pure     (M.lookup k s) @@ -230,77 +242,82 @@   = VersionComponentPre -- ^ The string "pre"   | VersionComponentString !Text -- ^ A string other than "pre"   | VersionComponentNumber !Integer -- ^ A number-  deriving (Show, Read, Eq, Ord)--versionComponentToString :: VersionComponent -> Text-versionComponentToString =-  \case-    VersionComponentPre      -> "pre"-    VersionComponentString s -> s-    VersionComponentNumber n -> show n+  deriving (Read, Eq, Ord) --- | Based on https://github.com/NixOS/nix/blob/4ee4fda521137fed6af0446948b3877e0c5db803/src/libexpr/names.cc#L44-versionComponentSeparators :: String-versionComponentSeparators = ".-"+instance Show VersionComponent where+  show =+    \case+      VersionComponentPre      -> "pre"+      VersionComponentString s -> show s+      VersionComponentNumber n -> show n  splitVersion :: Text -> [VersionComponent] splitVersion s =-  case Text.uncons s of-    Nothing -> mempty-    Just (h, t)+ whenJust+   (\ (x, xs) -> if+      | isRight eDigitsPart ->+          either+            (\ e -> error $ "splitVersion: did hit impossible: '" <> toText e <> "' while parsing '" <> s <> "'.")+            (\ res ->+              one (VersionComponentNumber $ fst res)+              <> splitVersion (snd res)+            )+            eDigitsPart -      | h `elem` versionComponentSeparators -> splitVersion t+      | x `elem` separators -> splitVersion xs -      | isDigit h ->-        let (digits, rest) = Text.span isDigit s-        in-        VersionComponentNumber-            (fromMaybe (error $ "splitVersion: couldn't parse " <> show digits) $ readMaybe $ toString digits) : splitVersion rest+      | otherwise -> one charsPart <> splitVersion rest2+  )+  (Text.uncons s)+ where+  -- | Based on https://github.com/NixOS/nix/blob/4ee4fda521137fed6af0446948b3877e0c5db803/src/libexpr/names.cc#L44+  separators :: String+  separators = ".-" -      | otherwise ->-        let-          (chars, rest) =-            Text.span-              (\c -> not $ isDigit c || c `elem` versionComponentSeparators)-              s-          thisComponent =-            case chars of-              "pre" -> VersionComponentPre-              x     -> VersionComponentString x-        in-        thisComponent : splitVersion rest+  eDigitsPart :: Either String (Integer, Text)+  eDigitsPart = decimal @Integer $ s +  (charsSpan, rest2) =+    Text.span+      (\c -> not $ isDigit c || c `elem` separators)+      s++  charsPart :: VersionComponent+  charsPart =+    case charsSpan of+      "pre" -> VersionComponentPre+      xs'   -> VersionComponentString xs'++ compareVersions :: Text -> Text -> Ordering compareVersions s1 s2 =-  mconcat $-    alignWith-      f-      (splitVersion s1)-      (splitVersion s2)+  fold $ (alignWith cmp `on` splitVersion) s1 s2  where-  z = VersionComponentString ""-  f = uncurry compare . fromThese z z+  cmp :: These VersionComponent VersionComponent -> Ordering+  cmp = uncurry compare . join fromThese (VersionComponentString mempty)  splitDrvName :: Text -> (Text, Text) splitDrvName s =-  let-    sep    = "-"-    pieces = Text.splitOn sep s-    isFirstVersionPiece p =-      case Text.uncons p of-        Just (h, _) -> isDigit h-        _           -> False-    -- Like 'break', but always puts the first item into the first result-    -- list-    breakAfterFirstItem :: (a -> Bool) -> [a] -> ([a], [a])-    breakAfterFirstItem f =-      list-        (mempty, mempty)-        (\ (h : t) -> let (a, b) = break f t in (h : a, b))-    (namePieces, versionPieces) =-      breakAfterFirstItem isFirstVersionPiece pieces-  in-  (Text.intercalate sep namePieces, Text.intercalate sep versionPieces)+  both (Text.intercalate sep) (namePieces, versionPieces)+ where+  sep    = "-"+  pieces :: [Text]+  pieces = Text.splitOn sep s+  isFirstVersionPiece :: Text -> Bool+  isFirstVersionPiece p =+    maybe+      False+      (isDigit . fst)+      (Text.uncons p)+  -- Like 'break', but always puts the first item into the first result+  -- list+  breakAfterFirstItem :: (a -> Bool) -> [a] -> ([a], [a])+  breakAfterFirstItem f =+    list+      mempty+      (\ (h : t) -> let (a, b) = break f t in (h : a, b))+  (namePieces, versionPieces) =+    breakAfterFirstItem isFirstVersionPiece pieces  splitMatches   :: forall e t f m@@ -309,7 +326,7 @@   -> [[(ByteString, (Int, Int))]]   -> ByteString   -> [NValue t f m]-splitMatches _ [] haystack = [thunkStr haystack]+splitMatches _ [] haystack = one $ thunkStr haystack splitMatches _ ([] : _) _ =   fail "Fail in splitMatches: this should never happen!" splitMatches numDropped (((_, (start, len)) : captures) : mts) haystack =@@ -319,7 +336,9 @@  where   relStart       = max 0 start - numDropped   (before, rest) = B.splitAt relStart haystack+  caps :: NValue t f m   caps           = nvList (f <$> captures)+  f :: (ByteString, (Int, b)) -> NValue t f m   f (a, (s, _))  =     bool       nvNull@@ -334,23 +353,18 @@    . (MonadNix e t f m, FromValue a m (NValue t f m))   => NValue t f m   -> m (NValue t f m)-hasKind nv =-  do-    v <- fromValueMay nv--    toValue $-      case v of-        Just (_ :: a) -> True-        _             -> False+hasKind =+  inHaskMay+    (isJust @a)  -absolutePathFromValue :: MonadNix e t f m => NValue t f m -> m FilePath+absolutePathFromValue :: MonadNix e t f m => NValue t f m -> m Path absolutePathFromValue =   \case     NVStr ns ->       do         let-          path = toString $ stringIgnoreContext ns+          path = coerce . toString $ stringIgnoreContext ns          unless (isAbsolute path) $ throwError $ ErrorCall $ "string " <> show path <> " doesn't represent an absolute path"         pure path@@ -368,7 +382,7 @@  instance Convertible e t f m => ToValue FileType m (NValue t f m) where   toValue =-    toValue . makeNixStringWithoutContext .+    toValue . mkNixStringWithoutContext .       \case         FileTypeRegular   -> "regular" :: Text         FileTypeDirectory -> "directory"@@ -411,29 +425,26 @@     [|| expr ||]   ) -nixPathNix :: MonadNix e t f m => m (NValue t f m)+nixPathNix :: forall e t f m . MonadNix e t f m => m (NValue t f m) nixPathNix =   fmap     nvList-    (foldNixPath mempty $-      \p mn ty rest ->-        pure $-          pure-            (nvSet-              mempty-              (M.fromList-                [case ty of-                  PathEntryPath -> ("path", nvPath p)-                  PathEntryURI  -> ( "uri", mkNvStr p)+    $ foldNixPath mempty $+        \p mn ty rest ->+          pure $+            pure+              (nvSet+                mempty+                (M.fromList+                  [case ty of+                    PathEntryPath -> ("path", nvPath  p)+                    PathEntryURI  -> ( "uri", nvStrWithoutContext $ fromString $ coerce p) -                , ( "prefix", mkNvStr $ toString $ fromMaybe "" mn)-                ]+                  , ( "prefix", nvStrWithoutContext $ maybeToMonoid mn)+                  ]+                )               )-            )-          <> rest-    )- where-  mkNvStr = nvStrWithoutContext . toText+            <> rest  toStringNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) toStringNix = toValue <=< coerceToString callFunc DontCopyToStore CoerceAny@@ -446,13 +457,13 @@   -> m (NValue t f m) hasAttrNix x y =   do-    key <- fromStringNoContext =<< fromValue x-    (aset, _) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) y+    (coerce -> key) <- fromStringNoContext =<< fromValue x+    (aset, _) <- fromValue @(AttrSet (NValue t f m), PositionSet) y      toValue $ M.member key aset  hasContextNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-hasContextNix = toValue . stringHasContext <=< fromValue+hasContextNix = inHask stringHasContext  getAttrNix   :: forall e t f m@@ -462,8 +473,8 @@   -> m (NValue t f m) getAttrNix x y =   do-    key <- fromStringNoContext =<< fromValue x-    (aset, _) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) y+    (coerce -> key) <- fromStringNoContext =<< fromValue x+    (aset, _) <- fromValue @(AttrSet (NValue t f m), PositionSet) y      attrsetGet key aset @@ -479,18 +490,18 @@     y <- demand nvY      case (x, y) of-      (NVStr ns, NVSet _ apos) ->+      (NVStr ns, NVSet apos _) ->         maybe           (pure nvNull)           toValue-          (M.lookup (stringIgnoreContext ns) apos)+          (M.lookup @VarName (coerce $ stringIgnoreContext ns) apos)       _xy -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPosNix: " <> show _xy  -- This function is a bit special in that it doesn't care about the contents -- of the list. lengthNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)-lengthNix = toValue . (length :: [NValue t f m] -> Int) <=< fromValue+lengthNix = inHask (length :: [NValue t f m] -> Int)  addNix   :: MonadNix e t f m@@ -587,7 +598,7 @@ headNix =   maybe     (throwError $ ErrorCall "builtins.head: empty list")-    (pure)+    pure   . viaNonEmpty head <=< fromValue @[NValue t f m]  tailNix :: forall e t f m. MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -603,7 +614,7 @@     version <- fromStringNoContext =<< fromValue v     pure $       nvList $-        nvStrWithoutContext . versionComponentToString <$>+        nvStrWithoutContext . show <$>           splitVersion version  compareVersionsNix@@ -639,7 +650,7 @@      toValue @(AttrSet (NValue t f m)) $       M.fromList-        [ ( "name" :: Text+        [ ( "name" :: VarName           , mkNVStr name           )         , ( "version"@@ -671,7 +682,7 @@       mkMatch t =         bool           (toValue ()) -- Shorthand for Null-          (toValue $ makeNixStringWithoutContext t)+          (toValue $ mkNixStringWithoutContext t)           (not $ Text.null t)      case matchOnceText re s of@@ -682,8 +693,8 @@             traverse               mkMatch               (case submatches of-                 [] -> []-                 [a] -> [a]+                 [] -> mempty+                 [a] -> one a                  _:xs -> xs -- return only the matched groups, drop the full string               )       _ -> pure nvNull@@ -726,8 +737,10 @@ attrNamesNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) attrNamesNix =-  (fmap (coerce :: CoerceDeeperToNValue t f m) . toValue . fmap makeNixStringWithoutContext . sort . M.keys)-  <=< fromValue @(AttrSet (NValue t f m))+    coersion . inHask @(AttrSet (NValue t f m))+      (fmap (mkNixStringWithoutContext . coerce) . sort . M.keys)+ where+  coersion = fmap (coerce :: CoerceDeeperToNValue t f m)  attrValuesNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -737,7 +750,7 @@     toValue $       snd <$>         sortOn-          (fst @Text @(NValue t f m))+          (fst @VarName @(NValue t f m))           (M.toList attrs)  mapNix@@ -747,13 +760,13 @@   -> NValue t f m   -> m (NValue t f m) mapNix f =-  toValue <=<-    traverse-      (defer @(NValue t f m)+  inHaskM @[NValue t f m]+    (traverse+      (defer       . withFrame Debug (ErrorCall "While applying f in map:\n")       . callFunc f       )-      <=< fromValue @[NValue t f m]+    )  mapAttrsNix   :: forall e t f m@@ -770,7 +783,7 @@        applyFunToKeyVal (key, val) =         do-          runFunForKey <- callFunc f $ nvStrWithoutContext key+          runFunForKey <- callFunc f $ nvStrWithoutContext (coerce key)           callFunc runFunForKey val      newVals <-@@ -787,10 +800,11 @@   -> NValue t f m   -> m (NValue t f m) filterNix f =-  toValue <=<-    filterM-      (fromValue <=< callFunc f)-      <=< fromValue+  inHaskM+    (filterM fh)+ where+  fh :: NValue t f m -> m Bool+  fh = fromValue <=< callFunc f  catAttrsNix   :: forall e t f m@@ -805,7 +819,7 @@      nvList . catMaybes <$>       traverse-        (fmap (M.lookup n) . fromValue <=< demand)+        (fmap (M.lookup @VarName $ coerce n) . fromValue <=< demand)         l  baseNameOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -815,7 +829,7 @@     pure $       nvStr $         modifyNixContents-          (toText . takeFileName . toString)+          (fromString . coerce takeFileName . toString)           ns  bitAndNix@@ -829,7 +843,7 @@     a <- fromValue @Integer x     b <- fromValue @Integer y -    toValue (a .&. b)+    toValue $ a .&. b  bitOrNix   :: forall e t f m@@ -842,7 +856,7 @@     a <- fromValue @Integer x     b <- fromValue @Integer y -    toValue (a .|. b)+    toValue $ a .|. b  bitXorNix   :: forall e t f m@@ -855,7 +869,7 @@     a <- fromValue @Integer x     b <- fromValue @Integer y -    toValue (a `xor` b)+    toValue $ a `xor` b  builtinsBuiltinNix   :: forall e t f m@@ -869,16 +883,15 @@     dir <- demand nvdir      case dir of-      NVStr ns -> pure $ nvStr $ modifyNixContents (toText . takeDirectory . toString) ns+      NVStr ns -> pure $ nvStr $ modifyNixContents (fromString . coerce takeDirectory . toString) ns       NVPath path -> pure $ nvPath $ takeDirectory path       v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " <> show v  -- jww (2018-04-28): This should only be a string argument, and not coerced? unsafeDiscardStringContextNix   :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-unsafeDiscardStringContextNix mnv = do-  ns <- fromValue mnv-  toValue $ makeNixStringWithoutContext $ stringIgnoreContext ns+unsafeDiscardStringContextNix =+  inHask (mkNixStringWithoutContext . stringIgnoreContext)  -- | Evaluate `a` to WHNF to collect its topmost effect. seqNix@@ -902,15 +915,18 @@   => NValue t f m   -> NValue t f m   -> m (NValue t f m)-elemNix x = toValue <=< anyMNix (valueEqM x) <=< fromValue+elemNix x = inHaskM (anyMNix $ valueEqM x)  where   anyMNix :: Monad m => (a -> m Bool) -> [a] -> m Bool-  anyMNix _ []       = pure False-  anyMNix p (x : xs) =-    bool-      (anyMNix p xs)-      (pure True)-      =<< p x+  anyMNix p =+    list+      (pure False)+      (\ (x : xss) ->+        bool+          (anyMNix p xss)+          (pure True)+          =<< p x+      )  elemAtNix   :: MonadNix e t f m@@ -954,33 +970,32 @@       do         ss <- fromValue @[NValue t f m] =<< demand startSet         op <- demand operator+        let+          go+            :: Set (WValue t f m)+            -> [NValue t f m]+            -> m (Set (WValue t f m), [NValue t f m])+          go ks []       = pure (ks, mempty)+          go ks (t : ts) =+            do+              v <- demand t+              k <- demand =<< attrsetGet "key" =<< fromValue @(AttrSet (NValue t f m)) v -        toValue @[NValue t f m] =<< snd <$> go op mempty ss- where-  go-    :: NValue t f m-    -> Set (WValue t f m)-    -> [NValue t f m]-    -> m (Set (WValue t f m), [NValue t f m])-  go _  ks []       = pure (ks, mempty)-  go op ks (t : ts) =-    do-      v <- demand t-      k <- demand =<< attrsetGet "key" =<< fromValue @(AttrSet (NValue t f m)) v+              bool+                (do+                  checkComparable k $+                    list+                      k+                      (\ (WValue j:_) -> j)+                      (S.toList ks) -      bool-        (do-          ys <- fromValue @[NValue t f m] =<< callFunc op v-          checkComparable k-            (case S.toList ks of-              []           -> k-              WValue j : _ -> j-            )-          (t :) <<$>> go op (S.insert (WValue k) ks) (ts <> ys)-        )-        (go op ks ts)-        (S.member (WValue k) ks)+                  (<<$>>) (v :) . go (S.insert (WValue k) ks) . (<>) ts =<< fromValue @[NValue t f m] =<< callFunc op v+                )+                (go ks ts)+                (S.member (WValue k) ks) +        toValue @[NValue t f m] =<< snd <$> go mempty ss+ -- | Takes: -- 1. List of strings to match. -- 2. List of strings to replace corresponding match occurance. (arg 1 & 2 lists matched by index)@@ -1021,7 +1036,7 @@         maybePrefixMatch :: Maybe (Text, NixString, Text)         maybePrefixMatch = formMatchReplaceTailInfo <$> find ((`Text.isPrefixOf` input) . fst) fromKeysToValsMap          where-          formMatchReplaceTailInfo = (\(m, r) -> (m, r, Text.drop (Text.length m) input))+          formMatchReplaceTailInfo (m, r) = (m, r, Text.drop (Text.length m) input)            fromKeysToValsMap = zip (stringIgnoreContext <$> fromKeys) toVals @@ -1034,7 +1049,7 @@          --  2021-02-18: NOTE: rly?: toStrict . toLazyText         --  Maybe `text-builder`, `text-show`?-        finish ctx output = makeNixString (LazyText.toStrict $ Builder.toLazyText output) ctx+        finish ctx output = mkNixString (toStrict $ Builder.toLazyText output) ctx          replace (key, replacementNS, unprocessedInput) = replaceWithNixBug unprocessedInput updatedOutput @@ -1080,11 +1095,12 @@   -> m (NValue t f m) removeAttrsNix set v =   do-    (m, p) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set+    (m, p) <- fromValue @(AttrSet (NValue t f m), PositionSet) set     (nsToRemove :: [NixString]) <- fromValue $ Deeper v-    toRemove <- traverse fromStringNoContext nsToRemove+    (coerce -> toRemove) <- traverse fromStringNoContext nsToRemove     toValue (go m toRemove, go p toRemove)  where+  go :: forall k v . (Eq k, Hashable k) => HashMap k v -> [k] -> HashMap k v   go = foldl' (flip M.delete)  intersectAttrsNix@@ -1095,8 +1111,8 @@   -> m (NValue t f m) intersectAttrsNix set1 set2 =   do-    (s1, p1) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set1-    (s2, p2) <- fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set2+    (s1, p1) <- fromValue @(AttrSet (NValue t f m), PositionSet) set1+    (s2, p2) <- fromValue @(AttrSet (NValue t f m), PositionSet) set2      pure $ nvSet (p2 `M.intersection` p1) (s2 `M.intersection` s1) @@ -1110,7 +1126,7 @@         toValue @(AttrSet (NValue t f m)) $ mkNVBool <$>           case p of             Param name     -> one (name, False)-            ParamSet s _ _ -> isJust <$> M.fromList s+            ParamSet _ _ pset -> isJust <$> M.fromList pset       _v -> throwError $ ErrorCall $ "builtins.functionArgs: expected function, got " <> show _v  toFileNix@@ -1123,18 +1139,18 @@     name' <- fromStringNoContext =<< fromValue name     s'    <- fromValue s     mres  <--      (toFile_ `on` toString)-        name'+      toFile_+        (coerce $ toString name')         (stringIgnoreContext s')      let-      t  = toText $ unStorePath mres-      sc = StringContext t DirectPath+      storepath  = coerce (fromString @Text) mres+      sc = StringContext storepath DirectPath -    toValue $ makeNixStringWithSingletonContext t sc+    toValue $ mkNixStringWithSingletonContext storepath sc  toPathNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-toPathNix = toValue @Path <=< fromValue @Path+toPathNix = inHask @Path id  pathExistsNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) pathExistsNix nvpath =@@ -1143,7 +1159,7 @@     toValue =<<       case path of         NVPath p  -> doesPathExist p-        NVStr  ns -> doesPathExist $ toString $ stringIgnoreContext ns+        NVStr  ns -> doesPathExist $ coerce $ toString $ stringIgnoreContext ns         _v -> throwError $ ErrorCall $ "builtins.pathExists: expected path, got " <> show _v  isAttrsNix@@ -1258,8 +1274,8 @@   -> m (NValue t f m) scopedImportNix asetArg pathArg =   do-    s        <- fromValue @(AttrSet (NValue t f m)) asetArg-    (Path p) <- fromValue pathArg+    (coerce -> scope) <- fromValue @(AttrSet (NValue t f m)) asetArg+    p <- fromValue pathArg      path  <- pathToDefaultNix @t @f @m p     path' <-@@ -1270,7 +1286,7 @@         )         (\ res ->           do-            (Path p') <- fromValue =<< demand res+            p' <- fromValue @Path =<< demand res              traceM $ "Current file being evaluated is: " <> show p'             pure $ takeDirectory p' </> path@@ -1279,36 +1295,34 @@      clearScopes @(NValue t f m)       $ withNixContext (pure path')-      $ pushScope s+      $ pushScope scope       $ importPath @t @f @m path'  getEnvNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) getEnvNix v =-  do-    s <- fromStringNoContext =<< fromValue v-    mres <- getEnvVar s--    toValue $ makeNixStringWithoutContext $-      fromMaybe mempty mres+  (toValue . mkNixStringWithoutContext . maybeToMonoid) =<< getEnvVar =<< fromStringNoContext =<< fromValue v  sortNix-  :: MonadNix e t f m+  :: forall e t f m+  . MonadNix e t f m   => NValue t f m   -> NValue t f m   -> m (NValue t f m)-sortNix comp = toValue <=< sortByM (cmp comp) <=< fromValue+sortNix comp =+  inHaskM (sortByM cmp)  where-  cmp f a b =-    do-      isLessThan <- (`callFunc` b) =<< callFunc f a-      bool-        (do-          isGreaterThan <- (`callFunc` a) =<< callFunc f b-          fromValue isGreaterThan <&>-            bool EQ GT-        )-        (pure LT)-        =<< fromValue isLessThan+  cmp :: NValue t f m -> NValue t f m -> m Ordering+  cmp a b =+    bool+      (fmap+         (bool EQ GT)+         (compare b a)+      )+      (pure LT)+      =<< compare a b+   where+    compare :: NValue t f m -> NValue t f m -> m Bool+    compare a2 a1 = fromValue =<< (`callFunc` a1) =<< callFunc comp a2  lessThanNix   :: MonadNix e t f m@@ -1343,10 +1357,11 @@   -> NValue t f m   -> m (NValue t f m) concatWith f =-  toValue . concat <=<-    traverse-      (fromValue @[NValue t f m] <=< f)-      <=< fromValue @[NValue t f m]+  toValue .+    concat <=<+      traverse+        (fromValue @[NValue t f m] <=< f)+        <=< fromValue @[NValue t f m]  -- | Nix function of Haskell: -- > concat :: [[a]] -> [a]@@ -1377,7 +1392,7 @@         (\ nvattrset ->           do             a <- fromValue @(AttrSet (NValue t f m)) =<< demand nvattrset-            name <- fromStringNoContext =<< fromValue =<< demand =<< attrsetGet "name" a+            (coerce -> name) <- fromStringNoContext =<< fromValue =<< demand =<< attrsetGet "name" a             val  <- attrsetGet "value" a              pure (name, val)@@ -1413,17 +1428,17 @@         mkHash s = hash $ encodeUtf8 s  -placeHolderNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)+placeHolderNix :: forall t f m e . MonadNix e t f m => NValue t f m -> m (NValue t f m) placeHolderNix p =   do     t <- fromStringNoContext =<< fromValue p     h <--      runPrim $-        (hashStringNix `on` makeNixStringWithoutContext)+      coerce @(Prim m NixString) @(m NixString) $+        (hashStringNix `on` mkNixStringWithoutContext)           "sha256"           ("nix-output:" <> t)     toValue-      $ makeNixStringWithoutContext+      $ mkNixStringWithoutContext       $ Text.cons '/'       $ Base32.encode       -- Please, stop Text -> Bytestring here after migration to Text@@ -1440,7 +1455,7 @@       bytes :: NixString -> ByteString       bytes = encodeUtf8 . body -      body h = stringIgnoreContext h+      body = stringIgnoreContext  readFileNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) readFileNix = toValue <=< Nix.Render.readFile <=< absolutePathFromValue <=< demand@@ -1459,7 +1474,7 @@     case (aset, filePath) of       (NVList x, NVStr ns) ->         do-          mres <- findPath @t @f @m x $ toString $ stringIgnoreContext ns+          mres <- findPath @t @f @m x $ coerce $ toString $ stringIgnoreContext ns            pure $ nvPath mres @@ -1475,6 +1490,7 @@     items          <- listDirectory path      let+      detectFileTypes :: Path -> m (VarName, FileType)       detectFileTypes item =         do           s <- getSymbolicLinkStatus $ path </> item@@ -1486,7 +1502,7 @@                 | isSymbolicLink s -> FileTypeSymlink                 | otherwise        -> FileTypeUnknown -          pure (toText item, t)+          pure (coerce @Text @VarName $ toText item, t) -- function indeed binds filepaths as keys (VarNames) in Nix attrset.      itemsWithTypes <-       traverse@@ -1563,7 +1579,7 @@           NVBuiltin _ _ -> "lambda"           _             -> error "Pattern synonyms obscure complete patterns" -    toValue $ makeNixStringWithoutContext detectType+    toValue $ mkNixStringWithoutContext detectType  tryEvalNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -1623,7 +1639,7 @@   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) fetchurlNix =   (\case-    NVSet s _ -> go (M.lookup "sha256" s) =<< demand =<< attrsetGet "url" s+    NVSet _ s -> go (M.lookup "sha256" s) =<< demand =<< attrsetGet "url" s     v@NVStr{} -> go Nothing v     v -> throwError $ ErrorCall $ "builtins.fetchurl: Expected URI or set, got " <> show v   ) <=< demand@@ -1697,7 +1713,7 @@     case v' of       (NVStr ns) -> do         let context = getNixLikeContext $ toNixLikeContext $ getContext ns-        valued :: AttrSet (NValue t f m) <- sequenceA $ toValue <$> context+        valued :: AttrSet (NValue t f m) <- traverseToValue context         pure $ nvSet mempty valued       x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x @@ -1713,7 +1729,7 @@     y <- demand ty      case (x, y) of-      (NVStr ns, NVSet attrs _) ->+      (NVStr ns, NVSet _ attrs) ->         do           newContextValues <- traverse getPathNOuts attrs @@ -1727,7 +1743,7 @@       x <- demand tx        case x of-        NVSet attrs _ ->+        NVSet _ attrs->           do             -- TODO: Fail for unexpected keys. @@ -1759,7 +1775,7 @@         _x -> throwError $ ErrorCall $ "Invalid types for context value in builtins.appendContext: " <> show _x    addContext ns newContextValues =-    makeNixString+    mkNixString       (stringIgnoreContext ns)       (fromNixLikeContext $         NixLikeContext $@@ -1772,18 +1788,18 @@             )       ) +nixVersionNix :: MonadNix e t f m => m (NValue t f m)+nixVersionNix = toValue $ mkNixStringWithoutContext "2.3" +langVersionNix :: MonadNix e t f m => m (NValue t f m)+langVersionNix = toValue (5 :: Int)+ -- ** @builtinsList@  builtinsList :: forall e t f m . MonadNix e t f m => m [Builtin (NValue t f m)]-builtinsList = sequence-  [ do-      version <- toValue (makeNixStringWithoutContext "2.3")-      pure $ Builtin Normal ("nixVersion", version)-  , do-      version <- toValue (5 :: Int)-      pure $ Builtin Normal ("langVersion", version)-+builtinsList = sequenceA+  [ add0 Normal   "nixVersion"       nixVersionNix+  , add0 Normal   "langVersion"      langVersionNix   , add  TopLevel "abort"            throwNix -- for now   , add2 Normal   "add"              addNix   , add2 Normal   "addErrorContext"  addErrorContextNix@@ -1888,42 +1904,46 @@   , add  Normal   "valueSize"        getRecursiveSizeNix   ]  where++  arity0 :: a -> Prim m a+  arity0 = Prim . pure+   arity1 :: (a -> b) -> (a -> Prim m b)-  arity1 f = Prim . pure . f+  arity1 g = arity0 . g    arity2 :: (a -> b -> c) -> (a -> b -> Prim m c)-  arity2 f = ((Prim . pure) .) . f+  arity2 f = arity1 . f -  mkBuiltin :: BuiltinType -> Text -> m (NValue t f m) -> m (Builtin (NValue t f m))+  mkBuiltin :: BuiltinType -> VarName -> m (NValue t f m) -> m (Builtin (NValue t f m))   mkBuiltin t n v = wrap t n <$> mkThunk n v    where-    wrap :: BuiltinType -> Text -> v -> Builtin v+    wrap :: BuiltinType -> VarName -> v -> Builtin v     wrap t n f = Builtin t (n, f) -    mkThunk :: Text -> m (NValue t f m) -> m (NValue t f m)+    mkThunk :: VarName -> m (NValue t f m) -> m (NValue t f m)     mkThunk n = defer . withFrame Info (ErrorCall $ "While calling builtin " <> toString n <> "\n")    hAdd-    :: ( Text+    :: ( VarName       -> fun       -> m (NValue t f m)       )     -> BuiltinType-    -> Text+    -> VarName     -> fun     -> m (Builtin (NValue t f m))   hAdd f t n v = mkBuiltin t n $ f n v    add0     :: BuiltinType-    -> Text+    -> VarName     -> m (NValue t f m)     -> m (Builtin (NValue t f m))   add0 = hAdd (\ _ x -> x)    add     :: BuiltinType-    -> Text+    -> VarName     -> ( NValue t f m       -> m (NValue t f m)       )@@ -1932,7 +1952,7 @@    add2     :: BuiltinType-    -> Text+    -> VarName     -> ( NValue t f m       -> NValue t f m       -> m (NValue t f m)@@ -1942,7 +1962,7 @@    add3     :: BuiltinType-    -> Text+    -> VarName     -> ( NValue t f m       -> NValue t f m       -> NValue t f m@@ -1954,10 +1974,10 @@   add'     :: ToBuiltin t f m a     => BuiltinType-    -> Text+    -> VarName     -> a     -> m (Builtin (NValue t f m))-  add' = hAdd toBuiltin+  add' = hAdd (toBuiltin . coerce)   -- * Exported@@ -1966,7 +1986,7 @@ withNixContext   :: forall e t f m r    . (MonadNix e t f m, Has e Options)-  => Maybe FilePath+  => Maybe Path   -> m r   -> m r withNixContext mpath action =@@ -1977,7 +1997,7 @@       i = nvList $ nvStrWithoutContext . toText <$> include opts      pushScope-      (one ("__includes", i))+      (coerce $ M.fromList $ one ("__includes", i))       (pushScopes         base $         maybe@@ -1986,29 +2006,35 @@             do               traceM $ "Setting __cur_file = " <> show path               let ref = nvPath path-              pushScope (one ("__cur_file", ref)) act+              pushScope (coerce $ M.fromList $ one ("__cur_file", ref)) act           )           mpath           action       )  builtins-  :: ( MonadNix e t f m+  :: forall e t f m+  . ( MonadNix e t f m      , Scoped (NValue t f m) m      )   => m (Scopes m (NValue t f m)) builtins =   do     ref <- defer $ nvSet mempty <$> buildMap-    lst <- ([("builtins", ref)] <>) <$> topLevelBuiltins-    pushScope (M.fromList lst) currentScopes+    lst <- (one ("builtins", ref) <>) <$> topLevelBuiltins+    pushScope (coerce (M.fromList lst)) currentScopes  where-  buildMap         =  fmap (M.fromList . fmap mapping) builtinsList+  buildMap :: m (HashMap VarName (NValue t f m))+  buildMap         =  M.fromList . (mapping <$>) <$> builtinsList++  topLevelBuiltins :: m [(VarName, NValue t f m)]   topLevelBuiltins = mapping <<$>> fullBuiltinsList +  fullBuiltinsList :: m [Builtin (NValue t f m)]   fullBuiltinsList = nameBuiltins <<$>> builtinsList    where+    nameBuiltins :: Builtin v -> Builtin v     nameBuiltins b@(Builtin TopLevel _) = b     nameBuiltins (Builtin Normal nB) =-      Builtin TopLevel $ first ("__" <>) nB+      Builtin TopLevel $ first (coerce @Text . ("__" <>) . coerce @VarName) nB 

@@ -1,9 +1,9 @@-{-# LANGUAGE CPP #-}+{-# language CPP #-}  -- | Reading and writing Nix cache files module Nix.Cache where -import qualified Data.ByteString.Lazy          as BS+import qualified Data.ByteString.Lazy          as BSL import           Nix.Expr.Types.Annotated  #if defined (__linux__)@@ -17,7 +17,7 @@ #endif import qualified Codec.Serialise               as S -readCache :: FilePath -> IO NExprLoc+readCache :: Path -> IO NExprLoc readCache path = do #if USE_COMPACT   eres <- C.unsafeReadCompact path@@ -26,17 +26,17 @@     (\ expr -> pure $ C.getCompact expr)     eres #else-  eres <- S.deserialiseOrFail <$> BS.readFile path+  eres <- S.deserialiseOrFail <$> BSL.readFile (coerce path)   either     (\ err  -> fail $ "Error reading cache file: " <> show err)     pure     eres #endif -writeCache :: FilePath -> NExprLoc -> IO ()+writeCache :: Path -> NExprLoc -> IO () writeCache path expr = #ifdef USE_COMPACT   C.writeCompact path =<< C.compact expr #else-  BS.writeFile path (S.serialise expr)+  BSL.writeFile (coerce path) (S.serialise expr) #endif

@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE TemplateHaskell #-}+{-# language DeriveAnyClass #-}+{-# language TemplateHaskell #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# options_ghc -Wno-missing-signatures #-}  module Nix.Cited where 

@@ -1,12 +1,9 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE PatternSynonyms    #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language UndecidableInstances #-}+{-# language PatternSynonyms    #-}  module Nix.Cited.Basic where -import           Prelude                 hiding ( force ) import           Control.Comonad                ( Comonad ) import           Control.Comonad.Env            ( ComonadEnv ) import           Control.Monad.Catch     hiding ( catchJust )@@ -14,11 +11,10 @@ import           Nix.Eval                      as Eval                                                 ( EvalFrame(EvaluatingExpr,ForcingExpr) ) import           Nix.Exec-import           Nix.Expr+import           Nix.Expr.Types.Annotated import           Nix.Frames import           Nix.Options import           Nix.Thunk-import           Nix.Utils import           Nix.Value  @@ -94,11 +90,11 @@             -- Gather the current evaluation context at the time of thunk             -- creation, and record it along with the thunk.             let-              go (fromException -> Just (EvaluatingExpr scope (AnnE s e))) =-                let e' = AnnFP s (Nothing <$ e) in-                [Provenance scope e']+              go :: SomeException -> [Provenance m (NValue u f m)]+              go (fromException -> Just (EvaluatingExpr scope (Ann s e))) =+                one $ Provenance scope $ AnnF s (Nothing <$ e)               go _ = mempty-              ps = concatMap (go . frame) frames+              ps = foldMap (go . frame) frames              cite ps t         )@@ -182,6 +178,6 @@ displayProvenance =   list     id-    (\ (Provenance scope e@(AnnFP s _) : _) ->+    (\ (Provenance scope e@(AnnF s _) : _) ->       withFrame Info $ ForcingExpr scope $ wrapExprLoc s e     )

@@ -7,8 +7,8 @@ import           Nix.Expr.Types.Annotated       ( SrcSpan                                                 , nullSpan                                                 )-import           Nix.Utils                      ( Has(..) ) +--  2021-07-18: NOTE: It should be Options -> Scopes -> Frames -> Source(span) data Context m t = Context     { scopes  :: Scopes m t     , source  :: SrcSpan

@@ -1,11 +1,10 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE IncoherentInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}+{-# language AllowAmbiguousTypes #-}+{-# language ConstraintKinds #-}+{-# language IncoherentInstances #-}+{-# language TypeFamilies #-}+{-# language UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# options_ghc -fno-warn-name-shadowing #-}  -- | Although there are a lot of instances in this file, really it's just a --   combinatorial explosion of the following combinations:@@ -16,7 +15,6 @@  module Nix.Convert where -import           Prelude                 hiding ( force ) import           Control.Monad.Free import qualified Data.HashMap.Lazy             as M import           Nix.Atoms@@ -28,7 +26,6 @@ import           Nix.Value import           Nix.Value.Monad import           Nix.Thunk                      ( MonadThunk(force) )-import           Nix.Utils  newtype Deeper a = Deeper a   deriving (Typeable, Functor, Foldable, Traversable)@@ -50,13 +47,39 @@ -}  +type Convertible e t f m+  = (Framed e m, MonadDataErrorContext t f m, MonadThunk t m (NValue t f m))++-- | Transform Nix -> Hask. Run function. Convert Hask -> Nix.+inHask :: forall a1 a2 v b m . (Monad m, FromValue a1 m v, ToValue a2 m b) => (a1 -> a2) -> v -> m b+inHask f = toValue . f <=< fromValue++inHaskM :: forall a1 a2 v b m . (Monad m, FromValue a1 m v, ToValue a2 m b) => (a1 -> m a2) -> v -> m b+inHaskM f = toValue <=< f <=< fromValue++-- | Maybe transform Nix -> Hask. Run function. Convert Hask -> Nix.+inHaskMay :: forall a1 a2 v b m . (Monad m, FromValue a1 m v, ToValue a2 m b) => (Maybe a1 -> a2) -> v -> m b+inHaskMay f = toValue . f <=< fromValueMay++ -- * FromValue  class FromValue a m v where   fromValue    :: v -> m a   fromValueMay :: v -> m (Maybe a) +traverseFromM+  :: ( Applicative m+     , Traversable t+     , FromValue b m a+     )+  => t a+  -> m (Maybe (t b))+traverseFromM = traverseM fromValueMay +traverseToValue :: ((Traversable t, Applicative f, ToValue a f b) => t a -> f (t b))+traverseToValue = traverse toValue+ -- Please, hide these helper function from export, to be sure they get optimized away. fromMayToValue   :: forall t f m a e@@ -67,12 +90,10 @@   -> NValue' t f m (NValue t f m)   -> m a fromMayToValue t v =-  do-    v' <- fromValueMay v-    maybe-      (throwError $ Expectation @t @f @m t (Free v))-      pure-      v'+  maybe+    (throwError $ Expectation @t @f @m t (Free v))+    pure+    =<< fromValueMay v  fromMayToDeeperValue   :: forall t f m a e m1@@ -83,15 +104,10 @@   -> Deeper (NValue' t f m (NValue t f m))   -> m (m1 a) fromMayToDeeperValue t v =-  do-    v' <- fromValueMay v-    maybe-      (throwError $ Expectation @t @f @m t $ Free $ (coerce :: CoerceDeeperToNValue' t f m) v)-      pure-      v'--type Convertible e t f m-  = (Framed e m, MonadDataErrorContext t f m, MonadThunk t m (NValue t f m))+  maybe+    (throwError $ Expectation @t @f @m t $ Free $ (coerce :: CoerceDeeperToNValue' t f m) v)+    pure+    =<< fromValueMay v  instance ( Convertible e t f m          , MonadValue (NValue t f m) m@@ -135,7 +151,7 @@   fromValueMay =     pure .       \case-        NVConstant' NNull -> pass+        NVConstant' NNull -> stub         _                 -> mempty    fromValue = fromMayToValue TNull@@ -195,17 +211,18 @@     \case       NVStr' ns -> pure $ pure ns       NVPath' p ->-        fmap-          (pure . (\s -> makeNixStringWithSingletonContext s (StringContext s DirectPath)) . toText . unStorePath)-          (addPath p)-      NVSet' s _ ->+        (\path -> pure $ mkNixStringWithSingletonContext path (StringContext path DirectPath)) . fromString . coerce <$>+          addPath p+      NVSet' _ s ->         maybe           stub           fromValueMay           (M.lookup "outPath" s)       _ -> stub -  fromValue = fromMayToValue $ TString NoContext+  --  2021-07-18: NOTE: There may be cases where conversion wrongly marks the content to have a context.+  --  See: https://github.com/haskell-nix/hnix/pull/958#issuecomment-881949183 thread.+  fromValue = fromMayToValue $ TString HasContext  instance Convertible e t f m   => FromValue ByteString m (NValue' t f m (NValue t f m)) where@@ -213,15 +230,22 @@   fromValueMay =     pure .       \case-        NVStr' ns -> encodeUtf8 <$> getStringNoContext  ns+        NVStr' ns -> encodeUtf8 <$> getStringNoContext ns         _         -> mempty -  fromValue = fromMayToValue $ TString NoContext+  fromValue = fromMayToValue $ TString mempty +instance Convertible e t f m+  => FromValue Text m (NValue' t f m (NValue t f m)) where -newtype Path = Path { getPath :: FilePath }-    deriving Show+  fromValueMay =+    pure .+      \case+        NVStr' ns -> getStringNoContext ns+        _         -> mempty +  fromValue = fromMayToValue $ TString mempty+ instance ( Convertible e t f m          , MonadValue (NValue t f m) m          )@@ -229,14 +253,14 @@    fromValueMay =     \case-      NVPath' p  -> pure $ pure $ Path p-      NVStr'  ns -> pure $ Path . toString <$> getStringNoContext  ns-      NVSet' s _ ->+      NVPath' p  -> pure $ pure $ coerce p+      NVStr'  ns -> pure $ coerce . toString <$> getStringNoContext  ns+      NVSet' _ s ->         maybe-          (pure Nothing)+          stub           (fromValueMay @Path)           (M.lookup "outPath" s)-      _ -> pure Nothing+      _ -> stub    fromValue = fromMayToValue TPath @@ -257,7 +281,7 @@   => FromValue [a] m (Deeper (NValue' t f m (NValue t f m))) where   fromValueMay =     \case-      Deeper (NVList' l) -> sequence <$> traverse fromValueMay l+      Deeper (NVList' l) -> traverseFromM l       _                  -> stub  @@ -269,7 +293,7 @@   fromValueMay =     pure .       \case-        NVSet' s _ -> pure s+        NVSet' _ s -> pure s         _          -> mempty    fromValue = fromMayToValue TSet@@ -281,19 +305,19 @@    fromValueMay =     \case-      Deeper (NVSet' s _) -> sequence <$> traverse fromValueMay s+      Deeper (NVSet' _ s) -> traverseFromM s       _                   -> stub    fromValue = fromMayToDeeperValue TSet  instance Convertible e t f m-  => FromValue (AttrSet (NValue t f m), AttrSet SourcePos) m+  => FromValue (AttrSet (NValue t f m), PositionSet) m               (NValue' t f m (NValue t f m)) where    fromValueMay =     pure .       \case-        NVSet' s p -> pure (s, p)+        NVSet' p s -> pure (s, p)         _          -> mempty    fromValue = fromMayToValue TSet@@ -301,12 +325,12 @@ instance ( Convertible e t f m          , FromValue a m (NValue t f m)          )-  => FromValue (AttrSet a, AttrSet SourcePos) m+  => FromValue (AttrSet a, PositionSet) m               (Deeper (NValue' t f m (NValue t f m))) where    fromValueMay =     \case-      Deeper (NVSet' s p) -> fmap (, p) . sequence <$> traverse fromValueMay s+      Deeper (NVSet' p s) -> (, p) <<$>> traverseFromM s       _                   -> stub    fromValue = fromMayToDeeperValue TSet@@ -325,13 +349,15 @@ class ToValue a m v where   toValue :: a -> m v -instance (Convertible e t f m, ToValue a m (NValue' t f m (NValue t f m)))+instance (Convertible e t f m+  , ToValue a m (NValue' t f m (NValue t f m))+  )   => ToValue a m (NValue t f m) where   toValue v = Free <$> toValue v  instance ( Convertible e t f m-         , ToValue a m (Deeper (NValue' t f m (NValue t f m)))-         )+  , ToValue a m (Deeper (NValue' t f m (NValue t f m)))+  )   => ToValue a m (Deeper (NValue t f m)) where   toValue v = Free <<$>> toValue v @@ -361,24 +387,27 @@  instance Convertible e t f m   => ToValue ByteString m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvStr' . makeNixStringWithoutContext . decodeUtf8+  toValue = pure . nvStr' . mkNixStringWithoutContext . decodeUtf8  instance Convertible e t f m+  => ToValue Text m (NValue' t f m (NValue t f m)) where+  toValue = pure . nvStr' . mkNixStringWithoutContext++instance Convertible e t f m   => ToValue Path m (NValue' t f m (NValue t f m)) where-  toValue = pure . nvPath' . getPath+  toValue = pure . nvPath' . coerce  instance Convertible e t f m   => ToValue StorePath m (NValue' t f m (NValue t f m)) where-  toValue = toValue . Path . unStorePath+  toValue = toValue @Path . coerce -instance ( Convertible e t f m-         )+instance Convertible e t f m   => ToValue SourcePos m (NValue' t f m (NValue t f m)) where   toValue (SourcePos f l c) = do-    f' <- toValue $ makeNixStringWithoutContext $ toText f+    f' <- toValue $ mkNixStringWithoutContext $ fromString f     l' <- toValue $ unPos l     c' <- toValue $ unPos c-    let pos = M.fromList [("file" :: Text, f'), ("line", l'), ("column", c')]+    let pos = M.fromList [("file" :: VarName, f'), ("line", l'), ("column", c')]     pure $ nvSet' mempty pos  -- | With 'ToValue', we can always act recursively@@ -386,9 +415,11 @@   => ToValue [NValue t f m] m (NValue' t f m (NValue t f m)) where   toValue = pure . nvList' -instance (Convertible e t f m, ToValue a m (NValue t f m))+instance (Convertible e t f m+  , ToValue a m (NValue t f m)+  )   => ToValue [a] m (Deeper (NValue' t f m (NValue t f m))) where-  toValue l = Deeper . nvList' <$> traverse toValue l+  toValue l = Deeper . nvList' <$> traverseToValue l  instance Convertible e t f m   => ToValue (AttrSet (NValue t f m)) m (NValue' t f m (NValue t f m)) where@@ -398,20 +429,20 @@   => ToValue (AttrSet a) m (Deeper (NValue' t f m (NValue t f m))) where   toValue s =     liftA2 (\ v s -> Deeper $ nvSet' s v)-      (traverse toValue s)+      (traverseToValue s)       stub  instance Convertible e t f m-  => ToValue (AttrSet (NValue t f m), AttrSet SourcePos) m+  => ToValue (AttrSet (NValue t f m), PositionSet) m             (NValue' t f m (NValue t f m)) where   toValue (s, p) = pure $ nvSet' p s  instance (Convertible e t f m, ToValue a m (NValue t f m))-  => ToValue (AttrSet a, AttrSet SourcePos) m+  => ToValue (AttrSet a, PositionSet) m             (Deeper (NValue' t f m (NValue t f m))) where   toValue (s, p) =     liftA2 (\ v s -> Deeper $ nvSet' s v)-      (traverse toValue s)+      (traverseToValue s)       (pure p)  instance Convertible e t f m@@ -427,9 +458,9 @@     allOutputs <- g nlcvAllOutputs     outputs <- do       let-        outputs = makeNixStringWithoutContext <$> nlcvOutputs nlcv+        outputs = mkNixStringWithoutContext <$> nlcvOutputs nlcv -      ts :: [NValue t f m] <- traverse toValue outputs+      ts :: [NValue t f m] <- traverseToValue outputs       list         (pure Nothing)         (fmap pure . toValue)

@@ -1,24 +1,21 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@+{-# language AllowAmbiguousTypes #-}+{-# language CPP #-}+{-# language DefaultSignatures #-}+{-# language TypeFamilies #-}+{-# language DataKinds #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language UndecidableInstances #-}+{-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@ -{-# OPTIONS_GHC -Wno-orphans #-}+{-# options_ghc -Wno-orphans #-}   module Nix.Effects where -import           Prelude                 hiding ( traceM-                                                , putStr-                                                , putStrLn+import           Prelude                 hiding ( putStrLn                                                 , print                                                 )-import qualified Prelude-import           Nix.Utils+import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import qualified Data.HashSet                  as HS import qualified Data.Text                     as Text import           Network.HTTP.Client     hiding ( path, Proxy )@@ -26,15 +23,13 @@ import           Network.HTTP.Types import qualified "cryptonite" Crypto.Hash      as Hash import           Nix.Utils.Fix1-import           Nix.Expr+import           Nix.Expr.Types.Annotated import           Nix.Frames              hiding ( Proxy ) import           Nix.Parser import           Nix.Render import           Nix.Value import qualified Paths_hnix import           System.Exit-import qualified System.Environment            as Env-import           System.FilePath                ( takeFileName ) import qualified System.Info import           System.Process @@ -42,7 +37,7 @@ import qualified System.Nix.StorePath          as Store  -- | A path into the nix store-newtype StorePath = StorePath { unStorePath :: FilePath }+newtype StorePath = StorePath Path   -- All of the following type classes defer to the underlying 'm'.@@ -62,16 +57,15 @@   )   => MonadEffects t f m where -  -- | Determine the absolute path of relative path in the current context-  makeAbsolutePath :: FilePath -> m FilePath-  findEnvPath :: String -> m FilePath+  -- | Determine the absolute path in the current context.+  toAbsolutePath :: Path -> m Path+  findEnvPath :: String -> m Path -  -- | Having an explicit list of sets corresponding to the NIX_PATH-  -- and a file path try to find an existing path-  findPath :: [NValue t f m] -> FilePath -> m FilePath+  -- | Having an explicit list of sets corresponding to the @NIX_PATH@ and a file path try to find an existing path.+  findPath :: [NValue t f m] -> Path -> m Path -  importPath :: FilePath -> m (NValue t f m)-  pathToDefaultNix :: FilePath -> m FilePath+  importPath :: Path -> m (NValue t f m)+  pathToDefaultNix :: Path -> m Path    derivationStrict :: NValue t f m -> m (NValue t f m) @@ -108,7 +102,7 @@ #ifdef MIN_VERSION_ghc_datasize     recursiveSize #else-    \_ -> pure 0+    const $ pure 0 #endif  deriving@@ -140,9 +134,9 @@   exec' = \case     []            -> pure $ Left $ ErrorCall "exec: missing program"     (prog : args) -> do-      (exitCode, out, _) <- liftIO $ readProcessWithExitCode (toString prog) (toString <$> args) ""+      (exitCode, out, _) <- liftIO $ readProcessWithExitCode (toString prog) (toString <$> args) mempty       let-        t    = Text.strip $ toText out+        t    = Text.strip $ fromString out         emsg = "program[" <> prog <> "] args=" <> show args       case exitCode of         ExitSuccess ->@@ -191,7 +185,7 @@         readProcessWithExitCode           "nix-instantiate"           ["--eval", "--expr", toString expr]-          ""+          mempty        pure $         case exitCode of@@ -199,7 +193,7 @@             either               (\ e -> Left $ ErrorCall $ "Error parsing output of nix-instantiate: " <> show e)               pure-              (parseNixTextLoc $ toText out)+              (parseNixTextLoc $ fromString out)           status -> Left $ ErrorCall $ "nix-instantiate failed: " <> show status <> ": " <> err  deriving@@ -235,12 +229,12 @@ -- ** Instances  instance MonadEnv IO where-  getEnvVar            = (<<$>>) toText . Env.lookupEnv . toString+  getEnvVar            = (<<$>>) fromString . lookupEnv . toString -  getCurrentSystemOS   = pure $ toText System.Info.os+  getCurrentSystemOS   = pure $ fromString System.Info.os    -- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4-  getCurrentSystemArch = pure $ toText $ case System.Info.arch of+  getCurrentSystemArch = pure $ fromString $ case System.Info.arch of     "i386" -> "i686"     arch   -> arch @@ -260,15 +254,15 @@ class   Monad m   => MonadPaths m where-  getDataDir :: m FilePath-  default getDataDir :: (MonadTrans t, MonadPaths m', m ~ t m') => m FilePath+  getDataDir :: m Path+  default getDataDir :: (MonadTrans t, MonadPaths m', m ~ t m') => m Path   getDataDir = lift getDataDir   -- ** Instances  instance MonadPaths IO where-  getDataDir = Paths_hnix.getDataDir+  getDataDir = coerce Paths_hnix.getDataDir  deriving   instance@@ -328,7 +322,7 @@ -- * @class MonadPutStr m@  class-  Monad m+  (Monad m, MonadIO m)   => MonadPutStr m where    --TODO: Should this be used *only* when the Nix to be evaluated invokes a@@ -336,7 +330,7 @@   --  2021-04-01: Due to trace operation here, leaving it as String.   putStr :: String -> m ()   default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m ()-  putStr = lift . putStr+  putStr = lift . Prelude.putStr   -- ** Instances@@ -358,7 +352,7 @@ -- ** Functions  putStrLn :: MonadPutStr m => String -> m ()-putStrLn = putStr . (<> "\n")+putStrLn = Nix.Effects.putStr . (<> "\n")  print :: (MonadPutStr m, Show a) => a -> m () print = putStrLn . show@@ -370,7 +364,7 @@ type RecursiveFlag = Bool type RepairFlag = Bool type StorePathName = Text-type FilePathFilter m = FilePath -> m Bool+type PathFilter m = Path -> m Bool type StorePathSet = HS.HashSet StorePath  -- ** @class MonadStore m@@@ -382,8 +376,8 @@   -- | Copy the contents of a local path to the store.  The resulting store   -- path is returned.  Note: This does not support yet support the expected   -- `filter` function that allows excluding some files.-  addToStore :: StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)-  default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)+  addToStore :: StorePathName -> Path -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)+  default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Path -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)   addToStore a b c d = lift $ addToStore a b c d    -- | Like addToStore, but the contents written to the output path is a@@ -403,10 +397,10 @@       (\ pathName ->         do           -- TODO: redesign the filter parameter-          res <- Store.Remote.runStore $ Store.Remote.addToStore @Hash.SHA256 pathName path recursive (const False) repair+          res <- Store.Remote.runStore $ Store.Remote.addToStore @Hash.SHA256 pathName (coerce path) recursive (const False) repair           either             Left -- err-            (pure . StorePath . decodeUtf8 . Store.storePathToRawFilePath) -- store path+            (pure . StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath) -- store path             <$> parseStoreResult "addToStore" res       )       (Store.makeStorePathName name)@@ -416,7 +410,7 @@       res <- Store.Remote.runStore $ Store.Remote.addTextToStore name text references repair       either         Left -- err-        (pure . StorePath . decodeUtf8 . Store.storePathToRawFilePath) -- path+        (pure . StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath) -- path         <$> parseStoreResult "addTextToStore" res  @@ -438,12 +432,12 @@     pure     =<< addTextToStore' a b c d -addPath :: (Framed e m, MonadStore m) => FilePath -> m StorePath+addPath :: (Framed e m, MonadStore m) => Path -> m StorePath addPath p =   either     throwError     pure-    =<< addToStore (toText $ takeFileName p) p True False+    =<< addToStore (fromString $ coerce takeFileName p) p True False -toFile_ :: (Framed e m, MonadStore m) => FilePath -> String -> m StorePath-toFile_ p contents = addTextToStore (toText p) (toText contents) mempty False+toFile_ :: (Framed e m, MonadStore m) => Path -> Text -> m StorePath+toFile_ p contents = addTextToStore (toText p) contents mempty False

@@ -1,27 +1,24 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}+{-# language CPP #-}  module Nix.Effects.Basic where -import           Prelude                 hiding ( traceM-                                                , head+import           Prelude                 hiding ( head                                                 ) import           Relude.Unsafe                  ( head )-import           Nix.Utils+import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import           Control.Monad                  ( foldM ) import qualified Data.HashMap.Lazy             as M import           Data.List.Split                ( splitOn ) import qualified Data.Text                     as Text import           Prettyprinter                  ( fillSep )-import           System.FilePath import           Nix.Convert import           Nix.Effects import           Nix.Exec                       ( MonadNix                                                 , evalExprLoc                                                 , nixInstantiateExpr                                                 )-import           Nix.Expr+import           Nix.Expr.Types+import           Nix.Expr.Types.Annotated import           Nix.Frames import           Nix.Parser import           Nix.Render@@ -34,137 +31,134 @@ import           GHC.DataSize #endif -defaultMakeAbsolutePath :: MonadNix e t f m => FilePath -> m FilePath-defaultMakeAbsolutePath origPath = do-  origPathExpanded <- expandHomePath origPath-  absPath          <--    bool-      (do-        cwd <- do-          mres <- lookupVar "__cur_file"-          maybe-            getCurrentDirectory-            (-              (\case-                NVPath s -> pure $ takeDirectory s-                val -> throwError $ ErrorCall $ "when resolving relative path, __cur_file is in scope, but is not a path; it is: " <> show val-              ) <=< demand++++defaultToAbsolutePath :: forall e t f m . MonadNix e t f m => Path -> m Path+defaultToAbsolutePath origPath =+  do+    origPathExpanded <- expandHomePath origPath+    fmap+      removeDotDotIndirections+      . canonicalizePath+        =<< bool+            (fmap+              (<///> origPathExpanded)+              $ maybe+                  getCurrentDirectory+                  ( (\case+                      NVPath s -> pure $ takeDirectory s+                      val -> throwError $ ErrorCall $ "when resolving relative path, __cur_file is in scope, but is not a path; it is: " <> show val+                    ) <=< demand+                  )+                  =<< lookupVar "__cur_file"             )-            mres-        pure $ cwd <///> origPathExpanded-      )-      (pure origPathExpanded)-      (isAbsolute origPathExpanded)-  removeDotDotIndirections <$> canonicalizePath absPath+            (pure origPathExpanded)+            (isAbsolute origPathExpanded) -expandHomePath :: MonadFile m => FilePath -> m FilePath-expandHomePath ('~' : xs) = (<> xs) <$> getHomeDirectory+expandHomePath :: MonadFile m => Path -> m Path+expandHomePath (coerce -> ('~' : xs)) = (<> coerce xs) <$> getHomeDirectory expandHomePath p          = pure p  -- | Incorrectly normalize paths by rewriting patterns like @a/b/..@ to @a@. --   This is incorrect on POSIX systems, because if @b@ is a symlink, its --   parent may be a different directory from @a@. See the discussion at --   https://hackage.haskell.org/package/directory-1.3.1.5/docs/System-Directory.html#v:canonicalizePath-removeDotDotIndirections :: FilePath -> FilePath-removeDotDotIndirections = intercalate "/" . go mempty . splitOn "/"+removeDotDotIndirections :: Path -> Path+removeDotDotIndirections = coerce . intercalate "/" . go mempty . splitOn "/" . coerce  where   go s       []            = reverse s   go (_ : s) (".." : rest) = go s rest   go s       (this : rest) = go (this : s) rest  infixr 9 <///>-(<///>) :: FilePath -> FilePath -> FilePath-x <///> y | isAbsolute y || "." `isPrefixOf` y = x </> y-          | otherwise                          = joinByLargestOverlap x y+(<///>) :: Path -> Path -> Path+x <///> y+  | isAbsolute y || "." `isPrefixOf` coerce y = x </> y+  | otherwise                          = joinByLargestOverlap x y  where+  joinByLargestOverlap :: Path -> Path -> Path   joinByLargestOverlap (splitDirectories -> xs) (splitDirectories -> ys) =     joinPath $ head       [ xs <> drop (length tx) ys | tx <- tails xs, tx `elem` inits ys ] -defaultFindEnvPath :: MonadNix e t f m => String -> m FilePath-defaultFindEnvPath = findEnvPathM--findEnvPathM :: forall e t f m . MonadNix e t f m => FilePath -> m FilePath-findEnvPathM name = do-  mres <- lookupVar "__nixPath"+defaultFindEnvPath :: MonadNix e t f m => String -> m Path+defaultFindEnvPath = findEnvPathM . coerce +findEnvPathM :: forall e t f m . MonadNix e t f m => Path -> m Path+findEnvPathM name =   maybe     (fail "impossible")-    (-      (\ nv ->-        do-          (l :: [NValue t f m]) <- fromValue nv-          findPathBy nixFilePath l name-      ) <=< demand+    (\ v ->+      do+        l <- fromValue @[NValue t f m] =<< demand v+        findPathBy nixFilePath l name     )-    mres+    =<< lookupVar "__nixPath"   where-  nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)-  nixFilePath path = do-    absPath <- makeAbsolutePath @t @f path-    isDir   <- doesDirectoryExist absPath-    absFile <--      bool-        (pure absPath)-        (makeAbsolutePath @t @f $ absPath </> "default.nix")-        isDir-    exists <- doesFileExist absFile-    pure $-      bool-        mempty-        (pure absFile)-        exists+  nixFilePath :: MonadEffects t f m => Path -> m (Maybe Path)+  nixFilePath path =+    do+      absPath <- toAbsolutePath @t @f path+      isDir   <- doesDirectoryExist absPath+      absFile <-+        bool+          (pure absPath)+          (toAbsolutePath @t @f $ absPath </> "default.nix")+          isDir +      (pure absFile `whenTrue`) <$> doesFileExist absFile+ findPathBy   :: forall e t f m    . MonadNix e t f m-  => (FilePath -> m (Maybe FilePath))+  => (Path -> m (Maybe Path))   -> [NValue t f m]-  -> FilePath-  -> m FilePath-findPathBy finder ls name = do-  mpath <- foldM go mempty ls+  -> Path+  -> m Path+findPathBy finder ls name =   maybe-    (throwError $ ErrorCall $ "file '" <> name <> "' was not found in the Nix search path (add it's using $NIX_PATH or -I)")+    (throwError $ ErrorCall $ "file ''" <> coerce name <> "'' was not found in the Nix search path (add it's using $NIX_PATH or -I)")     pure-    mpath+    =<< foldM fun mempty ls  where-  go :: Maybe FilePath -> NValue t f m -> m (Maybe FilePath)-  go mp =+  fun+    :: MonadNix e t f m+    => Maybe Path+    -> NValue t f m+    -> m (Maybe Path)+  fun =     maybe       (\ nv ->         do-          (s :: HashMap Text (NValue t f m)) <- fromValue =<< demand nv+          (s :: HashMap VarName (NValue t f m)) <- fromValue =<< demand nv           p <- resolvePath s-          nvpath <- demand p-          (Path path) <- fromValue nvpath+          path <- fromValue =<< demand p            maybe             (tryPath path mempty)             (\ nv' ->               do-                mns <- fromValueMay =<< demand nv'+                mns <- fromValueMay @NixString =<< demand nv'                 tryPath path $-                  case mns of-                    Just (nsPfx :: NixString) ->+                  whenJust+                    (\ nsPfx ->                       let pfx = stringIgnoreContext nsPfx in-                      bool-                        mempty-                        (pure (toString pfx))-                        (not $ Text.null pfx)-                    _ -> mempty+                      pure $ coerce $ toString pfx `whenFalse` Text.null pfx+                    )+                    mns             )             (M.lookup "prefix" s)       )       (const . pure . pure)-      mp -  tryPath :: FilePath -> Maybe FilePath -> m (Maybe FilePath)+  tryPath :: Path -> Maybe Path -> m (Maybe Path)   tryPath p (Just n) | n' : ns <- splitDirectories name, n == n' =     finder $ p <///> joinPath ns   tryPath p _ = finder $ p <///> name +  resolvePath :: HashMap VarName (NValue t f m) -> m (NValue t f m)   resolvePath s =     maybe       (maybe@@ -176,22 +170,29 @@       (M.lookup "path" s)  fetchTarball-  :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)+  :: forall e t f m+   . MonadNix e t f m+  => NValue t f m+  -> m (NValue t f m) fetchTarball =   \case-    NVSet s _ ->+    NVSet _ s ->       maybe         (throwError $ ErrorCall "builtins.fetchTarball: Missing url attribute")-        (go (M.lookup "sha256" s) <=< demand)+        (fetchFromString (M.lookup "sha256" s) <=< demand)         (M.lookup "url" s)-    v@NVStr{} -> go Nothing v+    v@NVStr{} -> fetchFromString Nothing v     v -> throwError $ ErrorCall $ "builtins.fetchTarball: Expected URI or set, got " <> show v   <=< demand  where-  go :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)-  go msha = \case-    NVStr ns -> fetch (stringIgnoreContext ns) msha-    v -> throwError $ ErrorCall $ "builtins.fetchTarball: Expected URI or string, got " <> show v+  fetchFromString+    :: Maybe (NValue t f m)+    -> NValue t f m+    -> m (NValue t f m)+  fetchFromString msha =+    \case+      NVStr ns -> fetch (stringIgnoreContext ns) msha+      v -> throwError $ ErrorCall $ "builtins.fetchTarball: Expected URI or string, got " <> show v  {- jww (2018-04-11): This should be written using pipes in another module     fetch :: Text -> Maybe (NThunk m) -> m (NValue t f m)@@ -206,68 +207,73 @@ -}    fetch :: Text -> Maybe (NValue t f m) -> m (NValue t f m)-  fetch uri Nothing =-    nixInstantiateExpr $ "builtins.fetchTarball \"" <> uri <> "\""-  fetch url (Just t) =-      (\nv -> do-        nsSha <- fromValue nv+  fetch uri =+    maybe+      (nixInstantiateExpr $+        "builtins.fetchTarball \"" <> uri <> "\""+      )+      (\ v ->+        do+          nsSha <- fromValue =<< demand v -        let sha = stringIgnoreContext nsSha+          let sha = stringIgnoreContext nsSha -        nixInstantiateExpr-          $ "builtins.fetchTarball { " <> "url    = \"" <> url <> "\"; " <> "sha256 = \"" <> sha <> "\"; }"-      ) =<< demand t+          nixInstantiateExpr $+            "builtins.fetchTarball { " <> "url    = \"" <> uri <> "\"; " <> "sha256 = \"" <> sha <> "\"; }"+      ) -defaultFindPath :: MonadNix e t f m => [NValue t f m] -> FilePath -> m FilePath+defaultFindPath :: MonadNix e t f m => [NValue t f m] -> Path -> m Path defaultFindPath = findPathM  findPathM   :: forall e t f m    . MonadNix e t f m   => [NValue t f m]-  -> FilePath-  -> m FilePath+  -> Path+  -> m Path findPathM = findPathBy existingPath  where-  existingPath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)+  existingPath :: MonadEffects t f m => Path -> m (Maybe Path)   existingPath path =     do-      apath  <- makeAbsolutePath @t @f path+      apath  <- toAbsolutePath @t @f path       doesExist <- doesPathExist apath       pure $ pure apath `whenTrue` doesExist  defaultImportPath-  :: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc, b) m)-  => FilePath+  :: (MonadNix e t f m, MonadState (HashMap Path NExprLoc, b) m)+  => Path   -> m (NValue t f m)-defaultImportPath path = do-  traceM $ "Importing file " <> path-  withFrame Info (ErrorCall $ "While importing file " <> show path) $ do-    imports <- gets fst-    evalExprLoc =<<-      maybe-        (do-          eres <- parseNixFileLoc path-          either-            (\ err -> throwError $ ErrorCall . show $ fillSep ["Parse during import failed:", err])-            (\ expr ->-              do-                modify (first (M.insert path expr))-                pure expr+defaultImportPath path =+  do+    traceM $ "Importing file " <> coerce path+    withFrame+      Info+      (ErrorCall $ "While importing file " <> show path)+      $ evalExprLoc =<<+          (maybe+            (either+              (\ err -> throwError $ ErrorCall . show $ fillSep ["Parse during import failed:", err])+              (\ expr ->+                do+                  modify $ first $ M.insert path expr+                  pure expr+              )+              =<< parseNixFileLoc path             )-            eres-        )-        pure  -- return expr-        (M.lookup path imports)+            pure  -- return expr+            . M.lookup path+          ) =<< gets fst -defaultPathToDefaultNix :: MonadNix e t f m => FilePath -> m FilePath+defaultPathToDefaultNix :: MonadNix e t f m => Path -> m Path defaultPathToDefaultNix = pathToDefaultNixFile  -- Given a path, determine the nix file to load-pathToDefaultNixFile :: MonadFile m => FilePath -> m FilePath-pathToDefaultNixFile p = do-  isDir <- doesDirectoryExist p-  pure $ p </> "default.nix" `whenTrue` isDir+pathToDefaultNixFile :: MonadFile m => Path -> m Path+pathToDefaultNixFile p =+  do+    isDir <- doesDirectoryExist p+    pure $ p </> "default.nix" `whenTrue` isDir  defaultTraceEffect :: MonadPutStr m => String -> m () defaultTraceEffect = Nix.Effects.putStrLn

@@ -1,12 +1,12 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@+{-# language DataKinds #-}+{-# language NamedFieldPuns #-}+{-# language RecordWildCards #-}+{-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@  module Nix.Effects.Derivation ( defaultDerivationStrict ) where -import           Nix.Utils+import           Prelude                 hiding ( readFile )+import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import           Data.Char                      ( isAscii                                                 , isAlphaNum                                                 )@@ -24,6 +24,7 @@ import qualified "cryptonite" Crypto.Hash      as Hash -- 2021-07-05: Attrocity of Haskell hashing situation, in HNix we ended-up with 2 hash package dependencies @{hashing, cryptonite}@  import           Nix.Atoms+import           Nix.Expr.Types          hiding ( Recursive ) import           Nix.Convert import           Nix.Effects import           Nix.Exec                       ( MonadNix@@ -40,9 +41,9 @@ import qualified System.Nix.ReadonlyStore      as Store import qualified System.Nix.Hash               as Store import qualified System.Nix.StorePath          as Store-import Prelude hiding (readFile)  +--  2021-07-17: NOTE: Derivation consists of @"keys"@ @"vals"@ (of text), so underlining type boundary currently stops here. data Derivation = Derivation   { name :: Text   , outputs :: Map Text Text@@ -75,11 +76,11 @@   let (inputSrcs, inputDrvs) = inputs   references <- Set.fromList <$> traverse parsePath (Set.toList $ inputSrcs <> Set.fromList (Map.keys inputDrvs))   path <- addTextToStore (Text.append name ".drv") (unparseDrv drv) (S.fromList $ Set.toList references) False-  parsePath $ toText $ unStorePath path+  parsePath $ fromString $ coerce path  -- | Traverse the graph of inputDrvs to replace fixed output derivations with their fixed output hash. -- this avoids propagating changes to their .drv when the output hash stays the same.-hashDerivationModulo :: (MonadNix e t f m, MonadState (b, AttrSet Text) m) => Derivation -> m (Hash.Digest Hash.SHA256)+hashDerivationModulo :: (MonadNix e t f m, MonadState (b, KeyMap Text) m) => Derivation -> m (Hash.Digest Hash.SHA256) hashDerivationModulo   Derivation     { mFixed = Just (Store.SomeDigest (digest :: Hash.Digest hashType))@@ -91,7 +92,7 @@       Hash.hash @ByteString @Hash.SHA256 $         encodeUtf8 $           "fixed:out"-          <> (if hashMode == Recursive then ":r" else "")+          <> (if hashMode == Recursive then ":r" else mempty)           <> ":" <> (Store.algoName @hashType)           <> ":" <> Store.encodeDigestWith Store.Base16 digest           <> ":" <> path@@ -110,7 +111,7 @@           (\(path, outs) ->             maybe               (do-                drv' <- readDerivation $ toString path+                drv' <- readDerivation $ coerce $ toString path                 hash <- Store.encodeDigestWith Store.Base16 <$> hashDerivationModulo drv'                 pure (hash, outs)               )@@ -144,7 +145,7 @@       ]   where     produceOutputInfo (outputName, outputPath) =-      let prefix = if hashMode == Recursive then "r:" else "" in+      let prefix = if hashMode == Recursive then "r:" else mempty in       parens $ (s <$>) $ ([outputName, outputPath] <>) $         maybe           [mempty, mempty]@@ -168,13 +169,13 @@     escape '\t' = "\\t"     escape c = one c -readDerivation :: (Framed e m, MonadFile m) => FilePath -> m Derivation+readDerivation :: (Framed e m, MonadFile m) => Path -> m Derivation readDerivation path = do-  content <- decodeUtf8 <$> readFile path+  content <- readFile path   either     (\ err -> throwError $ ErrorCall $ "Failed to parse " <> show path <> ":\n" <> show err)     pure-    (parse derivationParser path content)+    (parse derivationParser (coerce path) content)  derivationParser :: Parsec () Text Derivation derivationParser = do@@ -199,13 +200,13 @@    let outputs = Map.fromList $ (\(a, b, _, _) -> (a, b)) <$> fullOutputs   let (mFixed, hashMode) = parseFixed fullOutputs-  let name = "" -- FIXME (extract from file path ?)-  let useJson = ["__json"] == Map.keys env+  let name = mempty -- FIXME (extract from file path ?)+  let useJson = one "__json" == Map.keys env    pure $ Derivation {inputs = (inputSrcs, inputDrvs), ..}  where   s :: Parsec () Text Text-  s = fmap toText $ string "\"" *> manyTill (escaped <|> regular) (string "\"")+  s = fmap fromString $ string "\"" *> manyTill (escaped <|> regular) (string "\"")   escaped = char '\\' *>     (   '\n' <$ string "n"     <|> '\r' <$ string "r"@@ -218,12 +219,13 @@     string o *> sepBy p (string ",") <* string c    parens :: Parsec () Text a -> Parsec () Text [a]-  parens p = wrap "(" ")" p-  serializeList p = wrap "[" "]" p+  parens = wrap "(" ")"+  serializeList :: Parsec () Text a -> Parsec () Text [a]+  serializeList = wrap "[" "]"    parseFixed :: [(Text, Text, Text, Text)] -> (Maybe Store.SomeNamedDigest, HashMode)   parseFixed fullOutputs = case fullOutputs of-    [("out", _path, rht, hash)] | rht /= "" && hash /= "" ->+    [("out", _path, rht, hash)] | rht /= mempty && hash /= mempty ->       let         (hashType, hashMode) = case Text.splitOn ":" rht of           ["r", ht] -> (ht, Recursive)@@ -238,9 +240,9 @@     _ -> (Nothing, Flat)  -defaultDerivationStrict :: forall e t f m b. (MonadNix e t f m, MonadState (b, AttrSet Text) m) => NValue t f m -> m (NValue t f m)+defaultDerivationStrict :: forall e t f m b. (MonadNix e t f m, MonadState (b, KeyMap Text) m) => NValue t f m -> m (NValue t f m) defaultDerivationStrict val = do-    s <- fromValue @(AttrSet (NValue t f m)) val+    s <- M.mapKeys coerce <$> fromValue @(AttrSet (NValue t f m)) val     (drv, ctx) <- runWithStringContextT' $ buildDerivationWithContext s     drvName <- makeStorePathName $ name drv     let@@ -266,47 +268,50 @@               ifNotJsonModEnv                 (\ baseEnv ->                   foldl'-                    (\m k -> Map.insert k "" m)+                    (\m k -> Map.insert k mempty m)                     baseEnv                     (Map.keys $ outputs drv)                 )           }-        outputs' <- sequence $ Map.mapWithKey (\o _ -> makeOutputPath o hash drvName) $ outputs drv+        outputs' <- sequenceA $ Map.mapWithKey (\o _ -> makeOutputPath o hash drvName) $ outputs drv         pure $ drv           { inputs           , outputs = outputs'-          , env = ifNotJsonModEnv $ (outputs' <>)+          , env = ifNotJsonModEnv (outputs' <>)           } -    drvPath <- pathToText <$> writeDerivation drv'+    (coerce @Text @VarName -> drvPath) <- pathToText <$> writeDerivation drv'      -- Memoize here, as it may be our last chance in case of readonly stores.     drvHash <- Store.encodeDigestWith Store.Base16 <$> hashDerivationModulo drv'-    modify $ second $ MS.insert drvPath drvHash+    modify $ second $ MS.insert (coerce drvPath) drvHash      let       outputsWithContext =         Map.mapWithKey-          (\out path -> makeNixStringWithSingletonContext path $ StringContext drvPath $ DerivationOutput out)+          (\out (coerce -> path) -> mkNixStringWithSingletonContext path $ StringContext drvPath $ DerivationOutput out)           (outputs drv')-      drvPathWithContext = makeNixStringWithSingletonContext drvPath $ StringContext drvPath AllOutputs+      drvPathWithContext = mkNixStringWithSingletonContext drvPath $ StringContext drvPath AllOutputs       attrSet = nvStr <$> M.fromList (("drvPath", drvPathWithContext) : Map.toList outputsWithContext)     -- TODO: Add location information for all the entries.     --              here --v-    pure $ nvSet mempty attrSet+    pure $ nvSet mempty (M.mapKeys coerce attrSet)    where      pathToText = decodeUtf8 . Store.storePathToRawFilePath      makeOutputPath o h n = do-      name <- makeStorePathName $ Store.unStorePathName n <> if o == "out" then "" else "-" <> o+      name <- makeStorePathName $ Store.unStorePathName n <> if o == "out" then mempty else "-" <> o       pure $ pathToText $ Store.makeStorePath "/nix/store" ("output:" <> encodeUtf8 o) h name -    toStorePaths ctx = foldl (flip addToInputs) (mempty, mempty) ctx+    toStorePaths :: HashSet StringContext -> (Set Text, Map Text [Text])+    toStorePaths = foldl (flip addToInputs) mempty++    addToInputs :: Bifunctor p => StringContext -> p (Set Text) (Map Text [Text])  -> p (Set Text) (Map Text [Text])     addToInputs (StringContext path kind) = case kind of-      DirectPath -> first (Set.insert path)-      DerivationOutput o -> second (Map.insertWith (<>) path [o])+      DirectPath -> first (Set.insert (coerce path))+      DerivationOutput o -> second (Map.insertWith (<>) (coerce path) $ one o)       AllOutputs ->         -- TODO: recursive lookup. See prim_derivationStrict         -- XXX: When is this really used ?@@ -316,7 +321,7 @@ -- | Build a derivation in a context collecting string contexts. -- This is complex from a typing standpoint, but it allows to perform the -- full computation without worrying too much about all the string's contexts.-buildDerivationWithContext :: forall e t f m. (MonadNix e t f m) => AttrSet (NValue t f m) -> WithStringContextT m Derivation+buildDerivationWithContext :: forall e t f m. (MonadNix e t f m) => KeyMap (NValue t f m) -> WithStringContextT m Derivation buildDerivationWithContext drvAttrs = do     -- Parse name first, so we can add an informative frame     drvName     <- getAttr   "name"                      $ assertDrvStoreName <=< extractNixString@@ -330,13 +335,13 @@       platform    <- getAttr   "system"                    $ assertNonNull <=< extractNoCtx       mHash       <- getAttrOr "outputHash"        mempty  $ (pure . pure) <=< extractNoCtx       hashMode    <- getAttrOr "outputHashMode"    Flat    $ parseHashMode <=< extractNoCtx-      outputs     <- getAttrOr "outputs"           ["out"] $ traverse (extractNoCtx <=< fromValue')+      outputs     <- getAttrOr "outputs"       (one "out") $ traverse (extractNoCtx <=< fromValue')        mFixedOutput <-         maybe           (pure Nothing)           (\ hash -> do-            when (outputs /= ["out"]) $ lift $ throwError $ ErrorCall "Multiple outputs are not supported for fixed-output derivations"+            when (outputs /= one "out") $ lift $ throwError $ ErrorCall "Multiple outputs are not supported for fixed-output derivations"             hashType <- getAttr "outputHashAlgo" extractNoCtx             digest <- lift $ either (throwError . ErrorCall) pure $ Store.mkNamedDigest hashType hash             pure $ pure digest)@@ -362,7 +367,7 @@        env <- if useJson         then do-          jsonString :: NixString <- lift $ nvalueToJSONNixString $ nvSet mempty $+          jsonString :: NixString <- lift $ nvalueToJSONNixString $ nvSet mempty $ M.mapKeys coerce $             deleteKeys [ "args", "__ignoreNulls", "__structuredAttrs" ] attrs           rawString :: Text <- extractNixString jsonString           pure $ one ("__json", rawString)@@ -374,7 +379,7 @@         , name = drvName         , outputs = Map.fromList $ (, mempty) <$> outputs         , mFixed = mFixedOutput-        , inputs = (mempty, mempty) -- stub for now+        , inputs = mempty -- stub for now         }   where @@ -386,7 +391,7 @@     withFrame' :: (Framed e m, Exception s) => NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a     withFrame' level f = join . lift . withFrame level f . pure -    -- shortcuts to get the (forced) value of an AttrSet field+    -- shortcuts to get the (forced) value of an KeyMap field      getAttrOr' :: forall v a. (MonadNix e t f m, FromValue v m (NValue' t f m (NValue t f m)))       => Text -> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a@@ -395,7 +400,7 @@       Just v  -> withFrame' Info (ErrorCall $ "While evaluating attribute '" <> show n <> "'") $                    f =<< fromValue' v -    getAttrOr n d f = getAttrOr' n (pure d) f+    getAttrOr n = getAttrOr' n . pure      getAttr n = getAttrOr' n (throwError $ ErrorCall $ "Required attribute '" <> show n <> "' not found.") @@ -431,6 +436,6 @@      -- Other helpers -    deleteKeys :: [Text] -> AttrSet a -> AttrSet a+    deleteKeys :: [Text] -> KeyMap a -> KeyMap a     deleteKeys keys attrSet = foldl' (flip M.delete) attrSet keys 

@@ -1,38 +1,39 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# language AllowAmbiguousTypes #-}+{-# language ConstraintKinds #-}+{-# language RankNTypes #-}    module Nix.Eval where +import           Relude.Extra                   ( set ) import           Control.Monad                  ( foldM ) import           Control.Monad.Fix              ( MonadFix )+import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import           Data.Semialign.Indexed         ( ialignWith ) import qualified Data.HashMap.Lazy             as M import           Data.List                      ( partition ) import           Data.These                     ( These(..) ) import           Nix.Atoms import           Nix.Convert-import           Nix.Expr+import           Nix.Expr.Types+import           Nix.Expr.Types.Annotated import           Nix.Expr.Strings               ( runAntiquoted ) import           Nix.Frames import           Nix.String import           Nix.Scope-import           Nix.Utils import           Nix.Value.Monad  class (Show v, Monad m) => MonadEval v m where-  freeVariable    :: Text -> m v-  synHole         :: Text -> m v-  attrMissing     :: NonEmpty Text -> Maybe v -> m v-  evaledSym       :: Text -> v -> m v+  freeVariable    :: VarName -> m v+  synHole         :: VarName -> m v+  attrMissing     :: NonEmpty VarName -> Maybe v -> m v+  evaledSym       :: VarName -> v -> m v   evalCurPos      :: m v   evalConstant    :: NAtom -> m v   evalString      :: NString (m v) -> m v-  evalLiteralPath :: FilePath -> m v-  evalEnvPath     :: FilePath -> m v+  evalLiteralPath :: Path -> m v+  evalEnvPath     :: Path -> m v   evalUnary       :: NUnaryOp -> v -> m v   evalBinary      :: NBinaryOp -> v -> m v -> m v   -- ^ The second argument is an action because operators such as boolean &&@@ -60,9 +61,9 @@   evalListElem   :: [m v] -> Int -> m v -> m v   evalList       :: [v] -> m v   evalSetElem    :: AttrSet (m v) -> Text -> m v -> m v-  evalSet        :: AttrSet v -> AttrSet SourcePos -> m v+  evalSet        :: AttrSet v -> PositionSet -> m v   evalRecSetElem :: AttrSet (m v) -> Text -> m v -> m v-  evalRecSet     :: AttrSet v -> AttrSet SourcePos -> m v+  evalRecSet     :: AttrSet v -> PositionSet -> m v   evalLetElem    :: Text -> m v -> m v   evalLet        :: m v -> m v -}@@ -76,8 +77,8 @@   , ToValue Bool m v   , ToValue [v] m v   , FromValue NixString m v-  , ToValue (AttrSet v, AttrSet SourcePos) m v-  , FromValue (AttrSet v, AttrSet SourcePos) m v+  , ToValue (AttrSet v, PositionSet) m v+  , FromValue (AttrSet v, PositionSet) m v   )  data EvalFrame m v@@ -129,12 +130,12 @@     lav <- larg     evalBinary op lav rarg -eval (NSelect aset attr alt ) =+eval (NSelect alt aset attr) =   do     let useAltOrReportMissing (s, ks) = fromMaybe (attrMissing ks $ pure s) alt      eAttr <- evalSelect aset attr-    either useAltOrReportMissing id eAttr+    either useAltOrReportMissing id (coerce eAttr)  eval (NHasAttr aset attr) =   do@@ -144,23 +145,17 @@ eval (NList l           ) =   do     scope <- currentScopes-    lst <- traverse (defer @v @m . withScopes @v scope) l-    toValue lst--eval (NSet NNonRecursive binds) =-  do-    attrSet <- evalBinds False $ desugarBinds (eval . NSet NNonRecursive) binds-    toValue attrSet+    toValue =<< traverse (defer @v @m . withScopes @v scope) l -eval (NSet NRecursive binds) =+eval (NSet r binds) =   do-    attrSet <- evalBinds True $ desugarBinds (eval . NSet NNonRecursive) binds+    attrSet <- evalBinds (r == Recursive) $ desugarBinds (eval . NSet mempty) binds     toValue attrSet  eval (NLet binds body    ) =   do     (attrSet, _) <- evalBinds True binds-    pushScope attrSet body+    pushScope (coerce attrSet) body  eval (NIf cond t f       ) =   do@@ -179,78 +174,97 @@   -- needs to be used when evaluating the body and default arguments, hence we   -- defer here so the present scope is restored when the parameters and body   -- are forced during application.-  scope <- currentScopes :: m (Scopes m v)+  curScope <- currentScopes   let-    withScope = withScopes scope-    withScopeInform = withScope . inform+    withCurScope = withScopes curScope -  evalAbs-    params-    (\arg k ->-      withScope $+    fun :: m v -> (AttrSet (m v) -> m v -> m r) -> m r+    fun arg k =+      withCurScope $         do-          args <- buildArgument params arg+          (coerce -> newScopeToAdd) <- buildArgument params arg           pushScope-            args $+            newScopeToAdd $             k-              (withScopeInform <$> args)+              (coerce $ withCurScope . inform <$> newScopeToAdd)               body-    ) +  evalAbs+    params+    fun+ eval (NSynHole name) = synHole name  -- | If you know that the 'scope' action will result in an 'AttrSet v', then --   this implementation may be used as an implementation for 'evalWith'. evalWithAttrSet :: forall v m . MonadNixEval v m => m v -> m v -> m v evalWithAttrSet aset body = do-  scope <- currentScopes :: m (Scopes m v)+  scopes <- currentScopes :: m (Scopes m v)   -- The scope is deliberately wrapped in a thunk here, since it is demanded   -- each time a name is looked up within the weak scope, and we want to be   -- sure the action it evaluates is to force a thunk, so its value is only   -- computed once.-  deferredAset <- defer $ withScopes scope aset-  let attrSet = fst <$> (fromValue @(AttrSet v, AttrSet SourcePos) =<< demand deferredAset)+  deferredAset <- defer $ withScopes scopes aset+  let weakscope = coerce . fst <$> (fromValue @(AttrSet v, PositionSet) =<< demand deferredAset) -  pushWeakScope attrSet body+  pushWeakScope weakscope body  attrSetAlter   :: forall v m    . MonadNixEval v m-  => [Text]+  => [VarName]   -> SourcePos   -> AttrSet (m v)-  -> AttrSet SourcePos+  -> PositionSet   -> m v-  -> m (AttrSet (m v), AttrSet SourcePos)-attrSetAlter [] _ _ _ _ = evalError @v $ ErrorCall "invalid selector with no components"-attrSetAlter (k : ks) pos m p val =-  bool-    go-    (maybe-      (recurse mempty mempty)-      (\x ->-        do-          (st, sp) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< x-          recurse (demand <$> st) sp-      )-      (M.lookup k m)-    )-    (not $ null ks)+  -> m (AttrSet (m v), PositionSet)+attrSetAlter ks' pos m' p' val =+  swap <$> go p' m' ks'  where-  go = pure (M.insert k val m, M.insert k pos p)--  recurse st sp =-    (\(st', _) ->-      (M.insert-        k-        (toValue @(AttrSet v, AttrSet SourcePos) =<< (, mempty) <$> sequence st')-        m-      , M.insert k pos p+  -- This `go` does traverse in disquise. Notice how it traverses `ks`.+  go+    :: PositionSet+    -> AttrSet (m v)+    -> [VarName]+    -> m (PositionSet, AttrSet (m v))+  go _ _ [] = evalError @v $ ErrorCall "invalid selector with no components"+  go p m (k : ks) =+    bool+      (pure $ insertVal val)+      (maybe+        (recurse mempty mempty)+        (\x ->+          do+            --  2021-10-12: NOTE: swapping sourcewide into (PositionSet, AttrSet) would optimize code and remove this `swap`+            (swap -> (sp, st)) <- fromValue @(AttrSet v, PositionSet) =<< x+            recurse sp $ demand <$> st+        )+        ((`M.lookup` m) k)       )-    ) <$> attrSetAlter ks pos st sp val+      (not $ null ks)+   where+    insertVal :: m v -> (PositionSet, AttrSet (m v))+    insertVal v =+      ( insertPos+      , insertV v+      )+     where+      insertV v' = M.insert k v' m+      insertPos = M.insert k pos p +    recurse+      :: PositionSet+      -> AttrSet (m v)+      -> m ( PositionSet+          , AttrSet (m v)+          )+    recurse p'' m'' =+      fmap+        (insertVal . (=<<) (toValue @(AttrSet v, PositionSet)) . fmap (,mempty) . sequenceA . snd)+        (go p'' m'' ks)+ desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r]-desugarBinds embed binds = evalState (traverse (go <=< collect) binds) mempty+desugarBinds embed binds = evalState (traverse (findBinding <=< collect) binds) mempty  where   collect     :: Binding r@@ -261,76 +275,79 @@     do       m <- get       put $-        M.insert-          x-          (maybe-            (p, [bindValAt p])-            (\ (q, v) -> (q, bindValAt q : v))-            (M.lookup x m)+        join+          (M.insert+            x+            . maybe+              (p, one $ bindValAt p)+              (\ (sp, bnd) -> (sp, one (bindValAt sp) <> bnd))+              . M.lookup x           )           m       pure $ Left x    where-    bindValAt pos = NamedVar (y :| ys) val pos+    bindValAt = NamedVar (y :| ys) val   collect x = pure $ pure x -  go+  findBinding     :: Either VarName (Binding r)     -> State (HashMap VarName (SourcePos, [Binding r])) (Binding r)-  go =+  findBinding =     either-      (\ x -> do-        maybeValue <- gets $ M.lookup x+      (\ x ->         maybe           (error $ "No binding " <> show x)-          (\ (p, v) -> pure $ NamedVar (StaticKey x :| mempty) (embed v) p)-          maybeValue+          (\ (p, v) -> pure $ NamedVar (one $ StaticKey x) (embed v) p)+          =<< gets (M.lookup x)       )       pure  evalBinds   :: forall v m    . MonadNixEval v m+--  2021-07-19: NOTE: Recutsivity data type   => Bool   -> [Binding (m v)]-  -> m (AttrSet v, AttrSet SourcePos)-evalBinds recursive binds =+--  2021-07-19: NOTE: AttrSet is a Scope+  -> m (AttrSet v, PositionSet)+evalBinds isRecursive binds =   do     scope <- currentScopes :: m (Scopes m v) -    buildResult scope . concat =<< traverse (applyBindToAdt scope) (moveOverridesLast binds)+    buildResult scope . fold =<< (`traverse` moveOverridesLast binds) (applyBindToAdt scope)   where   buildResult     :: Scopes m v-    -> [([Text], SourcePos, m v)]-    -> m (AttrSet v, AttrSet SourcePos)-  buildResult scope bindings =+    -> [([VarName], SourcePos, m v)]+    -> m (AttrSet v, PositionSet)+  buildResult scopes bindings =     do-      (s, p) <- foldM insert (mempty, mempty) bindings+      (coerce -> scope, p) <- foldM insert mempty bindings       res <-         bool-          (traverse mkThunk s)-          (loebM $ encapsulate <$> s)-          recursive+          (traverse mkThunk)+          (loebM . fmap encapsulate)+          isRecursive+          scope -      pure (res, p)+      pure (coerce res, p)     where     insert (m, p) (path, pos, value) = attrSetAlter path pos m p value -    mkThunk = defer . withScopes scope+    mkThunk = defer . withScopes scopes      encapsulate f attrs = mkThunk $ pushScope attrs f -  applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([Text], SourcePos, m v)]+  applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]   applyBindToAdt _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =     do       (o', p') <- fromValue =<< finalValue       -- jww (2018-05-09): What to do with the key position here?       pure $         (\ (k, v) ->-          ( [k]+          ( one k           , fromMaybe pos $ M.lookup k p'           , demand v           )@@ -341,19 +358,19 @@       -- When there are no path segments, e.g. `${null} = 5;`, we don't       -- bind anything       ([], _, _) -> mempty-      result     -> [result]+      result     -> one result     ) <$> processAttrSetKeys pathExpr     where-    processAttrSetKeys :: NAttrPath (m v) -> m ([Text], SourcePos, m v)+    processAttrSetKeys :: NAttrPath (m v) -> m ([VarName], SourcePos, m v)     processAttrSetKeys (h :| t) =       maybe         -- Empty attrset - return a stub.-        (pure ( mempty, nullPos, toValue @(AttrSet v, AttrSet SourcePos) (mempty, mempty)) )+        (pure (mempty, nullPos, toValue @(AttrSet v, PositionSet) mempty) )         (\ k ->           list             -- No more keys in the attrset - return the result-            (pure ( [k], pos, finalValue ) )+            (pure ( one k, pos, finalValue ) )             -- There are unprocessed keys in attrset - recurse appending the results             (\ (x : xs) ->               do@@ -364,37 +381,28 @@         )         =<< evalSetterKeyName h -  applyBindToAdt scope (Inherit ms names pos) =-    catMaybes <$>-      traverse-        processScope-        names+  applyBindToAdt scopes (Inherit ms names pos) =+    pure $ processScope <$> names    where     processScope-      :: NKeyName (m v)-      -> m (Maybe ([Text], SourcePos, m v))-    processScope nkeyname =-      (\ mkey ->-        do-          key <- mkey-          pure-            ([key]-            , pos-            , maybe-                (attrMissing (key :| mempty) Nothing)-                demand-                =<< maybe-                    (withScopes scope $ lookupVar key)-                    (\ s ->-                      do-                        (attrset, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< s+      :: VarName+      -> ([VarName], SourcePos, m v)+    processScope var =+      ( one var+      , pos+      , maybe+          (attrMissing (one var) Nothing)+          demand+          =<< maybe+              (withScopes scopes $ lookupVar var)+              (\ s ->+                do+                  (coerce -> scope, _) <- fromValue @(AttrSet v, PositionSet) =<< s -                        clearScopes @v $ pushScope attrset $ lookupVar key-                    )-                    ms-            )-      ) <$>-        evalSetterKeyName nkeyname+                  clearScopes $ pushScope @v scope $ lookupVar var+              )+              ms+      )    moveOverridesLast = uncurry (<>) . partition     (\case@@ -407,30 +415,33 @@    . MonadNixEval v m   => m v   -> NAttrPath (m v)-  -> m (Either (v, NonEmpty Text) (m v))+  -> m (Either (v, NonEmpty VarName) (m v)) evalSelect aset attr =   do     s    <- aset     path <- traverse evalGetterKeyName attr -    extract s path+    extract path s   where-  extract x path@(k :| ks) =-    do-      x' <- fromValueMay x--      case x' of-        Nothing -> pure $ Left (x, path)-        Just (s :: AttrSet v, p :: AttrSet SourcePos)-          | Just t <- M.lookup k s ->-            do-              list-                (pure . pure)-                (\ (y : ys) -> ((`extract` (y :| ys)) =<<))-                ks-                $ demand t-          | otherwise -> Left . (, path) <$> toValue (s, p)+  extract :: NonEmpty VarName -> v -> m (Either (v, NonEmpty VarName) (m v))+  extract path@(k :| ks) x =+    maybe+      left+      (maybe+        left+        (list+          (pure . pure)+          (\ (y : ys) -> (extract (y :| ys) =<<))+          ks+          . demand+        )+        . M.lookup k . fst+      )+      =<< fromValueMay @(AttrSet v, PositionSet) x+   where+    left :: m (Either (v, NonEmpty VarName) b)+    left = pure $ Left (x, path)  -- | Evaluate a component of an attribute path in a context where we are -- *retrieving* a value@@ -438,7 +449,7 @@   :: forall v m    . (MonadEval v m, FromValue NixString m v)   => NKeyName (m v)-  -> m Text+  -> m VarName evalGetterKeyName =   maybe     (evalError @v $ ErrorCall "value is null while a string was expected")@@ -450,33 +461,29 @@ evalSetterKeyName   :: (MonadEval v m, FromValue NixString m v)   => NKeyName (m v)-  -> m (Maybe Text)+  -> m (Maybe VarName) evalSetterKeyName =   \case     StaticKey k -> pure $ pure k     DynamicKey k ->-      maybe-        mempty-        (pure . stringIgnoreContext)-        <$> runAntiquoted "\n" assembleString (fromValueMay =<<) k+      (coerce . stringIgnoreContext) <<$>>+        runAntiquoted "\n" assembleString (fromValueMay =<<) k  assembleString   :: forall v m    . (MonadEval v m, FromValue NixString m v)   => NString (m v)   -> m (Maybe NixString)-assembleString =-  fromParts .-    \case-      Indented   _ parts -> parts-      DoubleQuoted parts -> parts+assembleString = fromParts . stringParts  where-  fromParts xs = (mconcat <$>) . sequence <$> traverse go xs+  fromParts :: [Antiquoted Text (m v)] -> m (Maybe NixString)+  fromParts xs = fold <<$>> traverseM fun xs -  go =+  fun :: Antiquoted Text (m v) -> m (Maybe NixString)+  fun =     runAntiquoted       "\n"-      (pure . pure . makeNixStringWithoutContext)+      (pure . pure . mkNixStringWithoutContext)       (fromValueMay =<<)  buildArgument@@ -484,43 +491,42 @@ buildArgument params arg =   do     scope <- currentScopes :: m (Scopes m v)-    let argThunk = defer $ withScopes scope arg+    let+      argThunk = defer $ withScopes scope arg     case params of-      Param name -> M.singleton name <$> argThunk-      ParamSet s isVariadic m ->+      Param name -> one . (name,) <$> argThunk+      ParamSet mname variadic pset ->         do-          (args, _) <- fromValue @(AttrSet v, AttrSet SourcePos) =<< arg+          (args, _) <- fromValue @(AttrSet v, PositionSet) =<< arg           let             inject =               maybe                 id-                (\ n -> M.insert n $ const argThunk) -- why insert into const?-                m-          loebM-            (inject $-                M.mapMaybe-                  id-                  (ialignWith-                    (assemble scope isVariadic)+                (`M.insert` const argThunk) -- why insert into const? Thunk value getting magic point?+                mname+          loebM $+            inject $+              M.mapMaybe+                id+                $ ialignWith+                    (assemble scope variadic)                     args-                    $ M.fromList s-                  )-            )+                    $ M.fromList pset  where   assemble     :: Scopes m v-    -> Bool-    -> Text+    -> Variadic+    -> VarName     -> These v (Maybe (m v))     -> Maybe (AttrSet v -> m v)-  assemble scope isVariadic k =-    \case-      That Nothing -> pure $ const $ evalError @v $ ErrorCall $ "Missing value for parameter: " <> show k-      That (Just f) -> pure $ \args -> defer $ withScopes scope $ pushScope args f-      This _-        | isVariadic -> Nothing-        | otherwise  -> pure $ const $ evalError @v $ ErrorCall $ "Unexpected parameter: " <> show k-      These x _ -> pure $ const $ pure x+  assemble _ Variadic _ (This _) = Nothing+  assemble scope _ k t =+    pure $+      case t of+        That Nothing -> const $ evalError @v $ ErrorCall $ "Missing value for parameter: ''" <> show k+        That (Just f) -> coerce $ defer . withScopes scope . (`pushScope` f)+        This _ -> const $ evalError @v $ ErrorCall $ "Unexpected parameter: " <> show k+        These x _ -> const $ pure x  -- | Add source positions to @NExprLoc@. --@@ -533,7 +539,7 @@ -- > -> NExprLoc -> m a addSourcePositions   :: (MonadReader e m, Has e SrcSpan) => Transform NExprLocF (m a)-addSourcePositions f (v@(AnnE ann _) :: NExprLoc) =+addSourcePositions f (v@(Ann ann _) :: NExprLoc) =   local (set hasLens ann) $ f v  addStackFrames@@ -571,4 +577,4 @@   :: MonadNixEval v m   => AnnF ann NExprF (m v)   -> m v-evalContent = eval . stripAnn+evalContent = eval . stripAnnF

@@ -1,14 +1,13 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE PartialTypeSignatures #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}+{-# language AllowAmbiguousTypes #-}+{-# language CPP #-}+{-# language ConstraintKinds #-}+{-# language PartialTypeSignatures #-}+{-# language RankNTypes #-}+{-# language TypeFamilies #-}+{-# language UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# options_ghc -Wno-orphans #-}+{-# options_ghc -fno-warn-name-shadowing #-}   module Nix.Exec where@@ -17,7 +16,7 @@                                                 , putStrLn                                                 , print                                                 )-+import           GHC.Exception                  ( ErrorCall(ErrorCall) ) import           Control.Monad.Catch     hiding ( catchJust ) import           Control.Monad.Fix import           Data.Fix@@ -29,7 +28,8 @@ import           Nix.Convert import           Nix.Effects import           Nix.Eval                      as Eval-import           Nix.Expr+import           Nix.Expr.Types+import           Nix.Expr.Types.Annotated import           Nix.Frames import           Nix.Options import           Nix.Pretty@@ -38,7 +38,6 @@ import           Nix.String import           Nix.String.Coerce import           Nix.Thunk-import           Nix.Utils import           Nix.Value import           Nix.Value.Equal import           Nix.Value.Monad@@ -72,7 +71,7 @@ nvPathP   :: MonadCited t f m   => Provenance m (NValue t f m)-  -> FilePath+  -> Path   -> NValue t f m nvPathP p x = addProvenance p $ nvPath x @@ -86,7 +85,7 @@ nvSetP   :: MonadCited t f m   => Provenance m (NValue t f m)-  -> AttrSet SourcePos+  -> PositionSet   -> AttrSet (NValue t f m)   -> NValue t f m nvSetP p x s = addProvenance p $ nvSet x s@@ -102,7 +101,7 @@ nvBuiltinP   :: MonadCited t f m   => Provenance m (NValue t f m)-  -> Text+  -> VarName   -> (NValue t f m -> m (NValue t f m))   -> NValue t f m nvBuiltinP p name f = addProvenance p $ nvBuiltin name f@@ -140,21 +139,21 @@ currentPos = asks $ view hasLens  wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc-wrapExprLoc span x = Fix $ Fix (NSym_ span "<?>") <$ x+wrapExprLoc span x = Fix $ NSymAnn span "<?>" <$ x {-# inline wrapExprLoc #-}  --  2021-01-07: NOTE: This instance belongs to be beside MonadEval type class. -- Currently instance is stuck in orphanage between the requirements to be MonadEval, aka Eval stage, and emposed requirement to be MonadNix (Execution stage). MonadNix constraint tries to put the cart before horse and seems superflous, since Eval in Nix also needs and can throw exceptions. It is between `nverr` and `evalError`. instance MonadNix e t f m => MonadEval (NValue t f m) m where   freeVariable var =-    nverr @e @t @f $ ErrorCall $ "Undefined variable '" <> toString var <> "'"+    nverr @e @t @f $ ErrorCall $ toString @Text $ "Undefined variable '" <> coerce var <> "'"    synHole name = do     span  <- currentPos     scope <- currentScopes     evalError @(NValue t f m) $ SynHole $       SynHoleInfo-        { _synHoleInfo_expr  = Fix $ NSynHole_ span name+        { _synHoleInfo_expr  = NSynHoleAnn span name         , _synHoleInfo_scope = scope         } @@ -168,13 +167,13 @@         )         ms        where-        attr = Text.intercalate "." $ NE.toList ks+        attr = Text.intercalate "." $ NE.toList $ coerce ks    evalCurPos = do     scope                  <- currentScopes     span@(SrcSpan delta _) <- currentPos     addProvenance @_ @_ @(NValue t f m)-      (Provenance scope $ NSym_ span "__curPos") <$>+      (Provenance scope $ NSymAnnF span (coerce @Text "__curPos")) <$>         toValue delta    evaledSym name val = do@@ -182,13 +181,13 @@     span  <- currentPos     pure $       addProvenance @_ @_ @(NValue t f m)-        (Provenance scope $ NSym_ span name)+        (Provenance scope $ NSymAnnF span name)         val    evalConstant c = do     scope <- currentScopes     span  <- currentPos-    pure $ nvConstantP (Provenance scope $ NConstant_ span c) c+    pure $ join (nvConstantP . Provenance scope . NConstantAnnF span) c    evalString =     maybe@@ -198,10 +197,11 @@           scope <- currentScopes           span  <- currentPos           pure $-            nvStrP-              (Provenance-                scope-                (NStr_ span $ DoubleQuoted [Plain $ stringIgnoreContext ns])+            join+              (nvStrP+                . Provenance+                  scope+                  . NStrAnnF span . DoubleQuoted . one . Plain . stringIgnoreContext               )               ns       )@@ -210,14 +210,24 @@   evalLiteralPath p = do     scope <- currentScopes     span  <- currentPos-    nvPathP (Provenance scope $ NLiteralPath_ span p) <$>-      makeAbsolutePath @t @f @m p+    let+      evalPath :: Path -> m (NValue t f m)+      evalPath p1 =+        fmap+          (g p1)+          (f p1)+       where+        g :: Path -> Path -> NValue t f m+        g = nvPathP . Provenance scope . NLiteralPathAnnF span+        f :: Path -> m Path+        f = toAbsolutePath @t @f @m+    evalPath p    evalEnvPath p = do     scope <- currentScopes     span  <- currentPos-    nvPathP (Provenance scope $ NEnvPath_ span p) <$>-      findEnvPath @t @f @m p+    nvPathP (Provenance scope $ NEnvPathAnnF span p) <$>+      findEnvPath @t @f @m (coerce p)    evalUnary op arg = do     scope <- currentScopes@@ -232,24 +242,24 @@   evalWith c b = do     scope <- currentScopes     span  <- currentPos-    let f = join $ addProvenance . Provenance scope . NWith_ span Nothing . pure+    let f = join $ addProvenance . Provenance scope . NWithAnnF span Nothing . pure     f <$> evalWithAttrSet c b -  evalIf c t f = do+  evalIf c tVal fVal = do     scope <- currentScopes     span  <- currentPos-    b <- fromValue c+    bl <- fromValue c      let-      fun x y z = addProvenance (Provenance scope $ NIf_ span (pure c) x y) z+      fun x y = addProvenance (Provenance scope $ NIfAnnF span (pure c) x y)       -- Note: join acts as \ f x -> f x x-      false = join (fun Nothing . pure) <$> f-      true = join (flip fun Nothing . pure) <$> t+      falseVal = join (fun Nothing . pure) <$> fVal+      trueVal = join (flip fun Nothing . pure) <$> tVal      bool-      false-      true-      b+      falseVal+      trueVal+      bl    evalAssert c body =     do@@ -259,25 +269,26 @@         (nverr $ Assertion span c)         (do           scope <- currentScopes-          let f = join (addProvenance . Provenance scope . NAssert_ span (pure c) . pure)-          f <$> body+          join (addProvenance . Provenance scope . NAssertAnnF span (pure c) . pure) <$> body         )         b    evalApp f x = do     scope <- currentScopes     span  <- currentPos-    addProvenance (Provenance scope $ NBinary_ span NApp (pure f) Nothing) <$>+    addProvenance (Provenance scope $ NBinaryAnnF span NApp (pure f) Nothing) <$>       (callFunc f =<< defer x)    evalAbs p k = do+    let+      fk = flip k     scope <- currentScopes     span  <- currentPos     pure $       nvClosureP-        (Provenance scope $ NAbs_ span (Nothing <$ p) Nothing)+        (Provenance scope $ NAbsAnnF span (Nothing <$ p) Nothing)         (void p)-        (\arg -> snd <$> k (pure arg) (\_ b -> ((), ) <$> b))+        $ fmap snd . fk (const $ fmap ((), )) . pure    evalError = throwError @@ -299,8 +310,8 @@       NVBuiltin name f    ->         do           span <- currentPos-          withFrame Info ((Calling @m @(NValue t f m)) name span) $ f arg -- Is this cool?-      (NVSet m _) | Just f <- M.lookup "__functor" m ->+          withFrame Info ((Calling @m @(NValue t f m)) (coerce name) span) $ f arg -- Is this cool?+      (NVSet _ m) | Just f <- M.lookup "__functor" m ->         (`callFunc` arg) =<< (`callFunc` fun') =<< demand f       _x -> throwError $ ErrorCall $ "Attempt to call non-function: " <> show _x @@ -311,7 +322,7 @@   -> NUnaryOp   -> NValue t f m   -> m (NValue t f m)-execUnaryOp scope span op arg = do+execUnaryOp scope span op arg =   case arg of     NVConstant c ->       case (op, c) of@@ -323,7 +334,7 @@     _x ->       throwError $ ErrorCall $ "argument to unary operator must evaluate to an atomic type: " <> show _x  where-  unaryOp = pure . nvConstantP (Provenance scope $ NUnary_ span op $ pure arg)+  unaryOp = pure . nvConstantP (Provenance scope $ NUnaryAnnF span op $ pure arg)  execBinaryOp   :: forall e t f m@@ -351,6 +362,7 @@   where +  helperEq :: (Bool -> Bool) -> m (NValue t f m)   helperEq flag =     do       rval <- rarg@@ -375,7 +387,7 @@   toBoolOp r b =     pure $       nvConstantP-        (Provenance scope $ NBinary_ span op (pure lval) r)+        (Provenance scope $ NBinaryAnnF span op (pure lval) r)         (NBool b)  execBinaryOpForced@@ -403,9 +415,9 @@    NUpdate ->     case (lval, rval) of-      (NVSet ls lp, NVSet rs rp) -> pure $ nvSetP prov (rp <> lp) (rs <> ls)-      (NVSet ls lp, NVConstant NNull) -> pure $ nvSetP prov lp ls-      (NVConstant NNull, NVSet rs rp) -> pure $ nvSetP prov rp rs+      (NVSet lp ls, NVSet rp rs) -> pure $ nvSetP prov (rp <> lp) (rs <> ls)+      (NVSet lp ls, NVConstant NNull) -> pure $ nvSetP prov lp ls+      (NVConstant NNull, NVSet rp rs) -> pure $ nvSetP prov rp rs       _ -> unsupportedTypes    NPlus ->@@ -421,10 +433,10 @@           (throwError $ ErrorCall "A string that refers to a store path cannot be appended to a path.") -- data/nix/src/libexpr/eval.cc:1412           (\ rs2 ->             nvPathP prov <$>-              makeAbsolutePath @t @f (ls <> toString rs2)+              toAbsolutePath @t @f (ls <> coerce (toString rs2))           )           (getStringNoContext rs)-      (NVPath ls, NVPath rs) -> nvPathP prov <$> makeAbsolutePath @t @f (ls <> rs)+      (NVPath ls, NVPath rs) -> nvPathP prov <$> toAbsolutePath @t @f (ls <> rs)        (ls@NVSet{}, NVStr rs) ->         (\ls2 -> nvStrP prov (ls2 <> rs)) <$>@@ -443,7 +455,7 @@   where   prov :: Provenance m (NValue t f m)-  prov = Provenance scope $ NBinary_ span op (pure lval) (pure rval)+  prov = Provenance scope $ NBinaryAnnF span op (pure lval) (pure rval)    toBool = pure . nvConstantP prov . NBool   compare :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)@@ -452,8 +464,8 @@     (NVStr l, NVStr r) -> toBool $ l `op` r     _ -> unsupportedTypes -  toInt = pure . nvConstantP prov . NInt-  toFloat = pure . nvConstantP prov . NFloat+  nvInt = pure . nvConstantP prov . NInt+  nvFloat = pure . nvConstantP prov . NFloat    numBinOp :: (forall a. Num a => a -> a -> a) -> m (NValue t f m)   numBinOp op = numBinOp' op op@@ -462,13 +474,12 @@     :: (Integer -> Integer -> Integer)     -> (Float -> Float -> Float)     -> m (NValue t f m)-   numBinOp' intOp floatOp = case (lval, rval) of     (NVConstant l, NVConstant r) -> case (l, r) of-      (NInt   li, NInt   ri) -> toInt $ li `intOp` ri-      (NInt   li, NFloat rf) -> toFloat $ fromInteger li `floatOp` rf-      (NFloat lf, NInt   ri) -> toFloat $ lf `floatOp` fromInteger ri-      (NFloat lf, NFloat rf) -> toFloat $ lf `floatOp` rf+      (NInt   li, NInt   ri) -> nvInt $ li `intOp` ri+      (NInt   li, NFloat rf) -> nvFloat $ fromInteger li `floatOp` rf+      (NFloat lf, NInt   ri) -> nvFloat $ lf `floatOp` fromInteger ri+      (NFloat lf, NFloat rf) -> nvFloat $ lf `floatOp` rf       _ -> unsupportedTypes     _ -> unsupportedTypes @@ -502,7 +513,7 @@   depth <- ask   guard $ depth < 2000   local succ $ do-    v'@(AnnFP span x) <- sequence v+    v'@(AnnF span x) <- sequenceA v     pure $ do       opts :: Options <- asks $ view hasLens       let

@@ -1,251 +1,447 @@  -- | A bunch of shorthands for making nix expressions. ----- Functions with an @F@ suffix return a more general type without the outer--- 'Fix' wrapper.+-- Functions with an @F@ suffix return a more general type (base functor @F a@) without the outer+-- 'Fix' wrapper that creates @a@. module Nix.Expr.Shorthands where  import           Data.Fix import           Nix.Atoms import           Nix.Expr.Types-import           Text.Megaparsec.Pos            ( SourcePos ) --- | Make an integer literal expression.-mkInt :: Integer -> NExpr-mkInt = Fix . mkIntF+-- * Basic expression builders +-- | Put @NAtom@ as expression+mkConst :: NAtom -> NExpr+mkConst = Fix . NConstant -mkIntF :: Integer -> NExprF a-mkIntF = NConstant . NInt+-- | Put null.+mkNull :: NExpr+mkNull = Fix mkNullF --- | Make an floating point literal expression.+-- | Put boolean.+mkBool :: Bool -> NExpr+mkBool = Fix . mkBoolF++-- | Put integer.+mkInt :: Integer -> NExpr+mkInt = Fix . mkIntF++-- | Put floating point number. mkFloat :: Float -> NExpr mkFloat = Fix . mkFloatF -mkFloatF :: Float -> NExprF a-mkFloatF = NConstant . NFloat---- | Make a regular (double-quoted) string.+-- | Put a regular (double-quoted) string. mkStr :: Text -> NExpr-mkStr = Fix . NStr . DoubleQuoted . \case-  "" -> mempty-  x  -> [Plain x]+mkStr = Fix . NStr . DoubleQuoted .+  whenText+    mempty+    (one . Plain) --- | Make an indented string.+-- | Put an indented string. mkIndentedStr :: Int -> Text -> NExpr-mkIndentedStr w = Fix . NStr . Indented w . \case-  "" -> mempty-  x  -> [Plain x]+mkIndentedStr w = Fix . NStr . Indented w .+  whenText+    mempty+    (one . Plain) --- | Make a path. Use 'True' if the path should be read from the--- environment, else 'False'.+-- | Put a path. Use @True@ if the path should be read from the environment, else use @False@. mkPath :: Bool -> FilePath -> NExpr mkPath b = Fix . mkPathF b -mkPathF :: Bool -> FilePath -> NExprF a-mkPathF False = NLiteralPath-mkPathF True  = NEnvPath---- | Make a path expression which pulls from the NIX_PATH env variable.+-- | Put a path expression which pulls from the @NIX_PATH@ @env@ variable. mkEnvPath :: FilePath -> NExpr mkEnvPath = Fix . mkEnvPathF -mkEnvPathF :: FilePath -> NExprF a-mkEnvPathF = mkPathF True---- | Make a path expression which references a relative path.+-- | Put a path which references a relative path. mkRelPath :: FilePath -> NExpr mkRelPath = Fix . mkRelPathF -mkRelPathF :: FilePath -> NExprF a-mkRelPathF = mkPathF False---- | Make a variable (symbol)+-- | Put a variable (symbol). mkSym :: Text -> NExpr mkSym = Fix . mkSymF -mkSymF :: Text -> NExprF a-mkSymF = NSym-+-- | Put syntactic hole. mkSynHole :: Text -> NExpr mkSynHole = Fix . mkSynHoleF -mkSynHoleF :: Text -> NExprF a-mkSynHoleF = NSynHole- mkSelector :: Text -> NAttrPath NExpr-mkSelector = (:| mempty) . StaticKey+mkSelector = one . StaticKey . coerce -mkBool :: Bool -> NExpr-mkBool = Fix . mkBoolF+-- | Put an unary operator.+--  @since 0.15.0+mkOp :: NUnaryOp -> NExpr -> NExpr+mkOp op = Fix . NUnary op -mkBoolF :: Bool -> NExprF a-mkBoolF = NConstant . NBool+-- | Logical negation: @not@.+mkNot :: NExpr -> NExpr+mkNot = mkOp NNot -mkNull :: NExpr-mkNull = Fix mkNullF+-- | Number negation: @-@.+--+-- Negation in the language works with integers and floating point.+--  @since 0.15.0+mkNeg :: NExpr -> NExpr+mkNeg = mkOp NNeg -mkNullF :: NExprF a-mkNullF = NConstant NNull+-- | Put a binary operator.+--  @since 0.15.0+mkOp2 :: NBinaryOp -> NExpr -> NExpr -> NExpr+mkOp2 op a = Fix . NBinary op a -mkOper :: NUnaryOp -> NExpr -> NExpr-mkOper op = Fix . NUnary op+-- | > { x }+--  @since 0.15.0+mkParamSet :: [(Text, Maybe NExpr)] -> Params NExpr+mkParamSet pset = mkGeneralParamSet Nothing pset False -mkOper2 :: NBinaryOp -> NExpr -> NExpr -> NExpr-mkOper2 op a = Fix . NBinary op a+-- | > { x, ... }+--  @since 0.15.0+mkVariadicParamSet :: [(Text, Maybe NExpr)] -> Params NExpr+mkVariadicParamSet pset = mkGeneralParamSet Nothing pset True -mkParamset :: [(Text, Maybe NExpr)] -> Bool -> Params NExpr-mkParamset params variadic = ParamSet params variadic mempty+-- | > s@{ x }+--  @since 0.15.0+mkNamedParamSet :: Text -> [(Text, Maybe NExpr)] -> Params NExpr+mkNamedParamSet name pset = mkGeneralParamSet (pure name) pset False +-- | > s@{ x, ... }+--  @since 0.15.0+mkNamedVariadicParamSet :: Text -> [(Text, Maybe NExpr)] -> Params NExpr+mkNamedVariadicParamSet name params = mkGeneralParamSet (pure name) params True++-- | Args:+--+-- 1. Maybe name:+--+-- > Nothing  ->   {}+-- > Just "s" -> s@{}+--+-- 2. key:expr pairs+--+-- 3. Is variadic or not:+--+-- > True  -> {...}+-- > False -> {}+--  @since 0.15.0+mkGeneralParamSet :: Maybe Text -> [(Text, Maybe NExpr)] -> Bool -> Params NExpr+mkGeneralParamSet mname params variadic = ParamSet (coerce mname) (Variadic `whenTrue` variadic) (coerce params)++-- | > rec { .. } mkRecSet :: [Binding NExpr] -> NExpr-mkRecSet = Fix . NSet NRecursive+mkRecSet = mkSet Recursive +-- | Put a non-recursive set.+--+-- > { .. } mkNonRecSet :: [Binding NExpr] -> NExpr-mkNonRecSet = Fix . NSet NNonRecursive+mkNonRecSet = mkSet mempty -mkLets :: [Binding NExpr] -> NExpr -> NExpr-mkLets bindings = Fix . NLet bindings+-- | General set builder function.+mkSet :: Recursivity -> [Binding NExpr] -> NExpr+mkSet r = Fix . NSet r +-- | Empty set.+--+-- Monoid. Use @//@ operation (shorthand $//) to extend the set.+--  @since 0.15.0+emptySet :: NExpr+emptySet = mkNonRecSet mempty++-- | Put a list. mkList :: [NExpr] -> NExpr mkList = Fix . NList +--  @since 0.15.0+emptyList :: NExpr+emptyList = mkList mempty++-- | Wrap in a @let@.+--+-- (Evaluate the second argument after introducing the bindings.)+--+-- +------------------------+-----------------++-- | Haskell                | Nix             |+-- +========================+=================++-- | @mkLets bindings expr@ | @let bindings;@ |+-- |                        | @in expr@       |+-- +------------------------+-----------------++mkLets :: [Binding NExpr] -> NExpr -> NExpr+mkLets bindings = Fix . NLet bindings++-- | Create a @whith@:+-- 1st expr - what to bring into the scope.+-- 2nd - expression that recieves the scope extention.+--+-- +--------------------+-------------------++-- | Haskell            | Nix               |+-- +====================+===================++-- | @mkWith body main@ | @with body; expr@ |+-- +--------------------+-------------------+ mkWith :: NExpr -> NExpr -> NExpr mkWith e = Fix . NWith e +-- | Create an @assert@:+-- 1st expr - asserting itself, must return @true@.+-- 2nd - main expression to evaluated after assertion.+--+-- +-----------------------+----------------------++-- | Haskell               | Nix                  |+-- +=======================+======================++-- | @mkAssert check eval@ | @assert check; eval@ |+-- +-----------------------+----------------------+ mkAssert :: NExpr -> NExpr -> NExpr-mkAssert e = Fix . NWith e+mkAssert e = Fix . NAssert e +-- | Put:+--+-- > if expr1+-- >   then expr2+-- >   else expr3 mkIf :: NExpr -> NExpr -> NExpr -> NExpr mkIf e1 e2 = Fix . NIf e1 e2 +-- | Lambda function, analog of Haskell's @\\ x -> x@:+--+-- +-----------------------+-----------++-- | Haskell               | Nix       |+-- +=======================+===========++-- | @ mkFunction x expr @ | @x: expr@ |+-- +-----------------------+-----------+ mkFunction :: Params NExpr -> NExpr -> NExpr mkFunction params = Fix . NAbs params -{--mkDot :: NExpr -> Text -> NExpr-mkDot e key = mkDots e [key]+-- | General dot-reference with optional alternative if the jey does not exist.+--  @since 0.15.0+getRefOrDefault :: Maybe NExpr -> NExpr -> Text -> NExpr+getRefOrDefault alt obj = Fix . NSelect alt obj . mkSelector --- | Create a dotted expression using only text.-mkDots :: NExpr -> [Text] -> NExpr-mkDots e [] = e-mkDots (Fix (NSelect e keys' x)) keys =-  -- Special case: if the expression in the first argument is already-  -- a dotted expression, just extend it.-  Fix (NSelect e (keys' <> fmap (`StaticKey` Nothing) keys) x)-mkDots e keys = Fix $ NSelect e (fmap (`StaticKey` Nothing) keys) Nothing--}+-- ** Base functor builders for basic expressions builders *sic --- | An `inherit` clause without an expression to pull from.-inherit :: [NKeyName e] -> SourcePos -> Binding e-inherit = Inherit Nothing+-- | Unfixed @mkNull@.+mkNullF :: NExprF a+mkNullF = NConstant NNull +-- | Unfixed @mkBool@.+mkBoolF :: Bool -> NExprF a+mkBoolF = NConstant . NBool++-- | Unfixed @mkInt@.+mkIntF :: Integer -> NExprF a+mkIntF = NConstant . NInt++-- | Unfixed @mkFloat@.+mkFloatF :: Float -> NExprF a+mkFloatF = NConstant . NFloat++-- | Unfixed @mkPath@.+mkPathF :: Bool -> FilePath -> NExprF a+mkPathF False = NLiteralPath . coerce+mkPathF True  = NEnvPath . coerce++-- | Unfixed @mkEnvPath@.+mkEnvPathF :: FilePath -> NExprF a+mkEnvPathF = mkPathF True++-- | Unfixed @mkRelPath@.+mkRelPathF :: FilePath -> NExprF a+mkRelPathF = mkPathF False++-- | Unfixed @mkSym@.+mkSymF :: Text -> NExprF a+mkSymF = NSym . coerce++-- | Unfixed @mkSynHole@.+mkSynHoleF :: Text -> NExprF a+mkSynHoleF = NSynHole . coerce+++-- * Other+-- (org this better/make a better name for section(s))+ -- | An `inherit` clause with an expression to pull from.-inheritFrom :: e -> [NKeyName e] -> SourcePos -> Binding e-inheritFrom expr = Inherit (pure expr)+--+-- +------------------------+--------------------+------------++-- | Hask                   | Nix                | pseudocode |+-- +========================+====================+============++-- | @inheritFrom x [a, b]@ | @inherit (x) a b;@ | @a = x.a;@ |+-- |                        |                    | @b = x.b;@ |+-- +------------------------+--------------------+------------++inheritFrom :: e -> [VarName] -> Binding e+inheritFrom expr ks = Inherit (pure expr) ks nullPos --- | Shorthand for producing a binding of a name to an expression: @=-bindTo :: Text -> NExpr -> Binding NExpr-bindTo name x = NamedVar (mkSelector name) x nullPos+-- | An `inherit` clause without an expression to pull from.+--+-- +----------------------+----------------+------------------++-- | Hask                 | Nix            | pseudocode       |+-- +======================+================+==================++-- | @inheritFrom [a, b]@ | @inherit a b;@ | @a = outside.a;@ |+-- |                      |                | @b = outside.b;@ |+-- +----------------------+----------------+------------------++inherit :: [VarName] -> Binding e+inherit ks = Inherit Nothing ks nullPos --- | Infix version of @bindTo@: @=@+-- | Nix @=@ (bind operator). ($=) :: Text -> NExpr -> Binding NExpr ($=) = bindTo- infixr 2 $= +-- | Shorthand for producing a binding of a name to an expression: Nix's @=@.+bindTo :: Text -> NExpr -> Binding NExpr+bindTo name x = NamedVar (mkSelector name) x nullPos+ -- | Append a list of bindings to a set or let expression.--- For example, adding `[a = 1, b = 2]` to `let c = 3; in 4` produces--- `let a = 1; b = 2; c = 3; in 4`.+-- For example:+-- adding      `[a = 1, b = 2]`+-- to       `let               c = 3; in 4`+-- produces `let a = 1; b = 2; c = 3; in 4`. appendBindings :: [Binding NExpr] -> NExpr -> NExpr-appendBindings newBindings (Fix e) = case e of-  NLet bindings e'    -> Fix $ NLet (bindings <> newBindings) e'-  NSet recur bindings -> Fix $ NSet recur (bindings <> newBindings)-  _                   -> error "Can only append bindings to a set or a let"+appendBindings newBindings (Fix e) =+  case e of+    NLet bindings e'    -> mkLets (bindings <> newBindings) e'+    NSet recur bindings -> Fix $ NSet recur (bindings <> newBindings)+    _                   -> error "Can only append bindings to a set or a let" --- | Applies a transformation to the body of a nix function.+-- | Applies a transformation to the body of a Nix function. modifyFunctionBody :: (NExpr -> NExpr) -> NExpr -> NExpr-modifyFunctionBody f (Fix (NAbs params body)) = Fix $ NAbs params $ f body+modifyFunctionBody transform (Fix (NAbs params body)) = mkFunction params $ transform body modifyFunctionBody _ _ = error "Not a function" --- | A let statement with multiple assignments.+-- | A @let@ statement with multiple assignments. letsE :: [(Text, NExpr)] -> NExpr -> NExpr-letsE pairs = Fix . NLet (uncurry bindTo <$> pairs)+letsE pairs = mkLets $ uncurry ($=) <$> pairs  -- | Wrapper for a single-variable @let@. letE :: Text -> NExpr -> NExpr -> NExpr-letE varName varExpr = letsE [(varName, varExpr)]+letE varName varExpr = letsE $ one (varName, varExpr) --- | Make an attribute set (non-recursive).+-- | Make a non-recursive attribute set. attrsE :: [(Text, NExpr)] -> NExpr-attrsE pairs = Fix $ NSet NNonRecursive $ uncurry bindTo <$> pairs+attrsE pairs = mkNonRecSet $ uncurry ($=) <$> pairs --- | Make an attribute set (recursive).+-- | Make a recursive attribute set. recAttrsE :: [(Text, NExpr)] -> NExpr-recAttrsE pairs = Fix $ NSet NRecursive $ uncurry bindTo <$> pairs+recAttrsE pairs = mkRecSet $ uncurry ($=) <$> pairs --- | Logical negation.-mkNot :: NExpr -> NExpr-mkNot = Fix . NUnary NNot --- -- | Dot-reference into an attribute set.--- (!.) :: NExpr -> Text -> NExpr--- (!.) = mkDot--- infixl 8 !.- -- * Nix binary operators --- | Nix binary operator builder.-mkBinop :: NBinaryOp -> NExpr -> NExpr -> NExpr-mkBinop op e1 e2 = Fix $ NBinary op e1 e2- (@@), ($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++)   :: NExpr -> NExpr -> NExpr+--  2021-07-10: NOTE: Probably the presedence of some operators is still needs to be tweaked.++-- | Dot-reference into an attribute set: @attrSet.k@+(@.) :: NExpr -> Text -> NExpr+(@.) = getRefOrDefault Nothing+infix 9 @.++-- | Dot-reference into an attribute set with alternative if the key does not exist.+--+-- > s.x or y+--  @since 0.15.0+(@.<|>) :: NExpr -> Text -> NExpr -> NExpr+(@.<|>) obj name alt = getRefOrDefault (pure alt ) obj name+infix 9 @.<|>+ -- | Function application (@' '@ in @f x@)-(@@) = mkBinop NApp-infixl 1 @@--- | Equality: @==@-($==) = mkBinop NEq--- | Inequality: @!=@-($!=) = mkBinop NNEq--- | Less than: @<@-($<)  = mkBinop NLt--- | Less than OR equal: @<=@-($<=) = mkBinop NLte+(@@) = mkOp2 NApp+infixl 8 @@++-- | List concatenation: @++@+($++) = mkOp2 NConcat+infixr 7 $++++-- | Multiplication: @*@+($*)  = mkOp2 NMult+infixl 6 $*++-- | Division: @/@+($/)  = mkOp2 NDiv+infixl 6 $/++-- | Addition: @+@+($+)  = mkOp2 NPlus+infixl 5 $+++-- | Subtraction: @-@+($-)  = mkOp2 NMinus+infixl 5 $-++-- | Extend/override the left attr set, with the right one: @//@+($//) = mkOp2 NUpdate+infixr 5 $//+ -- | Greater than: @>@-($>)  = mkBinop NGt+($>)  = mkOp2 NGt+infix 4 $>+ -- | Greater than OR equal: @>=@-($>=) = mkBinop NGte+infix 4 $>=+($>=) = mkOp2 NGte++-- | Less than OR equal: @<=@+($<=) = mkOp2 NLte+infix 4 $<=++-- | Less than: @<@+($<)  = mkOp2 NLt+infix 4 $<++-- | Equality: @==@+($==) = mkOp2 NEq+infix 3 $==++-- | Inequality: @!=@+($!=) = mkOp2 NNEq+infix 3 $!=+ -- | AND: @&&@-($&&) = mkBinop NAnd+($&&) = mkOp2 NAnd+infixl 2 $&&+ -- | OR: @||@-($||) = mkBinop NOr--- | Logical implication: @->@-($->) = mkBinop NImpl--- | Extend/override the left attr set, with the right one: @//@-($//) = mkBinop NUpdate--- | Addition: @+@-($+)  = mkBinop NPlus--- | Subtraction: @-@-($-)  = mkBinop NMinus--- | Multiplication: @*@-($*)  = mkBinop NMult--- | Division: @/@-($/)  = mkBinop NDiv--- | List concatenation: @++@-($++) = mkBinop NConcat+($||) = mkOp2 NOr+infixl 2 $|| +-- | Logical implication: @->@+($->) = mkOp2 NImpl+infix 1 $-> --- | Lambda function.--- > x ==> x---Haskell:--- > \\ x -> x---Nix:--- > x: x+-- | Lambda function, analog of Haskell's @\\ x -> x@:+--+-- +---------------+-----------++-- | Haskell       | Nix       |+-- +===============+===========++-- | @x ==> expr @ | @x: expr@ |+-- +---------------+-----------+ (==>) :: Params NExpr -> NExpr -> NExpr (==>) = mkFunction infixr 1 ==> --- | Dot-reference into an attribute set: @attrSet.k@-(@.) :: NExpr -> Text -> NExpr-(@.) obj name = Fix $ NSelect obj (StaticKey name :| mempty) Nothing-infixl 2 @.++-- * Under deprecation++-- NOTE: Remove after 2023-07+-- | __@Deprecated@__: Please, use `mkOp`+-- Put an unary operator.+mkOper :: NUnaryOp -> NExpr -> NExpr+mkOper op = Fix . NUnary op++-- NOTE: Remove after 2023-07+-- | __@Deprecated@__: Please, use `mkOp2`+-- | Put a binary operator.+mkOper2 :: NBinaryOp -> NExpr -> NExpr -> NExpr+mkOper2 op a = Fix . NBinary op a++-- NOTE: Remove after 2023-07+-- | __@Deprecated@__: Please, use `mkOp2`+-- | Nix binary operator builder.+mkBinop :: NBinaryOp -> NExpr -> NExpr -> NExpr+mkBinop = mkOp2++-- NOTE: Remove after 2023-07+-- | __@Deprecated@__: Please, use:+--   * `mkParamSet` is for closed sets;+--   * `mkVariadicSet` is for variadic;+--   * `mkGeneralParamSet` a general constructor.+mkParamset :: [(Text, Maybe NExpr)] -> Bool -> Params NExpr+mkParamset params variadic = ParamSet Nothing (Variadic `whenTrue` variadic) (coerce params)

@@ -2,7 +2,6 @@ -- | Functions for manipulating nix strings. module Nix.Expr.Strings where -import           Nix.Utils import           Relude.Unsafe                 as Unsafe -- Please, switch things to NonEmpty import           Data.List                      ( dropWhileEnd@@ -10,7 +9,7 @@                                                 , lookup                                                 ) import qualified Data.Text                     as T-import           Nix.Expr+import           Nix.Expr.Types  -- | Merge adjacent @Plain@ values with @<>@. mergePlain :: [Antiquoted Text r] -> [Antiquoted Text r]@@ -22,8 +21,8 @@  -- | Remove 'Plain' values equal to 'mempty', as they don't have any -- informational content.-removePlainEmpty :: [Antiquoted Text r] -> [Antiquoted Text r]-removePlainEmpty = filter f where+removeEmptyPlains :: [Antiquoted Text r] -> [Antiquoted Text r]+removeEmptyPlains = filter f where   f (Plain x) = x /= mempty   f _         = True @@ -42,17 +41,18 @@ -- | Split a stream representing a string with antiquotes on line breaks. splitLines :: [Antiquoted Text r] -> [[Antiquoted Text r]] splitLines = uncurry (flip (:)) . go where-  go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls   where+  go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls+   where     (l : ls) = T.split (== '\n') t     f prefix (finished, current) = ((Plain prefix : current) : finished, mempty)   go (Antiquoted a   : xs) = (Antiquoted a :) <$> go xs   go (EscapedNewline : xs) = (EscapedNewline :) <$> go xs-  go []                    = (mempty, mempty)+  go []                    = mempty  -- | Join a stream of strings containing antiquotes again. This is the inverse -- of 'splitLines'. unsplitLines :: [[Antiquoted Text r]] -> [Antiquoted Text r]-unsplitLines = intercalate [Plain "\n"]+unsplitLines = intercalate $ one $ Plain "\n"  -- | Form an indented string by stripping spaces equal to the minimal indent. stripIndent :: [Antiquoted Text r] -> NString r@@ -60,7 +60,7 @@ stripIndent xs =   Indented     minIndent-    (removePlainEmpty $+    (removeEmptyPlains $       mergePlain $         (snd <$>) $           dropWhileEnd@@ -111,7 +111,7 @@   [('\n', 'n'), ('\r', 'r'), ('\t', 't'), ('\\', '\\'), ('$', '$'), ('"', '"')]  fromEscapeCode :: Char -> Maybe Char-fromEscapeCode = (`lookup` fmap swap escapeCodes)+fromEscapeCode = (`lookup` (swap <$> escapeCodes))  toEscapeCode :: Char -> Maybe Char toEscapeCode = (`lookup` escapeCodes)

@@ -1,40 +1,38 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# language ConstraintKinds #-}+{-# language CPP #-}+{-# language DeriveAnyClass #-}+{-# language FunctionalDependencies #-}+{-# language RankNTypes #-}+{-# language TemplateHaskell #-}+{-# language TypeFamilies #-} -{-# OPTIONS_GHC -Wno-orphans #-}-{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# options_ghc -Wno-orphans #-}+{-# options_ghc -Wno-missing-signatures #-}  -- | The Nix expression type and supporting types. ----- For a brief introduction of the Nix expression language, see--- <https://nixos.org/nix/manual/#ch-expression-language>.+-- [Brief introduction of the Nix expression language.](https://nixos.org/nix/manual/#ch-expression-language) -- -- This module is a beginning of a deep embedding (term) of a Nix language into Haskell.--- Shallow/deep embedding brief:--- <https://web.archive.org/web/20201112031804/https://alessandrovermeulen.me/2013/07/13/the-difference-between-shallow-and-deep-embedding/>+-- [Brief on shallow & deep embedding.](https://web.archive.org/web/20201112031804/https://alessandrovermeulen.me/2013/07/13/the-difference-between-shallow-and-deep-embedding/) ----- (additiona info for dev): Big use of TemplateHaskell in the module requires proper (top-down) organization of declarations+-- (additiona info for dev): Big use of TemplateHaskell in the module requires proper (top-down) organization of declarations. module Nix.Expr.Types where  import qualified Codec.Serialise                as Serialise import           Codec.Serialise                ( Serialise )-import           Control.DeepSeq+import           Control.DeepSeq                ( NFData1(..) ) import           Data.Aeson-import           Data.Aeson.TH import qualified Data.Binary                   as Binary import           Data.Binary                    ( Binary ) import           Data.Data-import           Data.Fix+import           Data.Fix                       ( Fix(Fix) ) import           Data.Functor.Classes import           Data.Hashable.Lifted+import qualified Data.HashMap.Lazy             as MapL import qualified Data.List.NonEmpty            as NE import qualified Text.Show-import           Data.Traversable+import           Data.Traversable               ( fmapDefault, foldMapDefault ) import           GHC.Generics import qualified Language.Haskell.TH.Syntax    as TH import           Lens.Family2@@ -44,22 +42,31 @@                                                 , mkPos                                                 , unPos                                                 )-import           Text.Show.Deriving-import           Text.Read.Deriving-import           Data.Eq.Deriving-import           Data.Ord.Deriving+import           Text.Show.Deriving             ( deriveShow1, deriveShow2 )+import           Text.Read.Deriving             ( deriveRead1, deriveRead2 )+import           Data.Eq.Deriving               ( deriveEq1  , deriveEq2   )+import           Data.Ord.Deriving              ( deriveOrd1 , deriveOrd2  )+import           Data.Aeson.TH                  ( deriveJSON2 ) import qualified Type.Reflection               as Reflection-import           Type.Reflection                ( eqTypeRep ) import           Nix.Atoms-import           Nix.Utils #if !MIN_VERSION_text(1,2,4) -- NOTE: Remove package @th-lift-instances@ removing this-import           Instances.TH.Lift              ()  -- importing Lift Text fo GHC 8.6+import           Instances.TH.Lift              ()  -- importing Lift Text for GHC 8.6 #endif  --- * Utilitary: orphan instances+-- * utils +-- | Holds file positionng information for abstrations.+-- A type synonym for @HashMap VarName SourcePos@.+type PositionSet = HashMap VarName SourcePos++--  2021-07-16: NOTE: Should replace @ParamSet@ List+-- | > Hashmap VarName -- type synonym+type AttrSet = HashMap VarName++-- ** orphan instances+ -- Placed here because TH inference depends on declaration sequence.  -- Upstreaming so far was not pursued.@@ -102,24 +109,53 @@   parseJSON = fmap mkPos . parseJSON instance FromJSON SourcePos - -- * Components of Nix expressions  -- NExpr is a composition of---   * direct reuse of the Haskell types (list, FilePath, Text)+--   * direct reuse of the Haskell types (list, Path, Text) --   * NAtom --   * Types in this section --   * Fixpoint nature -type VarName = Text+-- ** newtype VarName +newtype VarName = VarName Text+  deriving+    ( Eq, Ord, Generic+    , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON+    , Show, Read, Hashable+    ) --- ** @Params@+instance IsString VarName where+  fromString = coerce . fromString @Text +instance ToString VarName where+  toString = toString @Text . coerce++-- ** data Params++-- *** utils+ -- This uses an association list because nix XML serialization preserves the -- order of the param set. type ParamSet r = [(VarName, Maybe r)] +data Variadic = Closed | Variadic+  deriving+    ( Eq, Ord, Generic+    , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON+    , Show, Read, Hashable+    )++instance Semigroup Variadic where+  (<>) Closed Closed = Closed+  (<>) _      _      = Variadic++instance Monoid Variadic where+  mempty = Closed++-- *** data Params+ -- | @Params@ represents all the ways the formal parameters to a -- function can be represented. data Params r@@ -127,20 +163,18 @@   -- ^ For functions with a single named argument, such as @x: x + 1@.   --   -- > Param "x"                                  ~  x-  | ParamSet !(ParamSet r) !Bool !(Maybe VarName)-  --  2021-05-15: NOTE: Seems like we should flip the ParamSet, so partial application kicks in for Bool?-  --  2021-05-15: NOTE: '...' variadic property probably needs a Bool synonym.+  | ParamSet !(Maybe VarName) !Variadic !(ParamSet r)   -- ^ Explicit parameters (argument must be a set). Might specify a name to   -- bind to the set in the function body. The bool indicates whether it is   -- variadic or not.   ---  -- > ParamSet [("x",Nothing)] False Nothing     ~  { x }-  -- > ParamSet [("x",pure y)]  True  (pure "s")  ~  s@{ x ? y, ... }+  -- > ParamSet  Nothing   False [("x",Nothing)]  ~  { x }+  -- > ParamSet (pure "s") True  [("x", pure y)]  ~  s@{ x ? y, ... }   deriving     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, ToJSON1, FromJSON, FromJSON1     , Functor, Foldable, Traversable-    , Show, Hashable+    , Show, Hashable, Hashable1     )  instance IsString (Params r) where@@ -151,14 +185,12 @@ $(deriveEq1   ''Params) $(deriveOrd1  ''Params) -deriving instance Hashable1 Params---- *** Lens traversals+-- *** lens traversals  $(makeTraversals ''Params)  --- ** @Antiquoted@+-- ** data Antiquoted  -- | 'Antiquoted' represents an expression that is either -- antiquoted (surrounded by ${...}) or plain (not antiquoted).@@ -178,7 +210,7 @@     , Typeable, Data, NFData, NFData1, Serialise, Binary     , ToJSON, ToJSON1, FromJSON, FromJSON1     , Functor, Foldable, Traversable-    , Show, Read, Hashable+    , Show, Read, Hashable, Hashable1     )  instance Hashable2 Antiquoted where@@ -196,26 +228,25 @@ $(deriveOrd2  ''Antiquoted) $(deriveJSON2 defaultOptions ''Antiquoted) -deriving instance Hashable v => Hashable1 (Antiquoted v) --- *** Lens traversals+-- *** lens traversals  $(makeTraversals ''Antiquoted)  --- ** @NString@+-- ** data NString  -- | An 'NString' is a list of things that are either a plain string -- or an antiquoted expression. After the antiquotes have been evaluated, -- the final string is constructed by concatenating all the parts. data NString r   = DoubleQuoted ![Antiquoted Text r]-  -- ^ Strings wrapped with double-quotes (") can contain literal newline+  -- ^ Strings wrapped with double-quotes (__@"@__) can contain literal newline   -- characters, but the newlines are preserved and no indentation is stripped.   --   -- > DoubleQuoted [Plain "x",Antiquoted y]   ~  "x${y}"   | Indented !Int ![Antiquoted Text r]-  -- ^ Strings wrapped with two single quotes ('') can contain newlines, and+  -- ^ Strings wrapped with two single quotes (__@''@__) can contain newlines, and   --   their indentation will be stripped, but the amount stripped is   --   remembered.   --@@ -230,27 +261,25 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, ToJSON1, FromJSON, FromJSON1     , Functor, Foldable, Traversable-    , Show, Read, Hashable+    , Show, Read, Hashable, Hashable1     )  -- | For the the 'IsString' instance, we use a plain doublequoted string. instance IsString (NString r) where   fromString ""     = DoubleQuoted mempty-  fromString string = DoubleQuoted [Plain $ toText string]+  fromString string = DoubleQuoted [Plain $ fromString string]  $(deriveShow1 ''NString) $(deriveRead1 ''NString) $(deriveEq1   ''NString) $(deriveOrd1  ''NString) -deriving instance Hashable1 NString---- *** Lens traversals+-- *** lens traversals  $(makeTraversals ''NString)  --- ** @NKeyName@+-- ** data NKeyName  -- | A 'KeyName' is something that can appear on the left side of an -- equals sign. For example, @a@ is a 'KeyName' in @{ a = 3; }@, @let a = 3;@@ -318,11 +347,12 @@ -- occurs not only as last argument in @Antiquoted (NString r) r@ instance Show1 NKeyName where   liftShowsPrec sp sl p = \case-    DynamicKey a -> showsUnaryWith-      (liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl)-      "DynamicKey"-      p-      a+    DynamicKey a ->+      showsUnaryWith+        (liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl)+        "DynamicKey"+        p+        a     StaticKey t -> showsUnaryWith Text.Show.showsPrec "StaticKey" p t  -- Deriving this instance automatically is not possible because @r@@@ -344,12 +374,12 @@     DynamicKey EscapedNewline   -> pure $ DynamicKey EscapedNewline     StaticKey  key              -> pure $ StaticKey key --- *** Lens traversals+-- *** lens traversals  $(makeTraversals ''NKeyName)  --- ** @NAttrPath@+-- ** type NAttrPath  -- | A selector (for example in a @let@ or an attribute set) is made up -- of strung-together key names.@@ -358,7 +388,7 @@ type NAttrPath r = NonEmpty (NKeyName r)  --- ** @Binding@+-- ** data Binding  #if !MIN_VERSION_hashable(1,3,1) -- Required by Hashable Binding deriving. There was none of this Hashable instance before mentioned version, remove this in year >2022@@ -371,7 +401,7 @@   -- ^ An explicit naming.   --   -- > NamedVar (StaticKey "x" :| [StaticKey "y"]) z SourcePos{}  ~  x.y = z;-  | Inherit !(Maybe r) ![NKeyName r] !SourcePos+  | Inherit !(Maybe r) ![VarName] !SourcePos   -- ^ Inheriting an attribute (binding) into the attribute set from the other scope (attribute set). No denoted scope means to inherit from the closest outside scope.   --   -- +---------------------------------------------------------------+--------------------+-----------------------+@@ -391,7 +421,7 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, FromJSON     , Functor, Foldable, Traversable-    , Show, Hashable+    , Show, Hashable, Hashable1     )  $(deriveShow1 ''Binding)@@ -399,29 +429,33 @@ $(deriveOrd1  ''Binding) --x $(deriveJSON1 defaultOptions ''Binding) -deriving instance Hashable1 Binding---- *** Lens traversals+-- *** lens traversals  $(makeTraversals ''Binding)  --- ** @NRecordType@+-- ** data Recursivity --- | 'NRecordType' distinguishes between recursive and non-recursive attribute+-- | Distinguishes between recursive and non-recursive. Mainly for attribute -- sets.-data NRecordType-  = NNonRecursive  -- ^ >     { ... }-  | NRecursive     -- ^ > rec { ... }+data Recursivity+  = NonRecursive  -- ^ >     { ... }+  | Recursive     -- ^ > rec { ... }   deriving     ( Eq, Ord, Enum, Bounded, Generic     , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON     , Show, Read, Hashable     ) +instance Semigroup Recursivity where+  (<>) NonRecursive NonRecursive = NonRecursive+  (<>) _ _ = Recursive --- ** @NUnaryOp@+instance Monoid Recursivity where+  mempty = NonRecursive +-- ** data NUnaryOp+ -- | There are two unary operations: logical not and integer negation. data NUnaryOp   = NNeg  -- ^ @-@@@ -432,12 +466,12 @@     , Show, Read, Hashable     ) --- *** Lens traversals+-- *** lens traversals  $(makeTraversals ''NUnaryOp)  --- ** @NBinaryOp@+-- ** data NBinaryOp  -- | Binary operators expressible in the nix language. data NBinaryOp@@ -465,12 +499,12 @@     , Show, Read, Hashable     ) --- *** Lens traversals+-- *** lens traversals  $(makeTraversals ''NBinaryOp)  --- ** @NExprF@ - Nix expressions, base functor+-- * data NExprF - Nix expressions, base functor  -- | The main Nix expression type. As it is polimophic, has a functor, -- which allows to traverse expressions and map functions over them.@@ -490,19 +524,19 @@   -- ^ A list literal.   --   -- > NList [x,y]                                 ~  [ x y ]-  | NSet !NRecordType ![Binding r]+  | NSet !Recursivity ![Binding r]   -- ^ An attribute set literal   ---  -- > NSet NRecursive    [NamedVar x y _]         ~  rec { x = y; }-  -- > NSet NNonRecursive [Inherit Nothing [x] _]  ~  { inherit x; }-  | NLiteralPath !FilePath+  -- > NSet Recursive    [NamedVar x y _]         ~  rec { x = y; }+  -- > NSet NonRecursive [Inherit Nothing [x] _]  ~  { inherit x; }+  | NLiteralPath !Path   -- ^ A path expression, which is evaluated to a store path. The path here   -- can be relative, in which case it's evaluated relative to the file in   -- which it appears.   --   -- > NLiteralPath "/x"                           ~  /x   -- > NLiteralPath "x/y"                          ~  x/y-  | NEnvPath !FilePath+  | NEnvPath !Path   -- ^ A path which refers to something in the Nix search path (the NIX_PATH   -- environment variable. For example, @<nixpkgs/pkgs>@.   --@@ -517,14 +551,12 @@   --   -- > NBinary NPlus x y                           ~  x + y   -- > NBinary NApp  f x                           ~  f x-  | NSelect !r !(NAttrPath r) !(Maybe r)-  --  2021-05-15: NOTE: Default value should be first argument to leverage partial application.-  -- Cascading change diff is not that big.+  | NSelect !(Maybe r) !r !(NAttrPath r)   -- ^ Dot-reference into an attribute set, optionally providing an   -- alternative if the key doesn't exist.   ---  -- > NSelect s (x :| []) Nothing                 ~  s.x-  -- > NSelect s (x :| []) (pure y)                ~  s.x or y+  -- > NSelect Nothing  s (x :| [])                ~  s.x+  -- > NSelect (pure y) s (x :| [])                ~  s.x or y   | NHasAttr !r !(NAttrPath r)   -- ^ Ask if a set contains a given attribute path.   --@@ -549,7 +581,7 @@   --   -- > NWith x y                                   ~  with x; y   | NAssert !r !r-  -- ^ Assert that the first returns @true@ before evaluating the second.+  -- ^ Checks that the first argument is a predicate that is @true@ before evaluating the second argument.   --   -- > NAssert x y                                 ~  assert x; y   | NSynHole !VarName@@ -562,7 +594,7 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, FromJSON     , Functor, Foldable, Traversable-    , Show, Hashable+    , Show, Hashable, Hashable1     )  @@ -571,14 +603,12 @@ $(deriveOrd1  ''NExprF) --x $(deriveJSON1 defaultOptions ''NExprF) -deriving instance Hashable1 NExprF---- *** Lens traversals+-- ** lens traversals  $(makeTraversals ''NExprF)  --- *** @NExpr@+-- ** type NExpr  -- | The monomorphic expression type is a fixed point of the polymorphic one. type NExpr = Fix NExprF@@ -600,13 +630,13 @@           -- Reflection is a key strategy in metaprogramming.           -- <https://en.wikipedia.org/wiki/Reflective_programming>           HRefl <--            eqTypeRep+            Reflection.eqTypeRep               (Reflection.typeRep @Text)               (Reflection.typeOf  b    )           pure [| $(TH.lift b) |]       ) #if MIN_VERSION_template_haskell(2,17,0)-  liftTyped = TH.liftTyped+  liftTyped = TH.unsafeCodeCoerce . TH.lift #elif MIN_VERSION_template_haskell(2,16,0)   liftTyped = TH.unsafeTExpCoerce . TH.lift #endif@@ -624,31 +654,47 @@ #else hashAt :: VarName -> Lens' (AttrSet v) (Maybe v) #endif-hashAt = flip alterF+hashAt = alterF+ where+  alterF+    :: (Functor f)+    => VarName+    -> (Maybe v -> f (Maybe v))+    -> AttrSet v+    -> f (AttrSet v)+  alterF (coerce -> k) f m =+    maybe+      (MapL.delete k m)+      (\ v -> MapL.insert k v m)+      <$> f (MapL.lookup k m)  -- | Get the name out of the parameter (there might be none). paramName :: Params r -> Maybe VarName-paramName (Param n       ) = pure n-paramName (ParamSet _ _ n) = n+paramName (Param name        ) = pure name+paramName (ParamSet mname _ _) = mname +stringParts :: NString r -> [Antiquoted Text r]+stringParts (DoubleQuoted parts) = parts+stringParts (Indented _   parts) = parts+ stripPositionInfo :: NExpr -> NExpr stripPositionInfo = transport phi  where   transport f (Fix x) = Fix $ transport f <$> f x -  phi (NSet recur binds) = NSet recur $ go <$> binds-  phi (NLet binds body) = NLet (go <$> binds) body+  phi (NSet recur binds) = NSet recur $ erasePositions <$> binds+  phi (NLet binds body) = NLet (erasePositions <$> binds) body   phi x                 = x -  go (NamedVar path r     _pos) = NamedVar path r     nullPos-  go (Inherit  ms   names _pos) = Inherit  ms   names nullPos+  erasePositions (NamedVar path r     _pos) = NamedVar path r     nullPos+  erasePositions (Inherit  ms   names _pos) = Inherit  ms   names nullPos  nullPos :: SourcePos nullPos = on (SourcePos "<string>") mkPos 1 1  -- * Dead code --- ** @class NExprAnn@+-- ** class NExprAnn  class NExprAnn ann g | g -> ann where   fromNExpr :: g r -> (NExprF r, ann)@@ -657,37 +703,39 @@ -- ** Other  ekey-  :: NExprAnn ann g-  => NonEmpty Text+  :: forall ann g+  . NExprAnn ann g+  => NonEmpty VarName   -> SourcePos   -> Lens' (Fix g) (Maybe (Fix g))-ekey keys pos f e@(Fix x) | (NSet NNonRecursive xs, ann) <- fromNExpr x =-  case go xs of-    ((v, []      ) : _) -> fromMaybe e <$> f (pure v)-    ((v, r : rest) : _) -> ekey (r :| rest) pos f v+ekey keys pos f e@(Fix x)+  | (NSet NonRecursive xs, ann) <- fromNExpr x =+    let+      vals :: [(Fix g, [VarName])]+      vals =+        do+          let keys' = NE.toList keys+          (ks, rest) <- zip (inits keys') (tails keys')+          list+            mempty+            (\ (j : js) ->+              do+                NamedVar ns v _p <- xs+                guard $ (j : js) == (NE.toList ns ^.. traverse . _StaticKey)+                pure (v, rest)+            )+            ks+    in+    case vals of+      ((v, []      ) : _) -> fromMaybe e <$> f (pure v)+      ((v, r : rest) : _) -> ekey (r :| rest) pos f v -    _                   ->-      maybe-        e-        (\ v ->-          let entry = NamedVar (StaticKey <$> keys) v pos in-          Fix $ toNExpr ( NSet NNonRecursive $ [entry] <> xs, ann )-        )-      <$>-        f Nothing-  where-    go xs =-      do-        let keys' = NE.toList keys-        (ks, rest) <- zip (inits keys') (tails keys')-        list-          mempty-          (\ (j : js) ->-            do-              NamedVar ns v _p <- xs-              guard $ (j : js) == (NE.toList ns ^.. traverse . _StaticKey)-              pure (v, rest)+      _                   ->+        maybe+          e+          (\ v ->+            let entry = NamedVar (StaticKey <$> keys) v pos in+            Fix $ toNExpr ( NSet mempty $ one entry <> xs, ann )           )-          ks-+        <$> f Nothing ekey _ _ f e = fromMaybe e <$> f Nothing