hnix 0.16.0 → 0.17.0

raw patch · 37 files changed

+1263/−1198 lines, 37 filesdep +extradep ~aesondep ~basedep ~data-fixPVP ok

version bump matches the API change (PVP)

Dependencies added: extra

Dependency ranges changed: aeson, base, data-fix, deepseq, exceptions, filepath, hnix-store-core, hnix-store-remote, logict, megaparsec, mtl, optparse-applicative, relude, semialign, serialise, template-haskell, text, these, time, transformers, unix-compat, unordered-containers, vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +33/−0
• hnix.cabal +73/−185
• main/Repl.hs +15/−12
• src/Nix.hs +2/−2
• src/Nix/Builtins.hs +75/−82
• src/Nix/Cited/Basic.hs +1/−1
• src/Nix/Convert.hs +23/−24
• src/Nix/Effects.hs +51/−34
• src/Nix/Effects/Derivation.hs +3/−3
• src/Nix/Eval.hs +16/−15
• src/Nix/Exec.hs +26/−17
• src/Nix/Expr/Shorthands.hs +7/−2
• src/Nix/Expr/Strings.hs +2/−2
• src/Nix/Expr/Types.hs +98/−50
• src/Nix/Expr/Types/Annotated.hs +18/−15
• src/Nix/Fresh.hs +1/−1
• src/Nix/Json.hs +2/−2
• src/Nix/Lint.hs +108/−103
• src/Nix/Normal.hs +43/−38
• src/Nix/Parser.hs +303/−232
• src/Nix/Pretty.hs +75/−65
• src/Nix/Reduce.hs +10/−10
• src/Nix/Render.hs +6/−4
• src/Nix/Render/Frame.hs +7/−4
• src/Nix/Standard.hs +6/−9
• src/Nix/String.hs +4/−4
• src/Nix/TH.hs +56/−36
• src/Nix/Thunk.hs +1/−0
• src/Nix/Type/Infer.hs +10/−10
• src/Nix/Utils.hs +19/−16
• src/Nix/Utils/Fix1.hs +12/−4
• src/Nix/Value.hs +78/−146
• src/Nix/Value/Equal.hs +32/−37
• tests/EvalTests.hs +7/−2
• tests/Main.hs +20/−16
• tests/ParserTests.hs +11/−5
• tests/PrettyParseTests.hs +9/−10

@@ -1,6 +1,39 @@  # ChangeLog +## [(diff)](https://github.com/haskell-nix/hnix/compare/0.16.0...0.17.0#files_bucket) 0.17.0++* Additional+  * `Nix.Effect`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1051) Introduction of new type NarContent, a tagged union type of `byteString` and `FilePath`.+    * [(link)](https://github.com/haskell-nix/hnix/pull/1051) getURL of instance MonadHttp IO is finally working through hnix-store. Which also means+      builtins.fetchurl is working through it.+* Breaking:+  * `Nix.Effect`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1051) MonadStore's addToStore signature changed to `StorePathName -> NarContent -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)` with new introduction of NarContent. Which enable us to add byteString as file to Store. It is corresponding to the hnix-store api change.+  * `Nix.Expr.Types`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1042/files) The central HNix type `NExprF` changed, the `NApp` was moved out of `NBinary` & now a `NExprF` constructor of its own, the type signatures were changed accordingly.+    * [(link)](https://github.com/haskell-nix/hnix/pull/1038/files) project was using `megaparsec` `{,Source}Pos` and to use it shipped a lot of orphan instances. To improve the situation & performance (reports [#1026](https://github.com/haskell-nix/hnix/issues/1026), [#746](https://github.com/haskell-nix/hnix/issues/746)) project uses `N{,Source}Pos` types, related type signatures were changed accordingly.+  * `Nix.Value`+    * [(link)](https://github.com/haskell-nix/hnix/pull/1046/files) Unify builder `mkNV*` and `NV*` patterns by bidirectional synonyms, a lot of builders `mkNV*` are removed, and merged to `NV*`. e.g. instead of builder `mkNVList`, `NVList` should be used.+    * [(link)](https://github.com/haskell-nix/hnix/pull/1046/files) Constraint `NVConstraint f = (Comonad f, Applicative f)` was introduced, in order to unify builder `mkNV*` and `NV*` patterns.++  * `Nix.Parser`:+    * [(link)](https://github.com/haskell-nix/hnix/pull/1047/files) rm `OperatorInfo`, using `NOperatorDef`. Number of functions changed signatures accordingly:+    * In `Nix.Pretty`:+      * `NixDoc ann`+      * `mkNixDoc`+      * `selectOp`+      * `hasAttrOp`+      * `precedenceWrap`+      * `wrapPath`+    * In `Nix.Parser`:+      * rm `get{App,Unary,Binary,Special}Operator`, currely `NOp` class instances are used instead.+    +  * `Nix.Pretty`:+    * [(link)](https://github.com/haskell-nix/hnix/pull/1047/files) rm `appOp`, instead use `appOpDef`.+    * [(link)](https://github.com/haskell-nix/hnix/pull/1047/files) `precedenceWrap` behaviour is changed (to be literal to the name), the old behaviour is now a `wrap` function.+ ## [(diff)](https://github.com/haskell-nix/hnix/compare/0.15.0...0.16.0#files_bucket) 0.16.0  On update problems, please reach out to us. For support refere to: https://github.com/haskell-nix/hnix/issues/984

@@ -1,6 +1,6 @@ cabal-version:  2.2 name:           hnix-version:        0.16.0+version:        0.17.0 synopsis:       Haskell implementation of the Nix language description:    Haskell implementation of the Nix language. category:       System, Data, Nix@@ -327,7 +327,56 @@   manual: True   default: False +common shared+  default-language: Haskell2010+  default-extensions:+      NoImplicitPrelude+    , OverloadedStrings+    , DeriveGeneric+    , DeriveDataTypeable+    , DeriveFunctor+    , DeriveFoldable+    , DeriveTraversable+    , DeriveLift+    , FlexibleContexts+    , FlexibleInstances+    , ScopedTypeVariables+    , StandaloneDeriving+    , TypeApplications+    , TypeSynonymInstances+    , InstanceSigs+    , MultiParamTypeClasses+    , TupleSections+    , LambdaCase+    , BangPatterns+    , ViewPatterns+  build-depends:+      base >= 4.12 && < 5+    , data-fix >= 0.3.0 && < 0.4+    , exceptions >= 0.10.0 && < 0.11+    , filepath >= 1.4.2 && < 1.5+    , optparse-applicative >= 0.14.3 && < 0.19+    , relude >= 1.0.0 && < 1.3+    , serialise >= 0.2.1 && < 0.3+    , template-haskell >= 2.13 && < 2.22+    , time >= 1.8.0 && < 1.9 || >= 1.9.3 && < 1.13+  ghc-options:+    -Wall+    -Wno-incomplete-uni-patterns+    -fprint-potential-instances+  if flag(optimize)+    default-extensions:+      ApplicativeDo+    ghc-options:+      -O2+      -fexpose-all-unfoldings+      -fspecialise-aggressively+  -- if !flag(profiling)+  --   build-depends:+  --       ghc-datasize+ library+  import: shared   exposed-modules:     Nix     Nix.Prelude@@ -386,107 +435,65 @@     Paths_hnix   hs-source-dirs:     src-  ghc-options:-    -Wall-    -fprint-potential-instances   build-depends:-      aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.1+      aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.2     , array >= 0.4 && < 0.6-    , base >= 4.12 && < 4.16     , base16-bytestring >= 0.1.1 && < 1.1     , binary >= 0.8.5 && < 0.9     , bytestring >= 0.10.8 && < 0.12     , cryptonite     , comonad >= 5.0.4 && < 5.1     , containers >= 0.5.11.0 && < 0.7-    , data-fix >= 0.3.0 && < 0.4-    , deepseq >= 1.4.3 && <1.5+    , deepseq >= 1.4.3 && <1.6     , deriving-compat >= 0.3 && < 0.7     , directory >= 1.3.1 && < 1.4-    , exceptions >= 0.10.0 && < 0.11-    , filepath >= 1.4.2 && < 1.5+    , extra >= 1.7 && < 1.8     , free >= 5.1 && < 5.2     , gitrev >= 1.1.0 && < 1.4     , hashable >= 1.2.5 && < 1.5     , hashing >= 0.1.0 && < 0.2-    , hnix-store-core >= 0.5.0 && < 0.6-    , hnix-store-remote >= 0.5.0 && < 0.6+    , hnix-store-core >= 0.6.0 && < 0.8+    , hnix-store-remote >= 0.6.0 && < 0.7     , http-client >= 0.5.14 && < 0.6 || >= 0.6.4 && < 0.8     , http-client-tls >= 0.3.5 && < 0.4     , http-types >= 0.12.2 && < 0.13     , lens-family >= 1.2.2 && < 2.2     , lens-family-core >= 1.2.2 && < 2.2     , lens-family-th >= 0.5.0 && < 0.6-    , logict >= 0.6.0 && < 0.7 || >= 0.7.0.2 && < 0.8-    , megaparsec >= 7.0 && < 9.3+    , logict >= 0.6.0 && < 0.7 || >= 0.7.0.2 && < 0.9+    , megaparsec >= 7.0 && < 9.6     , monad-control >= 1.0.2 && < 1.1     , monadlist >= 0.0.2 && < 0.1-    , mtl >= 2.2.2 && < 2.3+    , mtl >= 2.2.2 && < 2.4     , neat-interpolation >= 0.4 && < 0.6-    , optparse-applicative >= 0.14.3 && < 0.17     , parser-combinators >= 1.0.1 && < 1.4     , pretty-show >= 1.9.5 && < 1.11     , prettyprinter >= 1.7.0 && < 1.8     , process >= 1.6.3 && < 1.7     , ref-tf >= 0.5 && < 0.6     , regex-tdfa >= 1.2.3 && < 1.4-    , relude >= 1.0.0 && < 1.1.0     , scientific >= 0.3.6 && < 0.4-    , semialign >= 1.2 && < 1.3-    , serialise >= 0.2.1 && < 0.3+    , semialign >= 1.2 && < 1.4     , some >= 1.0.1 && < 1.1     , split >= 0.2.3 && < 0.3     , syb >= 0.7 && < 0.8-    , template-haskell >= 2.13 && < 2.18     -- provides:     --   * compat instances for old versions of TH for old GHCs     --   * orphan instances for TH missing instances     -- aka Lift Text, Bytestring, Vector, Containers,     -- we use Lift Text particulrarly for GHC 8.6     , th-lift-instances >= 0.1 && < 0.2-    , text >= 1.2.3 && < 1.3-    , these >= 1.0.1 && < 1.2-    , time >= 1.8.0 && < 1.9 || >= 1.9.3 && < 1.10-    , transformers >= 0.5.5 && < 0.6+    , text >= 1.2.3 && < 2.2+    , these >= 1.0.1 && < 1.3+    , transformers >= 0.5.5 && < 0.7     , transformers-base >= 0.4.5 && < 0.5-    , unix-compat >= 0.4.3 && < 0.6-    , unordered-containers >= 0.2.9 && < 0.3-    , vector >= 0.12.0 && < 0.13+    , unix-compat >= 0.4.3 && < 0.8+    , unordered-containers >= 0.2.14 && < 0.3+    , vector >= 0.12.0 && < 0.14     , xml >= 1.3.14 && < 1.4-  default-extensions:-      NoImplicitPrelude-    , OverloadedStrings-    , DeriveGeneric-    , DeriveDataTypeable-    , DeriveFunctor-    , DeriveFoldable-    , DeriveTraversable-    , DeriveLift-    , FlexibleContexts-    , FlexibleInstances-    , ScopedTypeVariables-    , StandaloneDeriving-    , TypeApplications-    , TypeSynonymInstances-    , InstanceSigs-    , MultiParamTypeClasses-    , TupleSections-    , LambdaCase-    , BangPatterns-    , ViewPatterns-  if flag(optimize)-    default-extensions:-      ApplicativeDo-    ghc-options:-      -O2-      -fexpose-all-unfoldings-      -fspecialise-aggressively-  -- if !flag(profiling)-  --   build-depends:-  --       ghc-datasize-  default-language: Haskell2010  executable hnix+  import: shared   hs-source-dirs:     main   main-is: Main.hs@@ -495,64 +502,25 @@     Paths_hnix   autogen-modules:     Paths_hnix-  ghc-options:-    -Wall   build-depends:-      aeson-    , base+      hnix+    , aeson     , comonad     , containers-    , data-fix     , deepseq-    , exceptions-    , filepath     , free     , haskeline >= 0.8.0.0 && < 0.9-    , hnix-    , optparse-applicative     , pretty-show     , prettyprinter     , ref-tf-    , relude     , repline >= 0.4.0.0 && < 0.5-    , serialise-    , template-haskell-    , time-  default-extensions:-      NoImplicitPrelude-    , OverloadedStrings-    , DeriveGeneric-    , DeriveDataTypeable-    , DeriveFunctor-    , DeriveFoldable-    , DeriveTraversable-    , DeriveLift-    , FlexibleContexts-    , FlexibleInstances-    , ScopedTypeVariables-    , StandaloneDeriving-    , TypeApplications-    , TypeSynonymInstances-    , InstanceSigs-    , MultiParamTypeClasses-    , TupleSections-    , LambdaCase-    , BangPatterns-    , ViewPatterns-  if flag(optimize)-    default-extensions:-      ApplicativeDo-    ghc-options:-      -O2-      -fexpose-all-unfoldings-      -fspecialise-aggressively   if impl(ghc < 8.10)     -- GHC < 8.10 comes with haskeline < 0.8, which we don't support.     -- To simplify CI, we just disable the component.     buildable: False-  default-language: Haskell2010  test-suite hnix-tests+  import: shared   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:@@ -565,113 +533,33 @@     TestCommon   hs-source-dirs:     tests-  ghc-options:-    -Wall-    -threaded   build-depends:-      Diff+      hnix+    , Diff     , Glob-    , base     , containers-    , data-fix     , directory-    , exceptions-    , filepath     , hedgehog-    , hnix     , megaparsec     , neat-interpolation-    , optparse-applicative     , pretty-show     , prettyprinter     , process-    , relude     , split     , tasty     , tasty-hedgehog     , tasty-hunit     , tasty-th-    , serialise-    , template-haskell-    , time     , unix-compat-  default-extensions:-      NoImplicitPrelude-    , OverloadedStrings-    , DeriveGeneric-    , DeriveDataTypeable-    , DeriveFunctor-    , DeriveFoldable-    , DeriveTraversable-    , DeriveLift-    , FlexibleContexts-    , FlexibleInstances-    , ScopedTypeVariables-    , StandaloneDeriving-    , TypeApplications-    , TypeSynonymInstances-    , InstanceSigs-    , MultiParamTypeClasses-    , TupleSections-    , LambdaCase-    , BangPatterns-    , ViewPatterns-  if flag(optimize)-    default-extensions:-      ApplicativeDo-    ghc-options:-      -O2-      -fexpose-all-unfoldings-      -fspecialise-aggressively-  default-language: Haskell2010  benchmark hnix-benchmarks+  import: shared   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:     ParserBench   hs-source-dirs:     benchmarks-  ghc-options:-    -Wall   build-depends:-      base+    hnix     , criterion-    , data-fix-    , exceptions-    , filepath-    , hnix-    , optparse-applicative-    , relude-    , serialise-    , template-haskell-    , time-  default-extensions:-      NoImplicitPrelude-    , OverloadedStrings-    , DeriveGeneric-    , DeriveDataTypeable-    , DeriveFunctor-    , DeriveFoldable-    , DeriveTraversable-    , DeriveLift-    , FlexibleContexts-    , FlexibleInstances-    , ScopedTypeVariables-    , StandaloneDeriving-    , TypeApplications-    , TypeSynonymInstances-    , InstanceSigs-    , MultiParamTypeClasses-    , TupleSections-    , LambdaCase-    , BangPatterns-    , ViewPatterns-  if flag(optimize)-    default-extensions:-      ApplicativeDo-    ghc-options:-      -O2-      -fexpose-all-unfoldings-      -fspecialise-aggressively-  default-language: Haskell2010

@@ -342,7 +342,7 @@ -- | @:set@ command setConfig :: (MonadNix e t f m, MonadIO m) => Text -> Repl e t f m () setConfig args =-  list+  handlePresence     (liftIO $ Text.putStrLn "No option to set specified")     (\ (x:_xs)  ->       case filter ((==x) . helpSetOptionName) helpSetOptions of@@ -393,7 +393,7 @@     listFiles word    -- Attributes of sets in REPL context-  | var : subFields <- Text.split (== '.') (fromString word) , not $ null subFields =+  | var : subFields <- Text.split (== '.') (fromString word) , isPresent subFields =     do       state <- get       maybe@@ -575,16 +575,19 @@      -> Repl e t f m () help hs _ = do   liftIO $ putStrLn "Available commands:\n"-  for_ hs $ \h ->-    liftIO .-      Text.putStrLn .-        Prettyprinter.renderStrict .-          Prettyprinter.layoutPretty Prettyprinter.defaultLayoutOptions $-            ":"-            <> Prettyprinter.pretty (helpOptionName h) <> space-            <> helpOptionSyntax h-            <> Prettyprinter.line-            <> Prettyprinter.indent 4 (helpOptionDoc h)+  traverse_+    (\h ->+      liftIO .+        Text.putStrLn .+          Prettyprinter.renderStrict .+            Prettyprinter.layoutPretty Prettyprinter.defaultLayoutOptions $+              ":"+              <> Prettyprinter.pretty (helpOptionName h) <> space+              <> helpOptionSyntax h+              <> Prettyprinter.line+              <> Prettyprinter.indent 4 (helpOptionDoc h)+    )+    hs  options   :: (MonadNix e t f m, MonadIO m)

@@ -114,7 +114,7 @@     f' <- demand f     val <-       case f' of-        NVClosure _ g -> g $ mkNVSet mempty $ M.fromList args+        NVClosure _ g -> g $ NVSet mempty $ M.fromList args         _             -> pure f     processResult handler val  where@@ -142,7 +142,7 @@  where   processKeys :: [VarName] -> NValue t f m -> m a   processKeys kys v =-    list+    handlePresence       (h v)       (\ ((k : ks) :: [VarName]) ->         do

@@ -7,6 +7,7 @@ {-# language MultiWayIf #-} {-# language PartialTypeSignatures #-} {-# language QuasiQuotes #-}+{-# language PatternSynonyms #-} {-# 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}@@@ -23,7 +24,6 @@  import           Nix.Prelude import           GHC.Exception                  ( ErrorCall(ErrorCall) )-import           Control.Comonad                ( Comonad ) import           Control.Monad                  ( foldM ) import           Control.Monad.Catch            ( MonadCatch(catch) ) import           Control.Monad.ListM            ( sortByM )@@ -126,14 +126,14 @@   )   => ToBuiltin t f m (a -> b) where   toBuiltin name f =-    pure $ mkNVBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper+    pure $ NVBuiltin (coerce name) $ toBuiltin name . f <=< fromValue . Deeper  -- *** @WValue@ closure wrapper to have @Ord@  -- We wrap values solely to provide an Ord instance for genericClosure newtype WValue t f m = WValue (NValue t f m) -instance Comonad f => Eq (WValue t f m) where+instance NVConstraint f => Eq (WValue t f m) where   WValue (NVConstant (NFloat x)) == WValue (NVConstant (NInt y)) =     x == fromInteger y   WValue (NVConstant (NInt   x)) == WValue (NVConstant (NFloat y)) =@@ -145,7 +145,7 @@     ignoreContext x == ignoreContext y   _ == _ = False -instance Comonad f => Ord (WValue t f m) where+instance NVConstraint f => Ord (WValue t f m) where   WValue (NVConstant (NFloat x)) <= WValue (NVConstant (NInt y)) =     x <= fromInteger y   WValue (NVConstant (NInt   x)) <= WValue (NVConstant (NFloat y)) =@@ -159,11 +159,8 @@  -- ** Helpers -mkNVBool-  :: MonadNix e t f m-  => Bool-  -> NValue t f m-mkNVBool = mkNVConstant . NBool+pattern NVBool :: MonadNix e t f m => Bool -> NValue t f m+pattern NVBool a = NVConstant (NBool a)  data NixPathEntryType   = PathEntryPath@@ -307,7 +304,7 @@   -- list   breakAfterFirstItem :: (a -> Bool) -> [a] -> ([a], [a])   breakAfterFirstItem f =-    list+    handlePresence       mempty       (\ (h : t) -> let (a, b) = break f t in (h : a, b))   (namePieces, versionPieces) =@@ -331,15 +328,15 @@   relStart       = max 0 start - numDropped   (before, rest) = B.splitAt relStart haystack   caps :: NValue t f m-  caps           = mkNVList (f <$> captures)+  caps           = NVList (f <$> captures)   f :: (ByteString, (Int, b)) -> NValue t f m   f (a, (s, _))  =     bool-      nvNull+      NVNull       (thunkStr a)       (s >= 0) -thunkStr :: Applicative f => ByteString -> NValue t f m+thunkStr :: NVConstraint f => ByteString -> NValue t f m thunkStr s = mkNVStrWithoutContext $ decodeUtf8 s  hasKind@@ -360,7 +357,7 @@         let           path = coerce . toString $ ignoreContext ns -        unless (isAbsolute path) $ throwError $ ErrorCall $ "string " <> show path <> " doesn't represent an absolute path"+        when (not (isAbsolute path)) $ throwError $ ErrorCall $ "string " <> show path <> " doesn't represent an absolute path"         pure path      NVPath path -> pure path@@ -422,16 +419,16 @@ nixPathNix :: forall e t f m . MonadNix e t f m => m (NValue t f m) nixPathNix =   fmap-    mkNVList+    NVList     $ foldNixPath mempty $         \p mn ty rest ->           pure $             pure-              (mkNVSet+              (NVSet                 mempty                 (M.fromList                   [case ty of-                    PathEntryPath -> ("path", mkNVPath  p)+                    PathEntryPath -> ("path", NVPath  p)                     PathEntryURI  -> ( "uri", mkNVStrWithoutContext $ fromString $ coerce p)                    , ( "prefix", mkNVStrWithoutContext $ maybeToMonoid mn)@@ -500,7 +497,7 @@     case (x, y) of       (NVStr ns, NVSet apos _) ->         maybe-          (pure nvNull)+          (pure NVNull)           toValue           (M.lookup @VarName (coerce $ ignoreContext ns) apos)       _xy -> throwError $ ErrorCall $ "Invalid types for builtins.unsafeGetAttrPosNix: " <> show _xy@@ -613,7 +610,7 @@ tailNix =   maybe     (throwError $ ErrorCall "builtins.tail: empty list")-    (pure . mkNVList)+    (pure . NVList)   . viaNonEmpty tail <=< fromValue @[NValue t f m]  splitVersionNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -621,7 +618,7 @@   do     version <- fromStringNoContext =<< fromValue v     pure $-      mkNVList $+      NVList $         mkNVStrWithoutContext . show <$>           splitVersion version @@ -642,7 +639,7 @@           EQ -> 0           GT -> 1 -    pure $ mkNVConstant $ NInt cmpVers+    pure $ NVConstant $ NInt cmpVers   where   mkText = fromStringNoContext <=< fromValue@@ -689,7 +686,7 @@       re = makeRegex p :: Regex       mkMatch t =         bool-          (pure nvNull)+          (pure NVNull)           (toValue $ mkNixStringWithoutContext t)           (not $ Text.null t) @@ -697,7 +694,7 @@       Just ("", sarr, "") ->         do           let submatches = fst <$> elems sarr-          mkNVList <$>+          NVList <$>             traverse               mkMatch               (case submatches of@@ -705,7 +702,7 @@                  [a] -> one a                  _:xs -> xs -- return only the matched groups, drop the full string               )-      _ -> pure nvNull+      _ -> pure NVNull  splitNix   :: forall e t f m@@ -726,7 +723,7 @@       regex       = makeRegex p :: Regex       haystack = encodeUtf8 s -    pure $ mkNVList $ splitMatches 0 (elems <$> matchAllText regex haystack) haystack+    pure $ NVList $ splitMatches 0 (elems <$> matchAllText regex haystack) haystack  substringNix :: forall e t f m. MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString substringNix start len str =@@ -825,7 +822,7 @@     n <- fromStringNoContext =<< fromValue attrName     l <- fromValue @[NValue t f m] xs -    mkNVList . catMaybes <$>+    NVList . catMaybes <$>       traverse         (fmap (M.lookup @VarName $ coerce n) . fromValue <=< demand)         l@@ -835,7 +832,7 @@   do     ns <- coerceStringlikeToNixString DontCopyToStore x     pure $-      mkNVStr $+      NVStr $         modifyNixContents           (fromString . coerce takeFileName . toString)           ns@@ -915,9 +912,9 @@     name      <- toText <$> attrGetOr (takeFileName path) (fmap (coerce . toString) . fromStringNoContext) "name" attrs     recursive <- attrGetOr True pure "recursive" attrs -    Right (coerce . toText . coerce @StorePath @String -> s) <- addToStore name path recursive False+    Right (coerce . toText . coerce @StorePath @String -> s) <- addToStore name (NarFile path) recursive False     -- TODO: Ensure that s matches sha256 when not empty-    pure $ mkNVStr $ mkNixStringWithSingletonContext (StringContext DirectPath s) s+    pure $ NVStr $ mkNixStringWithSingletonContext (StringContext DirectPath s) s  where   coerceToPath = coerceToString callFunc DontCopyToStore CoerceAny @@ -927,8 +924,8 @@     dir <- demand nvdir      case dir of-      NVStr ns -> pure $ mkNVStr $ modifyNixContents (fromString . coerce takeDirectory . toString) ns-      NVPath path -> pure $ mkNVPath $ takeDirectory path+      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?@@ -963,7 +960,7 @@  where   anyMNix :: Monad m => (a -> m Bool) -> [a] -> m Bool   anyMNix p =-    list+    handlePresence       (pure False)       (\ (x : xss) ->         bool@@ -1028,7 +1025,7 @@               bool                 (do                   checkComparable k $-                    list+                    handlePresence                       k                       (\ (WValue j:_) -> j)                       (S.toList ks)@@ -1158,7 +1155,7 @@     (s1, p1) <- fromValue @(AttrSet (NValue t f m), PositionSet) set1     (s2, p2) <- fromValue @(AttrSet (NValue t f m), PositionSet) set2 -    pure $ mkNVSet (p2 `M.intersection` p1) (s2 `M.intersection` s1)+    pure $ NVSet (p2 `M.intersection` p1) (s2 `M.intersection` s1)  functionArgsNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)@@ -1167,7 +1164,7 @@     fun <- demand nvfun     case fun of       NVClosure p _ ->-        toValue @(AttrSet (NValue t f m)) $ mkNVBool <$>+        toValue @(AttrSet (NValue t f m)) $ NVBool <$>           case p of             Param name     -> one (name, False)             ParamSet _ _ pset -> isJust <$> M.fromList pset@@ -1272,7 +1269,7 @@ -- importNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)-importNix = scopedImportNix $ mkNVSet mempty mempty+importNix = scopedImportNix $ NVSet mempty mempty  -- | @scopedImport scope path@ -- An undocumented secret powerful function.@@ -1383,7 +1380,7 @@     let       badType = throwError $ ErrorCall $ "builtins.lessThan: expected two numbers or two strings, got '" <> show va <> "' and '" <> show vb <> "'." -    mkNVBool <$>+    NVBool <$>       case (va, vb) of         (NVConstant ca, NVConstant cb) ->           case (ca, cb) of@@ -1433,7 +1430,7 @@   do     l <- fromValue @[NValue t f m] lst     fmap-      (mkNVSet mempty . M.fromList . reverse)+      (NVSet mempty . M.fromList . reverse)       (traverse         (\ nvattrset ->           do@@ -1500,8 +1497,8 @@   list   <- demand nvlist   fun    <- demand nvfun   (f, l) <- extractP (fun, list)-  mkNVSet mempty-    .   fmap (mkNVList . reverse)+  NVSet mempty+    .   fmap (NVList . reverse)     .   M.fromListWith (<>)     <$> traverse (app f) l  where@@ -1565,7 +1562,7 @@         do           mres <- findPath @t @f @m x $ coerce $ toString $ ignoreContext ns -          pure $ mkNVPath mres+          pure $ NVPath mres        (NVList _, _y     ) -> throwError $ ErrorCall $ "expected a string, got " <> show _y       (_x      , NVStr _) -> throwError $ ErrorCall $ "expected a list, got " <> show _x@@ -1620,32 +1617,32 @@     \case       A.Object m ->         traverseToNValue-          (mkNVSet mempty)+          (NVSet mempty) #if MIN_VERSION_aeson(2,0,0)           (M.mapKeys (coerce . AKM.toText)  $ AKM.toHashMap m) #else           (M.mapKeys coerce m) #endif-      A.Array  l -> traverseToNValue mkNVList (V.toList l)+      A.Array  l -> traverseToNValue NVList (V.toList l)       A.String s -> pure $ mkNVStrWithoutContext s       A.Number n ->         pure $-          mkNVConstant $+          NVConstant $             either               NFloat               NInt               (floatingOrInteger n)-      A.Bool   b -> pure $ mkNVBool b-      A.Null     -> pure nvNull+      A.Bool   b -> pure $ NVBool b+      A.Null     -> pure NVNull    where     traverseToNValue :: Traversable t0 => (t0 (NValue t f m) -> b) -> t0 A.Value -> m b     traverseToNValue f v = f <$> traverse jsonToNValue v  toJSONNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-toJSONNix = (fmap mkNVStr . toJSONNixString) <=< demand+toJSONNix = (fmap NVStr . toJSONNixString) <=< demand  toXMLNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m)-toXMLNix = (fmap (mkNVStr . toXML) . normalForm) <=< demand+toXMLNix = (fmap (NVStr . toXML) . normalForm) <=< demand  typeOfNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) typeOfNix nvv =@@ -1677,19 +1674,19 @@   (onSuccess <$> demand e)  where   onSuccess v =-    mkNVSet+    NVSet       mempty       $ M.fromList-        [ ("success", mkNVBool True)+        [ ("success", NVBool True)         , ("value"  , v            )         ]    onError :: SomeException -> NValue t f m   onError _ =-    mkNVSet+    NVSet       mempty       $ M.fromList-        $ (, mkNVBool False) <$>+        $ (, NVBool False) <$>           [ "success"           , "value"           ]@@ -1717,40 +1714,37 @@ execNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) execNix xs =-  do-    xs' <- traverse (coerceStringlikeToNixString DontCopyToStore) =<< fromValue @[NValue t f m] xs-    -- 2018-11-19: NOTE: Still need to do something with the context here-    -- See prim_exec in nix/src/libexpr/primops.cc-    -- Requires the implementation of EvalState::realiseContext-    exec $ ignoreContext <$> xs'+  -- 2018-11-19: NOTE: Still need to do something with the context here+  -- See prim_exec in nix/src/libexpr/primops.cc+  -- Requires the implementation of EvalState::realiseContext+  (exec . fmap ignoreContext) =<< traverse (coerceStringlikeToNixString DontCopyToStore) =<< fromValue @[NValue t f m] xs  fetchurlNix   :: 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-    v@NVStr{} -> go Nothing v+    NVSet _ s -> fetch (M.lookup "sha256" s) =<< demand =<< attrsetGet "url" s+    v@NVStr{} -> fetch Nothing v     v -> throwError $ ErrorCall $ "builtins.fetchurl: 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 =+  --  2022-01-21: NOTE: Needs to check the hash match.+  fetch :: Maybe (NValue t f m) -> NValue t f m -> m (NValue t f m)+  fetch _msha =     \case       NVStr ns ->         either -- msha           throwError           toValue-          =<< getURL =<< noContextAttrs ns+          =<< getURL+            =<< maybe+              (throwError $ ErrorCall "builtins.fetchurl: unsupported arguments to url")+              pure+              (getStringNoContext ns)        v -> throwError $ ErrorCall $ "builtins.fetchurl: Expected URI or string, got " <> show v -  noContextAttrs ns =-    maybe-      (throwError $ ErrorCall "builtins.fetchurl: unsupported arguments to url")-      pure-      (getStringNoContext ns)- partitionNix   :: forall e t f m    . MonadNix e t f m@@ -1759,14 +1753,13 @@   -> m (NValue t f m) partitionNix f nvlst =   do-    l <- fromValue @[NValue t f m] nvlst     let       match t = (, t) <$> (fromValue =<< callFunc f t)-    selection <- traverse match l+    selection <- traverse match =<< fromValue @[NValue t f m] nvlst      let       (right, wrong) = partition fst selection-      makeSide       = mkNVList . fmap snd+      makeSide       = NVList . fmap snd      toValue @(AttrSet (NValue t f m))       $ M.fromList@@ -1791,15 +1784,15 @@ derivationStrictNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) derivationStrictNix = derivationStrict -getRecursiveSizeNix :: (MonadIntrospect m, Applicative f) => a -> m (NValue t f m)-getRecursiveSizeNix = fmap (mkNVConstant . NInt . fromIntegral) . recursiveSize+getRecursiveSizeNix :: (MonadIntrospect m, NVConstraint f) => a -> m (NValue t f m)+getRecursiveSizeNix = fmap (NVConstant . NInt . fromIntegral) . recursiveSize  getContextNix   :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m) getContextNix =   \case     (NVStr ns) ->-      mkNVSet mempty <$> traverseToValue (getNixLikeContext $ toNixLikeContext $ getStringContext ns)+      NVSet mempty <$> traverseToValue (getNixLikeContext $ toNixLikeContext $ getStringContext ns)     x -> throwError $ ErrorCall $ "Invalid type for builtins.getContext: " <> show x   <=< demand @@ -1927,7 +1920,7 @@     , add2 Normal   "elem"             elemNix     , add2 Normal   "elemAt"           elemAtNix     , add  Normal   "exec"             execNix-    , add0 Normal   "false"            (pure $ mkNVBool False)+    , add0 Normal   "false"            (pure $ NVBool False)     --, add  Normal   "fetchGit"         fetchGit     --, add  Normal   "fetchMercurial"   fetchMercurial     , add  Normal   "fetchTarball"     fetchTarball@@ -1966,7 +1959,7 @@     , add2 Normal   "match"            matchNix     , add2 Normal   "mul"              mulNix     , add0 Normal   "nixPath"          nixPathNix-    , add0 Normal   "null"             (pure nvNull)+    , add0 Normal   "null"             (pure NVNull)     , add  Normal   "parseDrvName"     parseDrvNameNix     , add2 Normal   "partition"        partitionNix     , add  Normal   "path"             pathNix@@ -1986,9 +1979,9 @@     , add  Normal   "tail"             tailNix     , add2 Normal   "toFile"           toFileNix     , add  Normal   "toJSON"           toJSONNix-    , add  Normal   "toPath"           toPathNix+    , add  Normal   "toPath"           toPathNix -- Deprecated in Nix: https://github.com/NixOS/nix/pull/2524     , add  Normal   "toXML"            toXMLNix-    , add0 Normal   "true"             (pure $ mkNVBool True)+    , add0 Normal   "true"             (pure $ NVBool True)     , add  Normal   "tryEval"          tryEvalNix     , add  Normal   "typeOf"           typeOfNix     , add  Normal   "unsafeDiscardOutputDependency" unsafeDiscardOutputDependencyNix@@ -2088,7 +2081,7 @@     opts <- askOptions      pushScope-      (one ("__includes", mkNVList $ mkNVStrWithoutContext . fromString . coerce <$> getInclude opts))+      (one ("__includes", NVList $ mkNVStrWithoutContext . fromString . coerce <$> getInclude opts))       (pushScopes         base $         maybe@@ -2096,7 +2089,7 @@           (\ path act ->             do               traceM $ "Setting __cur_file = " <> show path-              pushScope (one ("__cur_file", mkNVPath path)) act+              pushScope (one ("__cur_file", NVPath path)) act           )           mpath           action@@ -2110,7 +2103,7 @@   => m (Scopes m (NValue t f m)) builtins =   do-    ref <- defer $ mkNVSet mempty <$> buildMap+    ref <- defer $ NVSet mempty <$> buildMap     (`pushScope` askScopes) . coerce . M.fromList . (one ("builtins", ref) <>) =<< topLevelBuiltins  where   buildMap :: m (HashMap VarName (NValue t f m))

@@ -179,7 +179,7 @@   -> m a   -> m a displayProvenance =-  list+  handlePresence     id     (\ (Provenance scope e@(AnnF s _) : _) ->       withFrame Info $ ForcingExpr scope $ wrapExprLoc s e

@@ -21,7 +21,6 @@ import           Nix.Atoms import           Nix.Effects import           Nix.Expr.Types-import           Nix.Expr.Types.Annotated import           Nix.Frames import           Nix.String import           Nix.Value@@ -371,85 +370,85 @@  instance Convertible e t f m   => ToValue () m (NValue' t f m (NValue t f m)) where-  toValue = const $ pure nvNull'+  toValue = const $ pure NVNull'  instance Convertible e t f m   => ToValue Bool m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVConstant' . NBool+  toValue = pure . NVConstant' . NBool  instance Convertible e t f m   => ToValue Int m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVConstant' . NInt . toInteger+  toValue = pure . NVConstant' . NInt . toInteger  instance Convertible e t f m   => ToValue Integer m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVConstant' . NInt+  toValue = pure . NVConstant' . NInt  instance Convertible e t f m   => ToValue Float m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVConstant' . NFloat+  toValue = pure . NVConstant' . NFloat  instance Convertible e t f m   => ToValue NixString m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVStr'+  toValue = pure . NVStr'  instance Convertible e t f m   => ToValue ByteString m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVStr' . mkNixStringWithoutContext . 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 . mkNVStr' . mkNixStringWithoutContext+  toValue = pure . NVStr' . mkNixStringWithoutContext  instance Convertible e t f m   => ToValue Path m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVPath' . coerce+  toValue = pure . NVPath'  instance Convertible e t f m   => ToValue StorePath m (NValue' t f m (NValue t f m)) where   toValue = toValue @Path . coerce  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 $ mkNixStringWithoutContext $ fromString f-    l' <- toValue $ unPos l-    c' <- toValue $ unPos c+  => ToValue NSourcePos m (NValue' t f m (NValue t f m)) where+  toValue (NSourcePos f l c) = do+    f' <- toValue $ mkNixStringWithoutContext $ fromString $ coerce f+    l' <- toValue $ unPos $ coerce l+    c' <- toValue $ unPos $ coerce c     let pos = M.fromList [("file" :: VarName, f'), ("line", l'), ("column", c')]-    pure $ mkNVSet' mempty pos+    pure $ NVSet' mempty pos  -- | With 'ToValue', we can always act recursively instance Convertible e t f m   => ToValue [NValue t f m] m (NValue' t f m (NValue t f m)) where-  toValue = pure . mkNVList'+  toValue = pure . NVList'  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 . mkNVList' <$> traverseToValue 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-  toValue s = pure $ mkNVSet' mempty s+  toValue s = pure $ NVSet' mempty s  instance (Convertible e t f m, ToValue a m (NValue t f m))   => ToValue (AttrSet a) m (Deeper (NValue' t f m (NValue t f m))) where   toValue s =-    liftA2 (\ v s -> Deeper $ mkNVSet' s v)+    liftA2 (\ v s -> Deeper $ NVSet' s v)       (traverseToValue s)       stub  instance Convertible e t f m   => ToValue (AttrSet (NValue t f m), PositionSet) m             (NValue' t f m (NValue t f m)) where-  toValue (s, p) = pure $ mkNVSet' p s+  toValue (s, p) = pure $ NVSet' p s  instance (Convertible e t f m, ToValue a m (NValue t f m))   => ToValue (AttrSet a, PositionSet) m             (Deeper (NValue' t f m (NValue t f m))) where   toValue (s, p) =-    liftA2 (\ v s -> Deeper $ mkNVSet' s v)+    liftA2 (\ v s -> Deeper $ NVSet' s v)       (traverseToValue s)       (pure p) @@ -469,11 +468,11 @@         outputs = mkNixStringWithoutContext <$> nlcvOutputs nlcv        ts :: [NValue t f m] <- traverseToValue outputs-      list+      handlePresence         (pure Nothing)         (fmap pure . toValue)         ts-    pure $ mkNVSet' mempty $ M.fromList $ catMaybes+    pure $ NVSet' mempty $ M.fromList $ catMaybes       [ ("path"      ,) <$> path       , ("allOutputs",) <$> allOutputs       , ("outputs"   ,) <$> outputs

@@ -6,6 +6,7 @@ {-# 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 TypeOperators #-}  {-# options_ghc -Wno-orphans #-} @@ -36,6 +37,7 @@  import qualified System.Nix.Store.Remote       as Store.Remote import qualified System.Nix.StorePath          as Store+import qualified System.Nix.Nar                as Store.Nar  -- | A path into the nix store newtype StorePath = StorePath Path@@ -286,29 +288,39 @@   default getURL :: (MonadTrans t, MonadHttp m', m ~ t m') => Text -> m (Either ErrorCall StorePath)   getURL = lift . getURL +baseNameOf :: Text -> Text+baseNameOf a = Text.takeWhileEnd (/='/') $ Text.dropWhileEnd (=='/') a +-- conversion from Store.StorePath to Effects.StorePath, different type with the same name.+toStorePath :: Store.StorePath -> StorePath+toStorePath = StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath+ -- ** Instances  instance MonadHttp IO where-  getURL url = do-    let urlstr = toString url-    traceM $ "fetching HTTP URL: " <> urlstr-    req     <- parseRequest urlstr-    manager <--      if secure req-        then newTlsManager-        else newManager defaultManagerSettings-    -- print req-    response <- httpLbs (req { method = "GET" }) manager-    let status = statusCode $ responseStatus response-    pure $ Left $ ErrorCall $ if status /= 200-      then-        "fail, got " <> show status <> " when fetching url:" <> urlstr-      else-        -- do-        -- let bstr = responseBody response-        "success in downloading but hnix-store is not yet ready; url = " <> urlstr+  getURL url =+    do+      let urlstr = toString url+      traceM $ "fetching HTTP URL: " <> urlstr+      req     <- parseRequest urlstr+      manager <-+        bool+          (newManager defaultManagerSettings)+          newTlsManager+          (secure req)+      response <- httpLbs (req { method = "GET" }) manager+      let status = statusCode $ responseStatus response+      let body = responseBody response+      -- let digest::Hash.Digest Hash.SHA256 = Hash.hash $ (B.concat . BL.toChunks) body+      let name = baseNameOf url+      bool+        (pure $ Left $ ErrorCall $ "fail, got " <> show status <> " when fetching url = " <> urlstr)+        -- using addTextToStore' result in different hash from the addToStore.+        -- see https://github.com/haskell-nix/hnix/pull/1051#issuecomment-1031380804+        (addToStore name (NarText $ toStrict body) False False)+        (status == 200) + deriving   instance     MonadHttp (t (Fix1 t))@@ -368,17 +380,24 @@ type PathFilter m = Path -> m Bool type StorePathSet = HS.HashSet StorePath + -- ** @class MonadStore m@ +data NarContent = NarFile Path | NarText ByteString+-- | convert NarContent to NarSource needed in the store API+toNarSource :: MonadIO m => NarContent -> Store.Nar.NarSource m+toNarSource (NarFile path) = Store.Nar.dumpPath $ coerce path+toNarSource (NarText text) = Store.Nar.dumpString text+ class   Monad m   => MonadStore m where -  -- | Copy the contents of a local path to the store.  The resulting store+  -- | Copy the contents of a local path(Or pure text) 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 -> 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 :: StorePathName -> NarContent -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)+  default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> NarContent -> 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@@ -392,16 +411,15 @@  instance MonadStore IO where -  addToStore name path recursive repair =+  addToStore name content recursive repair =     either       (\ err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> err)       (\ pathName ->         do-          -- TODO: redesign the filter parameter-          res <- Store.Remote.runStore $ Store.Remote.addToStore @Hash.SHA256 pathName (coerce path) recursive (const False) repair+          res <- Store.Remote.runStore $ Store.Remote.addToStore @Hash.SHA256 pathName (toNarSource content) recursive repair           either             Left -- err-            (pure . StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath) -- store path+            (pure . toStorePath) -- store path             <$> parseStoreResult "addToStore" res       )       (Store.makeStorePathName name)@@ -411,20 +429,19 @@       res <- Store.Remote.runStore $ Store.Remote.addTextToStore name text references repair       either         Left -- err-        (pure . StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath) -- path+        (pure . toStorePath) -- path         <$> parseStoreResult "addTextToStore" res   -- ** Functions  parseStoreResult :: Monad m => Text -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a)-parseStoreResult name res =-  pure $ either-    (\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> msg <> "\n" <> show logs)-    pure -- result-    (fst res)- where-  logs = snd res+parseStoreResult name (res, logs) =+  pure $+    either+      (\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> msg <> "\n" <> show logs)+      pure+      res  addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m StorePath addTextToStore a b c d =@@ -440,7 +457,7 @@   either     throwError     pure-    =<< addToStore (fromString $ coerce takeFileName p) p True False+    =<< addToStore (fromString $ coerce takeFileName p) (NarFile p) True False  toFile_ :: (Framed e m, MonadStore m) => Path -> Text -> m StorePath toFile_ p contents = addTextToStore (fromString $ coerce p) contents mempty False

@@ -292,10 +292,10 @@           (\out (coerce -> path) -> mkNixStringWithSingletonContext (StringContext (DerivationOutput out) drvPath) path)           (outputs drv')       drvPathWithContext = mkNixStringWithSingletonContext (StringContext AllOutputs drvPath) drvPath-      attrSet = mkNVStr <$> M.fromList (("drvPath", drvPathWithContext) : Map.toList outputsWithContext)+      attrSet = NVStr <$> M.fromList (("drvPath", drvPathWithContext) : Map.toList outputsWithContext)     -- TODO: Add location information for all the entries.     --              here --v-    pure $ mkNVSet mempty $ M.mapKeys coerce attrSet+    pure $ NVSet mempty $ M.mapKeys coerce attrSet    where @@ -368,7 +368,7 @@        env <- if useJson         then do-          jsonString :: NixString <- lift $ toJSONNixString $ mkNVSet mempty $ M.mapKeys coerce $+          jsonString :: NixString <- lift $ toJSONNixString $ NVSet mempty $ M.mapKeys coerce $             deleteKeys [ "args", "__ignoreNulls", "__structuredAttrs" ] attrs           rawString :: Text <- extractNixString jsonString           pure $ one ("__json", rawString)

@@ -119,7 +119,7 @@ eval (NEnvPath     p      ) = evalEnvPath p eval (NUnary op arg       ) = evalUnary op =<< arg -eval (NBinary NApp fun arg) =+eval (NApp fun arg        ) =   do     f <- fun     scope <- askScopes@@ -213,7 +213,7 @@   :: forall v m    . MonadNixEval v m   => [VarName]-  -> SourcePos+  -> NSourcePos   -> AttrSet (m v)   -> PositionSet   -> m v@@ -241,7 +241,7 @@         )         ((`M.lookup` m) k)       )-      (not $ null ks)+      (isPresent ks)    where     insertVal :: m v -> (PositionSet, AttrSet (m v))     insertVal v =@@ -267,7 +267,7 @@   collect     :: Binding r     -> State-         (AttrSet (SourcePos, [Binding r]))+         (AttrSet (NSourcePos, [Binding r]))          (Either VarName (Binding r))   collect (NamedVar (StaticKey x :| y : ys) val oldPosition) =     do@@ -275,24 +275,24 @@       pure $ Left x    where     updateBindingInformation-      :: AttrSet (SourcePos, [Binding r])-      -> AttrSet (SourcePos, [Binding r])+      :: AttrSet (NSourcePos, [Binding r])+      -> AttrSet (NSourcePos, [Binding r])     updateBindingInformation =       M.insert x         =<< maybe             (mkBindingSingleton oldPosition)             (\ (foundPosition, newBindings) -> second (<> newBindings) $ mkBindingSingleton foundPosition)             . M.lookup x-    mkBindingSingleton :: SourcePos -> (SourcePos, [Binding r])+    mkBindingSingleton :: NSourcePos -> (NSourcePos, [Binding r])     mkBindingSingleton np = (np , one $ bindValAt np)      where-      bindValAt :: SourcePos -> Binding r+      bindValAt :: NSourcePos -> Binding r       bindValAt = NamedVar (y :| ys) val   collect x = pure $ pure x    findBinding     :: Either VarName (Binding r)-    -> State (AttrSet (SourcePos, [Binding r])) (Binding r)+    -> State (AttrSet (NSourcePos, [Binding r])) (Binding r)   findBinding =     either       (\ x ->@@ -320,7 +320,7 @@  where   buildResult     :: Scopes m v-    -> [([VarName], SourcePos, m v)]+    -> [([VarName], NSourcePos, m v)]     -> m (AttrSet v, PositionSet)   buildResult scopes bindings =     do@@ -335,13 +335,14 @@       pure (coerce res, p)     where+    insert :: (AttrSet (m v), PositionSet) -> ([VarName], NSourcePos, m v) -> m (AttrSet (m v), PositionSet)     insert (m, p) (path, pos, value) = attrSetAlter path pos m p value      mkThunk = defer . withScopes scopes      encapsulate f attrs = mkThunk $ pushScope attrs f -  applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([VarName], SourcePos, m v)]+  applyBindToAdt :: Scopes m v -> Binding (m v) -> m [([VarName], NSourcePos, m v)]   applyBindToAdt _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =     do       (o', p') <- fromValue =<< finalValue@@ -363,13 +364,13 @@     ) <$> processAttrSetKeys pathExpr     where-    processAttrSetKeys :: NAttrPath (m v) -> m ([VarName], SourcePos, m v)+    processAttrSetKeys :: NAttrPath (m v) -> m ([VarName], NSourcePos, m v)     processAttrSetKeys (h :| t) =       maybe         -- Empty attrset - return a stub.         (pure (mempty, nullPos, toValue @(AttrSet v, PositionSet) mempty) )         (\ k ->-          list+          handlePresence             -- No more keys in the attrset - return the result             (pure ( one k, pos, finalValue ) )             -- There are unprocessed keys in attrset - recurse appending the results@@ -387,7 +388,7 @@    where     processScope       :: VarName-      -> ([VarName], SourcePos, m v)+      -> ([VarName], NSourcePos, m v)     processScope var =       ( one var       , pos@@ -431,7 +432,7 @@       left       (maybe         left-        (list+        (handlePresence           (pure . pure)           (\ (y : ys) -> (extract (y :| ys) =<<))           ks

@@ -61,7 +61,7 @@   -> NAtom   -> NValue t f m mkNVConstantWithProvenance scopes span x =-  addProvenance (Provenance scopes . NConstantAnnF span $ x) $ mkNVConstant x+  addProvenance (Provenance scopes . NConstantAnnF span $ x) $ NVConstant x  mkNVStrWithProvenance   :: MonadCited t f m@@ -70,7 +70,7 @@   -> NixString   -> NValue t f m mkNVStrWithProvenance scopes span x =-  addProvenance (Provenance scopes . NStrAnnF span . DoubleQuoted . one . Plain . ignoreContext $ x) $ mkNVStr x+  addProvenance (Provenance scopes . NStrAnnF span . DoubleQuoted . one . Plain . ignoreContext $ x) $ NVStr x  mkNVPathWithProvenance   :: MonadCited t f m@@ -80,7 +80,7 @@   -> Path   -> NValue t f m mkNVPathWithProvenance scope span lit real =-  addProvenance (Provenance scope . NLiteralPathAnnF span $ lit) $ mkNVPath real+  addProvenance (Provenance scope . NLiteralPathAnnF span $ lit) $ NVPath real  mkNVClosureWithProvenance   :: MonadCited t f m@@ -90,7 +90,7 @@   -> (NValue t f m -> m (NValue t f m))   -> NValue t f m mkNVClosureWithProvenance scopes span x f =-  addProvenance (Provenance scopes $ NAbsAnnF span (Nothing <$ x) Nothing) $ mkNVClosure x f+  addProvenance (Provenance scopes $ NAbsAnnF span (Nothing <$ x) Nothing) $ NVClosure x f  mkNVUnaryOpWithProvenance   :: MonadCited t f m@@ -103,6 +103,17 @@ mkNVUnaryOpWithProvenance scope span op val =   addProvenance (Provenance scope $ NUnaryAnnF span op val) +mkNVAppOpWithProvenance+  :: MonadCited t f m+  => Scopes m (NValue t f m)+  -> SrcSpan+  -> Maybe (NValue t f m)+  -> Maybe (NValue t f m)+  -> NValue t f m+  -> NValue t f m+mkNVAppOpWithProvenance scope span lval rval =+  addProvenance (Provenance scope $ NAppAnnF span lval rval)+ mkNVBinaryOpWithProvenance   :: MonadCited t f m   => Scopes m (NValue t f m)@@ -274,7 +285,7 @@     do       scope <- askScopes       span  <- askSpan-      mkNVBinaryOpWithProvenance scope span NApp (pure f) Nothing <$> (callFunc f =<< defer x)+      mkNVAppOpWithProvenance scope span (pure f) Nothing <$> (callFunc f =<< defer x)    evalAbs     :: Params (m (NValue t f m))@@ -309,11 +320,11 @@      fun' <- demand fun     case fun' of-      NVClosure _params f -> f arg       NVBuiltin name f    ->         do           span <- askSpan           withFrame Info ((Calling @m @(NValue t f m)) name span) $ f arg -- Is this cool?+      NVClosure _params f -> f arg       (NVSet _ m) | Just f <- M.lookup "__functor" m ->         (`callFunc` arg) =<< (`callFunc` fun') f       _x -> throwError $ ErrorCall $ "Attempt to call non-function: " <> show _x@@ -339,7 +350,7 @@       throwError $ ErrorCall $ "argument to unary operator must evaluate to an atomic type: " <> show _x  where   mkUnaryOp :: (a -> NAtom) -> (a -> a) -> a -> m (NValue t f m)-  mkUnaryOp c b a = pure . mkNVUnaryOpWithProvenance scope span op (pure arg) . mkNVConstant $ c (b a)+  mkUnaryOp c b a = pure . mkNVUnaryOpWithProvenance scope span op (pure arg) . NVConstant $ c (b a)  execBinaryOp   :: forall e t f m@@ -390,7 +401,7 @@    toBoolOp :: Maybe (NValue t f m) -> Bool -> m (NValue t f m)   toBoolOp r b =-    pure $ mkNVBinaryOpWithProvenance scope span op (pure lval) r $ mkNVConstant $ NBool b+    pure $ mkNVBinaryOpWithProvenance scope span op (pure lval) r $ NVConstant $ NBool b  execBinaryOpForced   :: forall e t f m@@ -444,8 +455,6 @@           mkStrP . (ls <>) <$>             coerceAnyToNixString callFunc DontCopyToStore rs         _ -> unsupportedTypes--    NApp  -> throwError $ ErrorCall "NApp should be handled by evalApp"     _other   -> shouldBeAlreadyHandled   where@@ -454,25 +463,25 @@     mkNVBinaryOpWithProvenance scope span op (pure lval) (pure rval)    mkBoolP :: Bool -> m (NValue t f m)-  mkBoolP = pure . addProv . mkNVConstant . NBool+  mkBoolP = pure . addProv . NVConstant . NBool    mkIntP :: Integer -> m (NValue t f m)-  mkIntP = pure . addProv . mkNVConstant . NInt+  mkIntP = pure . addProv . NVConstant . NInt    mkFloatP :: Float -> m (NValue t f m)-  mkFloatP = pure . addProv . mkNVConstant . NFloat+  mkFloatP = pure . addProv . NVConstant . NFloat    mkListP :: [NValue t f m] -> NValue t f m-  mkListP = addProv . mkNVList+  mkListP = addProv . NVList    mkStrP :: NixString -> NValue t f m-  mkStrP = addProv . mkNVStr+  mkStrP = addProv . NVStr    mkPathP :: Path -> NValue t f m-  mkPathP = addProv . mkNVPath+  mkPathP = addProv . NVPath    mkSetP :: (PositionSet -> AttrSet (NValue t f m) -> NValue t f m)-  mkSetP x s = addProv $ mkNVSet x s+  mkSetP x s = addProv $ NVSet x s    mkCmpOp :: (forall a. Ord a => a -> a -> Bool) -> m (NValue t f m)   mkCmpOp op = case (lval, rval) of

@@ -68,7 +68,12 @@ mkSelector :: Text -> NAttrPath NExpr mkSelector = one . StaticKey . coerce +-- | Put a binary operator.+--  @since+mkApp :: NExpr -> NExpr -> NExpr+mkApp a = Fix . NApp a -- | Put an unary operator.+ --  @since 0.15.0 mkOp :: NUnaryOp -> NExpr -> NExpr mkOp op = Fix . NUnary op@@ -210,7 +215,7 @@ mkFunction :: Params NExpr -> NExpr -> NExpr mkFunction params = Fix . NAbs params --- | General dot-reference with optional alternative if the jey does not exist.+-- | General dot-reference with optional alternative if the key does not exist. --  @since 0.15.0 getRefOrDefault :: Maybe NExpr -> NExpr -> Text -> NExpr getRefOrDefault alt obj = Fix . NSelect alt obj . mkSelector@@ -343,7 +348,7 @@ infix 9 @.<|>  -- | Function application (@' '@ in @f x@)-(@@) = mkOp2 NApp+(@@) = mkApp infixl 8 @@  -- | List concatenation: @++@

@@ -72,7 +72,7 @@  where   pairWithLast ys =     zip-      (list+      (handlePresence         Nothing         (pure . Unsafe.last)         <$> inits ys@@ -83,7 +83,7 @@   ls'       = dropSpaces minIndent <$> ls    minIndent =-    list+    handlePresence       0       (minimum . (countSpaces . mergePlain <$>))       (stripEmptyLines ls)

@@ -18,7 +18,13 @@ -- [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.-module Nix.Expr.Types where+module Nix.Expr.Types+  ( module Nix.Expr.Types+  , SourcePos(..)+  , unPos+  , mkPos+  )+where  import           Nix.Prelude import qualified Codec.Serialise               as Serialise@@ -40,10 +46,10 @@ import qualified Language.Haskell.TH.Syntax    as TH import           Lens.Family2 import           Lens.Family2.TH-import           Text.Megaparsec.Pos            ( SourcePos(SourcePos)-                                                , Pos+import           Text.Megaparsec.Pos            ( Pos                                                 , mkPos                                                 , unPos+                                                , SourcePos(SourcePos)                                                 ) import           Text.Show.Deriving             ( deriveShow1, deriveShow2 ) import           Text.Read.Deriving             ( deriveRead1, deriveRead2 )@@ -60,57 +66,98 @@  -- * utils +newtype NPos = NPos Pos+ deriving+   ( Eq, Ord+   , Read, Show+   , Data, NFData+   , Generic+   )++instance Semigroup NPos where+  (NPos x) <> (NPos y) = NPos (x <> y)++-- | Represents source positions.+-- Source line & column positions change intensively during parsing,+-- so they are declared strict to avoid memory leaks.+--+-- The data type is a reimplementation of 'Text.Megaparsec.Pos' 'SourcePos'.+data NSourcePos =+  NSourcePos+  { -- | Name of source file+    getSourceName :: Path,+    -- | Line number+    getSourceLine :: !NPos,+    -- | Column number+    getSourceColumn :: !NPos+  }+ deriving+   ( Eq, Ord+   , Read, Show+   , Data, NFData+   , Generic+   )++-- | Helper for 'SourcePos' -> 'NSourcePos' coersion.+toNSourcePos :: SourcePos -> NSourcePos+toNSourcePos (SourcePos f l c) =+  NSourcePos (coerce f) (coerce l) (coerce c)++-- | Helper for 'NSourcePos' -> 'SourcePos' coersion.+toSourcePos :: NSourcePos -> SourcePos+toSourcePos (NSourcePos f l c) =+  SourcePos (coerce f) (coerce l) (coerce c)+ --  2021-07-16: NOTE: Should replace @ParamSet@ List -- | > Hashmap VarName -- type synonym type AttrSet = HashMap VarName  -- | Holds file positionng information for abstrations.--- A type synonym for @HashMap VarName SourcePos@.-type PositionSet = AttrSet SourcePos+-- A type synonym for @HashMap VarName NSourcePos@.+type PositionSet = AttrSet NSourcePos --- ** orphan instances+-- ** Additional N{,Source}Pos instances  -- Placed here because TH inference depends on declaration sequence. --- Upstreaming so far was not pursued.--instance Serialise Pos where-  encode = Serialise.encode . unPos-  decode = mkPos <$> Serialise.decode+instance Serialise NPos where+  encode = Serialise.encode . unPos . coerce+  decode = coerce . mkPos <$> Serialise.decode -instance Serialise SourcePos where-  encode (SourcePos f l c) =+instance Serialise NSourcePos where+  encode (NSourcePos f l c) =+    coerce $     Serialise.encode f <>     Serialise.encode l <>     Serialise.encode c   decode =-    liftA3 SourcePos+    liftA3 NSourcePos       Serialise.decode       Serialise.decode       Serialise.decode -instance Hashable Pos where-  hashWithSalt salt = hashWithSalt salt . unPos+instance Hashable NPos where+  hashWithSalt salt = hashWithSalt salt . unPos . coerce -instance Hashable SourcePos where-  hashWithSalt salt (SourcePos f l c) =+instance Hashable NSourcePos where+  hashWithSalt salt (NSourcePos f l c) =     salt       `hashWithSalt` f       `hashWithSalt` l       `hashWithSalt` c -instance Binary Pos where-  put = Binary.put . unPos-  get = mkPos <$> Binary.get-instance Binary SourcePos+instance Binary NPos where+  put = (Binary.put @Int) . unPos . coerce+  get = coerce . mkPos <$> Binary.get+instance Binary NSourcePos -instance ToJSON Pos where-  toJSON = toJSON . unPos-instance ToJSON SourcePos+instance ToJSON NPos where+  toJSON = toJSON . unPos . coerce+instance ToJSON NSourcePos -instance FromJSON Pos where-  parseJSON = fmap mkPos . parseJSON-instance FromJSON SourcePos+instance FromJSON NPos where+  parseJSON = coerce . fmap mkPos . parseJSON+instance FromJSON NSourcePos  -- * Components of Nix expressions @@ -177,7 +224,7 @@     ( Eq, Ord, Generic, Generic1     , Typeable, Data, NFData, NFData1, Serialise, Binary, ToJSON, ToJSON1, FromJSON, FromJSON1     , Functor, Foldable, Traversable-    , Show, Hashable+    , Show, Read, Hashable     )  instance IsString (Params r) where@@ -405,23 +452,23 @@  -- | A single line of the bindings section of a let expression or of a set. data Binding r-  = NamedVar !(NAttrPath r) !r !SourcePos+  = NamedVar !(NAttrPath r) !r !NSourcePos   -- ^ An explicit naming.   ---  -- > NamedVar (StaticKey "x" :| [StaticKey "y"]) z SourcePos{}  ~  x.y = z;-  | Inherit !(Maybe r) ![VarName] !SourcePos+  -- > NamedVar (StaticKey "x" :| [StaticKey "y"]) z NSourcePos{}  ~  x.y = z;+  | Inherit !(Maybe r) ![VarName] !NSourcePos   -- ^ 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.   ---  -- +---------------------------------------------------------------+--------------------+-----------------------+-  -- | Hask                                                          | Nix                | pseudocode            |-  -- +===============================================================+====================+=======================+-  -- | @Inherit Nothing  [StaticKey "a"] SourcePos{}@                | @inherit a;@       | @a = outside.a;@      |-  -- +---------------------------------------------------------------+--------------------+-----------------------+-  -- | @Inherit (pure x) [StaticKey "a"] SourcePos{}@                | @inherit (x) a;@   | @a = x.a;@            |-  -- +---------------------------------------------------------------+--------------------+-----------------------+-  -- | @Inherit (pure x) [StaticKey "a", StaticKey "b"] SourcePos{}@ | @inherit (x) a b;@ | @a = x.a;@            |-  -- |                                                               |                    | @b = x.b;@            |-  -- +---------------------------------------------------------------+--------------------+-----------------------++  -- +----------------------------------------------------------------+--------------------+-----------------------++  -- | Hask                                                           | Nix                | pseudocode            |+  -- +================================================================+====================+=======================++  -- | @Inherit Nothing  [StaticKey "a"] NSourcePos{}@                | @inherit a;@       | @a = outside.a;@      |+  -- +----------------------------------------------------------------+--------------------+-----------------------++  -- | @Inherit (pure x) [StaticKey "a"] NSourcePos{}@                | @inherit (x) a;@   | @a = x.a;@            |+  -- +----------------------------------------------------------------+--------------------+-----------------------++  -- | @Inherit (pure x) [StaticKey "a", StaticKey "b"] NSourcePos{}@ | @inherit (x) a b;@ | @a = x.a;@            |+  -- |                                                                |                    | @b = x.b;@            |+  -- +----------------------------------------------------------------+--------------------+-----------------------+   --   -- (2021-07-07 use details):   -- Inherits the position of the first name through @unsafeGetAttrPos@. The position of the scope inherited from else - the position of the first member of the binds list.@@ -480,7 +527,6 @@  $(makeTraversals ''NUnaryOp) - -- ** data NBinaryOp  -- | Binary operators expressible in the nix language.@@ -500,9 +546,6 @@   | NMult    -- ^ Multiplication (@*@)   | NDiv     -- ^ Division (@/@)   | NConcat  -- ^ List concatenation (@++@)-  | NApp     -- ^ Apply a function to an argument.-             ---             -- > NBinary NApp f x  ~  f x   deriving     ( Eq, Ord, Enum, Bounded, Generic     , Typeable, Data, NFData, Serialise, Binary, ToJSON, FromJSON@@ -551,6 +594,10 @@   -- environment variable. For example, @<nixpkgs/pkgs>@.   --   -- > NEnvPath "x"                                ~  <x>+  | NApp !r !r+  -- ^ Functional application (aka F.A., apply a function to an argument).+  --+  -- > NApp f x  ~  f x   | NUnary !NUnaryOp !r   -- ^ Application of a unary operator to an expression.   --@@ -701,8 +748,8 @@   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+nullPos :: NSourcePos+nullPos = on (NSourcePos "<string>") (coerce . mkPos) 1 1  -- * Dead code @@ -718,7 +765,7 @@   :: forall ann g   . NExprAnn ann g   => NonEmpty VarName-  -> SourcePos+  -> NSourcePos   -> Lens' (Fix g) (Maybe (Fix g)) ekey keys pos f e@(Fix x)   | (NSet NonRecursive xs, ann) <- fromNExpr x =@@ -728,7 +775,7 @@         do           let keys' = NE.toList keys           (ks, rest) <- zip (inits keys') (tails keys')-          list+          handlePresence             mempty             (\ (j : js) ->               do@@ -765,6 +812,7 @@     (NLiteralPath _               ) -> mempty     (NEnvPath     _               ) -> mempty     (NUnary       _    expr       ) -> getFreeVars expr+    (NApp         left right      ) -> collectFreeVars left right     (NBinary      _    left right ) -> collectFreeVars left right     (NSelect      orExpr expr path) ->       Set.unions

@@ -10,9 +10,6 @@ module Nix.Expr.Types.Annotated   ( module Nix.Expr.Types.Annotated   , module Data.Functor.Compose-  , SourcePos(..)-  , unPos-  , mkPos   ) where @@ -35,10 +32,6 @@ import           GHC.Generics import           Nix.Atoms import           Nix.Expr.Types-import           Text.Megaparsec                ( unPos-                                                , mkPos-                                                )-import           Text.Megaparsec.Pos            ( SourcePos(..) ) import           Text.Read.Deriving import           Text.Show.Deriving @@ -46,8 +39,8 @@  -- | Demarcation of a chunk in a source file. data SrcSpan = SrcSpan-  { spanBegin :: SourcePos-  , spanEnd   :: SourcePos+  { getSpanBegin :: NSourcePos+  , getSpanEnd   :: NSourcePos   }  deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData, Hashable) @@ -56,8 +49,8 @@ instance Semigroup SrcSpan where   s1 <> s2 =     SrcSpan-      (on min spanBegin s1 s2)-      (on max spanEnd   s1 s2)+      (on min getSpanBegin s1 s2)+      (on max getSpanEnd   s1 s2)  instance Binary SrcSpan instance ToJSON SrcSpan@@ -175,7 +168,7 @@ annNHasAttr e1@(Ann s1 _) (AnnUnit s2 ats) = NHasAttrAnn (s1 <> s2) e1 ats  annNApp :: NExprLoc -> NExprLoc -> NExprLoc-annNApp e1@(Ann s1 _) e2@(Ann s2 _) = NBinaryAnn (s1 <> s2) NApp e1 e2+annNApp e1@(Ann s1 _) e2@(Ann s2 _) = NAppAnn (s1 <> s2) e1 e2  annNAbs :: AnnUnit SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc annNAbs (AnnUnit s1 ps) e1@(Ann s2 _) = NAbsAnn (s1 <> s2) ps e1@@ -183,8 +176,8 @@ annNStr :: AnnUnit SrcSpan (NString NExprLoc) -> NExprLoc annNStr (AnnUnit s1 s) = NStrAnn s1 s -deltaInfo :: SourcePos -> (Text, Int, Int)-deltaInfo (SourcePos fp l c) = (fromString fp, unPos l, unPos c)+deltaInfo :: NSourcePos -> (Text, Int, Int)+deltaInfo (NSourcePos fp l c) = (fromString $ coerce fp, unPos $ coerce l, unPos $ coerce c)  annNNull :: NExprLoc annNNull = NConstantAnn nullSpan NNull@@ -194,8 +187,10 @@ nullSpan = SrcSpan nullPos nullPos {-# inline nullSpan #-} --- | Pattern systems for matching on @NExprLocF@ constructions.+-- ** Patterns +-- *** Patterns to match on 'NExprLocF' constructions (for 'SrcSpan'-based annotations).+ pattern NConstantAnnF    :: SrcSpan -> NAtom -> NExprLocF r pattern NConstantAnnF    ann x      = AnnF ann (NConstant x) @@ -220,6 +215,9 @@ pattern NUnaryAnnF       :: SrcSpan -> NUnaryOp -> r -> NExprLocF r pattern NUnaryAnnF       ann op x   = AnnF ann (NUnary op x) +pattern NAppAnnF         :: SrcSpan -> r -> r -> NExprLocF r+pattern NAppAnnF         ann x y    = AnnF ann (NApp x y)+ pattern NBinaryAnnF      :: SrcSpan -> NBinaryOp -> r -> r -> NExprLocF r pattern NBinaryAnnF      ann op x y = AnnF ann (NBinary op x y) @@ -249,6 +247,8 @@ {-# complete NConstantAnnF, NStrAnnF, NSymAnnF, NListAnnF, NSetAnnF, NLiteralPathAnnF, NEnvPathAnnF, NUnaryAnnF, NBinaryAnnF, NSelectAnnF, NHasAttrAnnF, NAbsAnnF, NLetAnnF, NIfAnnF, NWithAnnF, NAssertAnnF, NSynHoleAnnF #-}  +-- *** Patterns to match on 'NExprLoc' constructions (for 'SrcSpan'-based annotations).+ pattern NConstantAnn    :: SrcSpan -> NAtom -> NExprLoc pattern NConstantAnn    ann x      = Ann ann (NConstant x) @@ -272,6 +272,9 @@  pattern NUnaryAnn       :: SrcSpan -> NUnaryOp -> NExprLoc -> NExprLoc pattern NUnaryAnn       ann op x   = Ann ann (NUnary op x)++pattern NAppAnn         :: SrcSpan -> NExprLoc -> NExprLoc -> NExprLoc+pattern NAppAnn         ann x y    = Ann ann (NApp x y)  pattern NBinaryAnn      :: SrcSpan -> NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc pattern NBinaryAnn      ann op x y = Ann ann (NBinary op x y)

@@ -14,7 +14,7 @@                                       , MonadMask                                       , MonadThrow                                       )-import           Control.Monad.Except ( MonadFix )+import           Control.Monad.Fix    ( MonadFix ) import           Control.Monad.Ref    ( MonadAtomicRef(..)                                       , MonadRef(Ref)                                       )

@@ -25,8 +25,8 @@ toEncodingSorted = \case   A.Object m ->     A.pairs-      . fold-      . ((\(k, v) -> A.pair k $ toEncodingSorted v) <$>)+      . foldMap+      (\(k, v) -> A.pair k $ toEncodingSorted v)       . sortWith fst $ #if MIN_VERSION_aeson(2,0,0)           AKM.toList

@@ -1,7 +1,6 @@ {-# language ConstraintKinds #-} {-# language CPP #-} {-# language DataKinds #-}-{-# language GADTs #-} {-# language GeneralizedNewtypeDeriving #-} {-# language TypeFamilies #-} {-# language UndecidableInstances #-}@@ -105,6 +104,12 @@   -> m (Symbolic m) mkSymbolic = packSymbolic . NMany +mkSymbolic1+  :: MonadAtomicRef m+  => NTypeF m (Symbolic m)+  -> m (Symbolic m)+mkSymbolic1 = mkSymbolic . one+ packSymbolic   :: MonadAtomicRef m   => NSymbolicF (NTypeF m (Symbolic m))@@ -158,7 +163,7 @@               do                 (args, sym) <-                   do-                    f' <- mkSymbolic $ one f+                    f' <- mkSymbolic1 f                     lintApp (NAbs p mempty) f' everyPossible                 args' <- traverse renderSymbolic args                 sym'  <- renderSymbolic sym@@ -170,9 +175,9 @@   ) <=< unpackSymbolic  where   between a b c = a <> b <> c-  parens = between "(" ")"+  parens   = between "(" ")"   brackets = between "[" "]"-  braces = between "{" "}"+  braces   = between "{" "}"  -- This function is order and uniqueness preserving (of types). merge@@ -204,19 +209,21 @@     (TSet x       , TSet Nothing ) -> (one (TSet x) <>) <$> rest     (TSet Nothing , TSet x       ) -> (one (TSet x) <>) <$> rest     (TSet (Just l), TSet (Just r)) -> do-      m <- sequenceA $ M.intersectionWith-        (\ i j ->-          do-            i'' <- demand =<< i-            j'' <- demand =<< j-            (defer . unify context i'') j''-        )-        (pure <$> l)-        (pure <$> r)-      bool+      hm <-+        sequenceA $+          M.intersectionWith+            (\ i j ->+              do+                i'' <- i+                j'' <- j+                defer $ unify context i'' j''+            )+            (fmap demand l)+            (fmap demand r)+      handlePresence         id-        ((one (TSet $ pure m) <>) <$>)-        (not $ M.null m)+        (const ((one (TSet $ pure hm) <>) <$>))+        hm         rest      (TClosure{}, TClosure{}) ->@@ -251,40 +258,42 @@  -- | Result @== NMany []@ -> @unify@ fails. unify-  :: forall e m+  :: forall e m a    . MonadLint e m-  => NExprF ()+  => NExprF a   -> Symbolic m   -> Symbolic m   -> m (Symbolic m)-unify context (SV x) (SV y) = do+unify (void -> context) (SV x) (SV y) = do   x' <- readRef x   y' <- readRef y   case (x', y') of-    (NAny, _) -> do-      writeRef x y'-      pure $ SV y-    (_, NAny) -> do-      writeRef y x'-      pure $ SV x-    (NMany xs, NMany ys) -> do-      m <- merge context xs ys-      bool-        (do-          let-           nm = NMany m-          writeRef x   nm-          writeRef y   nm-          packSymbolic nm-        )+    (NAny, _) ->+      do+        writeRef x y'+        pure $ SV y+    (_, NAny) ->+      do+        writeRef y x'+        pure $ SV x+    (NMany xs, NMany ys) ->+      handlePresence         (-              -- x' <- renderSymbolic (Symbolic x)-              -- y' <- renderSymbolic (Symbolic y)+          -- x' <- renderSymbolic (Symbolic x)+          -- y' <- renderSymbolic (Symbolic y)           throwError $ ErrorCall "Cannot unify "                   -- <> show x' <> " with " <> show y'                   --  <> " in context: " <> show context         )-        (null m)+        (\ m ->+          do+            let+              nm = NMany m+            writeRef x   nm+            writeRef y   nm+            packSymbolic nm+        )+        =<< merge context xs ys unify _ _ _ = error "The unexpected hath transpired!"  -- These aren't worth defining yet, because once we move to Hindley-Milner,@@ -323,7 +332,7 @@   freeVariable var = symerr $ "Undefined variable '" <> coerce var <> "'"    attrMissing ks ms =-    evalError @(Symbolic m) $ ErrorCall $ toString $+    evalError @(Symbolic m) . ErrorCall . toString $       maybe         ("Inheriting unknown attribute: " <> attr)         (\ s ->  "Could not look up attribute " <> attr <> " in " <> show s)@@ -331,13 +340,14 @@    where     attr = Text.intercalate "." $ NE.toList $ coerce ks -  evalCurPos = do-    f <- mkSymbolic $ one TPath-    l <- mkSymbolic $ one $ TConstant $ one TInt-    c <- mkSymbolic $ one $ TConstant $ one TInt-    mkSymbolic $ one $ TSet (pure (M.fromList [("file", f), ("line", l), ("col", c)]))+  evalCurPos =+    do+      f <- mkSymbolic1 TPath+      l <- mkSymbolic1 $ TConstant $ one TInt+      c <- mkSymbolic1 $ TConstant $ one TInt+      mkSymbolic1 $ TSet . pure $ M.fromList [("file", f), ("line", l), ("col", c)] -  evalConstant c = mkSymbolic $ one $ fun c+  evalConstant c = mkSymbolic1 $ fun c    where     fun =       \case@@ -347,12 +357,12 @@         NBool  _ -> TConstant $ one TBool         NNull    -> TConstant $ one TNull -  evalString      = const $ mkSymbolic $ one TStr-  evalLiteralPath = const $ mkSymbolic $ one TPath-  evalEnvPath     = const $ mkSymbolic $ one TPath+  evalString      = const $ mkSymbolic1 TStr+  evalLiteralPath = const $ mkSymbolic1 TPath+  evalEnvPath     = const $ mkSymbolic1 TPath    evalUnary op arg =-    unify (void $ NUnary op arg) arg =<< mkSymbolic (one $ TConstant [TInt, TBool])+    unify (NUnary op arg) arg =<< mkSymbolic1 (TConstant [TInt, TBool])    evalBinary = lintBinaryOp @@ -376,20 +386,16 @@     do       t' <- t       f' <- f-      let e = NIf cond t' f'--      _ <- unify (void e) cond =<< mkSymbolic (one $ TConstant $ one TBool)-      unify (void e) t' f'+      let e = unify (NIf cond t' f')+      e t' f' <* (e cond =<< mkSymbolic1 (TConstant $ one TBool))    evalAssert cond body =     do       body' <- body-      let e = NAssert cond body'-      _ <- unify (void e) cond =<< mkSymbolic (one $ TConstant $ one TBool)-      pure body'+      body' <$ (unify (NAssert cond body') cond =<< mkSymbolic1 (TConstant $ one TBool)) -  evalApp = (fmap snd .) . lintApp (join (NBinary NApp) mempty)-  evalAbs params _ = mkSymbolic (one $ TClosure $ void params)+  evalApp = (fmap snd .) . lintApp (join NApp mempty)+  evalAbs params _ = mkSymbolic1 (TClosure $ void params)    evalError = throwError @@ -405,33 +411,31 @@     rsym <- rarg     y    <- defer everyPossible -    case op of-      NApp    -> symerr "lintBinaryOp:NApp: should never get here"-      _ -> check lsym rsym $-        case op of-          NEq     -> [TConstant [TInt, TBool, TNull], TStr, TList y]-          NNEq    -> [TConstant [TInt, TBool, TNull], TStr, TList y]+    check lsym rsym $+      case op of+        NEq     -> [TConstant [TInt, TBool, TNull], TStr, TList y]+        NNEq    -> [TConstant [TInt, TBool, TNull], TStr, TList y] -          NLt     -> one $ TConstant [TInt, TBool, TNull]-          NLte    -> one $ TConstant [TInt, TBool, TNull]-          NGt     -> one $ TConstant [TInt, TBool, TNull]-          NGte    -> one $ TConstant [TInt, TBool, TNull]+        NLt     -> one $ TConstant [TInt, TBool, TNull]+        NLte    -> one $ TConstant [TInt, TBool, TNull]+        NGt     -> one $ TConstant [TInt, TBool, TNull]+        NGte    -> one $ TConstant [TInt, TBool, TNull] -          NAnd    -> one $ TConstant $ one TBool-          NOr     -> one $ TConstant $ one TBool-          NImpl   -> one $ TConstant $ one TBool+        NAnd    -> one $ TConstant $ one TBool+        NOr     -> one $ TConstant $ one TBool+        NImpl   -> one $ TConstant $ one TBool -          -- jww (2018-04-01): NYI: Allow Path + Str-          NPlus   -> [TConstant $ one TInt, TStr, TPath]-          NMinus  -> one $ TConstant $ one TInt-          NMult   -> one $ TConstant $ one TInt-          NDiv    -> one $ TConstant $ one TInt+        -- jww (2018-04-01): NYI: Allow Path + Str+        NPlus   -> [TConstant $ one TInt, TStr, TPath]+        NMinus  -> one $ TConstant $ one TInt+        NMult   -> one $ TConstant $ one TInt+        NDiv    -> one $ TConstant $ one TInt -          NUpdate -> one $ TSet mempty+        NUpdate -> one $ TSet mempty -          NConcat -> one $ TList y-#if __GLASGOW_HASKELL__ < 900-          _ -> fail "Should not be possible"  -- symerr or this fun signature should be changed to work in type scope+        NConcat -> one $ TList y+#if __GLASGOW_HASKELL__ < 810+        _ -> fail "Should not be possible"  -- symerr or this fun signature should be changed to work in type scope #endif  @@ -440,13 +444,12 @@   check lsym rsym xs =     do       let-        e = NBinary op lsym rsym-        unifyE = unify (void e)+        contextUnify = unify $ NBinary op lsym rsym        m <- mkSymbolic xs-      _ <- unifyE lsym m-      _ <- unifyE rsym m-      unifyE lsym rsym+      _ <- contextUnify lsym m+      _ <- contextUnify rsym m+      contextUnify lsym rsym  infixl 1 `lintApp` lintApp@@ -460,24 +463,26 @@   (\case     NAny ->       throwError $ ErrorCall "Cannot apply something not known to be a function"-    NMany xs -> do-      (args, ys) <- fmap unzip $ forM xs $ \case-        TClosure _params ->-          (\case-            NAny -> do-              error "NYI"--            NMany [TSet (Just _)] -> do-              error "NYI"--            NMany _ -> throwError $ ErrorCall "NYI: lintApp NMany not set"-          ) =<< unpackSymbolic =<< arg-        TBuiltin _ _f -> throwError $ ErrorCall "NYI: lintApp builtin"-        TSet _m       -> throwError $ ErrorCall "NYI: lintApp Set"-        _x            -> throwError $ ErrorCall "Attempt to call non-function"+    NMany xs ->+      do+        (args, ys) <-+          unzip <$>+            traverse+              (\case+                TClosure _params ->+                  (\case+                    NAny                  -> error "NYI"+                    NMany [TSet (Just _)] -> error "NYI"+                    NMany _               -> throwError $ ErrorCall "NYI: lintApp NMany not set"+                  ) =<< unpackSymbolic =<< arg+                TBuiltin _ _f -> throwError $ ErrorCall "NYI: lintApp builtin"+                TSet _m       -> throwError $ ErrorCall "NYI: lintApp Set"+                _x            -> throwError $ ErrorCall "Attempt to call non-function"+              )+              xs -      y <- everyPossible-      (Unsafe.head args, ) <$> foldM (unify context) y ys+        y <- everyPossible+        (Unsafe.head args, ) <$> foldM (unify context) y ys   ) =<< unpackSymbolic fun  newtype Lint s a = Lint@@ -498,7 +503,7 @@   throwM e = Lint $ ReaderT $ const (throw e)  instance MonadCatch (Lint s) where-  catch _m _h = Lint $ ReaderT $ const (fail "Cannot catch in 'Lint s'")+  catch _m _h = Lint $ ReaderT $ const (error "Cannot catch in 'Lint s'")  runLintM :: Options -> Lint s a -> ST s a runLintM opts action =

@@ -1,7 +1,6 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} {-# language DataKinds #-}-{-# language GADTs #-} {-# language TypeFamilies #-} {-# language RankNTypes #-} @@ -35,39 +34,42 @@      )   => NValue t f m   -> m (NValue t f m)-normalizeValue v = run $ iterNValueM run (flip go) (fmap Free . sequenceNValue' run) v+normalizeValue v = run $ iterNValueM run go (fmap Free . sequenceNValue' run) v  where   start = 0 :: Int+  maxDepth = 2000   table = mempty    run :: ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r   run = (`evalStateT` table) . (`runReaderT` start)    go-    :: t-    -> (  NValue t f m+    :: (  NValue t f m        -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)        )+    -> t     -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)-  go t k = do-    b <- seen t+  go k tnk  =     bool       (do         i <- ask-        when (i > 2000) $ fail "Exceeded maximum normalization depth of 2000 levels"+        when (i > maxDepth) $ fail $ "Exceeded maximum normalization depth of " <> show maxDepth <> " levels."         (lifted . lifted)-          (=<< force t)-          (local succ . k)+          (=<< force tnk)+          (local (+1) . k)       )-      (pure $ pure t)-      b--  seen t = do-    let tid = thunkId t-    lift $ do-      res <- gets $ member tid-      unless res $ modify $ insert tid-      pure res+      (pure $ pure tnk)+      =<< seen tnk+   where+    seen :: t -> ReaderT Int (StateT (Set (ThunkId m)) m) Bool+    seen t =+      do+        let tnkid = thunkId t+        lift $+          do+            thunkWasVisited <- gets $ member tnkid+            when (not thunkWasVisited) $ modify $ insert tnkid+            pure thunkWasVisited  -- 2021-05-09: NOTE: This seems a bit excessive. If these functorial versions are not used for recursion schemes - just free from it. -- | Normalization HOF (functorial) version of @normalizeValue@. Accepts the special thunk operating/forcing/nirmalizing function & internalizes it.@@ -81,39 +83,42 @@   => (forall r . t -> (NValue t f m -> m r) -> m r)   -> NValue t f m   -> m (NValue t f m)-normalizeValueF f = run . iterNValueM run (flip go) (fmap Free . sequenceNValue' run)+normalizeValueF f = run . iterNValueM run go (fmap Free . sequenceNValue' run)  where   start = 0 :: Int+  maxDepth = 2000   table = mempty    run :: ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r   run = (`evalStateT` table) . (`runReaderT` start)    go-    :: t-    -> (  NValue t f m+    :: (  NValue t f m        -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)        )+    -> t     -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValue t f m)-  go t k = do-    b <- seen t+  go k tnk  =     bool       (do         i <- ask-        when (i > 2000) $ fail "Exceeded maximum normalization depth of 2000 levels"+        when (i > maxDepth) $ fail $ "Exceeded maximum normalization depth of " <> show maxDepth <> " levels."         (lifted . lifted)-          (f t)-          (local succ . k)+          (f tnk)+          (local (+1) . k)       )-      (pure $ pure t)-      b--  seen t = do-    let tid = thunkId t-    lift $ do-      res <- gets $ member tid-      unless res $ modify $ insert tid-      pure res+      (pure $ pure tnk)+      =<< seen tnk+   where+    seen :: t -> ReaderT Int (StateT (Set (ThunkId m)) m) Bool+    seen t =+      do+        let tnkid = thunkId t+        lift $+          do+            thunkWasVisited <- gets $ member tnkid+            when (not thunkWasVisited) $ modify $ insert tnkid+            pure thunkWasVisited  -- | Normalize value. -- Detect cycles.@@ -141,7 +146,7 @@   -> m () normalForm_ t = void $ normalizeValue t -opaqueVal :: Applicative f => NValue t f m+opaqueVal :: NVConstraint f => NValue t f m opaqueVal = mkNVStrWithoutContext "<cycle>"  -- | Detect cycles & stub them.@@ -167,14 +172,14 @@  where   Free (NValue' cyc) = opaqueVal -thunkStubVal :: Applicative f => NValue t f m+thunkStubVal :: NVConstraint f => NValue t f m thunkStubVal = mkNVStrWithoutContext thunkStubText  -- | Check if thunk @t@ is computed, -- then bind it into first arg. -- else bind the thunk stub val. bindComputedThunkOrStub-  :: ( Applicative f+  :: ( NVConstraint f     , MonadThunk t m (NValue t f m)     )   => (NValue t f m -> m a)

@@ -15,13 +15,11 @@   , parseFromText   , Result   , reservedNames-  , OperatorInfo(..)-  , NSpecialOp(..)   , NAssoc(..)-  , NOperatorDef-  , getUnaryOperator-  , getBinaryOperator-  , getSpecialOperator+  , NOpPrecedence(..)+  , NOpName(..)+  , NSpecialOp(..)+  , NOperatorDef(..)   , nixExpr   , nixExprAlgebra   , nixSet@@ -37,6 +35,10 @@   , nixBool   , nixNull   , whiteSpace++  --  2022-01-26: NOTE: Try to hide it after OperatorInfo is removed+  , NOp(..)+  , appOpDef   ) where @@ -60,9 +62,9 @@                                                 , isSpace                                                 ) import           Data.Data                      ( Data(..) )+import           Data.List.Extra                ( groupSort ) import           Data.Fix                       ( Fix(..) ) import qualified Data.HashSet                  as HashSet-import qualified Data.Map                      as Map import qualified Data.Text                     as Text import           Nix.Expr.Types import           Nix.Expr.Shorthands     hiding ( ($>) )@@ -97,7 +99,7 @@ isAlphanumeric x = isAlpha x || isDigit x {-# inline isAlphanumeric #-} --- | @<|>@ with additional preservation of @MonadPlus@ constraint.+-- | Alternative "<|>" with additional preservation of 'MonadPlus' constraint. infixl 3 <|> (<|>) :: MonadPlus m => m a -> m a -> m a (<|>) = mplus@@ -108,10 +110,10 @@ annotateLocation1 p =   do     begin <- getSourcePos-    res <- p+    res   <- p     end   <- get -- The state set before the last whitespace -    pure $ AnnUnit (SrcSpan begin end) res+    pure $ AnnUnit (SrcSpan (toNSourcePos begin) (toNSourcePos end)) res  annotateLocation :: Parser (NExprF NExprLoc) -> Parser NExprLoc annotateLocation = (annUnitToAnn <$>) . annotateLocation1@@ -136,14 +138,11 @@ reserved n =   lexeme $ try $ chunk n *> lookAhead (void (satisfy reservedEnd) <|> eof) -exprAfterP :: Parser a -> Parser NExprLoc-exprAfterP p = p *> nixExpr- exprAfterSymbol :: Char -> Parser NExprLoc-exprAfterSymbol p = exprAfterP $ symbol p+exprAfterSymbol p = symbol p *> nixExpr  exprAfterReservedWord :: Text -> Parser NExprLoc-exprAfterReservedWord word = exprAfterP $ reserved word+exprAfterReservedWord word = reserved word *> nixExpr  -- | A literal copy of @megaparsec@ one but with addition of the @\r@ for Windows EOL case (@\r\n@). -- Overall, parser should simply @\r\n -> \n@.@@ -173,7 +172,7 @@ symbols = lexeme . chunk  -- We restrict the type of 'parens' and 'brackets' here because if they were to--- take a @Parser NExprLoc@ argument they would parse additional text which+-- take a 'Parser NExprLoc' argument they would parse additional text which -- wouldn't be captured in the source location annotation. -- -- Braces and angles in hnix don't enclose a single expression so this type@@ -320,17 +319,16 @@     try $       do         indentedQuotationMark-        (Plain <$> ("''" <$ char '\'' <|> "$" <$ char '$'))+        Plain <$> ("''" <$ char '\'' <|> "$" <$ char '$')           <|>             do-              _ <- char '\\'-              c <- escapeCode+              c <- char '\\' *> escapeCode                pure $                 bool                   EscapedNewline                   (Plain $ one c)-                  (c /= '\n')+                  ('\n' /= c)    -- | Enclosed into indented quatation "'' <expr> ''"   inIndentedQuotation :: Parser a -> Parser a@@ -401,7 +399,7 @@       label "inherited binding" $         liftA2 (Inherit x)           (many identifier)-          (pure p)+          (pure (toNSourcePos p))   namedVar =     do       p <- getSourcePos@@ -409,7 +407,7 @@         liftA3 NamedVar           (annotated <$> nixSelector)           (exprAfterSymbol '=')-          (pure p)+          (pure (toNSourcePos p))   scope = label "inherit scope" nixParens  nixSet :: Parser NExprLoc@@ -464,23 +462,19 @@  -- ** Operators -data NSpecialOp = NHasAttrOp | NSelectOp-  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)--data NAssoc = NAssocNone | NAssocLeft | NAssocRight-  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)+--  2022-01-26: NOTE: Rename to 'literal'+newtype NOpName = NOpName Text+  deriving+    (Eq, Ord, Generic, Typeable, Data, Show, NFData) -data NOperatorDef-  = NUnaryDef          NUnaryOp   Text-  | NBinaryDef  NAssoc NBinaryOp  Text-  | NSpecialDef NAssoc NSpecialOp Text-  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)+instance IsString NOpName where+  fromString = coerce . fromString @Text -manyUnaryOp :: MonadPlus f => f (a -> a) -> f (a -> a)-manyUnaryOp f = foldr1 (.) <$> some f+instance ToString NOpName where+  toString = toString @Text . coerce -operator :: Text -> Parser Text-operator op =+operator :: NOpName -> Parser Text+operator (coerce -> op) =   case op of     c@"-" -> c `without` '>'     c@"/" -> c `without` '/'@@ -492,173 +486,210 @@   without opChar noNextChar =     lexeme . try $ chunk opChar <* notFollowedBy (char noNextChar) -opWithLoc :: (AnnUnit SrcSpan o -> a) -> o -> Text -> Parser a-opWithLoc f op name =-  do-    AnnUnit ann _ <--      annotateLocation1 $-        operator name+opWithLoc :: (AnnUnit SrcSpan o -> a) -> o -> NOpName -> Parser a+opWithLoc f op name = f . (op <$) <$> annotateLocation1 (operator name) -    pure . f $ AnnUnit ann op+--  2022-01-26: NOTE: Make presedence free and type safe by moving it into type level:+--  https://youtu.be/qaPdg0mZavM?t=1757+--  https://wiki.haskell.org/The_Monad.Reader/Issue5/Number_Param_Types+newtype NOpPrecedence = NOpPrecedence Int+  deriving (Eq, Ord, Generic, Bounded, Typeable, Data, Show, NFData) -binary-  :: NAssoc-  -> (Parser (NExprLoc -> NExprLoc -> NExprLoc) -> b)-  -> NBinaryOp-  -> Text-  -> (NOperatorDef, b)-binary assoc fixity op name =-  (NBinaryDef assoc op name, fixity $ opWithLoc annNBinary op name)+instance Enum NOpPrecedence where+  toEnum = coerce+  fromEnum = coerce -binaryN, binaryL, binaryR :: NBinaryOp -> Text -> (NOperatorDef, Operator Parser NExprLoc)-binaryN =-  binary NAssocNone InfixN-binaryL =-  binary NAssocLeft InfixL-binaryR =-  binary NAssocRight InfixR+instance Num NOpPrecedence where+  (+) = coerce ((+) @Int)+  (*) = coerce ((*) @Int)+  abs = coerce (abs @Int)+  signum = coerce (signum @Int)+  fromInteger = coerce (fromInteger @Int)+  negate = coerce (negate @Int) -prefix :: NUnaryOp -> Text -> (NOperatorDef, Operator Parser NExprLoc)-prefix op name =-  (NUnaryDef op name, Prefix $ manyUnaryOp $ opWithLoc annNUnary op name)--- postfix name op = (NUnaryDef name op,---                    Postfix (opWithLoc name op annNUnary))+--  2022-01-26: NOTE: This type belongs into 'Type.Expr' & be used in NExprF.+data NAppOp = NAppOp+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData) -nixOperators-  :: Parser (AnnUnit SrcSpan (NAttrPath NExprLoc))-  -> [[ ( NOperatorDef-       , Operator Parser NExprLoc-       )-    ]]-nixOperators selector =-  [ -- This is not parsed here, even though technically it's part of the-    -- expression table. The problem is that in some cases, such as list-    -- membership, it's also a term. And since terms are effectively the-    -- highest precedence entities parsed by the expression parser, it ends up-    -- working out that we parse them as a kind of "meta-term".+--  2022-01-26: NOTE: This type belongs into 'Type.Expr' & be used in NExprF.+data NSpecialOp+  = NHasAttrOp+  | NSelectOp+  | NTerm -- ^ For special handling of internal special cases.+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData) -    -- {-  1 -}-    -- [ ( NSpecialDef "." NSelectOp NAssocLeft-    --   , Postfix $-    --       do-    --         sel <- seldot *> selector-    --         mor <- optional (reserved "or" *> term)-    --         pure $ \x -> annNSelect x sel mor)-    -- ]+data NAssoc+  = NAssocLeft+  -- Nota bene: @parser-combinators@ named "associative property" as 'InfixN' stating it as "non-associative property".+  -- Binary operators having some associativity is a basis property in mathematical algebras in use (for example, in Category theory). Having no associativity in operators makes theory mostly impossible in use and so non-associativity is not encountered in notations, therefore under 'InfixN' @parser-combinators@ meant "associative".+  -- | Bidirectional associativity, or simply: associative property.+  | NAssoc+  | NAssocRight+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData) -    {-  2 -}-    one-      ( NBinaryDef NAssocLeft NApp " "-      ,-        -- Thanks to Brent Yorgey for showing me this trick!-        InfixL $ annNApp <$ symbols mempty-      )-  , {-  3 -}-    one $ prefix  NNeg "-"-  , {-  4 -}-    one-      ( NSpecialDef NAssocLeft NHasAttrOp "?"-      , Postfix $ symbol '?' *> (flip annNHasAttr <$> selector)-      )-  , {-  5 -}-    one $ binaryR NConcat "++"-  , {-  6 -}-    [ binaryL NMult "*"-    , binaryL NDiv  "/"-    ]-  , {-  7 -}-    [ binaryL NPlus "+"-    , binaryL NMinus "-"-    ]-  , {-  8 -}-    one $ prefix  NNot "!"-  , {-  9 -}-    one $ binaryR NUpdate "//"-  , {- 10 -}-    [ binaryL NLt "<"-    , binaryL NGt ">"-    , binaryL NLte "<="-    , binaryL NGte ">="-    ]-  , {- 11 -}-    [ binaryN NEq "=="-    , binaryN NNEq "!="-    ]-  , {- 12 -}-    one $ binaryL NAnd "&&"-  , {- 13 -}-    one $ binaryL NOr "||"-  , {- 14 -}-    one $ binaryR NImpl "->"-  ]+--  2022-01-31: NOTE: This type and related typeclasses & their design, probably need a refinement.+--+-- In the "Nix.Pretty", the code probably should be well-typed to the type of operations its processes.+-- Therefor splitting operation types into separate types there is probably needed.+--+-- After that:+--+-- > { NAssoc, NOpPrecedence, NOpName }+--+-- Can be formed into a type.+--+-- Also 'NAppDef' really has only 1 implementation, @{ NAssoc, NOpPrecedence, NOpName }@+-- were added there only to make type uniformal.+-- All impossible cases ideally should be unrepresentable.+-- | Single operator grammar entries.+data NOperatorDef+  = NAppDef     NAppOp     NAssoc NOpPrecedence NOpName+  | NUnaryDef   NUnaryOp   NAssoc NOpPrecedence NOpName+  | NBinaryDef  NBinaryOp  NAssoc NOpPrecedence NOpName+  | NSpecialDef NSpecialOp NAssoc NOpPrecedence NOpName+  --  2022-01-26: NOTE: Ord can be the order of evaluation of precedence (which 'Pretty' printing also accounts for).+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData) ---  2021-11-09: NOTE: rename OperatorInfo accessors to `get*`---  2021-08-10: NOTE:---  All this is a sidecar:---  * This type---  * detectPrecedence---  * getUnaryOperation---  * getBinaryOperation---  * getSpecialOperation---  can reduced in favour of adding precedence field into @NOperatorDef@.--- details: https://github.com/haskell-nix/hnix/issues/982-data OperatorInfo =-  OperatorInfo-    { precedence    :: Int-    , associativity :: NAssoc-    , operatorName  :: Text-    }- deriving (Eq, Ord, Generic, Typeable, Data, Show)+-- Supplied since its definition gets called/used frequently.+-- | Functional application operator definition, left associative, high precedence.+appOpDef :: NOperatorDef+appOpDef = NAppDef NAppOp NAssocLeft 1 " " -- This defined as "2" in Nix lang spec. -detectPrecedence-  :: Ord a-  => ( Int-    -> (NOperatorDef, Operator Parser NExprLoc)-    -> [(a, OperatorInfo)]-    )-  -> a-  -> OperatorInfo-detectPrecedence spec = (mapOfOpWithPrecedence Map.!)- where-  mapOfOpWithPrecedence =-    Map.fromList $-      fold $-        zipWith-          (foldMap . spec)-          [1 ..]-          l+--  2022-01-26: NOTE: When total - make sure to hide & inline all these instances to get free solution.+-- | Class to get a private free construction to abstract away the gap between the Nix operation types+-- 'NUnaryOp', 'NBinaryOp', 'NSpecialOp'.+-- And in doing remove 'OperatorInfo' from existance.+class NOp a where+  {-# minimal getOpDef, getOpAssoc, getOpPrecedence, getOpName #-}++  getOpDef :: a -> NOperatorDef+  getOpAssoc :: a -> NAssoc+  getOpPrecedence :: a -> NOpPrecedence+  getOpName :: a -> NOpName++instance NOp NAppOp where+  getOpDef NAppOp = appOpDef+  getOpAssoc _op = fun appOpDef    where-    l :: [[(NOperatorDef, Operator Parser NExprLoc)]]-    l = nixOperators $ fail "unused"+    fun (NAppDef _op assoc _prec _name) = assoc+    fun _ = error "Impossible happened, funapp operation should been matched."+  getOpPrecedence _op = fun appOpDef+   where+    fun (NAppDef _op _assoc prec _name) = prec+    fun _ = error "Impossible happened, funapp operation should been matched."+  getOpName _ = fun appOpDef+   where+    fun (NAppDef _op _assoc _prec name) = name+    fun _ = error "Impossible happened, funapp operation should been matched." -getUnaryOperator :: NUnaryOp -> OperatorInfo-getUnaryOperator = detectPrecedence spec- where-  spec :: Int -> (NOperatorDef, b) -> [(NUnaryOp, OperatorInfo)]-  spec i =+instance NOp NUnaryOp where+  getOpDef =     \case-      (NUnaryDef op name, _) -> one (op, OperatorInfo i NAssocNone name)-      _                      -> mempty+      NNeg -> NUnaryDef NNeg NAssocRight 3 "-"+      NNot -> NUnaryDef NNot NAssocRight 8 "!"+  getOpAssoc = fun . getOpDef+   where+    fun (NUnaryDef _op assoc _prec _name) = assoc+    fun _ = error "Impossible happened, unary operation should been matched."+  getOpPrecedence = fun . getOpDef+   where+    fun (NUnaryDef _op _assoc prec _name) = prec+    fun _ = error "Impossible happened, unary operation should been matched."+  getOpName = fun . getOpDef+   where+    fun (NUnaryDef _op _assoc _prec name) = name+    fun _ = error "Impossible happened, unary operation should been matched." -getBinaryOperator :: NBinaryOp -> OperatorInfo-getBinaryOperator = detectPrecedence spec- where-  spec :: Int -> (NOperatorDef, b) -> [(NBinaryOp, OperatorInfo)]-  spec i =+instance NOp NBinaryOp where+  getOpDef =     \case-      (NBinaryDef assoc op name, _) -> one (op, OperatorInfo i assoc name)-      _                             -> mempty+      NConcat -> NBinaryDef NConcat NAssocRight  5 "++"+      NMult   -> NBinaryDef NMult   NAssocLeft   6 "*"+      NDiv    -> NBinaryDef NDiv    NAssocLeft   6 "/"+      NPlus   -> NBinaryDef NPlus   NAssocLeft   7 "+"+      NMinus  -> NBinaryDef NMinus  NAssocLeft   7 "-"+      NUpdate -> NBinaryDef NUpdate NAssocRight  9 "//"+      NLt     -> NBinaryDef NLt     NAssocLeft  10 "<"+      NLte    -> NBinaryDef NLte    NAssocLeft  10 "<="+      NGt     -> NBinaryDef NGt     NAssocLeft  10 ">"+      NGte    -> NBinaryDef NGte    NAssocLeft  10 ">="+      NEq     -> NBinaryDef NEq     NAssoc      11 "=="+      NNEq    -> NBinaryDef NNEq    NAssoc      11 "!="+      NAnd    -> NBinaryDef NAnd    NAssocLeft  12 "&&"+      NOr     -> NBinaryDef NOr     NAssocLeft  13 "||"+      NImpl   -> NBinaryDef NImpl   NAssocRight 14 "->"+  getOpAssoc = fun . getOpDef+   where+    fun (NBinaryDef _op assoc _prec _name) = assoc+    fun _ = error "Impossible happened, binary operation should been matched."+  getOpPrecedence = fun . getOpDef+   where+    fun (NBinaryDef _op _assoc prec _name) = prec+    fun _ = error "Impossible happened, binary operation should been matched."+  getOpName = fun . getOpDef+   where+    fun (NBinaryDef _op _assoc _prec name) = name+    fun _ = error "Impossible happened, binary operation should been matched." -getSpecialOperator :: NSpecialOp -> OperatorInfo-getSpecialOperator NSelectOp = OperatorInfo 1 NAssocLeft "."-getSpecialOperator o         = detectPrecedence spec o- where-  spec :: Int -> (NOperatorDef, b) -> [(NSpecialOp, OperatorInfo)]-  spec i =-      \case-        (NSpecialDef assoc op name, _) -> one (op, OperatorInfo i assoc name)-        _                              -> mempty+instance NOp NSpecialOp where+  getOpDef =+    \case+      NSelectOp  -> NSpecialDef NSelectOp  NAssocLeft 1 "."+      NHasAttrOp -> NSpecialDef NHasAttrOp NAssocLeft 4 "?"+      NTerm      -> NSpecialDef NTerm      NAssocLeft 1 "???"+  getOpAssoc = fun . getOpDef+   where+    fun (NSpecialDef _op assoc _prec _name) = assoc+    fun _ = error "Impossible happened, special operation should been matched."+  getOpPrecedence = fun . getOpDef+   where+    fun (NSpecialDef _op _assoc prec _name) = prec+    fun _ = error "Impossible happened, special operation should been matched."+  getOpName = fun . getOpDef+   where+    fun (NSpecialDef _op _assoc _prec name) = name+    fun _ = error "Impossible happened, special operation should been matched." +instance NOp NOperatorDef where+  getOpDef op = op+  getOpAssoc = \case+    (NAppDef     _op assoc _prec _name) -> assoc+    (NUnaryDef   _op assoc _prec _name) -> assoc+    (NBinaryDef  _op assoc _prec _name) -> assoc+    (NSpecialDef _op assoc _prec _name) -> assoc+  getOpPrecedence = fun . getOpDef+   where+    fun (NAppDef     _op _assoc prec _name) = prec+    fun (NUnaryDef   _op _assoc prec _name) = prec+    fun (NBinaryDef  _op _assoc prec _name) = prec+    fun (NSpecialDef _op _assoc prec _name) = prec+  getOpName = fun . getOpDef+   where+    fun (NAppDef     _op _assoc _prec name) = name+    fun (NUnaryDef   _op _assoc _prec name) = name+    fun (NBinaryDef  _op _assoc _prec name) = name+    fun (NSpecialDef _op _assoc _prec name) = name++prefix :: NUnaryOp -> Operator Parser NExprLoc+prefix op =+  Prefix $ manyUnaryOp $ opWithLoc annNUnary op $ getOpName op+-- postfix name op = (NUnaryDef name op,+--                    Postfix (opWithLoc annNUnary op name))++manyUnaryOp :: MonadPlus f => f (a -> a) -> f (a -> a)+manyUnaryOp f = foldr1 (.) <$> some f++binary+  :: NBinaryOp+  -> Operator Parser NExprLoc+binary op =+  mapAssocToInfix (getOpAssoc op) $ opWithLoc annNBinary op (getOpName op)++mapAssocToInfix :: NAssoc -> m (a -> a -> a) -> Operator m a+mapAssocToInfix NAssocLeft  = InfixL+mapAssocToInfix NAssoc      = InfixN+mapAssocToInfix NAssocRight = InfixR+ -- ** x: y lambda function  -- | Gets all of the arguments for a function.@@ -686,13 +717,13 @@     try $       do         name             <- identifier <* symbol '@'-        (pset, variadic) <- params+        (variadic, pset) <- params         pure $ ParamSet (pure name) variadic pset    -- Parameters named by an identifier on the right, or none (`{x, y} @ args`)   atRight =     do-      (pset, variadic) <- params+      (variadic, pset) <- params       name             <- optional $ symbol '@' *> identifier       pure $ ParamSet name variadic pset @@ -701,18 +732,20 @@    -- Collects the parameters within curly braces. Returns the parameters and   -- an flag indication if the parameters are variadic.+  getParams :: Parser (Variadic, [(VarName, Maybe NExprLoc)])   getParams = go mempty    where     -- Attempt to parse `...`. If this succeeds, stop and return True.     -- Otherwise, attempt to parse an argument, optionally with a     -- default. If this fails, then return what has been accumulated     -- so far.-    go acc = ((acc, Variadic) <$ symbols "...") <|> getMore+    go :: [(VarName, Maybe NExprLoc)] -> Parser (Variadic, [(VarName, Maybe NExprLoc)])+    go acc = ((Variadic, acc) <$ symbols "...") <|> getMore      where-      getMore :: Parser ([(VarName, Maybe NExprLoc)], Variadic)+      getMore :: Parser (Variadic, [(VarName, Maybe NExprLoc)])       getMore =         -- Could be nothing, in which just return what we have so far.-        option (acc, mempty) $+        option (mempty, acc) $           do             -- Get an argument name and an optional default.             pair <-@@ -723,7 +756,7 @@             let args = acc <> one pair              -- Either return this, or attempt to get a comma and restart.-            option (args, mempty) $ symbol ',' *> go args+            option (mempty, args) $ symbol ',' *> go args  nixLambda :: Parser NExprLoc nixLambda =@@ -739,14 +772,16 @@   annotateNamedLocation "let block" $     reserved "let" *> (letBody <|> letBinders)  where+  -- | Expressions `let {..., body = ...}' are just desugared+  -- into `(rec {..., body = ...}).body'.+  letBody    = (\ expr -> NSelect Nothing expr (one $ StaticKey "body")) <$> attrset+   where+    attrset       = annotateLocation $ NSet Recursive <$> braces nixBinders+  -- | Regular `let`   letBinders =     liftA2 NLet       nixBinders       (exprAfterReservedWord "in")-  -- Let expressions `let {..., body = ...}' are just desugared-  -- into `(rec {..., body = ...}).body'.-  letBody    = (\x -> NSelect Nothing x (one $ StaticKey "body")) <$> aset-  aset       = annotateLocation $ NSet Recursive <$> braces nixBinders  -- ** if then else @@ -754,7 +789,7 @@ nixIf =   annotateNamedLocation "if" $     liftA3 NIf-      (reserved "if"   *> nixExprAlgebra)+      (reserved "if"   *> nixExpr)       (exprAfterReservedWord "then")       (exprAfterReservedWord "else") @@ -779,8 +814,8 @@  -- ** . - reference (selector) into attr -selDot :: Parser ()-selDot = label "." $ try (symbol '.' *> notFollowedBy nixPath)+selectorDot :: Parser ()+selectorDot = label "." $ try (symbol '.' *> notFollowedBy nixPath)  keyName :: Parser (NKeyName NExprLoc) keyName = dynamicKey <|> staticKey@@ -790,23 +825,20 @@  nixSelector :: Parser (AnnUnit SrcSpan (NAttrPath NExprLoc)) nixSelector =-  annotateLocation1 $-    do-      (x : xs) <- keyName `sepBy1` selDot-      pure $ x :| xs+  annotateLocation1 $ fromList <$> keyName `sepBy1` selectorDot  nixSelect :: Parser NExprLoc -> Parser NExprLoc nixSelect term =   do     res <--      liftA2 build+      liftA2 builder         term         (optional $-          liftA2 (,)-            (selDot *> nixSelector)+          liftA2 (flip (,))+            (selectorDot *> nixSelector)             (optional $ reserved "or" *> nixTerm)         )-    continues <- optional $ lookAhead selDot+    continues <- optional $ lookAhead selectorDot      maybe       id@@ -814,25 +846,60 @@       continues       (pure res)  where-  build+  builder     :: NExprLoc     -> Maybe-      ( AnnUnit SrcSpan (NAttrPath NExprLoc)-      , Maybe NExprLoc+      ( Maybe NExprLoc+      , AnnUnit SrcSpan (NAttrPath NExprLoc)       )     -> NExprLoc-  build t =+  builder t =     maybe       t-      (\ (a, m) -> (`annNSelect` t) m a)+      (uncurry (`annNSelect` t))   -- ** _ - syntax hole  nixSynHole :: Parser NExprLoc-nixSynHole = annotateLocation $ mkSynHoleF <$> coerce (char '^' *> identifier)+nixSynHole =+  annotateLocation $ mkSynHoleF <$> coerce (char '^' *> identifier) +-- List of Nix operation parsers with their precedence.+opParsers :: [(NOpPrecedence, Operator Parser NExprLoc)]+opParsers =+  -- This is not parsed here, even though technically it's part of the+  -- expression table. The problem is that in some cases, such as list+  -- membership, it's also a term. And since terms are effectively the+  -- highest precedence entities parsed by the expression parser, it ends up+  -- working out that we parse them as a kind of "meta-term". +  -- {-  1 -}+  -- [ ( NSpecialDef "." NSelectOp NAssocLeft+  --   , Postfix $+  --       do+  --         sel <- seldot *> selector+  --         mor <- optional (reserved "or" *> term)+  --         pure $ \x -> annNSelect x sel mor)+  -- ]++  -- NApp is left associative+  -- 2018-05-07: jwiegley: Thanks to Brent Yorgey for showing me this trick!+  specialBuilder NAppOp (InfixL $ annNApp <$ symbols mempty) <>+  specialBuilder NHasAttrOp (Postfix $ symbol '?' *> (flip annNHasAttr <$> nixSelector)) <>+  builder prefix <>+  builder binary+ where+  specialBuilder :: NOp t => t -> b -> [(NOpPrecedence, b)]+  specialBuilder op parser = one (entry op (const parser))++  builder :: (Enum t, Bounded t, NOp t) => (t -> b) -> [(NOpPrecedence, b)]+  builder tp = fmap (`entry` tp) universe++  entry :: NOp t => t -> (t -> b) -> (NOpPrecedence, b)+  entry op parser = (getOpPrecedence op, parser op)++ -- ** Expr & its constituents (Language term, expr algebra)  nixTerm :: Parser NExprLoc@@ -861,15 +928,19 @@                 <> [ nixNull | c == 'n' ]                 <> one (nixSelect nixSym) +-- | Bundles parsers into @[[]]@ based on precedence (form is required for `megaparsec`).+nixOperators :: [[ Operator Parser NExprLoc ]]+nixOperators =+  snd <$>+    groupSort opParsers+ -- | Nix expression algebra parser. -- "Expression algebra" is to explain @megaparsec@ use of the term "Expression" (parser for language algebraic coperators without any statements (without @let@ etc.)), which is essentially an algebra inside the language. nixExprAlgebra :: Parser NExprLoc nixExprAlgebra =   makeExprParser     nixTerm-    (snd <<$>>-      nixOperators nixSelector-    )+    nixOperators  nixExpr :: Parser NExprLoc nixExpr = keywords <|> nixLambda <|> nixExprAlgebra@@ -881,25 +952,25 @@  type Result a = Either (Doc Void) a -parseFromFileEx :: MonadFile m => Parser a -> Path -> m (Result a)-parseFromFileEx parser file =-  do-    input <- liftIO $ readFile file -    pure $-      either-        (Left . pretty . errorBundlePretty)-        pure-        $ (`evalState` initialPos (coerce file)) $ runParserT parser (coerce file) input--parseFromText :: Parser a -> Text -> Result a-parseFromText parser input =-  let stub = "<string>" in+parseWith+  :: Parser a+  -> Path+  -> Text+  -> Either (Doc Void) a+parseWith parser file input =   either     (Left . pretty . errorBundlePretty)     pure-    $ (`evalState` initialPos stub) $ (`runParserT` stub) parser input+    $ (`evalState` initialPos (coerce file)) $ (`runParserT` coerce file) parser input ++parseFromFileEx :: MonadFile m => Parser a -> Path -> m (Result a)+parseFromFileEx parser file = parseWith parser file <$> readFile file++parseFromText :: Parser a -> Text -> Result a+parseFromText = (`parseWith` "<string>")+ fullContent :: Parser NExprLoc fullContent = whiteSpace *> nixExpr <* eof @@ -927,7 +998,7 @@ parseNixTextLoc =   parseNixText' id -parseExpr :: (MonadFail m) => Text -> m NExpr+parseExpr :: MonadFail m => Text -> m NExpr parseExpr =   either     (fail . show)

@@ -39,7 +39,7 @@     -- the expression tree. For example, in '(a * b) + c', '+' would be the root     -- operator. It is needed to determine if we need to wrap the expression in     -- parentheses.-  , rootOp :: OperatorInfo+  , rootOp :: NOperatorDef   , wasPath :: Bool -- This is needed so that when a path is used in a selector path                     -- we can add brackets appropriately   }@@ -52,14 +52,15 @@ antiquote :: NixDoc ann -> Doc ann antiquote x = "${" <> getDoc x <> "}" -mkNixDoc :: OperatorInfo -> Doc ann -> NixDoc ann+mkNixDoc :: NOperatorDef -> Doc ann -> NixDoc ann mkNixDoc o d = NixDoc { getDoc = d, rootOp = o, wasPath = False }  -- | A simple expression is never wrapped in parentheses. The expression --   behaves as if its root operator had a precedence higher than all --   other operators (including function application). simpleExpr :: Doc ann -> NixDoc ann-simpleExpr = mkNixDoc $ OperatorInfo minBound NAssocNone "simple expr"+simpleExpr =+  mkNixDoc $ NSpecialDef NTerm NAssoc minBound "simple expr"  pathExpr :: Doc ann -> NixDoc ann pathExpr d = (simpleExpr d) { wasPath = True }@@ -71,50 +72,51 @@ --   binding). leastPrecedence :: Doc ann -> NixDoc ann leastPrecedence =-  mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"+  mkNixDoc $ NSpecialDef NTerm NAssoc maxBound "least precedence" -appOp :: OperatorInfo-appOp = getBinaryOperator NApp -appOpNonAssoc :: OperatorInfo-appOpNonAssoc = appOp { associativity = NAssocNone }+data WrapMode+  = ProcessAllWrap+  | PrecedenceWrap+ deriving Eq -selectOp :: OperatorInfo-selectOp = getSpecialOperator NSelectOp+needsParens+  :: WrapMode+  -> NOperatorDef+  -> NOperatorDef+  -> Bool+needsParens mode host sub =+  getOpPrecedence host > getOpPrecedence sub+  || bool+    False+    ( NAssoc /=  getOpAssoc      host+      && on (==) getOpAssoc      host sub+      && on (==) getOpPrecedence host sub+    )+    (ProcessAllWrap == mode) -hasAttrOp :: OperatorInfo-hasAttrOp = getSpecialOperator NHasAttrOp+maybeWrapDoc :: WrapMode -> NOperatorDef -> NixDoc ann -> Doc ann+maybeWrapDoc mode host sub =+  bool+    parens+    id+    (needsParens mode host (rootOp sub))+    (getDoc sub)  -- | Determine if to return doc wraped into parens, -- according the given operator.-precedenceWrap :: OperatorInfo -> NixDoc ann -> Doc ann-precedenceWrap op subExpr =-  maybeWrap $ getDoc subExpr- where-  maybeWrap :: Doc ann -> Doc ann-  maybeWrap =-    bool-      parens-      id-      needsParens-   where-    needsParens :: Bool-    needsParens =-      precedence root < precedence op-      || (  precedence    root == precedence    op-         && associativity root == associativity op-         && associativity op   /= NAssocNone-         )--    root = rootOp subExpr+wrap :: NOperatorDef -> NixDoc ann -> Doc ann+wrap = maybeWrapDoc ProcessAllWrap +precedenceWrap :: NOperatorDef -> NixDoc ann -> Doc ann+precedenceWrap = maybeWrapDoc PrecedenceWrap  -- Used in the selector case to print a path in a selector as -- "${./abc}"-wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann+wrapPath :: NOperatorDef -> NixDoc ann -> Doc ann wrapPath op sub =   bool-    (precedenceWrap op sub)+    (wrap op sub)     (dquotes $ antiquote sub)     (wasPath sub) @@ -243,7 +245,7 @@   NConstant atom -> prettyAtom atom   NStr      str  -> simpleExpr $ prettyString str   NList xs ->-    prettyContainer "[" (precedenceWrap appOpNonAssoc) "]" xs+    prettyContainer "[" (precedenceWrap appOpDef) "]" xs   NSet NonRecursive xs ->     prettyContainer "{" prettyBind "}" xs   NSet Recursive xs ->@@ -255,40 +257,49 @@           [ prettyParams args <> ":"           , getDoc body           ]-  NBinary NApp fun arg ->-    mkNixDoc appOp (precedenceWrap appOp fun <> " " <> precedenceWrap appOpNonAssoc arg)+  NApp fun arg ->+    mkNixDoc appOpDef (wrap appOpDef fun <> " " <> precedenceWrap appOpDef arg)   NBinary op r1 r2 ->     mkNixDoc-      opInfo $+      opDef $       hsep-        [ f NAssocLeft r1-        , pretty $ operatorName opInfo-        , f NAssocRight r2+        [ pickWrapMode NAssocLeft r1+        , pretty @Text $ coerce @NOpName $ getOpName op+        , pickWrapMode NAssocRight r2         ]    where-    opInfo = getBinaryOperator op-    f :: NAssoc -> NixDoc ann -> Doc ann-    f x =-      precedenceWrap-        $ bool-            opInfo-            (opInfo { associativity = NAssocNone })-            (associativity opInfo /= x)+    opDef = getOpDef op++    pickWrapMode :: NAssoc -> NixDoc ann -> Doc ann+    pickWrapMode x =+      bool+        wrap+        precedenceWrap+        (getOpAssoc opDef /= x)+        opDef   NUnary op r1 ->     mkNixDoc-      opInfo $-      pretty (operatorName opInfo) <> precedenceWrap opInfo r1+      opDef $+      pretty @Text (coerce $ getOpName op) <> wrap opDef r1    where-    opInfo = getUnaryOperator op+    opDef = getOpDef op   NSelect o r' attr ->     maybe       (mkNixDoc selectOp)       (const leastPrecedence)       o-      $ wrapPath selectOp (mkNixDoc selectOp (precedenceWrap appOpNonAssoc r')) <> "." <> prettySelector attr <>-        ((" or " <>) . precedenceWrap appOpNonAssoc) `whenJust` o+      $ wrapPath selectOp (mkNixDoc selectOp (wrap appOpDef r')) <> "." <> prettySelector attr <>+        ((" or " <>) . precedenceWrap appOpDef) `whenJust` o+   where+    selectOp :: NOperatorDef+    selectOp = getOpDef NSelectOp+   NHasAttr r attr ->-    mkNixDoc hasAttrOp (precedenceWrap hasAttrOp r <> " ? " <> prettySelector attr)+    mkNixDoc hasAttrOp (wrap hasAttrOp r <> " ? " <> prettySelector attr)+   where+    hasAttrOp :: NOperatorDef+    hasAttrOp = getOpDef NHasAttrOp+   NEnvPath     p -> simpleExpr $ pretty @String $ "<" <> coerce p <> ">"   NLiteralPath p ->     pathExpr $@@ -314,15 +325,14 @@   NIf cond trueBody falseBody ->     leastPrecedence $       group $-        nest 2 $-          ifThenElse getDoc+        nest 2 ifThenElse    where-    ifThenElse :: (NixDoc ann -> Doc ann) -> Doc ann-    ifThenElse wp =+    ifThenElse :: Doc ann+    ifThenElse =       sep-        [ "if " <> wp cond-        , align ("then " <> wp trueBody)-        , align ("else " <> wp falseBody)+        [         "if "   <> getDoc cond+        , align $ "then " <> getDoc trueBody+        , align $ "else " <> getDoc falseBody         ]   NWith scope body ->     prettyAddScope "with " scope body@@ -331,9 +341,9 @@   NSynHole name -> simpleExpr $ pretty @Text ("^" <> coerce name)  where   prettyContainer h f t c =-    list+    handlePresence       (simpleExpr (h <> t))-      (const $ simpleExpr $ group $ nest 2 $ vsep $ one h <> (f <$> c) <> one t)+      (const $ simpleExpr $ group $ nest 2 (h <> line <> vsep (f <$> c)) <> line <> t)       c    prettyAddScope h c b =@@ -380,7 +390,7 @@   -> NValue t f m   -> Doc ann prettyProv wasThunk v =-  list+  handlePresence     id     (\ ps pv ->       fillSep

@@ -22,7 +22,7 @@  import           Nix.Prelude import           Control.Monad.Catch            ( MonadCatch(catch) )-#if !MIN_VERSION_base(4,13,0)+#if !MIN_VERSION_base(4,12,0) import           Prelude                 hiding ( fail ) import           Control.Monad.Fail #endif@@ -102,7 +102,7 @@           (\ err -> fail $ "Parse failed: " <> show err)           (\ x -> do             let-              pos  = join (SourcePos "Reduce.hs") $ mkPos 1+              pos  = join (NSourcePos "Reduce.hs") $ (coerce . mkPos) 1               span = join SrcSpan pos               cur  =                 NamedVar@@ -171,13 +171,13 @@ -- --     * Reduce a lambda function by adding its name to the local --       scope and recursively reducing its body.-reduce (NBinaryAnnF bann NApp fun arg) =+reduce (NAppAnnF bann fun arg) =   (\case     f@(NSymAnn _ "import") ->       (\case           -- NEnvPathAnn     pann origPath -> staticImport pann origPath         NLiteralPathAnn pann origPath -> staticImport pann origPath-        v -> pure $ NBinaryAnn bann NApp f v+        v -> pure $ NAppAnn bann f v       ) =<< arg      NAbsAnn _ (Param name) body ->@@ -187,7 +187,7 @@           (coerce $ HM.singleton name x)           (foldFix reduce body) -    f -> NBinaryAnn bann NApp f <$> arg+    f -> NAppAnn bann f <$> arg   ) =<< fun  -- | Reduce an integer addition to its result.@@ -383,7 +383,7 @@      NLet binds (Just body@(Ann _ x)) ->       pure $-        list+        handlePresence           x           (`NLet` body)           (mapMaybe pruneBinding binds)@@ -391,13 +391,13 @@     NSelect alt (Just aset) attr ->       pure $ NSelect (join alt) aset $ pruneKeyName <$> attr +    -- If the function was never called, it means its argument was in a+    -- thunk that was forced elsewhere.+    NApp Nothing (Just _) -> Nothing+     -- These are the only short-circuiting binary operators     NBinary NAnd (Just (Ann _ larg)) _ -> pure larg     NBinary NOr  (Just (Ann _ larg)) _ -> pure larg--    -- If the function was never called, it means its argument was in a-    -- thunk that was forced elsewhere.-    NBinary NApp Nothing (Just _) -> Nothing      -- The idea behind emitted a binary operator where one side may be     -- invalid is that we're trying to emit what will reproduce whatever

@@ -2,7 +2,6 @@ {-# language CPP #-} {-# language ConstraintKinds #-} {-# language DefaultSignatures #-}-{-# language GADTs #-} {-# language TypeFamilies #-} {-# language TypeOperators #-} {-# language MultiWayIf #-}@@ -14,6 +13,9 @@ import           Nix.Utils.Fix1                 ( Fix1T                                                 , MonadFix1T                                                 )+import           Nix.Expr.Types                 ( NPos(..)+                                                , NSourcePos(..)+                                                ) import           Nix.Expr.Types.Annotated import           Prettyprinter import qualified System.Directory              as S@@ -65,14 +67,14 @@  instance (MonadFix1T t m, MonadIO (Fix1T t m), MonadFail (Fix1T t m), MonadFile m) => MonadFile (Fix1T t m) -posAndMsg :: SourcePos -> Doc a -> ParseError s Void-posAndMsg (SourcePos _ lineNo _) msg =+posAndMsg :: NSourcePos -> Doc a -> ParseError s Void+posAndMsg (NSourcePos _ (coerce -> lineNo) _) msg =   FancyError     (unPos lineNo)     (Set.fromList $ one (ErrorFail (show msg) :: ErrorFancy Void))  renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)-renderLocation (SrcSpan (SourcePos (coerce -> file) begLine begCol) (SourcePos (coerce -> file') endLine endCol)) msg+renderLocation (SrcSpan (NSourcePos file (coerce -> begLine) (coerce -> begCol)) (NSourcePos file' (coerce -> endLine) (coerce -> endCol))) msg   | file == file' && file == "<string>" && begLine == endLine =     pure $ "In raw input string at position " <> pretty (unPos begCol) 

@@ -2,7 +2,6 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} {-# language MultiWayIf #-}-{-# language GADTs #-} {-# language TypeFamilies #-}  @@ -50,7 +49,11 @@       --  2021-10-22: NOTE: List reverse is completely conterproductive. `reverse` of list famously neest to traverse the whole list to take the last element         | verbosity <= Informational -> (foldMap renderPosition (reverse xs) <>) <$> render1 x         | otherwise -> foldMapM render1 (reverse xss)-    pure $ list mempty vsep renderedFrames+    pure $+      handlePresence+        mempty+        vsep+        renderedFrames  where   render1 :: NixFrame -> m [Doc ann1]   render1 = renderFrame @v @t @f@@ -58,14 +61,14 @@   renderPosition :: NixFrame -> [Doc ann]   renderPosition =     whenJust-      (\ pos -> one ("While evaluating at " <> pretty (sourcePosPretty pos) <> colon))+      (\ pos -> one ("While evaluating at " <> pretty (sourcePosPretty $ toSourcePos pos) <> colon))       . framePos @v @m  framePos   :: forall v (m :: Type -> Type)    . (Typeable m, Typeable v)   => NixFrame-  -> Maybe SourcePos+  -> Maybe NSourcePos framePos (NixFrame _ f) =   (\case     EvaluatingExpr _ (Ann (SrcSpan beg _) _) -> pure beg

@@ -19,7 +19,7 @@ import           Control.Monad.Fail             ( MonadFail ) #endif import           Control.Monad.Free             ( Free(Free) )-import           Control.Monad.Reader           ( MonadFix )+import           Control.Monad.Fix              ( MonadFix ) import           Control.Monad.Ref              ( MonadRef(newRef)                                                 , MonadAtomicRef                                                 )@@ -47,14 +47,9 @@   StdCited     (Cited (StdThunk m) (StdCited m) m a)   deriving-    ( Generic-    , Typeable-    , Functor-    , Applicative-    , Foldable-    , Traversable-    , Comonad-    , ComonadEnv [Provenance m (StdValue m)]+    ( Generic, Typeable+    , Functor, Applicative, Comonad, ComonadEnv [Provenance m (StdValue m)]+    , Foldable, Traversable     )  newtype StdThunk m =@@ -172,6 +167,8 @@   -- * @instance MonadThunkF@ (Kleisli functor HOFs)++-- | This is a functorized version in CPS.  -- Please do not use MonadThunkF instances to define MonadThunk. as MonadThunk uses specialized functions. instance

@@ -143,7 +143,7 @@  -- | Returns True if the NixString has an associated context hasContext :: NixString -> Bool-hasContext (NixString c _) = not $ null c+hasContext (NixString c _) = isPresent c   -- ** Getters@@ -183,7 +183,7 @@         mkLstCtxFor DirectPath cv { nlcvPath = False }       NixLikeContextValue _    True _ ->         mkLstCtxFor AllOutputs cv { nlcvAllOutputs = False }-      NixLikeContextValue _    _    ls | not (null ls) ->+      NixLikeContextValue _    _    ls | isPresent ls ->         mkCtxFor . DerivationOutput <$> ls       _ -> mempty    where@@ -211,8 +211,8 @@       stringContext  where   fun :: (StringContext -> AttrSet NixLikeContextValue -> AttrSet NixLikeContextValue)-  fun sc hm =-    uncurry (M.insertWith (<>)) (swap $ toNixLikeContextValue sc) hm+  fun sc =+    uncurry (M.insertWith (<>)) (swap $ toNixLikeContextValue sc)  -- | Add 'StringContext's into the resulting set. addStringContext

@@ -1,72 +1,92 @@-{-# language QuasiQuotes #-}-{-# language TemplateHaskell #-}--{-# options_ghc -Wno-missing-fields #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-missing-fields #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}  module Nix.TH where -import           Nix.Prelude+import           Data.Fix                       ( Fix(Fix) ) import           Data.Generics.Aliases          ( extQ ) import qualified Data.Set                      as Set import           Language.Haskell.TH-import qualified Language.Haskell.TH.Syntax    as TH import           Language.Haskell.TH.Quote import           Nix.Atoms import           Nix.Expr.Types import           Nix.Expr.Types.Annotated import           Nix.Parser+import           Nix.Prelude +removeMissingNames :: Set VarName -> Q (Set VarName)+removeMissingNames =+  fmap Set.fromAscList+    . filterM (fmap isJust . lookupValueName . toString)+    . Set.toAscList+ quoteExprExp :: String -> ExpQ-quoteExprExp s =-  do-    expr <- parseExpr $ fromString s-    dataToExpQ-      (extQOnFreeVars metaExp expr `extQ` (pure . (TH.lift :: Text -> ExpQ)))-      expr+quoteExprExp s = do+  expr <- parseExpr $ fromString s+  vars <- removeMissingNames $ getFreeVars expr+  dataToExpQ (extQOnFreeVars metaExp vars) expr  quoteExprPat :: String -> PatQ-quoteExprPat s =-  do-    expr <- parseExpr @Q $ fromString s-    dataToPatQ-      (extQOnFreeVars @_ @NExprLoc @PatQ metaPat expr)-      expr-+quoteExprPat s = do+  expr <- parseExpr @Q $ fromString s+  vars <- removeMissingNames $ getFreeVars expr+  dataToPatQ (extQOnFreeVars @_ @NExprLoc @PatQ metaPat vars) expr  -- | Helper function. extQOnFreeVars-  :: ( Typeable b-    , Typeable loc-    )-  => ( Set VarName-    -> loc-    -> Maybe q-    )-  -> NExpr+  :: (Typeable b, Typeable loc)+  => (Set VarName -> loc -> Maybe q)+  -> Set VarName   -> b   -> Maybe q-extQOnFreeVars f = extQ (const Nothing) . f . getFreeVars+extQOnFreeVars f = extQ (const Nothing) . f  class ToExpr a where-  toExpr :: a -> NExprLoc+  toExpr :: a -> NExpr -instance ToExpr NExprLoc where+instance ToExpr NExpr where   toExpr = id  instance ToExpr VarName where-  toExpr = NSymAnn nullSpan+  toExpr = Fix . NSym +instance {-# OVERLAPPING #-} ToExpr String where+  toExpr = Fix . NStr . fromString++instance ToExpr Text where+  toExpr = toExpr . toString+ instance ToExpr Int where-  toExpr = NConstantAnn nullSpan . NInt . fromIntegral+  toExpr = Fix . NConstant . NInt . fromIntegral +instance ToExpr Bool where+  toExpr = Fix . NConstant . NBool+ instance ToExpr Integer where-  toExpr = NConstantAnn nullSpan . NInt+  toExpr = Fix . NConstant . NInt  instance ToExpr Float where-  toExpr = NConstantAnn nullSpan . NFloat+  toExpr = Fix . NConstant . NFloat -metaExp :: Set VarName -> NExprLoc -> Maybe ExpQ-metaExp fvs (NSymAnn _ x) | x `Set.member` fvs =+instance (ToExpr a) => ToExpr [a] where+  toExpr = Fix . NList . fmap toExpr++instance (ToExpr a) => ToExpr (NonEmpty a) where+  toExpr = toExpr . toList++instance ToExpr () where+  toExpr () = Fix $ NConstant NNull++instance (ToExpr a) => ToExpr (Maybe a) where+  toExpr = maybe (toExpr ()) toExpr++instance (ToExpr a, ToExpr b) => ToExpr (Either a b) where+  toExpr = either toExpr toExpr++metaExp :: Set VarName -> NExpr -> Maybe ExpQ+metaExp fvs (Fix (NSym x)) | x `Set.member` fvs =   pure [| toExpr $(varE (mkName $ toString x)) |] metaExp _ _ = Nothing 

@@ -1,6 +1,7 @@ {-# language DefaultSignatures #-} {-# language FunctionalDependencies #-} {-# language TypeFamilies #-}+{-# language TypeOperators #-}  module Nix.Thunk where 

@@ -26,8 +26,8 @@                                                 , MonadCatch(..)                                                 ) import           Control.Monad.Except           ( MonadError(throwError,catchError) )-import           Control.Monad.Logic     hiding ( fail )-import           Control.Monad.Reader           ( MonadFix )+import           Control.Monad.Logic+import           Control.Monad.Fix              ( MonadFix ) import           Control.Monad.Ref              ( MonadAtomicRef(..)                                                 , MonadRef(..)                                                 )@@ -635,8 +635,8 @@         (Set.difference `on` Set.fromList)           (Assumption.keys as )           (       Env.keys env)-    unless-      (Set.null unbounds)+    when+      (isPresent unbounds)       $ typeError $ UnboundVariables $ ordNub $ Set.toList unbounds      inferState <- get@@ -677,9 +677,8 @@ binops :: Type -> NBinaryOp -> [Constraint] binops u1 op =   if-    -- NApp in fact is handled separately     -- Equality tells nothing about the types, because any two types are allowed.-    | op `elem` [ NApp  , NEq  , NNEq        ] -> mempty+    | op `elem` [ NEq   , NNEq               ] -> mempty     | op `elem` [ NGt   , NGte , NLt  , NLte ] -> inequality     | op `elem` [ NAnd  , NOr  , NImpl       ] -> gate     | op ==       NConcat                      -> concatenation@@ -765,9 +764,10 @@  where   report :: [a] -> [TypeError] -> Either [TypeError] [a]   report xs e =-    if null xs-      then Left (ordNub e)-      else pure xs+    handlePresence+      (Left $ ordNub e)+      pure+      xs  -- ** Instances @@ -829,7 +829,7 @@   solvable (EqConst{}     , _) = True   solvable (ExpInstConst{}, _) = True   solvable (ImpInstConst _t1 ms t2, cs) =-    Set.null $ (ms `Set.difference` ftv t2) `Set.intersection` atv cs+    null $ (ms `Set.difference` ftv t2) `Set.intersection` atv cs  solve :: forall m . MonadState InferState m => [Constraint] -> Solver m Subst solve [] = stub

@@ -19,8 +19,9 @@   , whenTrue   , whenFalse   , whenJust+  , isPresent+  , handlePresence   , whenText-  , list   , free    , Path(..)@@ -67,13 +68,13 @@ import           Data.Binary                    ( Binary ) import           Data.Data                      ( Data ) import           Codec.Serialise                ( Serialise )+import           Control.Monad                  ( foldM ) import           Control.Monad.Fix              ( MonadFix(..) ) import           Control.Monad.Free             ( Free(..) ) import           Control.Monad.Trans.Control    ( MonadTransControl(..) ) import qualified Data.Aeson                    as A import           Data.Fix                       ( Fix(..) ) import qualified Data.Text                     as Text-import qualified Data.Text.IO                 as Text import           Lens.Family2                  as X                                                 ( view                                                 , over@@ -84,7 +85,6 @@                                                 , _2                                                 ) import qualified System.FilePath              as FilePath-import Control.Monad.List (foldM)  #if ENABLE_TRACING import qualified Relude.Debug                 as X@@ -207,24 +207,27 @@     mempty {-# inline whenJust #-} --- | Analog for @bool@ or @maybe@, for list-like cons structures.-list-  :: Foldable t-  => b -> (t a -> b) -> t a -> b-list e f l =+isPresent :: Foldable t => t a -> Bool+isPresent = not . null+{-# inline isPresent #-}+++-- | 'maybe'-like eliminator, for foldable empty/inhabited structures.+handlePresence :: Foldable t => b -> (t a -> b) -> t a -> b+handlePresence d f t =   bool-    (f l)-    e-    (null l)-{-# inline list #-}+    d+    (f t)+    (isPresent t)+{-# inline handlePresence #-}  whenText   :: a -> (Text -> a) -> Text -> a whenText e f t =   bool-    (f t)     e-    (Text.null t)+    (f t)+    (not $ Text.null t)  -- | Lambda analog of @maybe@ or @either@ for Free monad. free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b@@ -306,8 +309,8 @@ replaceExtension = coerce FilePath.replaceExtension  -- | 'Path's 'FilePath.readFile'.-readFile :: Path -> IO Text-readFile = Text.readFile . coerce+readFile :: MonadIO m => Path -> m Text+readFile = fmap decodeUtf8 . readFileBS . coerce   -- * Recursion scheme

@@ -5,7 +5,12 @@ {-# language PolyKinds #-} {-# language UndecidableInstances #-} -module Nix.Utils.Fix1 where+module Nix.Utils.Fix1+  ( Fix1(..)+  , Fix1T(..)+  , MonadFix1T+  )+where  import           Nix.Prelude import           Control.Monad.Fix              ( MonadFix )@@ -22,6 +27,7 @@ -- https://gist.github.com/gmalecha/ceb3778b9fdaa4374976e325ac8feced newtype Fix1 (t :: (k -> Type) -> k -> Type) (a :: k) = Fix1 { unFix1 :: t (Fix1 t) a } +deriving instance Generic (Fix1 t a) deriving instance Functor (t (Fix1 t))   => Functor (Fix1 t) deriving instance Applicative (t (Fix1 t))@@ -49,6 +55,7 @@ newtype Fix1T (t :: (k -> Type) -> (Type -> Type) -> k -> Type) (m :: Type -> Type) (a :: k)   = Fix1T { unFix1T :: t (Fix1T t m) m a } +deriving instance Generic (Fix1T t m m) deriving instance Functor (t (Fix1T t m) m)   => Functor (Fix1T t m) deriving instance Applicative (t (Fix1T t m) m)@@ -95,7 +102,6 @@   writeRef r = lift . writeRef r   {-# inline writeRef #-} - instance   ( MonadFix1T t m   , MonadAtomicRef m@@ -109,8 +115,10 @@  newtype Flip (f :: i -> j -> *) (a :: j) (b :: i) = Flip { unFlip :: f b a } --- | Natural Transformations (Included from---   [compdata](https://hackage.haskell.org/package/compdata))+-- | Natural Transformations+--  ( Included from+--   [compdata](https://hackage.haskell.org/package/compdata)+--  ) type (:->) f g = forall a. f a -> g a  class HFunctor f where

@@ -27,7 +27,6 @@                                                 , liftShowsPrec                                                 , showsUnaryWith                                                 , Eq1(liftEq) )-import           Data.Eq.Deriving import qualified Text.Show import           Text.Show                      ( showsPrec                                                 , showString@@ -140,6 +139,16 @@   deriving (Generic, Typeable, Functor)  +-- ** Eq++instance Eq r => Eq (NValueF p m r) where+  (==) (NVConstantF x) (NVConstantF y) = x == y+  (==) (NVStrF      x) (NVStrF      y) = x == y+  (==) (NVPathF     x) (NVPathF     y) = x == y+  (==) (NVListF     x) (NVListF     y) = x == y+  (==) (NVSetF  _   x) (NVSetF _    y) = x == y+  (==) _               _               = False+ -- ** Eq1  instance Eq1 (NValueF p m) where@@ -266,6 +275,12 @@  -- * @__NValue'__@: forming the (F(A)) +-- | NVConstraint constraint the f layer in @NValue'@.+-- It makes bijection between sub category of Hask and Nix Value possible.+-- 'Comonad' enable Nix Value to Hask part.+-- 'Applicative' enable Hask to Nix Value part.+type NVConstraint f = (Comonad f, Applicative f)+ -- | At the time of constructor, the expected arguments to closures are values --   that may contain thunks. The type of such thunks are fixed at that time. newtype NValue' t f m a =@@ -276,13 +291,13 @@     }   deriving (Generic, Typeable, Functor, Foldable) -instance (Comonad f, Show a) => Show (NValue' t f m a) where+instance (NVConstraint f, Show a) => Show (NValue' t f m a) where   show (NValue' (extract -> v)) = show v   -- ** Show1 -instance Comonad f => Show1 (NValue' t f m) where+instance NVConstraint f  => Show1 (NValue' t f m) where   liftShowsPrec sp sl p = \case     NVConstant' atom  -> showsUnaryWith showsPrec             "NVConstantF" p atom     NVStr' ns         -> showsUnaryWith showsPrec             "NVStrF"      p $ ignoreContext ns@@ -378,10 +393,9 @@   -- ** Bijective Hask subcategory <-> @NValue'@--- *** @F: Hask subcategory → NValue'@---+-- *** @F: Hask subcategory <-> NValue'@ -- #mantra#--- $Methods @F: Hask → NValue'@+-- $Patterns @F: Hask <-> NValue'@ -- -- Since Haskell and Nix are both recursive purely functional lazy languages. -- And since recursion-schemes.@@ -396,87 +410,56 @@ -- Since it is a proper way of scientific implementation, we would eventually form a -- lawful functor. ----- Facts of which are seen below:+-- Module pattens use @language PatternSynonyms@: bidirectional synonyms (@<-@),+-- and @ViewPatterns@: (@->@) at the same time.+-- @ViewPatterns Control.Comonad.extract@ extracts+-- from the @NValue (Free (NValueF a))@+-- the @NValueF a@. Which is @NValueF p m r@. Since it extracted from the+-- @NValue@, which is formed by \( (F a -> a) F a \) in the first place.+-- So @NValueF p m r@ which is extracted here, internally holds the next NValue.+--+-- Facts of bijection between Hask subcategory objects and Nix objects,+-- and between Hask subcategory morphisms and Nix morphisms are seen blow:  --- | Haskell constant to the Nix constant,-mkNVConstant' :: Applicative f-  => NAtom-  -> NValue' t f m r-mkNVConstant' = NValue' . pure . NVConstantF- -- | Using of Nulls is generally discouraged (in programming language design et al.), but, if you need it.-nvNull' :: Applicative f-  => NValue' t f m r-nvNull' = mkNVConstant' NNull+pattern NVNull' :: NVConstraint w => NValue' t w m a+pattern NVNull' = NVConstant' NNull +-- | Haskell constant to the Nix constant,+pattern NVConstant' :: NVConstraint w => NAtom -> NValue' t w m a+pattern NVConstant' x <- NValue' (extract -> NVConstantF x)+  where NVConstant' = NValue' . pure . NVConstantF  -- | Haskell text & context to the Nix text & context,-mkNVStr' :: Applicative f-  => NixString-  -> NValue' t f m r-mkNVStr' = NValue' . pure . NVStrF-+pattern NVStr' :: NVConstraint w => NixString -> NValue' t w m a+pattern NVStr' ns <- NValue' (extract -> NVStrF ns)+  where NVStr' = NValue' . pure . NVStrF  -- | Haskell @Path@ to the Nix path,-mkNVPath' :: Applicative f-  => Path-  -> NValue' t f m r-mkNVPath' = NValue' . pure . NVPathF . coerce-+pattern NVPath' :: NVConstraint w => Path -> NValue' t w m a+pattern NVPath' x <- NValue' (extract -> NVPathF x)+  where NVPath' = NValue' . pure . NVPathF . coerce  -- | Haskell @[]@ to the Nix @[]@,-mkNVList' :: Applicative f-  => [r]-  -> NValue' t f m r-mkNVList' = NValue' . pure . NVListF-+pattern NVList' :: NVConstraint w => [a] -> NValue' t w m a+pattern NVList' l <- NValue' (extract -> NVListF l)+  where NVList' = NValue' . pure . NVListF  -- | Haskell key-value to the Nix key-value,-mkNVSet' :: Applicative f-  => PositionSet-  -> AttrSet r-  -> NValue' t f m r-mkNVSet' p s = NValue' $ pure $ NVSetF p s-+pattern NVSet' :: NVConstraint w => PositionSet -> AttrSet a -> NValue' t w m a+pattern NVSet' p s <- NValue' (extract -> NVSetF p s)+  where NVSet' p s = NValue' $ pure $ NVSetF p s  -- | Haskell closure to the Nix closure,-mkNVClosure' :: (Applicative f, Functor m)-  => Params ()-  -> (NValue t f m-      -> m r-    )-  -> NValue' t f m r-mkNVClosure' x f = NValue' $ pure $ NVClosureF x f-+pattern NVClosure' :: NVConstraint w => Params () -> (NValue t w m -> m a) -> NValue' t w m a+pattern NVClosure' x f <- NValue' (extract -> NVClosureF x f)+  where NVClosure' x f = NValue' $ pure $ NVClosureF x f  -- | Haskell functions to the Nix functions!-mkNVBuiltin' :: (Applicative f, Functor m)-  => VarName-  -> (NValue t f m -> m r)-  -> NValue' t f m r-mkNVBuiltin' name f = NValue' $ pure $ NVBuiltinF name f----- So above we have maps of Hask subcategory objects to Nix objects,--- and Hask subcategory morphisms to Nix morphisms.---- *** @F: NValue -> NValue'@---- | Module pattens use @language PatternSynonyms@: unidirectional synonyms (@<-@),--- and @ViewPatterns@: (@->@) at the same time.--- @ViewPatterns Control.Comonad.extract@ extracts--- from the @NValue (Free (NValueF a))@--- the @NValueF a@. Which is @NValueF p m r@. Since it extracted from the--- @NValue@, which is formed by \( (F a -> a) F a \) in the first place.--- So @NValueF p m r@ which is extracted here, internally holds the next NValue.-pattern NVConstant' x <- NValue' (extract -> NVConstantF x)-pattern NVStr' ns <- NValue' (extract -> NVStrF ns)-pattern NVPath' x <- NValue' (extract -> NVPathF x)-pattern NVList' l <- NValue' (extract -> NVListF l)-pattern NVSet' p s <- NValue' (extract -> NVSetF p s)-pattern NVClosure' x f <- NValue' (extract -> NVClosureF x f)+pattern NVBuiltin' :: NVConstraint w => VarName -> (NValue t w m -> m a) -> NValue' t w m a pattern NVBuiltin' name f <- NValue' (extract -> NVBuiltinF name f)+  where NVBuiltin' name f = NValue' $ pure $ NVBuiltinF name f {-# complete NVConstant', NVStr', NVPath', NVList', NVSet', NVClosure', NVBuiltin' #-}  @@ -554,7 +537,7 @@   => (forall x . u m x -> m x)   -> NValue t f m   -> NValue t f (u m)-liftNValue = (`hoistNValue` lift)+liftNValue f = hoistNValue f lift   -- *** MonadTransUnlift@@ -574,72 +557,12 @@ -- The morphisms of the functor @Hask → NValue@. -- Continuation of the mantra: "Nix.Value#mantra" ---- | Life of a Haskell thunk to the life of a Nix thunk,-mkNVThunk :: Applicative f-  => t-  -> NValue t f m-mkNVThunk = Pure----- | Life of a Haskell constant to the life of a Nix constant,-mkNVConstant :: Applicative f-  => NAtom-  -> NValue t f m-mkNVConstant = Free . mkNVConstant'- -- | Using of Nulls is generally discouraged (in programming language design et al.), but, if you need it.-nvNull :: Applicative f-  => NValue t f m-nvNull = mkNVConstant NNull --- | Life of a Haskell sting & context to the life of a Nix string & context,-mkNVStr :: Applicative f-  => NixString-  -> NValue t f m-mkNVStr = Free . mkNVStr'--mkNVStrWithoutContext :: Applicative f+mkNVStrWithoutContext :: NVConstraint f   => Text   -> NValue t f m-mkNVStrWithoutContext = mkNVStr . mkNixStringWithoutContext----- | Life of a Haskell FilePath to the life of a Nix path-mkNVPath :: Applicative f-  => Path-  -> NValue t f m-mkNVPath = Free . mkNVPath'---mkNVList :: Applicative f-  => [NValue t f m]-  -> NValue t f m-mkNVList = Free . mkNVList'---mkNVSet :: Applicative f-  => PositionSet-  -> AttrSet (NValue t f m)-  -> NValue t f m-mkNVSet p s = Free $ mkNVSet' p s--mkNVClosure :: (Applicative f, Functor m)-  => Params ()-  -> (NValue t f m-      -> m (NValue t f m)-    )-  -> NValue t f m-mkNVClosure x f = Free $ mkNVClosure' x f---mkNVBuiltin :: (Applicative f, Functor m)-  => VarName-  -> (NValue t f m-    -> m (NValue t f m)-    )-  -> NValue t f m-mkNVBuiltin name f = Free $ mkNVBuiltin' name f+mkNVStrWithoutContext = NVStr . mkNixStringWithoutContext   builtin@@ -650,7 +573,7 @@     -> m (NValue t f m)     ) -- ^ unary function   -> m (NValue t f m)-builtin = (pure .) . mkNVBuiltin+builtin = (pure .) . NVBuiltin   builtin2@@ -680,20 +603,22 @@  -- *** @F: Evaluation -> NValue@ -pattern NVThunk t <- Pure t-pattern NVValue v <- Free v-{-# complete NVThunk, NVValue #-}-pattern NVConstant x <- Free (NVConstant' x)-pattern NVStr ns <- Free (NVStr' ns)-pattern NVPath x <- Free (NVPath' x)-pattern NVList l <- Free (NVList' l)-pattern NVSet s x <- Free (NVSet' s x)-pattern NVClosure x f <- Free (NVClosure' x f)-pattern NVBuiltin name f <- Free (NVBuiltin' name f)+pattern NVNull = Free NVNull'+pattern NVThunk t = Pure t+pattern NVValue v = Free v+{-# complete NVThunk, NVValue, NVNull #-}+pattern NVConstant x = Free (NVConstant' x)+pattern NVStr ns = Free (NVStr' ns)+pattern NVPath x = Free (NVPath' x)+pattern NVList l = Free (NVList' l)+pattern NVSet s x = Free (NVSet' s x)+pattern NVBuiltin name f = Free (NVBuiltin' name f)+pattern NVClosure x f = Free (NVClosure' x f) {-# complete NVThunk, NVConstant, NVStr, NVPath, NVList, NVSet, NVClosure, NVBuiltin #-}   + -- * @TStringContext@  data TStringContext = NoContext | HasContext@@ -784,7 +709,7 @@   | Expectation ValueType (NValue t f m)  deriving Typeable -deriving instance (Comonad f, Show t) => Show (ValueFrame t f m)+deriving instance (NVConstraint f, Show t) => Show (ValueFrame t f m)   -- * @MonadDataContext@@@ -799,10 +724,17 @@  instance MonadDataErrorContext t f m => Exception (ValueFrame t f m) ++-- * @instance Eq NValue'@++instance (Eq a, Comonad f) => Eq (NValue' t f m a) where+    (==) (NValue' (extract -> x)) (NValue' (extract -> y)) = x == y+ -- * @instance Eq1 NValue'@  -- TH derivable works only after MonadDataContext-$(deriveEq1 ''NValue')+instance Comonad f => Eq1 (NValue' t f m) where+  liftEq eq (NValue' (extract -> x)) (NValue' (extract -> y)) = liftEq eq x y   -- * @NValueF@ traversals, getter & setters

@@ -31,9 +31,9 @@   -> m () checkComparable x y =   case (x, y) of-    (NVConstant (NFloat _), NVConstant (NInt   _)) -> stub-    (NVConstant (NInt   _), NVConstant (NFloat _)) -> stub     (NVConstant (NInt   _), NVConstant (NInt   _)) -> stub+    (NVConstant (NInt   _), NVConstant (NFloat _)) -> stub+    (NVConstant (NFloat _), NVConstant (NInt   _)) -> stub     (NVConstant (NFloat _), NVConstant (NFloat _)) -> stub     (NVStr       _        , NVStr       _        ) -> stub     (NVPath      _        , NVPath      _        ) -> stub@@ -62,7 +62,8 @@             (Data.Semialign.align fa fb)  alignEq :: (Align f, Traversable f) => (a -> b -> Bool) -> f a -> f b -> Bool-alignEq eq fa fb = runIdentity $ alignEqM ((Identity .) . eq) fa fb+alignEq eq fa fb =+  runIdentity $ alignEqM ((Identity .) . eq) fa fb  isDerivationM   :: Monad m@@ -73,18 +74,14 @@   -> m Bool isDerivationM f m =   maybe-    (pure False)-    p-    (HashMap.Lazy.lookup "type" m)- where-  p t =-    maybe-      -- We should probably really make sure the context is empty here-      -- but the C++ implementation ignores it.-      False-      ((==) "derivation" . ignoreContext)-      <$> f t+    False+    -- (2019-03-18):+    -- We should probably really make sure the context is empty here+    -- but the C++ implementation ignores it.+    ((==) "derivation" . ignoreContext)+    . join <$> traverse f (HashMap.Lazy.lookup "type" m) + isDerivation   :: Monad m   => ( t@@ -141,21 +138,14 @@   -> AttrSet t   -> m Bool compareAttrSetsM f eq lm rm =-  do-    l <- isDerivationM f lm-    bool-      compareAttrs-      (do-        r <- isDerivationM f rm-        case r of-          True-            | Just lp <- HashMap.Lazy.lookup "outPath" lm,-              Just rp <- HashMap.Lazy.lookup "outPath" rm -> eq lp rp-          _ -> compareAttrs-      )-      l+  bool+    compareAttrs+    (fromMaybe compareAttrs equalOutPaths)+    =<< areDerivations  where-  compareAttrs = alignEqM eq lm rm+  areDerivations = on (liftA2 (&&)) (isDerivationM f              ) lm rm+  equalOutPaths  = on (liftA2   eq) (HashMap.Lazy.lookup "outPath") lm rm+  compareAttrs   =     alignEqM eq                                  lm rm  compareAttrSets   :: (t -> Maybe NixString)@@ -163,11 +153,12 @@   -> AttrSet t   -> AttrSet t   -> Bool-compareAttrSets f eq lm rm = runIdentity-  $ compareAttrSetsM (Identity . f) ((Identity .) . eq) lm rm+compareAttrSets f eq lm rm =+  runIdentity $ compareAttrSetsM (Identity . f) ((Identity .) . eq) lm rm  valueEqM-  :: (MonadThunk t m (NValue t f m), Comonad f)+  :: forall t f m+   . (MonadThunk t m (NValue t f m), NVConstraint f)   => NValue t f m   -> NValue t f m   -> m Bool@@ -176,12 +167,13 @@ valueEqM x@(Free _) (  Pure y) = (`thunkEqM` y) =<< thunk (pure x) valueEqM (Free (NValue' (extract -> x))) (Free (NValue' (extract -> y))) =   valueFEqM-    (compareAttrSetsM f valueEqM)+    (compareAttrSetsM findNVStr valueEqM)     valueEqM     x     y  where-  f =+  findNVStr :: NValue t f m -> m (Maybe NixString)+  findNVStr =     free       (pure .         (\case@@ -195,7 +187,9 @@           _        -> mempty       ) -thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool+-- This function has mutual recursion with `valueEqM`, and this function so far is not used across the project,+-- but that one is.+thunkEqM :: (MonadThunk t m (NValue t f m), NVConstraint f) => t -> t -> m Bool thunkEqM lt rt =   do     lv <- force lt@@ -203,9 +197,10 @@      let       unsafePtrEq =-        case (lt, rt) of-          (thunkId -> lid, thunkId -> rid) | lid == rid -> pure True-          _                                             -> valueEqM lv rv+        bool+          (valueEqM lv rv)+          (pure True)+          $ on (==) thunkId lt rt      case (lv, rv) of       (NVClosure _ _, NVClosure _ _) -> unsafePtrEq

@@ -534,6 +534,11 @@     "true"     "let nested = { y = _: (let x = x; in x); }; in nested == nested" +case_if_follow_by_with = +  constantEqualText+    "1"+    "let x = { a = true; b = 2; }; in if with x; a then 1 else 2"+ -- Regression test for #527  case_add_string_thunk_left =@@ -646,7 +651,7 @@             (normalForm =<< nixEvalExprLoc mempty a')         )         (\(_ :: NixException) -> pure True)-    unless errored $ assertFailure "Did not catch nix exception"+    when (not errored) $ assertFailure "Did not catch nix exception"  sameFreeVars :: Text -> [VarName] -> Assertion sameFreeVars a xs =@@ -657,7 +662,7 @@     assertEqual mempty (S.fromList xs) free'  maskedFiles :: [Path]-maskedFiles = one "builtins.fetchurl-01.nix"+maskedFiles = mempty  testDir :: Path testDir = "tests/eval-compare"

@@ -35,7 +35,7 @@ ensureLangTestsPresent :: Assertion ensureLangTestsPresent = do   exist <- fileExist "data/nix/tests/local.mk"-  unless exist $+  when (not exist) $     errorWithoutStackTrace $ String.unlines       [ "Directory data/nix does not have any files."       , "Did you forget to run"@@ -56,26 +56,30 @@           time <- getCurrentTime           runWithBasicEffectsIO (defaultOptions time) $             Nix.nixEvalExprLoc mempty expr-        let dir = ignoreContext ns-        exists <- fileExist $ toString dir-        unless exists $+        let dir = toString $ ignoreContext ns+        exists <- fileExist dir+        when (not exists) $           errorWithoutStackTrace $             "Directory " <> show dir <> " does not exist"-        files <- globDir1 (compile "**/*.nix") $ toString dir-        when (null files) $-          errorWithoutStackTrace $-            "Directory " <> show dir <> " does not have any files"-        for_ files $ \file ->-          unless ("azure-cli/default.nix" `isSuffixOf` file ||-                  "os-specific/linux/udisks/2-default.nix"  `isSuffixOf` file) $ do-            -- Parse and deepseq the resulting expression tree, to ensure the-            -- parser is fully executed.-            _ <- consider (coerce file) (parseNixFileLoc (coerce file)) $ Exc.evaluate . force-            stub+        files <- globDir1 (compile "**/*.nix") dir+        handlePresence+          (errorWithoutStackTrace $+            "Directory " <> show dir <> " does not have any files")+          (traverse_+            (\ path ->+              let notEndsIn suffix = not $ isSuffixOf suffix path in+              when+                (on (&&) notEndsIn "azure-cli/default.nix" "os-specific/linux/udisks/2-default.nix")+                $ -- Parse and deepseq the resulting expression tree, to ensure the+                  -- parser is fully executed.+                  mempty <$ consider (coerce path) (parseNixFileLoc (coerce path)) $ Exc.evaluate . force+            )+          )+          files     v -> fail $ "Unexpected parse from default.nix: " <> show v  where   getExpr   k m =-    let Just (Just r) = lookup k m in+    let Just r = join $ lookup k m in     r   getString k m =     let Fix (NStr (DoubleQuoted [Plain str])) = getExpr k m in

@@ -383,7 +383,15 @@     "if true then false else false else"     "1 + 2 then" +-- ** If follow by with +case_if_follow_by_with = checks +  (+    mkLets (one $ "x" $= mkNonRecSet ["a" $= mkBool True, "b" $= mkInt 2 ]) +      $ mkIf (mkWith (mkSym "x") (mkSym "a")) (mkInt 1) (mkInt 2)+    , "let x = { a = true; b = 2; }; in if with x; a then 1 else 2"+  )+ -- ** Literal expressions in vals  case_identifier_keyword_prefix_invariants =@@ -649,7 +657,7 @@  case_simpleLoc =   let-    mkSPos = on (SourcePos "<string>") mkPos+    mkSPos = on (NSourcePos "<string>") (coerce . mkPos)     mkSpan = on SrcSpan (uncurry mkSPos)   in     assertParseTextLoc [text|let@@ -662,12 +670,10 @@       (one $         NamedVar           (one $ StaticKey "foo")-          (NBinaryAnn+          (NAppAnn             (mkSpan (2, 7) (3, 15))-            NApp-            (NBinaryAnn+            (NAppAnn               (mkSpan (2, 7) (3, 9))-              NApp               (NSymAnn (mkSpan (2, 7) (2, 10)) "bar")               (NSymAnn (mkSpan (3, 6) (3, 9 )) "baz")             )

@@ -22,7 +22,6 @@ import           Prettyprinter import           Test.Tasty import           Test.Tasty.Hedgehog-import           Text.Megaparsec                ( Pos ) import qualified Text.Show.Pretty              as PS  asciiString :: MonadGen m => m String@@ -35,16 +34,16 @@ asciiVarName = coerce <$> asciiText  -- Might want to replace this instance with a constant value-genPos :: Gen Pos-genPos = mkPos <$> Gen.int (Range.linear 1 256)+genNPos :: Gen NPos+genNPos = fmap coerce $ mkPos <$> Gen.int (Range.linear 1 256) -genSourcePos :: Gen SourcePos-genSourcePos =+genNSourcePos :: Gen NSourcePos+genNSourcePos =   join (liftA3-      SourcePos-      asciiString+      NSourcePos+      (fmap coerce asciiString)     )-    genPos+    genNPos  genKeyName :: Gen (NKeyName NExpr) genKeyName =@@ -59,11 +58,11 @@   [ liftA3 NamedVar       genAttrPath       genExpr-      genSourcePos+      genNSourcePos   , liftA3 Inherit       (Gen.maybe genExpr)       (Gen.list (Range.linear 0 5) asciiVarName)-      genSourcePos+      genNSourcePos   ]  genString :: Gen (NString NExpr)