From c520632c066b97114c91068cd253abdc006a6ae9 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Fri, 13 Aug 2021 21:19:02 +0300 Subject: [PATCH 01/21] cabal: default to ScopeTypeVariables It is used in ~50% of modules & looks a standard feature at this point. --- hnix.cabal | 4 ++++ main/Main.hs | 1 - main/Repl.hs | 1 - src/Nix.hs | 1 - src/Nix/Builtins.hs | 1 - src/Nix/Cited/Basic.hs | 1 - src/Nix/Convert.hs | 1 - src/Nix/Effects/Basic.hs | 1 - src/Nix/Effects/Derivation.hs | 1 - src/Nix/Eval.hs | 1 - src/Nix/Exec.hs | 1 - src/Nix/Frames.hs | 1 - src/Nix/Fresh/Basic.hs | 1 - src/Nix/Lint.hs | 1 - src/Nix/Normal.hs | 1 - src/Nix/Pretty.hs | 1 - src/Nix/Reduce.hs | 1 - src/Nix/Render.hs | 1 - src/Nix/Render/Frame.hs | 1 - src/Nix/Scope.hs | 1 - src/Nix/Standard.hs | 1 - src/Nix/Thunk/Basic.hs | 1 - src/Nix/Type/Infer.hs | 1 - src/Nix/Utils.hs | 1 - src/Nix/Value.hs | 1 - src/Nix/Value/Equal.hs | 1 - src/Nix/Var.hs | 1 - src/Nix/XML.hs | 1 - tests/EvalTests.hs | 1 - tests/NixLanguageTests.hs | 1 - tests/TestCommon.hs | 1 - 31 files changed, 4 insertions(+), 30 deletions(-) diff --git a/hnix.cabal b/hnix.cabal index 14a5eb092..80411e7c5 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -477,6 +477,7 @@ library , DeriveLift , FlexibleContexts , FlexibleInstances + , ScopedTypeVariables , StandaloneDeriving , TypeApplications , TypeSynonymInstances @@ -544,6 +545,7 @@ executable hnix , DeriveLift , FlexibleContexts , FlexibleInstances + , ScopedTypeVariables , StandaloneDeriving , TypeApplications , TypeSynonymInstances @@ -623,6 +625,7 @@ test-suite hnix-tests , DeriveLift , FlexibleContexts , FlexibleInstances + , ScopedTypeVariables , StandaloneDeriving , TypeApplications , TypeSynonymInstances @@ -676,6 +679,7 @@ benchmark hnix-benchmarks , DeriveLift , FlexibleContexts , FlexibleInstances + , ScopedTypeVariables , StandaloneDeriving , TypeApplications , TypeSynonymInstances diff --git a/main/Main.hs b/main/Main.hs index 625ab44ac..e4eee3abe 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -1,5 +1,4 @@ {-# language MultiWayIf #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# language RecordWildCards #-} diff --git a/main/Repl.hs b/main/Repl.hs index 707725d69..61efef2db 100644 --- a/main/Repl.hs +++ b/main/Repl.hs @@ -8,7 +8,6 @@ -} {-# language MultiWayIf #-} -{-# language ScopedTypeVariables #-} module Repl ( main diff --git a/src/Nix.hs b/src/Nix.hs index 81b3b4084..9a4117b7e 100644 --- a/src/Nix.hs +++ b/src/Nix.hs @@ -1,4 +1,3 @@ -{-# language ScopedTypeVariables #-} module Nix ( module Nix.Cache diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index d60c1d8a3..a258cc997 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -7,7 +7,6 @@ {-# language MultiWayIf #-} {-# language PartialTypeSignatures #-} {-# language QuasiQuotes #-} -{-# language ScopedTypeVariables #-} {-# 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}@ diff --git a/src/Nix/Cited/Basic.hs b/src/Nix/Cited/Basic.hs index a154a6d0a..8f7265e49 100644 --- a/src/Nix/Cited/Basic.hs +++ b/src/Nix/Cited/Basic.hs @@ -1,5 +1,4 @@ {-# language GeneralizedNewtypeDeriving #-} -{-# language ScopedTypeVariables #-} {-# language UndecidableInstances #-} {-# language PatternSynonyms #-} diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index cd7c11d04..d815e0a69 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -1,7 +1,6 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} {-# language IncoherentInstances #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# language UndecidableInstances #-} diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs index 628b31634..065114a89 100644 --- a/src/Nix/Effects/Basic.hs +++ b/src/Nix/Effects/Basic.hs @@ -1,5 +1,4 @@ {-# language CPP #-} -{-# language ScopedTypeVariables #-} module Nix.Effects.Basic where diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs index ec15af47d..902f50b11 100644 --- a/src/Nix/Effects/Derivation.hs +++ b/src/Nix/Effects/Derivation.hs @@ -1,7 +1,6 @@ {-# language DataKinds #-} {-# language NamedFieldPuns #-} {-# language RecordWildCards #-} -{-# language ScopedTypeVariables #-} {-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@ module Nix.Effects.Derivation ( defaultDerivationStrict ) where diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs index c0eea21cc..408162b5a 100644 --- a/src/Nix/Eval.hs +++ b/src/Nix/Eval.hs @@ -1,7 +1,6 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} {-# language RankNTypes #-} -{-# language ScopedTypeVariables #-} diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index 419a7e953..b9b3ac0bd 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -3,7 +3,6 @@ {-# language ConstraintKinds #-} {-# language PartialTypeSignatures #-} {-# language RankNTypes #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# language UndecidableInstances #-} diff --git a/src/Nix/Frames.hs b/src/Nix/Frames.hs index 40418d5e6..6045d865e 100644 --- a/src/Nix/Frames.hs +++ b/src/Nix/Frames.hs @@ -1,6 +1,5 @@ {-# language ConstraintKinds #-} {-# language ExistentialQuantification #-} -{-# language ScopedTypeVariables #-} -- | Definitions of Frames. Frames are messages that gather and ship themself with a context related to the message. For example - the message about some exception would also gather, keep and bring with it the tracing information. module Nix.Frames diff --git a/src/Nix/Fresh/Basic.hs b/src/Nix/Fresh/Basic.hs index 1fcab9b94..1098afb74 100644 --- a/src/Nix/Fresh/Basic.hs +++ b/src/Nix/Fresh/Basic.hs @@ -1,5 +1,4 @@ {-# language CPP #-} -{-# language ScopedTypeVariables #-} {-# options_ghc -Wno-orphans #-} diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 5bcbfe88d..4aebfb1f7 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -3,7 +3,6 @@ {-# language DataKinds #-} {-# language GADTs #-} {-# language GeneralizedNewtypeDeriving #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# language UndecidableInstances #-} diff --git a/src/Nix/Normal.hs b/src/Nix/Normal.hs index 8d448da3d..2d5cfe0e7 100644 --- a/src/Nix/Normal.hs +++ b/src/Nix/Normal.hs @@ -2,7 +2,6 @@ {-# language ConstraintKinds #-} {-# language DataKinds #-} {-# language GADTs #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# language RankNTypes #-} diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index be0f138f8..bd644dc40 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -1,5 +1,4 @@ {-# language CPP #-} -{-# language ScopedTypeVariables #-} {-# options_ghc -fno-warn-name-shadowing #-} diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs index 919cde1a1..fd295611a 100644 --- a/src/Nix/Reduce.hs +++ b/src/Nix/Reduce.hs @@ -3,7 +3,6 @@ {-# language ConstraintKinds #-} {-# language GeneralizedNewtypeDeriving #-} {-# language PartialTypeSignatures #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# options_ghc -fno-warn-name-shadowing #-} diff --git a/src/Nix/Render.hs b/src/Nix/Render.hs index 03427aa58..aebbb04eb 100644 --- a/src/Nix/Render.hs +++ b/src/Nix/Render.hs @@ -3,7 +3,6 @@ {-# language ConstraintKinds #-} {-# language DefaultSignatures #-} {-# language GADTs #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# language TypeOperators #-} {-# language MultiWayIf #-} diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index 3b450f358..dbe882a8b 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -3,7 +3,6 @@ {-# language ConstraintKinds #-} {-# language MultiWayIf #-} {-# language GADTs #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} diff --git a/src/Nix/Scope.hs b/src/Nix/Scope.hs index 19c58c613..e011ffd27 100644 --- a/src/Nix/Scope.hs +++ b/src/Nix/Scope.hs @@ -2,7 +2,6 @@ {-# language ConstraintKinds #-} {-# language FunctionalDependencies #-} {-# language GeneralizedNewtypeDeriving #-} -{-# language ScopedTypeVariables #-} module Nix.Scope where diff --git a/src/Nix/Standard.hs b/src/Nix/Standard.hs index 1c67c97ef..19a06ed31 100644 --- a/src/Nix/Standard.hs +++ b/src/Nix/Standard.hs @@ -1,6 +1,5 @@ {-# language TypeFamilies #-} {-# language CPP #-} -{-# language ScopedTypeVariables #-} {-# language GeneralizedNewtypeDeriving #-} {-# language UndecidableInstances #-} diff --git a/src/Nix/Thunk/Basic.hs b/src/Nix/Thunk/Basic.hs index 561377a34..0cb5d8425 100644 --- a/src/Nix/Thunk/Basic.hs +++ b/src/Nix/Thunk/Basic.hs @@ -1,5 +1,4 @@ {-# language ConstraintKinds #-} -{-# language ScopedTypeVariables #-} {-# language UndecidableInstances #-} {-# options_ghc -Wno-unused-do-bind #-} diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs index 5c065d165..7cac5bc78 100644 --- a/src/Nix/Type/Infer.hs +++ b/src/Nix/Type/Infer.hs @@ -5,7 +5,6 @@ {-# language ExistentialQuantification #-} {-# language GeneralizedNewtypeDeriving #-} {-# language RankNTypes #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# options_ghc -Wno-name-shadowing #-} diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs index 005a34f90..0207937e5 100644 --- a/src/Nix/Utils.hs +++ b/src/Nix/Utils.hs @@ -1,6 +1,5 @@ {-# language CPP #-} {-# language FunctionalDependencies #-} -{-# language ScopedTypeVariables #-} {-# language TemplateHaskell #-} {-# language GeneralizedNewtypeDeriving #-} diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index 051e8e053..ac895aa3d 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -4,7 +4,6 @@ {-# language ConstraintKinds #-} {-# language PatternSynonyms #-} {-# language RankNTypes #-} -{-# language ScopedTypeVariables #-} {-# language TemplateHaskell #-} {-# options_ghc -Wno-missing-signatures #-} diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs index b840ef630..2f4b86386 100644 --- a/src/Nix/Value/Equal.hs +++ b/src/Nix/Value/Equal.hs @@ -1,6 +1,5 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} -{-# language ScopedTypeVariables #-} {-# language TypeFamilies #-} {-# options_ghc -Wno-missing-pattern-synonym-signatures #-} diff --git a/src/Nix/Var.hs b/src/Nix/Var.hs index 09c142265..5f789e2ab 100644 --- a/src/Nix/Var.hs +++ b/src/Nix/Var.hs @@ -1,6 +1,5 @@ {-# language AllowAmbiguousTypes #-} {-# language ConstraintKinds #-} -{-# language ScopedTypeVariables #-} {-# options_ghc -Wno-orphans #-} {-# options_ghc -Wno-unused-top-binds #-} diff --git a/src/Nix/XML.hs b/src/Nix/XML.hs index c5d547a77..6eeb9b2b6 100644 --- a/src/Nix/XML.hs +++ b/src/Nix/XML.hs @@ -1,4 +1,3 @@ -{-# language ScopedTypeVariables #-} module Nix.XML ( toXML ) diff --git a/tests/EvalTests.hs b/tests/EvalTests.hs index 888a3ec7a..b5140d120 100644 --- a/tests/EvalTests.hs +++ b/tests/EvalTests.hs @@ -1,5 +1,4 @@ {-# language QuasiQuotes #-} -{-# language ScopedTypeVariables #-} {-# language TemplateHaskell #-} {-# options_ghc -Wno-missing-signatures #-} diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index 0fcdb0f7d..a80e23fb4 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -1,4 +1,3 @@ -{-# language ScopedTypeVariables #-} module NixLanguageTests (genTests) where diff --git a/tests/TestCommon.hs b/tests/TestCommon.hs index a392ea627..93a935eff 100644 --- a/tests/TestCommon.hs +++ b/tests/TestCommon.hs @@ -1,5 +1,4 @@ {-# language PartialTypeSignatures #-} -{-# language ScopedTypeVariables #-} module TestCommon where From 4d727995b762fb2e6c23c5859182edd9f45e6da5 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Fri, 13 Aug 2021 21:20:06 +0300 Subject: [PATCH 02/21] String.Coerce: coerceToString: reduce demand --- src/Nix/String/Coerce.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Nix/String/Coerce.hs b/src/Nix/String/Coerce.hs index a05944f3b..111e846d8 100644 --- a/src/Nix/String/Coerce.hs +++ b/src/Nix/String/Coerce.hs @@ -75,7 +75,7 @@ coerceToString call ctsm clevel = go castToNixString "" -- NVConstant: NAtom (NURI Text) is not matched NVList l -> - nixStringUnwords <$> traverse (go <=< demand) l + nixStringUnwords <$> traverse go l v -> coerceStringy v coerceStringy x' = From dbdd30b3e067702c0b53f22cc5dae4bd633123d2 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Fri, 13 Aug 2021 21:20:48 +0300 Subject: [PATCH 03/21] Exec: m refactor --- src/Nix/Exec.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index b9b3ac0bd..7799bc02c 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -259,8 +259,7 @@ instance MonadNix e t f m => MonadEval (NValue t f m) m where (nverr $ Assertion span c) (do scope <- currentScopes - let f = join (addProvenance . Provenance scope . NAssertAnnF span (pure c) . pure) - f <$> body + join (addProvenance . Provenance scope . NAssertAnnF span (pure c) . pure) <$> body ) b From 663a53e24f93f907fabf2151a226aa5f89823fb9 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Fri, 13 Aug 2021 21:23:29 +0300 Subject: [PATCH 04/21] cabal: expose Prelude module --- hnix.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/hnix.cabal b/hnix.cabal index 80411e7c5..8e40eb33c 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -341,6 +341,7 @@ flag profiling library exposed-modules: + Prelude Nix Nix.Atoms Nix.Builtins From 0864e1acf397aa9dd8f74a80cd36e9869d09a583 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 14 Aug 2021 01:42:29 +0300 Subject: [PATCH 05/21] treewide: merge Prelude with Utils This allows to achieve Zen of Text<->String & Path<->FilePath. Set of functions for Text & Path now can be formed & exported. --- benchmarks/ParserBench.hs | 1 - hnix.cabal | 5 ---- main/Main.hs | 20 ++++++--------- main/Repl.hs | 44 +++++++++++++++++++------------- src/Nix.hs | 1 - src/Nix/Builtins.hs | 2 -- src/Nix/Cache.hs | 1 - src/Nix/Cited/Basic.hs | 2 -- src/Nix/Context.hs | 1 - src/Nix/Convert.hs | 17 ++++++++++-- src/Nix/Effects.hs | 12 +++------ src/Nix/Effects/Basic.hs | 4 +-- src/Nix/Effects/Derivation.hs | 3 +-- src/Nix/Eval.hs | 2 +- src/Nix/Exec.hs | 1 - src/Nix/Expr/Shorthands.hs | 1 - src/Nix/Expr/Strings.hs | 1 - src/Nix/Expr/Types.hs | 1 - src/Nix/Expr/Types/Annotated.hs | 1 - src/Nix/Frames.hs | 6 ----- src/Nix/Json.hs | 1 - src/Nix/Lint.hs | 9 +++---- src/Nix/Normal.hs | 2 -- src/Nix/Parser.hs | 3 +-- src/Nix/Pretty.hs | 1 - src/Nix/Reduce.hs | 1 - src/Nix/Render.hs | 19 +++++--------- src/Nix/Render/Frame.hs | 3 +-- src/Nix/Scope.hs | 1 - src/Nix/Standard.hs | 2 -- src/Nix/String.hs | 1 - src/Nix/String/Coerce.hs | 1 - src/Nix/TH.hs | 1 + src/Nix/Thunk/Basic.hs | 2 -- src/Nix/Type/Infer.hs | 1 - src/Nix/Value.hs | 2 -- src/Nix/Value/Equal.hs | 5 +--- src/Nix/XML.hs | 1 - src/{Nix/Utils.hs => Prelude.hs} | 25 +++++++++++++++--- tests/EvalTests.hs | 1 - tests/Main.hs | 2 +- tests/NixLanguageTests.hs | 1 - tests/ParserTests.hs | 1 - tests/PrettyParseTests.hs | 1 - tests/TestCommon.hs | 1 - 45 files changed, 93 insertions(+), 121 deletions(-) rename src/{Nix/Utils.hs => Prelude.hs} (88%) diff --git a/benchmarks/ParserBench.hs b/benchmarks/ParserBench.hs index 9f98b9e59..84ed1dcfd 100644 --- a/benchmarks/ParserBench.hs +++ b/benchmarks/ParserBench.hs @@ -1,6 +1,5 @@ module ParserBench (benchmarks) where -import Nix.Utils import Nix.Parser import Criterion diff --git a/hnix.cabal b/hnix.cabal index 8e40eb33c..cbc20e41d 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -384,7 +384,6 @@ library Nix.Type.Env Nix.Type.Infer Nix.Type.Type - Nix.Utils Nix.Utils.Fix1 Nix.Value Nix.Value.Equal @@ -399,7 +398,6 @@ library src mixins: base hiding (Prelude) - , relude (Relude as Prelude) , relude ghc-options: -Wall @@ -534,7 +532,6 @@ executable hnix , time mixins: base hiding (Prelude) - , relude (Relude as Prelude) , relude default-extensions: OverloadedStrings @@ -582,7 +579,6 @@ test-suite hnix-tests TestCommon mixins: base hiding (Prelude) - , relude (Relude as Prelude) , relude hs-source-dirs: tests @@ -654,7 +650,6 @@ benchmark hnix-benchmarks benchmarks mixins: base hiding (Prelude) - , relude (Relude as Prelude) , relude ghc-options: -Wall diff --git a/main/Main.hs b/main/Main.hs index e4eee3abe..e3f2bb13e 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -4,20 +4,16 @@ module Main ( main ) where -import Nix.Utils +import Relude as Prelude ( force ) import Control.Comonad ( extract ) import qualified Control.Exception as Exception import GHC.Err ( errorWithoutStackTrace ) import Control.Monad.Free import Control.Monad.Ref ( MonadRef(readRef) ) import Control.Monad.Catch -import System.IO ( hPutStrLn - , getContents - ) +import System.IO ( hPutStrLn ) import qualified Data.HashMap.Lazy as M import qualified Data.Map as Map -import Data.Maybe ( fromJust ) -import qualified Data.String as String import Data.Time import qualified Data.Text.IO as Text import Text.Show.Pretty ( ppShow ) @@ -55,14 +51,14 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl execContentsFilesOrRepl :: StandardT (StdIdT IO) () execContentsFilesOrRepl = fromMaybe - loadFromCLIFilePathList + loadFromCliFilePathList ( loadBinaryCacheFile <|> loadLiteralExpression <|> loadExpressionFromFile ) where -- | The base case: read expressions from the last CLI directive (@[FILE]@) listed on the command line. - loadFromCLIFilePathList = + loadFromCliFilePathList = case filePaths of [] -> runRepl ["-"] -> readExpressionFromStdin @@ -96,10 +92,10 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl -- We can start use Text as in the base case, requires changing Path -> Text -- But that is a gradual process: -- https://github.com/haskell-nix/hnix/issues/912 - (processSeveralFiles . (coerce <$>) . String.lines <=< liftIO) . + (processSeveralFiles . (coerce . toString <$>) . lines <=< liftIO) . (\case - "-" -> getContents - _fp -> readFile _fp + "-" -> Text.getContents + _fp -> Text.readFile _fp ) <$> fromFile processExpr text = handleResult Nothing $ parseNixTextLoc text @@ -125,7 +121,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl either (\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err) (\ ty -> liftIO $ putStrLn $ "Type of expression: " <> - ppShow (fromJust $ Map.lookup @VarName @[Scheme] "it" (coerce ty)) + ppShow (fromMaybe mempty $ Map.lookup @VarName @[Scheme] "it" $ coerce ty) ) (HM.inferTop mempty [("it", stripAnnotation expr')]) diff --git a/main/Repl.hs b/main/Repl.hs index 61efef2db..c2aa9dfba 100644 --- a/main/Repl.hs +++ b/main/Repl.hs @@ -17,7 +17,6 @@ module Repl import Prelude hiding ( state ) import Nix hiding ( exec ) import Nix.Scope -import Nix.Utils import Nix.Value.Monad ( demand ) import qualified Data.HashMap.Lazy as M @@ -268,11 +267,15 @@ printValue :: (MonadNix e t f m, MonadIO m) -> Repl e t f m () printValue val = do cfg <- replCfg <$> get + let + g :: MonadIO m => Doc ann0 -> m () + g = liftIO . print + lift $ lift $ (if - | cfgStrict cfg -> liftIO . print . prettyNValue <=< normalForm - | cfgValues cfg -> liftIO . print . prettyNValueProv <=< removeEffects - | otherwise -> liftIO . print . prettyNValue <=< removeEffects + | cfgStrict cfg -> g . prettyNValue <=< normalForm + | cfgValues cfg -> g . prettyNValueProv <=< removeEffects + | otherwise -> g . prettyNValue <=< removeEffects ) val @@ -297,16 +300,15 @@ browse _ = load :: (MonadNix e t f m, MonadIO m) -- This one does I String -> O String pretty fast, it is ugly to double marshall here. - => String + => Path -> Repl e t f m () -load args = +load path = do - contents <- liftIO $ - Text.readFile $ - trim args + contents <- liftIO $ Prelude.readFile $ + trim path void $ exec True contents where - trim = dropWhileEnd isSpace . dropWhile isSpace + trim = dropWhileEnd isSpace . dropWhile isSpace . coerce -- | @:type@ command typeof @@ -404,14 +406,20 @@ completeFunc reversedPrev word candidates ) ) - (M.lookup (coerce var) (coerce $ replCtx state)) + (M.lookup (coerce var) $ coerce $ replCtx state) -- Builtins, context variables | otherwise = do state <- get - let contextKeys = M.keys @VarName @(NValue t f m) (coerce $ replCtx state) - (Just (NVSet _ builtins)) = M.lookup "builtins" (coerce $ replCtx state) + let + scopeHashMap :: HashMap VarName (NValue t f m) + scopeHashMap = coerce $ replCtx state + contextKeys :: [VarName] + contextKeys = M.keys scopeHashMap + builtins :: AttrSet (NValue t f m) + (Just (NVSet _ builtins)) = M.lookup "builtins" scopeHashMap + shortBuiltins :: [VarName] shortBuiltins = M.keys builtins pure $ listCompletion $ toString <$> @@ -468,7 +476,7 @@ helpOptions = "help" "" "Print help text" - (help helpOptions . toText) + (help helpOptions . fromString) , HelpOption "paste" "" @@ -478,17 +486,17 @@ helpOptions = "load" "FILENAME" "Load .nix file into scope" - load + (load . fromString) , HelpOption "browse" "" "Browse bindings in interpreter context" - (browse . toText) + (browse . fromString) , HelpOption "type" "EXPRESSION" "Evaluate expression or binding from context and print the type of the result value" - (typeof . toText) + (typeof . fromString) , HelpOption "quit" "" @@ -503,7 +511,7 @@ helpOptions = <> Prettyprinter.line <> renderSetOptions helpSetOptions ) - (setConfig . toText) + (setConfig . fromString) ] -- | Options for :set diff --git a/src/Nix.hs b/src/Nix.hs index 9a4117b7e..d9d210774 100644 --- a/src/Nix.hs +++ b/src/Nix.hs @@ -47,7 +47,6 @@ import Nix.Pretty import Nix.Reduce import Nix.Render.Frame import Nix.Thunk -import Nix.Utils import Nix.Value import Nix.Value.Monad import Nix.XML diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index a258cc997..05849cc22 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -21,9 +21,7 @@ module Nix.Builtins where -import Prelude hiding ( traceM ) import GHC.Exception ( ErrorCall(ErrorCall) ) -import Nix.Utils import Control.Comonad ( Comonad ) import Control.Monad ( foldM ) import Control.Monad.Catch ( MonadCatch(catch) ) diff --git a/src/Nix/Cache.hs b/src/Nix/Cache.hs index 792724a37..3ea53a969 100644 --- a/src/Nix/Cache.hs +++ b/src/Nix/Cache.hs @@ -4,7 +4,6 @@ module Nix.Cache where import qualified Data.ByteString.Lazy as BSL -import Nix.Utils import Nix.Expr.Types.Annotated #if defined (__linux__) diff --git a/src/Nix/Cited/Basic.hs b/src/Nix/Cited/Basic.hs index 8f7265e49..fce4e0d46 100644 --- a/src/Nix/Cited/Basic.hs +++ b/src/Nix/Cited/Basic.hs @@ -4,7 +4,6 @@ module Nix.Cited.Basic where -import Prelude hiding ( force ) import Control.Comonad ( Comonad ) import Control.Comonad.Env ( ComonadEnv ) import Control.Monad.Catch hiding ( catchJust ) @@ -16,7 +15,6 @@ import Nix.Expr.Types.Annotated import Nix.Frames import Nix.Options import Nix.Thunk -import Nix.Utils import Nix.Value diff --git a/src/Nix/Context.hs b/src/Nix/Context.hs index f7b943f1c..9972bc366 100644 --- a/src/Nix/Context.hs +++ b/src/Nix/Context.hs @@ -7,7 +7,6 @@ import Nix.Frames ( Frames ) import Nix.Expr.Types.Annotated ( SrcSpan , nullSpan ) -import Nix.Utils ( Has(..) ) -- 2021-07-18: NOTE: It should be Options -> Scopes -> Frames -> Source(span) data Context m t = Context diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index d815e0a69..240044c43 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -15,7 +15,6 @@ module Nix.Convert where -import Prelude hiding ( force ) import Control.Monad.Free import qualified Data.HashMap.Lazy as M import Nix.Atoms @@ -27,7 +26,6 @@ import Nix.String import Nix.Value import Nix.Value.Monad import Nix.Thunk ( MonadThunk(force) ) -import Nix.Utils newtype Deeper a = Deeper a deriving (Typeable, Functor, Foldable, Traversable) @@ -233,6 +231,17 @@ instance Convertible e t f m fromValue = fromMayToValue $ TString mempty +instance Convertible e t f m + => FromValue Text m (NValue' t f m (NValue t f m)) where + + fromValueMay = + pure . + \case + NVStr' ns -> getStringNoContext ns + _ -> mempty + + fromValue = fromMayToValue $ TString mempty + instance ( Convertible e t f m , MonadValue (NValue t f m) m ) @@ -374,6 +383,10 @@ instance Convertible e t f m => ToValue ByteString m (NValue' t f m (NValue t f m)) where toValue = pure . nvStr' . mkNixStringWithoutContext . decodeUtf8 +instance Convertible e t f m + => ToValue Text m (NValue' t f m (NValue t f m)) where + toValue = pure . nvStr' . mkNixStringWithoutContext + instance Convertible e t f m => ToValue Path m (NValue' t f m (NValue t f m)) where toValue = pure . nvPath' . coerce diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs index c389995e9..40a96951a 100644 --- a/src/Nix/Effects.hs +++ b/src/Nix/Effects.hs @@ -12,14 +12,10 @@ module Nix.Effects where -import Prelude hiding ( traceM - , putStr - , putStrLn +import Prelude hiding ( putStrLn , print ) -import qualified Prelude import GHC.Exception ( ErrorCall(ErrorCall) ) -import Nix.Utils import qualified Data.HashSet as HS import qualified Data.Text as Text import Network.HTTP.Client hiding ( path, Proxy ) @@ -327,7 +323,7 @@ deriving -- * @class MonadPutStr m@ class - Monad m + (Monad m, MonadIO m) => MonadPutStr m where --TODO: Should this be used *only* when the Nix to be evaluated invokes a @@ -335,7 +331,7 @@ class -- 2021-04-01: Due to trace operation here, leaving it as String. putStr :: String -> m () default putStr :: (MonadTrans t, MonadPutStr m', m ~ t m') => String -> m () - putStr = lift . putStr + putStr = lift . Prelude.putStr -- ** Instances @@ -357,7 +353,7 @@ deriving -- ** Functions putStrLn :: MonadPutStr m => String -> m () -putStrLn = putStr . (<> "\n") +putStrLn = Nix.Effects.putStr . (<> "\n") print :: (MonadPutStr m, Show a) => a -> m () print = putStrLn . show diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs index 065114a89..915280ab8 100644 --- a/src/Nix/Effects/Basic.hs +++ b/src/Nix/Effects/Basic.hs @@ -2,12 +2,10 @@ module Nix.Effects.Basic where -import Prelude hiding ( traceM - , head +import Prelude hiding ( head ) import Relude.Unsafe ( head ) import GHC.Exception ( ErrorCall(ErrorCall) ) -import Nix.Utils import Control.Monad ( foldM ) import qualified Data.HashMap.Lazy as M import Data.List.Split ( splitOn ) diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs index 902f50b11..849ac5614 100644 --- a/src/Nix/Effects/Derivation.hs +++ b/src/Nix/Effects/Derivation.hs @@ -7,7 +7,6 @@ module Nix.Effects.Derivation ( defaultDerivationStrict ) where import Prelude hiding ( readFile ) import GHC.Exception ( ErrorCall(ErrorCall) ) -import Nix.Utils import Data.Char ( isAscii , isAlphaNum ) @@ -172,7 +171,7 @@ unparseDrv Derivation{..} = readDerivation :: (Framed e m, MonadFile m) => Path -> m Derivation readDerivation path = do - content <- decodeUtf8 <$> readFile path + content <- readFile path either (\ err -> throwError $ ErrorCall $ "Failed to parse " <> show path <> ":\n" <> show err) pure diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs index 408162b5a..9dfb70b48 100644 --- a/src/Nix/Eval.hs +++ b/src/Nix/Eval.hs @@ -6,6 +6,7 @@ module Nix.Eval where +import Relude.Extra ( set ) import Control.Monad ( foldM ) import Control.Monad.Fix ( MonadFix ) import GHC.Exception ( ErrorCall(ErrorCall) ) @@ -21,7 +22,6 @@ import Nix.Expr.Strings ( runAntiquoted ) import Nix.Frames import Nix.String import Nix.Scope -import Nix.Utils import Nix.Value.Monad class (Show v, Monad m) => MonadEval v m where diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index 7799bc02c..dd9450f3e 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -38,7 +38,6 @@ import Nix.Scope import Nix.String import Nix.String.Coerce import Nix.Thunk -import Nix.Utils import Nix.Value import Nix.Value.Equal import Nix.Value.Monad diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs index 506a76c12..6889782f2 100644 --- a/src/Nix/Expr/Shorthands.hs +++ b/src/Nix/Expr/Shorthands.hs @@ -8,7 +8,6 @@ module Nix.Expr.Shorthands where import Data.Fix import Nix.Atoms import Nix.Expr.Types -import Nix.Utils -- * Basic expression builders diff --git a/src/Nix/Expr/Strings.hs b/src/Nix/Expr/Strings.hs index dbac39be9..65acd52a2 100644 --- a/src/Nix/Expr/Strings.hs +++ b/src/Nix/Expr/Strings.hs @@ -2,7 +2,6 @@ -- | Functions for manipulating nix strings. module Nix.Expr.Strings where -import Nix.Utils import Relude.Unsafe as Unsafe -- Please, switch things to NonEmpty import Data.List ( dropWhileEnd diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs index fe6b8eff8..8ab9f2fe1 100644 --- a/src/Nix/Expr/Types.hs +++ b/src/Nix/Expr/Types.hs @@ -49,7 +49,6 @@ import Data.Ord.Deriving ( deriveOrd1 , deriveOrd2 ) import Data.Aeson.TH ( deriveJSON2 ) import qualified Type.Reflection as Reflection import Nix.Atoms -import Nix.Utils #if !MIN_VERSION_text(1,2,4) -- NOTE: Remove package @th-lift-instances@ removing this import Instances.TH.Lift () -- importing Lift Text for GHC 8.6 diff --git a/src/Nix/Expr/Types/Annotated.hs b/src/Nix/Expr/Types/Annotated.hs index 4c29ced06..7471d261e 100644 --- a/src/Nix/Expr/Types/Annotated.hs +++ b/src/Nix/Expr/Types/Annotated.hs @@ -32,7 +32,6 @@ import Data.Functor.Compose import Data.Hashable.Lifted import Data.Ord.Deriving import GHC.Generics -import Nix.Utils import Nix.Atoms import Nix.Expr.Types import Text.Megaparsec ( unPos diff --git a/src/Nix/Frames.hs b/src/Nix/Frames.hs index 6045d865e..c3d5c45da 100644 --- a/src/Nix/Frames.hs +++ b/src/Nix/Frames.hs @@ -14,15 +14,9 @@ module Nix.Frames ) where -import Prelude hiding ( traceM ) import Data.Typeable hiding ( typeOf ) import Control.Monad.Catch ( MonadThrow(..) ) import qualified Text.Show -import Nix.Utils ( Has(..) - , view - , over - , traceM - ) data NixLevel = Fatal | Error | Warning | Info | Debug deriving (Ord, Eq, Bounded, Enum, Show) diff --git a/src/Nix/Json.hs b/src/Nix/Json.hs index 8ef506486..661ea0c9f 100644 --- a/src/Nix/Json.hs +++ b/src/Nix/Json.hs @@ -11,7 +11,6 @@ import Nix.Effects import Nix.Exec import Nix.Frames import Nix.String -import Nix.Utils import Nix.Value import Nix.Value.Monad import Nix.Expr.Types diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 4aebfb1f7..88fd3e638 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -11,12 +11,9 @@ module Nix.Lint where -import Prelude hiding ( head - , force - ) +import Relude.Unsafe as Unsafe ( head ) import Control.Exception ( throw ) import GHC.Exception ( ErrorCall(ErrorCall) ) -import Nix.Utils import Control.Monad ( foldM ) import Control.Monad.Catch import Control.Monad.Fix @@ -24,7 +21,7 @@ import Control.Monad.Ref import Control.Monad.ST import qualified Data.HashMap.Lazy as M -- Plese, use NonEmpty -import Data.List +import Data.List ( intersect ) import qualified Data.List.NonEmpty as NE import qualified Data.Text as Text import qualified Text.Show @@ -451,7 +448,7 @@ lintApp context fun arg = _x -> throwError $ ErrorCall "Attempt to call non-function" y <- everyPossible - (head args, ) <$> foldM (unify context) y ys + (Unsafe.head args, ) <$> foldM (unify context) y ys ) =<< unpackSymbolic fun newtype Lint s a = Lint diff --git a/src/Nix/Normal.hs b/src/Nix/Normal.hs index 2d5cfe0e7..19fc0f383 100644 --- a/src/Nix/Normal.hs +++ b/src/Nix/Normal.hs @@ -10,8 +10,6 @@ -- And so do not converge into a normal form. module Nix.Normal where -import Prelude hiding ( force ) -import Nix.Utils import Control.Monad.Free ( Free(..) ) import Data.Set ( member , insert diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs index 5ed39efe1..f81a41afb 100644 --- a/src/Nix/Parser.hs +++ b/src/Nix/Parser.hs @@ -64,7 +64,6 @@ import Data.Fix ( Fix(..) ) import qualified Data.HashSet as HashSet import qualified Data.Map as Map import qualified Data.Text as Text -import Nix.Utils import Nix.Expr.Types import Nix.Expr.Shorthands hiding ( ($>) ) import Nix.Expr.Types.Annotated @@ -877,7 +876,7 @@ type Result a = Either (Doc Void) a parseFromFileEx :: MonadFile m => Parser a -> Path -> m (Result a) parseFromFileEx parser file = do - input <- decodeUtf8 <$> readFile file + input <- readFile file pure $ either diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index bd644dc40..74abaf44f 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -6,7 +6,6 @@ module Nix.Pretty where import Prelude hiding ( toList, group ) -import Nix.Utils import Control.Monad.Free ( Free(Free) ) import Data.Fix ( Fix(..) , foldFix ) diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs index fd295611a..710b3d3f3 100644 --- a/src/Nix/Reduce.hs +++ b/src/Nix/Reduce.hs @@ -49,7 +49,6 @@ import Nix.Options ( Options ) import Nix.Parser import Nix.Scope -import Nix.Utils import System.Directory import System.FilePath diff --git a/src/Nix/Render.hs b/src/Nix/Render.hs index aebbb04eb..a12e9017d 100644 --- a/src/Nix/Render.hs +++ b/src/Nix/Render.hs @@ -9,11 +9,7 @@ module Nix.Render where -import Prelude hiding ( readFile ) - -import qualified Data.ByteString as BS import qualified Data.Set as Set -import Nix.Utils import Nix.Utils.Fix1 ( Fix1T , MonadFix1T ) import Nix.Expr.Types.Annotated @@ -24,10 +20,10 @@ import Text.Megaparsec.Error import Text.Megaparsec.Pos import qualified Data.Text as Text -class MonadFail m => MonadFile m where - readFile :: Path -> m ByteString - default readFile :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m ByteString - readFile = lift . readFile +class (MonadFail m, MonadIO m) => MonadFile m where + readFile :: Path -> m Text + default readFile :: (MonadTrans t, MonadIO m', MonadFile m', m ~ t m') => Path -> m Text + readFile = liftIO . Prelude.readFile . coerce listDirectory :: Path -> m [Path] default listDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m [Path] listDirectory = lift . listDirectory @@ -54,7 +50,7 @@ class MonadFail m => MonadFile m where getSymbolicLinkStatus = lift . getSymbolicLinkStatus instance MonadFile IO where - readFile = BS.readFile . coerce + readFile = liftIO . Prelude.readFile . coerce listDirectory = coerce <$> (S.listDirectory . coerce) getCurrentDirectory = coerce <$> S.getCurrentDirectory canonicalizePath = coerce <$> (S.canonicalizePath . coerce) @@ -65,7 +61,7 @@ instance MonadFile IO where getSymbolicLinkStatus = S.getSymbolicLinkStatus . coerce -instance (MonadFix1T t m, MonadFail (Fix1T t m), MonadFile m) => MonadFile (Fix1T t m) +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 = @@ -107,8 +103,7 @@ sourceContext path (unPos -> begLine) (unPos -> _begCol) (unPos -> endLine) (unP . take (end' - beg') . drop (pred beg') . lines - . decodeUtf8 - <$> readFile path + <$> Nix.Render.readFile path let longest = Text.length $ show $ beg' + length ls - 1 pad :: Int -> Text diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index dbe882a8b..6c4937859 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -11,7 +11,6 @@ module Nix.Render.Frame where import Prelude hiding ( Comparison ) import GHC.Exception ( ErrorCall ) -import Nix.Utils import Data.Fix ( Fix(..) ) import Nix.Eval import Nix.Exec @@ -41,7 +40,7 @@ renderFrames -> m (Doc ann) renderFrames [] = stub renderFrames (x : xs) = do - opts :: Options <- asks (view hasLens) + opts :: Options <- asks $ view hasLens frames <- if | verbose opts <= ErrorsOnly -> renderFrame @v @t @f x | verbose opts <= Informational -> do diff --git a/src/Nix/Scope.hs b/src/Nix/Scope.hs index e011ffd27..fbd13b57c 100644 --- a/src/Nix/Scope.hs +++ b/src/Nix/Scope.hs @@ -8,7 +8,6 @@ module Nix.Scope where import qualified Data.HashMap.Lazy as M import qualified Text.Show import Lens.Family2 -import Nix.Utils import Nix.Expr.Types -- 2021-07-19: NOTE: Scopes can gain from sequentiality, HashMap (aka AttrSet) may not be proper to it. diff --git a/src/Nix/Standard.hs b/src/Nix/Standard.hs index 19a06ed31..a01268283 100644 --- a/src/Nix/Standard.hs +++ b/src/Nix/Standard.hs @@ -8,7 +8,6 @@ module Nix.Standard where -import Prelude hiding ( force ) import Control.Comonad ( Comonad ) import Control.Comonad.Env ( ComonadEnv ) import Control.Monad.Catch ( MonadThrow @@ -38,7 +37,6 @@ import Nix.Render import Nix.Scope import Nix.Thunk import Nix.Thunk.Basic -import Nix.Utils import Nix.Utils.Fix1 ( Fix1T(Fix1T) ) import Nix.Value import Nix.Value.Monad diff --git a/src/Nix/String.hs b/src/Nix/String.hs index fc91b7502..98232d371 100644 --- a/src/Nix/String.hs +++ b/src/Nix/String.hs @@ -32,7 +32,6 @@ where -import Nix.Utils import Control.Monad.Writer ( WriterT(..), MonadWriter(tell)) import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as S diff --git a/src/Nix/String/Coerce.hs b/src/Nix/String/Coerce.hs index 111e846d8..a7408ee40 100644 --- a/src/Nix/String/Coerce.hs +++ b/src/Nix/String/Coerce.hs @@ -5,7 +5,6 @@ module Nix.String.Coerce where import Control.Monad.Catch ( MonadThrow ) import GHC.Exception ( ErrorCall(ErrorCall) ) import qualified Data.HashMap.Lazy as M -import Nix.Utils import Nix.Atoms import Nix.Effects import Nix.Frames diff --git a/src/Nix/TH.hs b/src/Nix/TH.hs index d177c6b43..3ffc99d61 100644 --- a/src/Nix/TH.hs +++ b/src/Nix/TH.hs @@ -2,6 +2,7 @@ {-# language TemplateHaskell #-} {-# options_ghc -Wno-missing-fields #-} +{-# options_ghc -Wno-name-shadowing #-} module Nix.TH where diff --git a/src/Nix/Thunk/Basic.hs b/src/Nix/Thunk/Basic.hs index 0cb5d8425..ff0749888 100644 --- a/src/Nix/Thunk/Basic.hs +++ b/src/Nix/Thunk/Basic.hs @@ -10,8 +10,6 @@ module Nix.Thunk.Basic , MonadBasicThunk ) where -import Prelude hiding ( force ) -import Relude.Extra ( dup ) import Control.Monad.Ref ( MonadRef(Ref, newRef, readRef, writeRef) , MonadAtomicRef(atomicModifyRef) ) diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs index 7cac5bc78..827045309 100644 --- a/src/Nix/Type/Infer.hs +++ b/src/Nix/Type/Infer.hs @@ -26,7 +26,6 @@ import Prelude hiding ( Type , TVar , Constraint ) -import Nix.Utils import Control.Monad.Logic hiding ( fail ) import Control.Monad.Reader ( MonadFix ) import Control.Monad.Ref ( MonadAtomicRef(..) diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index ac895aa3d..ca8555f85 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -13,8 +13,6 @@ module Nix.Value where -import Prelude hiding ( force ) -import Nix.Utils import Control.Comonad ( Comonad , extract ) diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs index 2f4b86386..fa5fb8bb7 100644 --- a/src/Nix/Value/Equal.hs +++ b/src/Nix/Value/Equal.hs @@ -6,10 +6,7 @@ module Nix.Value.Equal where -import Prelude hiding ( Comparison - , force - ) -import Nix.Utils +import Prelude hiding ( Comparison ) import Control.Comonad ( Comonad(extract)) import Control.Monad.Free ( Free(Pure,Free) ) import Control.Monad.Trans.Except ( throwE ) diff --git a/src/Nix/XML.hs b/src/Nix/XML.hs index 6eeb9b2b6..05bd76b19 100644 --- a/src/Nix/XML.hs +++ b/src/Nix/XML.hs @@ -4,7 +4,6 @@ module Nix.XML where import qualified Data.HashMap.Lazy as M -import Nix.Utils import Nix.Atoms import Nix.Expr.Types import Nix.String diff --git a/src/Nix/Utils.hs b/src/Prelude.hs similarity index 88% rename from src/Nix/Utils.hs rename to src/Prelude.hs index 0207937e5..aefd86c87 100644 --- a/src/Nix/Utils.hs +++ b/src/Prelude.hs @@ -5,7 +5,20 @@ {-# options_ghc -Wno-missing-signatures #-} -module Nix.Utils (module Nix.Utils, module X) where +module Prelude + ( module Prelude + , module Relude + , Text.readFile + , module X + ) where + +import Relude hiding ( force + , readFile + , whenJust + , whenNothing + , trace + , traceM + ) import Data.Binary ( Binary ) import Data.Data ( Data ) @@ -18,15 +31,21 @@ import qualified Data.Aeson.Encoding as A import Data.Fix ( Fix(..) ) import qualified Data.HashMap.Lazy as M import qualified Data.Text as Text +import qualified Data.Text.IO as Text import qualified Data.Vector as V -import Lens.Family2 as X hiding ((&)) +import Lens.Family2 as X + ( view + , over + , LensLike' + , Lens' + ) import Lens.Family2.Stock ( _1 , _2 ) import Lens.Family2.TH ( makeLensesBy ) #if ENABLE_TRACING -import Debug.Trace as X +import qualified Relude.Debug as X #else -- Well, since it is currently CPP intermingled with Debug.Trace, required to use String here. trace :: String -> a -> a diff --git a/tests/EvalTests.hs b/tests/EvalTests.hs index b5140d120..6ef9c7500 100644 --- a/tests/EvalTests.hs +++ b/tests/EvalTests.hs @@ -15,7 +15,6 @@ import Nix import Nix.Standard import Nix.TH import Nix.Value.Equal -import Nix.Utils import qualified System.Directory as D import System.FilePath import Test.Tasty diff --git a/tests/Main.hs b/tests/Main.hs index 2e76e41c7..1e2311296 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -2,6 +2,7 @@ module Main where +import Relude (force) import Relude.Unsafe (read) import qualified Control.Exception as Exc import GHC.Err (errorWithoutStackTrace) @@ -11,7 +12,6 @@ import qualified Data.String as String import Data.Time import qualified EvalTests import NeatInterpolation (text) -import Nix.Utils import qualified Nix import Nix.Expr.Types import Nix.String diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index a80e23fb4..df15a39f6 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -13,7 +13,6 @@ import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Time import GHC.Exts -import Nix.Utils import Nix.Lint import Nix.Options import Nix.Options.Parser diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs index 780faa1d3..026adfbb9 100644 --- a/tests/ParserTests.hs +++ b/tests/ParserTests.hs @@ -13,7 +13,6 @@ module ParserTests (tests) where import Prelude hiding (($<)) import Data.Fix import NeatInterpolation (text) -import Nix.Utils import Nix.Atoms import Nix.Expr import Nix.Parser diff --git a/tests/PrettyParseTests.hs b/tests/PrettyParseTests.hs index cd603b3b4..7dc10ac3f 100644 --- a/tests/PrettyParseTests.hs +++ b/tests/PrettyParseTests.hs @@ -18,7 +18,6 @@ import Nix.Atoms import Nix.Expr import Nix.Parser import Nix.Pretty -import Nix.Utils import Prettyprinter import Test.Tasty import Test.Tasty.Hedgehog diff --git a/tests/TestCommon.hs b/tests/TestCommon.hs index 93a935eff..d59780042 100644 --- a/tests/TestCommon.hs +++ b/tests/TestCommon.hs @@ -5,7 +5,6 @@ module TestCommon where import GHC.Err ( errorWithoutStackTrace ) import Control.Monad.Catch import Data.Time -import Nix.Utils import Nix import Nix.Standard import Nix.Fresh.Basic From 067928380933ba1fd0dfb79aa519a495f50a7bc1 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 14 Aug 2021 02:10:05 +0300 Subject: [PATCH 06/21] Options: Options: (FilePath -> Path) --- main/Main.hs | 8 ++++---- src/Nix/Options.hs | 12 ++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index e3f2bb13e..0ceb24f64 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -78,10 +78,10 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl -- | The `--read` option: load expression from a serialized file. loadBinaryCacheFile = - (\binaryCacheFile -> + (\ (binaryCacheFile :: Path) -> do - let file = replaceExtension binaryCacheFile "nixc" - processCLIOptions (Just $ coerce file) =<< liftIO (readCache $ coerce binaryCacheFile) + let file = coerce $ (replaceExtension . coerce) binaryCacheFile "nixc" + processCLIOptions (Just file) =<< liftIO (readCache $ binaryCacheFile) ) <$> readFrom -- | The `--expr` option: read expression from the argument string @@ -95,7 +95,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl (processSeveralFiles . (coerce . toString <$>) . lines <=< liftIO) . (\case "-" -> Text.getContents - _fp -> Text.readFile _fp + _fp -> readFile $ coerce _fp ) <$> fromFile processExpr text = handleResult Nothing $ parseNixTextLoc text diff --git a/src/Nix/Options.hs b/src/Nix/Options.hs index 53412e4c8..0bff73644 100644 --- a/src/Nix/Options.hs +++ b/src/Nix/Options.hs @@ -13,30 +13,30 @@ data Options = Options , thunks :: Bool , values :: Bool , showScopes :: Bool - , reduce :: Maybe FilePath + , reduce :: Maybe Path , reduceSets :: Bool , reduceLists :: Bool , parse :: Bool , parseOnly :: Bool , finder :: Bool - , findFile :: Maybe FilePath + , findFile :: Maybe Path , strict :: Bool , evaluate :: Bool , json :: Bool , xml :: Bool , attr :: Maybe Text - , include :: [FilePath] + , include :: [Path] , check :: Bool - , readFrom :: Maybe FilePath + , readFrom :: Maybe Path , cache :: Bool , repl :: Bool , ignoreErrors :: Bool , expression :: Maybe Text , arg :: [(Text, Text)] , argstr :: [(Text, Text)] - , fromFile :: Maybe FilePath + , fromFile :: Maybe Path , currentTime :: UTCTime - , filePaths :: [FilePath] + , filePaths :: [Path] } deriving Show From 28a5f694d9a7cb981922e4040c268a693a5b5be2 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 14 Aug 2021 02:24:00 +0300 Subject: [PATCH 07/21] Prelude: use readFile (Path -> Text) --- main/Main.hs | 4 ++-- main/Repl.hs | 11 ++++++----- src/Nix/Parser.hs | 5 ++--- src/Nix/Render.hs | 4 ++-- src/Prelude.hs | 4 +++- tests/NixLanguageTests.hs | 11 +++++------ 6 files changed, 20 insertions(+), 19 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index 0ceb24f64..b611020de 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -81,7 +81,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl (\ (binaryCacheFile :: Path) -> do let file = coerce $ (replaceExtension . coerce) binaryCacheFile "nixc" - processCLIOptions (Just file) =<< liftIO (readCache $ binaryCacheFile) + processCLIOptions (Just file) =<< liftIO (readCache binaryCacheFile) ) <$> readFrom -- | The `--expr` option: read expression from the argument string @@ -95,7 +95,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl (processSeveralFiles . (coerce . toString <$>) . lines <=< liftIO) . (\case "-" -> Text.getContents - _fp -> readFile $ coerce _fp + _fp -> readFile _fp ) <$> fromFile processExpr text = handleResult Nothing $ parseNixTextLoc text diff --git a/main/Repl.hs b/main/Repl.hs index c2aa9dfba..3deedefb5 100644 --- a/main/Repl.hs +++ b/main/Repl.hs @@ -96,7 +96,7 @@ main' iniVal = rcFile = do - f <- liftIO $ Text.readFile ".hnixrc" `catch` handleMissing + f <- liftIO $ readFile ".hnixrc" `catch` handleMissing traverse_ (\case @@ -116,8 +116,8 @@ main' iniVal = -- Replicated and slightly adjusted `optMatcher` from `System.Console.Repline` -- which doesn't export it. - -- * @MonadIO m@ instead of @MonadHaskeline m@ - -- * @putStrLn@ instead of @outputStrLn@ + -- * @MonadIO m@ instead of @MonadHaskeline m@ + -- * @putStrLn@ instead of @outputStrLn@ optMatcher :: MonadIO m => Text -> Console.Options m @@ -304,11 +304,12 @@ load -> Repl e t f m () load path = do - contents <- liftIO $ Prelude.readFile $ + contents <- liftIO $ readFile $ trim path void $ exec True contents where - trim = dropWhileEnd isSpace . dropWhile isSpace . coerce + trim :: Path -> Path + trim = coerce . dropWhileEnd isSpace . dropWhile isSpace . coerce -- | @:type@ command typeof diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs index f81a41afb..7b20d44b2 100644 --- a/src/Nix/Parser.hs +++ b/src/Nix/Parser.hs @@ -42,7 +42,6 @@ where import Prelude hiding ( (<|>) , some , many - , readFile ) import Data.Foldable ( foldr1 ) @@ -72,7 +71,7 @@ import Nix.Expr.Strings ( escapeCodes , mergePlain , removeEmptyPlains ) -import Nix.Render ( MonadFile(readFile) ) +import Nix.Render ( MonadFile() ) import Prettyprinter ( Doc , pretty ) @@ -876,7 +875,7 @@ type Result a = Either (Doc Void) a parseFromFileEx :: MonadFile m => Parser a -> Path -> m (Result a) parseFromFileEx parser file = do - input <- readFile file + input <- liftIO $ readFile file pure $ either diff --git a/src/Nix/Render.hs b/src/Nix/Render.hs index a12e9017d..a37be7794 100644 --- a/src/Nix/Render.hs +++ b/src/Nix/Render.hs @@ -23,7 +23,7 @@ import qualified Data.Text as Text class (MonadFail m, MonadIO m) => MonadFile m where readFile :: Path -> m Text default readFile :: (MonadTrans t, MonadIO m', MonadFile m', m ~ t m') => Path -> m Text - readFile = liftIO . Prelude.readFile . coerce + readFile = liftIO . Prelude.readFile listDirectory :: Path -> m [Path] default listDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m [Path] listDirectory = lift . listDirectory @@ -50,7 +50,7 @@ class (MonadFail m, MonadIO m) => MonadFile m where getSymbolicLinkStatus = lift . getSymbolicLinkStatus instance MonadFile IO where - readFile = liftIO . Prelude.readFile . coerce + readFile = Prelude.readFile listDirectory = coerce <$> (S.listDirectory . coerce) getCurrentDirectory = coerce <$> S.getCurrentDirectory canonicalizePath = coerce <$> (S.canonicalizePath . coerce) diff --git a/src/Prelude.hs b/src/Prelude.hs index aefd86c87..527622ccf 100644 --- a/src/Prelude.hs +++ b/src/Prelude.hs @@ -8,7 +8,6 @@ module Prelude ( module Prelude , module Relude - , Text.readFile , module X ) where @@ -294,3 +293,6 @@ mapPair ~(f,g) ~(a,b) = (f a, g b) stub :: (Applicative f, Monoid a) => f a stub = pure mempty {-# inline stub #-} + +readFile :: Path -> IO Text +readFile = Text.readFile . coerce diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index df15a39f6..57f974d5a 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -10,7 +10,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.String as String import qualified Data.Text as Text -import qualified Data.Text.IO as Text import Data.Time import GHC.Exts import Nix.Lint @@ -130,13 +129,13 @@ assertParseFail opts file = do assertLangOk :: Options -> Path -> Assertion assertLangOk opts file = do actual <- printNix <$> hnixEvalFile opts (file <> ".nix") - expected <- Text.readFile $ coerce $ file <> ".exp" - assertEqual "" expected $ toText (actual <> "\n") + expected <- readFile $ file <> ".exp" + assertEqual "" expected $ fromString (actual <> "\n") assertLangOkXml :: Options -> Path -> Assertion assertLangOkXml opts file = do actual <- stringIgnoreContext . toXML <$> hnixEvalFile opts (file <> ".nix") - expected <- Text.readFile $ coerce $ file <> ".exp.xml" + expected <- readFile $ file <> ".exp.xml" assertEqual "" expected actual assertEval :: Options -> [Path] -> Assertion @@ -144,7 +143,7 @@ assertEval _opts files = do time <- liftIO getCurrentTime let opts = defaultOptions time - case delete ".nix" $ sort $ toText . takeExtensions . coerce <$> files of + case delete ".nix" $ sort $ fromString @Text . takeExtensions . coerce <$> files of [] -> void $ hnixEvalFile opts (name <> ".nix") [".exp" ] -> assertLangOk opts name [".exp.xml" ] -> assertLangOkXml opts name @@ -153,7 +152,7 @@ assertEval _opts files = [".exp", ".flags"] -> do liftIO $ setEnv "NIX_PATH" "lang/dir4:lang/dir5" - flags <- Text.readFile $ coerce $ name <> ".flags" + flags <- readFile $ name <> ".flags" let flags' | Text.last flags == '\n' = Text.init flags | otherwise = flags case runParserGetResult time flags' of From 49d91c789185e45bf6f55306b644d44bdfdd6770 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 14 Aug 2021 02:51:08 +0300 Subject: [PATCH 08/21] treewide: (toText -> fromString) This explicitly states the code smell of String use left. --- main/Main.hs | 2 +- main/Repl.hs | 6 +++--- src/Nix/Builtins.hs | 6 +++--- src/Nix/Convert.hs | 2 +- src/Nix/Effects.hs | 16 ++++++++-------- src/Nix/Effects/Derivation.hs | 4 ++-- src/Nix/Expr/Types.hs | 2 +- src/Nix/Expr/Types/Annotated.hs | 2 +- src/Nix/Parser.hs | 2 +- src/Nix/Pretty.hs | 2 +- src/Nix/Type/Infer.hs | 4 ++-- src/Nix/XML.hs | 2 +- tests/PrettyParseTests.hs | 4 ++-- 13 files changed, 27 insertions(+), 27 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index b611020de..7d1c193a0 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -121,7 +121,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl either (\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err) (\ ty -> liftIO $ putStrLn $ "Type of expression: " <> - ppShow (fromMaybe mempty $ Map.lookup @VarName @[Scheme] "it" $ coerce ty) + ppShow (maybeToMonoid $ Map.lookup @VarName @[Scheme] "it" $ coerce ty) ) (HM.inferTop mempty [("it", stripAnnotation expr')]) diff --git a/main/Repl.hs b/main/Repl.hs index 3deedefb5..d7bce0aac 100644 --- a/main/Repl.hs +++ b/main/Repl.hs @@ -68,7 +68,7 @@ main' iniVal = evalStateT (evalRepl banner - (cmd . toText) + (cmd . fromString) options (pure commandPrefix) (pure "paste") @@ -125,7 +125,7 @@ main' iniVal = -> m () optMatcher s [] _ = liftIO $ Text.putStrLn $ "No such command :" <> s optMatcher s ((x, m) : xs) args - | s `Text.isPrefixOf` toText x = m $ toString args + | s `Text.isPrefixOf` fromString x = m $ toString args | otherwise = optMatcher s xs args @@ -392,7 +392,7 @@ completeFunc reversedPrev word listFiles word -- Attributes of sets in REPL context - | var : subFields <- Text.split (== '.') (toText word) , not $ null subFields = + | var : subFields <- Text.split (== '.') (fromString word) , not $ null subFields = do state <- get maybe diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 05849cc22..2101282ad 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -798,7 +798,7 @@ baseNameOfNix x = pure $ nvStr $ modifyNixContents - (toText . takeFileName . toString) + (fromString . takeFileName . toString) ns bitAndNix @@ -852,7 +852,7 @@ dirOfNix nvdir = dir <- demand nvdir case dir of - NVStr ns -> pure $ nvStr $ modifyNixContents (toText . takeDirectory . toString) ns + NVStr ns -> pure $ nvStr $ modifyNixContents (fromString . takeDirectory . toString) ns NVPath path -> pure $ nvPath $ coerce $ takeDirectory $ coerce path v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " <> show v @@ -1112,7 +1112,7 @@ toFileNix name s = mres <- toFile_ (coerce $ toString name') - (toString $ stringIgnoreContext s') + (stringIgnoreContext s') let t = coerce $ toText @FilePath $ coerce mres diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index 240044c43..b591c5950 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -399,7 +399,7 @@ 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 $ toText f + f' <- toValue $ mkNixStringWithoutContext $ fromString f l' <- toValue $ unPos l c' <- toValue $ unPos c let pos = M.fromList [("file" :: VarName, f'), ("line", l'), ("column", c')] diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs index 40a96951a..f2e7205f5 100644 --- a/src/Nix/Effects.hs +++ b/src/Nix/Effects.hs @@ -137,7 +137,7 @@ instance MonadExec IO where (prog : args) -> do (exitCode, out, _) <- liftIO $ readProcessWithExitCode (toString prog) (toString <$> args) "" let - t = Text.strip $ toText out + t = Text.strip $ fromString out emsg = "program[" <> prog <> "] args=" <> show args case exitCode of ExitSuccess -> @@ -194,7 +194,7 @@ instance MonadInstantiate IO where either (\ e -> Left $ ErrorCall $ "Error parsing output of nix-instantiate: " <> show e) pure - (parseNixTextLoc $ toText out) + (parseNixTextLoc $ fromString out) status -> Left $ ErrorCall $ "nix-instantiate failed: " <> show status <> ": " <> err deriving @@ -230,12 +230,12 @@ class -- ** Instances instance MonadEnv IO where - getEnvVar = (<<$>>) toText . lookupEnv . toString + getEnvVar = (<<$>>) fromString . lookupEnv . toString - getCurrentSystemOS = pure $ toText System.Info.os + getCurrentSystemOS = pure $ fromString System.Info.os -- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4 - getCurrentSystemArch = pure $ toText $ case System.Info.arch of + getCurrentSystemArch = pure $ fromString $ case System.Info.arch of "i386" -> "i686" arch -> arch @@ -438,7 +438,7 @@ addPath p = either throwError pure - =<< addToStore (toText $ takeFileName (coerce p)) p True False + =<< addToStore (fromString $ takeFileName (coerce p)) p True False -toFile_ :: (Framed e m, MonadStore m) => Path -> String -> m StorePath -toFile_ p contents = addTextToStore (toText p) (toText contents) mempty False +toFile_ :: (Framed e m, MonadStore m) => Path -> Text -> m StorePath +toFile_ p contents = addTextToStore (toText p) contents mempty False diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs index 849ac5614..e3fab55f6 100644 --- a/src/Nix/Effects/Derivation.hs +++ b/src/Nix/Effects/Derivation.hs @@ -76,7 +76,7 @@ writeDerivation drv@Derivation{inputs, name} = do let (inputSrcs, inputDrvs) = inputs references <- Set.fromList <$> traverse parsePath (Set.toList $ inputSrcs <> Set.fromList (Map.keys inputDrvs)) path <- addTextToStore (Text.append name ".drv") (unparseDrv drv) (S.fromList $ Set.toList references) False - parsePath $ toText @Path $ coerce path + parsePath $ fromString $ coerce path -- | Traverse the graph of inputDrvs to replace fixed output derivations with their fixed output hash. -- this avoids propagating changes to their .drv when the output hash stays the same. @@ -206,7 +206,7 @@ derivationParser = do pure $ Derivation {inputs = (inputSrcs, inputDrvs), ..} where s :: Parsec () Text Text - s = fmap toText $ string "\"" *> manyTill (escaped <|> regular) (string "\"") + s = fmap fromString $ string "\"" *> manyTill (escaped <|> regular) (string "\"") escaped = char '\\' *> ( '\n' <$ string "n" <|> '\r' <$ string "r" diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs index 8ab9f2fe1..94763865d 100644 --- a/src/Nix/Expr/Types.hs +++ b/src/Nix/Expr/Types.hs @@ -267,7 +267,7 @@ data NString r -- | For the the 'IsString' instance, we use a plain doublequoted string. instance IsString (NString r) where fromString "" = DoubleQuoted mempty - fromString string = DoubleQuoted [Plain $ toText string] + fromString string = DoubleQuoted [Plain $ fromString string] $(deriveShow1 ''NString) $(deriveRead1 ''NString) diff --git a/src/Nix/Expr/Types/Annotated.hs b/src/Nix/Expr/Types/Annotated.hs index 7471d261e..6faa8ad4d 100644 --- a/src/Nix/Expr/Types/Annotated.hs +++ b/src/Nix/Expr/Types/Annotated.hs @@ -183,7 +183,7 @@ annNStr :: AnnUnit SrcSpan (NString NExprLoc) -> NExprLoc annNStr (AnnUnit s1 s) = NStrAnn s1 s deltaInfo :: SourcePos -> (Text, Int, Int) -deltaInfo (SourcePos fp l c) = (toText fp, unPos l, unPos c) +deltaInfo (SourcePos fp l c) = (fromString fp, unPos l, unPos c) annNNull :: NExprLoc annNNull = NConstantAnn nullSpan NNull diff --git a/src/Nix/Parser.hs b/src/Nix/Parser.hs index 7b20d44b2..46a4f8c3a 100644 --- a/src/Nix/Parser.hs +++ b/src/Nix/Parser.hs @@ -326,7 +326,7 @@ nixString' = label "string" $ lexeme $ doubleQuoted <|> indented antiquoted <|> Plain . one <$> char '$' <|> esc - <|> Plain . toText <$> some plainChar + <|> Plain . fromString <$> some plainChar where plainChar :: Parser Char plainChar = diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index 74abaf44f..e53ffd193 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -383,7 +383,7 @@ printNix = iterNValueByDiscardWith thk phi phi :: NValue' t f m String -> String phi (NVConstant' a ) = toString $ atomText a phi (NVStr' ns) = show $ stringIgnoreContext ns - phi (NVList' l ) = toString $ "[ " <> unwords (fmap toText l) <> " ]" + phi (NVList' l ) = toString $ "[ " <> unwords (fmap fromString l) <> " ]" phi (NVSet' _ s) = "{ " <> concat diff --git a/src/Nix/Type/Infer.hs b/src/Nix/Type/Infer.hs index 827045309..b3a2a6c41 100644 --- a/src/Nix/Type/Infer.hs +++ b/src/Nix/Type/Infer.hs @@ -75,7 +75,7 @@ normalizeScheme (Forall _ body) = Forall (snd <$> ord) (normtype body) ord = zip (ordNub $ fv body) - (TV . toText <$> letters) + (TV . fromString <$> letters) fv (TVar a ) = [a] fv (a :~> b ) = fv a <> fv b @@ -174,7 +174,7 @@ freshTVar = do s <- get put $ succ s - pure $ TV $ toText $ letters !! coerce s + pure $ TV $ fromString $ letters !! coerce s fresh :: MonadState InferState m => m Type fresh = TVar <$> freshTVar diff --git a/src/Nix/XML.hs b/src/Nix/XML.hs index 05bd76b19..295f2640a 100644 --- a/src/Nix/XML.hs +++ b/src/Nix/XML.hs @@ -22,7 +22,7 @@ toXML = runWithStringContext . fmap pp . iterNValueByDiscardWith cyc phi pp e = heading - <> toText + <> fromString (ppElement $ mkE "expr" diff --git a/tests/PrettyParseTests.hs b/tests/PrettyParseTests.hs index 7dc10ac3f..d555b032c 100644 --- a/tests/PrettyParseTests.hs +++ b/tests/PrettyParseTests.hs @@ -28,7 +28,7 @@ asciiString :: MonadGen m => m String asciiString = Gen.list (Range.linear 1 15) Gen.lower asciiText :: Gen Text -asciiText = toText <$> asciiString +asciiText = fromString <$> asciiString -- Might want to replace this instance with a constant value genPos :: Gen Pos @@ -237,7 +237,7 @@ prop_prettyparse p = do success (equivUpToNormalization p v) ) - (parse $ toText prog) + (parse $ fromString prog) where parse = parseNixText From 2b39c5f33d12a29702e74abdd627c94ed7172177 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 14 Aug 2021 18:38:54 +0300 Subject: [PATCH 09/21] src: Nix: replace last FilePath in function types for Path --- main/Main.hs | 2 +- src/Nix.hs | 16 ++++++++-------- src/Nix/Builtins.hs | 6 +++--- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index 7d1c193a0..9d1c0b996 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -154,7 +154,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl | evaluate = if | tracing -> evaluateExprWithEvaluator nixTracingEvalExprLoc expr - | Just path <- reduce -> evaluateExprWithEvaluator (reduction (coerce path) . coerce) expr + | Just path <- reduce -> evaluateExprWithEvaluator (reduction path . coerce) expr | null arg || null argstr -> evaluateExprWithEvaluator nixEvalExprLoc expr | otherwise -> processResult printer <=< nixEvalExprLoc (coerce mpath) $ expr | xml = fail "Rendering expression trees to XML is not yet implemented" diff --git a/src/Nix.hs b/src/Nix.hs index d9d210774..e385d89c7 100644 --- a/src/Nix.hs +++ b/src/Nix.hs @@ -58,15 +58,15 @@ nixEval :: (MonadNix e t f m, Has e Options, Functor g) => Transform g (m a) -> Alg g (m a) - -> Maybe FilePath + -> Maybe Path -> Fix g -> m a -nixEval transform alg mpath = withNixContext (coerce mpath) . adi transform alg +nixEval transform alg mpath = withNixContext mpath . adi transform alg -- | Evaluate a nix expression in the default context nixEvalExpr :: (MonadNix e t f m, Has e Options) - => Maybe FilePath + => Maybe Path -> NExpr -> m (NValue t f m) nixEvalExpr = nixEval id Eval.eval @@ -75,7 +75,7 @@ nixEvalExpr = nixEval id Eval.eval nixEvalExprLoc :: forall e t f m . (MonadNix e t f m, Has e Options) - => Maybe FilePath + => Maybe Path -> NExprLoc -> m (NValue t f m) nixEvalExprLoc = @@ -90,15 +90,15 @@ nixEvalExprLoc = -- context. nixTracingEvalExprLoc :: (MonadNix e t f m, Has e Options, MonadIO m, Alternative m) - => Maybe FilePath + => Maybe Path -> NExprLoc -> m (NValue t f m) -nixTracingEvalExprLoc mpath = withNixContext (coerce mpath) . evalExprLoc +nixTracingEvalExprLoc mpath = withNixContext mpath . evalExprLoc evaluateExpression :: (MonadNix e t f m, Has e Options) - => Maybe FilePath - -> (Maybe FilePath -> NExprLoc -> m (NValue t f m)) + => Maybe Path + -> (Maybe Path -> NExprLoc -> m (NValue t f m)) -> (NValue t f m -> m a) -> NExprLoc -> m a diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 2101282ad..a964b1238 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -1115,10 +1115,10 @@ toFileNix name s = (stringIgnoreContext s') let - t = coerce $ toText @FilePath $ coerce mres - sc = StringContext t DirectPath + storepath = coerce $ toText @FilePath $ coerce mres + sc = StringContext storepath DirectPath - toValue $ mkNixStringWithSingletonContext t sc + toValue $ mkNixStringWithSingletonContext storepath sc toPathNix :: MonadNix e t f m => NValue t f m -> m (NValue t f m) toPathNix = toValue @Path <=< fromValue @Path From 11ed79bdd1cffe44a799cc0d4f250567049ba875 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 12:51:06 +0300 Subject: [PATCH 10/21] reintroduce Nix.Utils, pass ith through Prelude After making this flexible prelude setup, we are moving the custom code back into Nix.Utils, so the downstream projects do not have trouble importing Prelude module, but just use regular Nix.Utils module. --- hnix.cabal | 1 + src/Nix/Utils.hs | 302 +++++++++++++++++++++++++++++++++++++++++++++++ src/Prelude.hs | 293 ++------------------------------------------- 3 files changed, 310 insertions(+), 286 deletions(-) create mode 100644 src/Nix/Utils.hs diff --git a/hnix.cabal b/hnix.cabal index cbc20e41d..b7984466e 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -343,6 +343,7 @@ library exposed-modules: Prelude Nix + Nix.Utils Nix.Atoms Nix.Builtins Nix.Cache diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs new file mode 100644 index 000000000..31ba96d7a --- /dev/null +++ b/src/Nix/Utils.hs @@ -0,0 +1,302 @@ +{-# language NoImplicitPrelude #-} +{-# language CPP #-} +{-# language FunctionalDependencies #-} +{-# language TemplateHaskell #-} +{-# language GeneralizedNewtypeDeriving #-} + +{-# options_ghc -Wno-missing-signatures #-} + +-- | This is a module of custom "Prelude" code. +-- It is for import for projects other then @HNix@. +-- For @HNix@ - this module gets reexported by "Prelude", so for @HNix@ please fix-up pass-through there. +module Nix.Utils + ( module Nix.Utils + , module X + ) + where + +import Relude hiding ( force + , readFile + , whenJust + , whenNothing + , trace + , traceM + ) + +import Data.Binary ( Binary ) +import Data.Data ( Data ) +import Codec.Serialise ( Serialise ) +import Control.Monad.Fix ( MonadFix(..) ) +import Control.Monad.Free ( Free(..) ) +import Control.Monad.Trans.Control ( MonadTransControl(..) ) +import qualified Data.Aeson as A +import qualified Data.Aeson.Encoding as A +import Data.Fix ( Fix(..) ) +import qualified Data.HashMap.Lazy as M +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import qualified Data.Vector as V +import Lens.Family2 as X + ( view + , over + , LensLike' + , Lens' + ) +import Lens.Family2.Stock ( _1 + , _2 + ) +import Lens.Family2.TH ( makeLensesBy ) + +#if ENABLE_TRACING +import qualified Relude.Debug as X +#else +-- Well, since it is currently CPP intermingled with Debug.Trace, required to use String here. +trace :: String -> a -> a +trace = const id +{-# inline trace #-} +traceM :: Monad m => String -> m () +traceM = const pass +{-# inline traceM #-} +#endif + +$(makeLensesBy (\n -> pure $ "_" <> n) ''Fix) + +-- | To have explicit type boundary between FilePath & String. +newtype Path = Path FilePath + deriving + ( Eq, Ord, Generic + , Typeable, Data, NFData, Serialise, Binary, A.ToJSON, A.FromJSON + , Show, Read, Hashable + , Semigroup, Monoid + ) + +instance ToText Path where + toText = toText @String . coerce + +instance IsString Path where + fromString = coerce + + +-- | > Hashmap Text -- type synonym +type KeyMap = HashMap Text + +-- | F-algebra defines how to reduce the fixed-point of a functor to a value. +-- > type Alg f a = f a -> a +type Alg f a = f a -> a + +-- | > type AlgM f m a = f a -> m a +type AlgM f m a = f a -> m a + +-- | Do according transformation. +-- +-- It is a transformation of a recursion scheme. +-- See @TransformF@. +type Transform f a = TransformF (Fix f) a +-- | Do according transformation. +-- +-- It is a transformation between functors. +-- ... +-- You got me, it is a natural transformation. +type TransformF f a = (f -> a) -> f -> a + +loeb :: Functor f => f (f a -> a) -> f a +loeb x = go + where + go = ($ go) <$> x + +loebM :: (MonadFix m, Traversable t) => t (t a -> m a) -> m (t a) +-- Sectioning here insures optimization happening. +loebM f = mfix $ \a -> (`traverse` f) ($ a) +{-# inline loebM #-} + +para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a +para f = f . fmap (id &&& para f) . unFix + +paraM :: (Traversable f, Monad m) => (f (Fix f, a) -> m a) -> Fix f -> m a +paraM f = f <=< traverse (\x -> (x, ) <$> paraM f x) . unFix + +cataP :: Functor f => (Fix f -> f a -> a) -> Fix f -> a +cataP f x = f x . fmap (cataP f) . unFix $ x + +cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a +cataPM f x = f x <=< traverse (cataPM f) . unFix $ x + +lifted + :: (MonadTransControl u, Monad (u m), Monad m) + => ((a -> m (StT u b)) -> m (StT u b)) + -> (a -> u m b) + -> u m b +lifted f k = + do + lftd <- liftWith (\run -> f (run . k)) + restoreT $ pure lftd + +-- | Replace: +-- @Pure a -> a@ +-- @Free -> Fix@ +freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f +freeToFix f = go + where + go = + free + f + $ Fix . (go <$>) + +-- | Replace: +-- @a -> Pure a@ +-- @Fix -> Free@ +fixToFree :: Functor f => Fix f -> Free f a +fixToFree = Free . go + where + go (Fix f) = Free . go <$> f + +-- | adi is Abstracting Definitional Interpreters: +-- +-- https://arxiv.org/abs/1707.04755 +-- +-- Essentially, it does for evaluation what recursion schemes do for +-- representation: allows threading layers through existing structure, only +-- in this case through behavior. +adi + :: Functor f + => Transform f a + -> Alg f a + -> Fix f + -> a +adi g f = g $ f . (adi g f <$>) . unFix + +adiM + :: ( Traversable t + , Monad m + ) + => Transform t (m a) + -> AlgM t m a + -> Fix t + -> m a +adiM g f = g $ f <=< traverse (adiM g f) . unFix + + +class Has a b where + hasLens :: Lens' a b + +instance Has a a where + hasLens f = f + +instance Has (a, b) a where + hasLens = _1 + +instance Has (a, b) b where + hasLens = _2 + +toEncodingSorted :: A.Value -> A.Encoding +toEncodingSorted = \case + A.Object m -> + A.pairs + . mconcat + . ((\(k, v) -> A.pair k $ toEncodingSorted v) <$>) + . sortWith fst + $ M.toList m + A.Array l -> A.list toEncodingSorted $ V.toList l + v -> A.toEncoding v + +data NixPathEntryType = PathEntryPath | PathEntryURI deriving (Show, Eq) + +-- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon +-- (i.e. @https://...@) +uriAwareSplit :: Text -> [(Text, NixPathEntryType)] +uriAwareSplit txt = + case Text.break (== ':') txt of + (e1, e2) + | Text.null e2 -> [(e1, PathEntryPath)] + | "://" `Text.isPrefixOf` e2 -> + let ((suffix, _) : path) = uriAwareSplit (Text.drop 3 e2) in + (e1 <> "://" <> suffix, PathEntryURI) : path + | otherwise -> (e1, PathEntryPath) : uriAwareSplit (Text.drop 1 e2) + +-- | Analog for @bool@ or @maybe@, for list-like cons structures. +list + :: Foldable t + => b -> (t a -> b) -> t a -> b +list e f l = + bool + (f l) + e + (null l) +{-# inline list #-} + +whenText + :: a -> (Text -> a) -> Text -> a +whenText e f t = + bool + (f t) + e + (Text.null t) + +-- | Lambda analog of @maybe@ or @either@ for Free monad. +free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b +free fP fF fr = + case fr of + Pure a -> fP a + Free fa -> fF fa +{-# inline free #-} + + +whenTrue :: (Monoid a) + => a -> Bool -> a +whenTrue = + bool + mempty +{-# inline whenTrue #-} + +whenFalse :: (Monoid a) + => a -> Bool -> a +whenFalse f = + bool + f + mempty +{-# inline whenFalse #-} + +whenFree :: (Monoid b) + => (f (Free f a) -> b) -> Free f a -> b +whenFree = + free + mempty +{-# inline whenFree #-} + +whenPure :: (Monoid b) + => (a -> b) -> Free f a -> b +whenPure f = + free + f + mempty +{-# inline whenPure #-} + + +-- | Apply a single function to both components of a pair. +-- +-- > both succ (1,2) == (2,3) +-- +-- Taken From package @extra@ +both :: (a -> b) -> (a, a) -> (b, b) +both f (x,y) = (f x, f y) +{-# inline both #-} + + +-- | Duplicates object into a tuple. +dup :: a -> (a, a) +dup x = (x, x) +{-# inline dup #-} + +-- | From @utility-ht@ for tuple laziness. +mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d) +mapPair ~(f,g) ~(a,b) = (f a, g b) +{-# inline mapPair #-} + +-- After migration from the @relude@ - @relude: pass -> stub@ +-- | @pure mempty@: Short-curcuit, stub. +stub :: (Applicative f, Monoid a) => f a +stub = pure mempty +{-# inline stub #-} + +readFile :: Path -> IO Text +readFile = Text.readFile . coerce diff --git a/src/Prelude.hs b/src/Prelude.hs index 527622ccf..994715e01 100644 --- a/src/Prelude.hs +++ b/src/Prelude.hs @@ -1,16 +1,14 @@ -{-# language CPP #-} -{-# language FunctionalDependencies #-} -{-# language TemplateHaskell #-} -{-# language GeneralizedNewtypeDeriving #-} - -{-# options_ghc -Wno-missing-signatures #-} - +-- | This is a @Prelude@, but, please, do not put things in here, +-- put them into "Nix.Utils". This module is a pass-through-multiplexer, +-- between our custom code ("Nix.Utils") that shadows over the outside prelude that is in use ("Relude") +-- "Prelude" module has a problem of being imported & used by other projects. +-- "Nix.Utils" as a module with a regular name does not have that problem. module Prelude - ( module Prelude + ( module Nix.Utils , module Relude - , module X ) where +import Nix.Utils import Relude hiding ( force , readFile , whenJust @@ -19,280 +17,3 @@ import Relude hiding ( force , traceM ) -import Data.Binary ( Binary ) -import Data.Data ( Data ) -import Codec.Serialise ( Serialise ) -import Control.Monad.Fix ( MonadFix(..) ) -import Control.Monad.Free ( Free(..) ) -import Control.Monad.Trans.Control ( MonadTransControl(..) ) -import qualified Data.Aeson as A -import qualified Data.Aeson.Encoding as A -import Data.Fix ( Fix(..) ) -import qualified Data.HashMap.Lazy as M -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import qualified Data.Vector as V -import Lens.Family2 as X - ( view - , over - , LensLike' - , Lens' - ) -import Lens.Family2.Stock ( _1 - , _2 - ) -import Lens.Family2.TH ( makeLensesBy ) - -#if ENABLE_TRACING -import qualified Relude.Debug as X -#else --- Well, since it is currently CPP intermingled with Debug.Trace, required to use String here. -trace :: String -> a -> a -trace = const id -{-# inline trace #-} -traceM :: Monad m => String -> m () -traceM = const pass -{-# inline traceM #-} -#endif - -$(makeLensesBy (\n -> pure $ "_" <> n) ''Fix) - --- | To have explicit type boundary between FilePath & String. -newtype Path = Path FilePath - deriving - ( Eq, Ord, Generic - , Typeable, Data, NFData, Serialise, Binary, A.ToJSON, A.FromJSON - , Show, Read, Hashable - , Semigroup, Monoid - ) - -instance ToText Path where - toText = toText @String . coerce - -instance IsString Path where - fromString = coerce - - --- | > Hashmap Text -- type synonym -type KeyMap = HashMap Text - --- | F-algebra defines how to reduce the fixed-point of a functor to a value. --- > type Alg f a = f a -> a -type Alg f a = f a -> a - --- | > type AlgM f m a = f a -> m a -type AlgM f m a = f a -> m a - --- | Do according transformation. --- --- It is a transformation of a recursion scheme. --- See @TransformF@. -type Transform f a = TransformF (Fix f) a --- | Do according transformation. --- --- It is a transformation between functors. --- ... --- You got me, it is a natural transformation. -type TransformF f a = (f -> a) -> f -> a - -loeb :: Functor f => f (f a -> a) -> f a -loeb x = go - where - go = ($ go) <$> x - -loebM :: (MonadFix m, Traversable t) => t (t a -> m a) -> m (t a) --- Sectioning here insures optimization happening. -loebM f = mfix $ \a -> (`traverse` f) ($ a) -{-# inline loebM #-} - -para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a -para f = f . fmap (id &&& para f) . unFix - -paraM :: (Traversable f, Monad m) => (f (Fix f, a) -> m a) -> Fix f -> m a -paraM f = f <=< traverse (\x -> (x, ) <$> paraM f x) . unFix - -cataP :: Functor f => (Fix f -> f a -> a) -> Fix f -> a -cataP f x = f x . fmap (cataP f) . unFix $ x - -cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a -cataPM f x = f x <=< traverse (cataPM f) . unFix $ x - -lifted - :: (MonadTransControl u, Monad (u m), Monad m) - => ((a -> m (StT u b)) -> m (StT u b)) - -> (a -> u m b) - -> u m b -lifted f k = - do - lftd <- liftWith (\run -> f (run . k)) - restoreT $ pure lftd - --- | Replace: --- @Pure a -> a@ --- @Free -> Fix@ -freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f -freeToFix f = go - where - go = - free - f - $ Fix . (go <$>) - --- | Replace: --- @a -> Pure a@ --- @Fix -> Free@ -fixToFree :: Functor f => Fix f -> Free f a -fixToFree = Free . go - where - go (Fix f) = Free . go <$> f - --- | adi is Abstracting Definitional Interpreters: --- --- https://arxiv.org/abs/1707.04755 --- --- Essentially, it does for evaluation what recursion schemes do for --- representation: allows threading layers through existing structure, only --- in this case through behavior. -adi - :: Functor f - => Transform f a - -> Alg f a - -> Fix f - -> a -adi g f = g $ f . (adi g f <$>) . unFix - -adiM - :: ( Traversable t - , Monad m - ) - => Transform t (m a) - -> AlgM t m a - -> Fix t - -> m a -adiM g f = g $ f <=< traverse (adiM g f) . unFix - - -class Has a b where - hasLens :: Lens' a b - -instance Has a a where - hasLens f = f - -instance Has (a, b) a where - hasLens = _1 - -instance Has (a, b) b where - hasLens = _2 - -toEncodingSorted :: A.Value -> A.Encoding -toEncodingSorted = \case - A.Object m -> - A.pairs - . mconcat - . ((\(k, v) -> A.pair k $ toEncodingSorted v) <$>) - . sortWith fst - $ M.toList m - A.Array l -> A.list toEncodingSorted $ V.toList l - v -> A.toEncoding v - -data NixPathEntryType = PathEntryPath | PathEntryURI deriving (Show, Eq) - --- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon --- (i.e. @https://...@) -uriAwareSplit :: Text -> [(Text, NixPathEntryType)] -uriAwareSplit txt = - case Text.break (== ':') txt of - (e1, e2) - | Text.null e2 -> [(e1, PathEntryPath)] - | "://" `Text.isPrefixOf` e2 -> - let ((suffix, _) : path) = uriAwareSplit (Text.drop 3 e2) in - (e1 <> "://" <> suffix, PathEntryURI) : path - | otherwise -> (e1, PathEntryPath) : uriAwareSplit (Text.drop 1 e2) - --- | Analog for @bool@ or @maybe@, for list-like cons structures. -list - :: Foldable t - => b -> (t a -> b) -> t a -> b -list e f l = - bool - (f l) - e - (null l) -{-# inline list #-} - -whenText - :: a -> (Text -> a) -> Text -> a -whenText e f t = - bool - (f t) - e - (Text.null t) - --- | Lambda analog of @maybe@ or @either@ for Free monad. -free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b -free fP fF fr = - case fr of - Pure a -> fP a - Free fa -> fF fa -{-# inline free #-} - - -whenTrue :: (Monoid a) - => a -> Bool -> a -whenTrue = - bool - mempty -{-# inline whenTrue #-} - -whenFalse :: (Monoid a) - => a -> Bool -> a -whenFalse f = - bool - f - mempty -{-# inline whenFalse #-} - -whenFree :: (Monoid b) - => (f (Free f a) -> b) -> Free f a -> b -whenFree = - free - mempty -{-# inline whenFree #-} - -whenPure :: (Monoid b) - => (a -> b) -> Free f a -> b -whenPure f = - free - f - mempty -{-# inline whenPure #-} - - --- | Apply a single function to both components of a pair. --- --- > both succ (1,2) == (2,3) --- --- Taken From package @extra@ -both :: (a -> b) -> (a, a) -> (b, b) -both f (x,y) = (f x, f y) -{-# inline both #-} - - --- | Duplicates object into a tuple. -dup :: a -> (a, a) -dup x = (x, x) -{-# inline dup #-} - --- | From @utility-ht@ for tuple laziness. -mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d) -mapPair ~(f,g) ~(a,b) = (f a, g b) -{-# inline mapPair #-} - --- After migration from the @relude@ - @relude: pass -> stub@ --- | @pure mempty@: Short-curcuit, stub. -stub :: (Applicative f, Monoid a) => f a -stub = pure mempty -{-# inline stub #-} - -readFile :: Path -> IO Text -readFile = Text.readFile . coerce From 4de75f02e19a63e71daf039d54ddf386ca602df9 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 14:45:45 +0300 Subject: [PATCH 11/21] Nix.Utils: clean-up; add Nix.Unused Moved function got some alteration. Reduced Lazy -> Strict marchalling. Also instead of Lazy used Strict data types, since on the conveyor that data seems to be consumed fully (which I may be wrong about). --- hnix.cabal | 1 + src/Nix/Builtins.hs | 17 +++++ src/Nix/Json.hs | 19 ++++-- src/Nix/Unused.hs | 82 +++++++++++++++++++++++ src/Nix/Utils.hs | 156 +++++++++++--------------------------------- 5 files changed, 152 insertions(+), 123 deletions(-) create mode 100644 src/Nix/Unused.hs diff --git a/hnix.cabal b/hnix.cabal index b7984466e..e192ff80f 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -393,6 +393,7 @@ library Nix.XML other-modules: Paths_hnix + Nix.Unused autogen-modules: Paths_hnix hs-source-dirs: diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index a964b1238..be8ea4c80 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -164,6 +164,23 @@ mkNVBool -> NValue t f m mkNVBool = nvConstant . NBool +data NixPathEntryType + = PathEntryPath + | PathEntryURI + deriving (Show, Eq) + +-- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon +-- (i.e. @https://...@) +uriAwareSplit :: Text -> [(Text, NixPathEntryType)] +uriAwareSplit txt = + case Text.break (== ':') txt of + (e1, e2) + | Text.null e2 -> [(e1, PathEntryPath)] + | "://" `Text.isPrefixOf` e2 -> + let ((suffix, _) : path) = uriAwareSplit (Text.drop 3 e2) in + (e1 <> "://" <> suffix, PathEntryURI) : path + | otherwise -> (e1, PathEntryPath) : uriAwareSplit (Text.drop 1 e2) + foldNixPath :: forall e t f m r . MonadNix e t f m diff --git a/src/Nix/Json.hs b/src/Nix/Json.hs index 661ea0c9f..da9e8ccf8 100644 --- a/src/Nix/Json.hs +++ b/src/Nix/Json.hs @@ -3,9 +3,8 @@ module Nix.Json where import qualified Data.Aeson as A import qualified Data.Aeson.Encoding as A -import qualified Data.HashMap.Lazy as HM -import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Vector as V +import qualified Data.HashMap.Strict as HM import Nix.Atoms import Nix.Effects import Nix.Exec @@ -15,12 +14,24 @@ import Nix.Value import Nix.Value.Monad import Nix.Expr.Types +-- This was moved from Utils. +toEncodingSorted :: A.Value -> A.Encoding +toEncodingSorted = \case + A.Object m -> + A.pairs + . mconcat + . ((\(k, v) -> A.pair k $ toEncodingSorted v) <$>) + . sortWith fst + $ HM.toList m + A.Array l -> A.list toEncodingSorted $ V.toList l + v -> A.toEncoding v + nvalueToJSONNixString :: MonadNix e t f m => NValue t f m -> m NixString nvalueToJSONNixString = runWithStringContextT . fmap - ( toStrict - . TL.decodeUtf8 + ( decodeUtf8 + -- This is completely not optimal, but seems we do not have better encoding analog (except for @unsafe*@), Aeson gatekeeps through this. . A.encodingToLazyByteString . toEncodingSorted ) diff --git a/src/Nix/Unused.hs b/src/Nix/Unused.hs new file mode 100644 index 000000000..e94059878 --- /dev/null +++ b/src/Nix/Unused.hs @@ -0,0 +1,82 @@ +{-# language FunctionalDependencies #-} +{-# language TemplateHaskell #-} + +{-# options_ghc -Wno-missing-signatures #-} + +-- | This module holds unused code. +-- So, if someone wants something - look here, use it & move to appropriate place. +module Nix.Unused + where + +import Control.Monad.Free ( Free(..) ) +import Data.Fix ( Fix(..) ) +import Lens.Family2.TH ( makeLensesBy ) + +-- * From "Nix.Utils" + +-- | > type AlgM f m a = f a -> m a +type AlgM f m a = f a -> m a + +whenFree :: (Monoid b) + => (f (Free f a) -> b) -> Free f a -> b +whenFree = + free + mempty +{-# inline whenFree #-} + +whenPure :: (Monoid b) + => (a -> b) -> Free f a -> b +whenPure f = + free + f + mempty +{-# inline whenPure #-} + +-- | Replace: +-- @Pure a -> a@ +-- @Free -> Fix@ +freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f +freeToFix f = go + where + go = + free + f + $ Fix . (go <$>) + +-- | Replace: +-- @a -> Pure a@ +-- @Fix -> Free@ +fixToFree :: Functor f => Fix f -> Free f a +fixToFree = Free . go + where + go (Fix f) = Free . go <$> f + + +loeb :: Functor f => f (f a -> a) -> f a +loeb x = go + where + go = ($ go) <$> x + +adiM + :: ( Traversable t + , Monad m + ) + => Transform t (m a) + -> AlgM t m a + -> Fix t + -> m a +adiM g f = g $ f <=< traverse (adiM g f) . unFix + +para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a +para f = f . fmap (id &&& para f) . unFix + +paraM :: (Traversable f, Monad m) => (f (Fix f, a) -> m a) -> Fix f -> m a +paraM f = f <=< traverse (\x -> (x, ) <$> paraM f x) . unFix + +cataP :: Functor f => (Fix f -> f a -> a) -> Fix f -> a +cataP f x = f x . fmap (cataP f) . unFix $ x + +cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a +cataPM f x = f x <=< traverse (cataPM f) . unFix $ x + +$(makeLensesBy (\n -> pure $ "_" <> n) ''Fix) diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs index 31ba96d7a..0bfc731a8 100644 --- a/src/Nix/Utils.hs +++ b/src/Nix/Utils.hs @@ -1,16 +1,31 @@ {-# language NoImplicitPrelude #-} {-# language CPP #-} -{-# language FunctionalDependencies #-} -{-# language TemplateHaskell #-} {-# language GeneralizedNewtypeDeriving #-} -{-# options_ghc -Wno-missing-signatures #-} - -- | This is a module of custom "Prelude" code. -- It is for import for projects other then @HNix@. -- For @HNix@ - this module gets reexported by "Prelude", so for @HNix@ please fix-up pass-through there. module Nix.Utils - ( module Nix.Utils + ( KeyMap + , TransformF + , Transform + , Alg + , Path(..) + , Has(..) + , trace + , traceM + , stub + , whenTrue + , list + , whenText + , free + , dup + , mapPair + , both + , readFile + , lifted + , loebM + , adi , module X ) where @@ -30,12 +45,9 @@ import Control.Monad.Fix ( MonadFix(..) ) import Control.Monad.Free ( Free(..) ) import Control.Monad.Trans.Control ( MonadTransControl(..) ) import qualified Data.Aeson as A -import qualified Data.Aeson.Encoding as A import Data.Fix ( Fix(..) ) -import qualified Data.HashMap.Lazy as M import qualified Data.Text as Text import qualified Data.Text.IO as Text -import qualified Data.Vector as V import Lens.Family2 as X ( view , over @@ -45,7 +57,6 @@ import Lens.Family2 as X import Lens.Family2.Stock ( _1 , _2 ) -import Lens.Family2.TH ( makeLensesBy ) #if ENABLE_TRACING import qualified Relude.Debug as X @@ -59,8 +70,6 @@ traceM = const pass {-# inline traceM #-} #endif -$(makeLensesBy (\n -> pure $ "_" <> n) ''Fix) - -- | To have explicit type boundary between FilePath & String. newtype Path = Path FilePath deriving @@ -84,9 +93,6 @@ type KeyMap = HashMap Text -- > type Alg f a = f a -> a type Alg f a = f a -> a --- | > type AlgM f m a = f a -> m a -type AlgM f m a = f a -> m a - -- | Do according transformation. -- -- It is a transformation of a recursion scheme. @@ -99,28 +105,25 @@ type Transform f a = TransformF (Fix f) a -- You got me, it is a natural transformation. type TransformF f a = (f -> a) -> f -> a -loeb :: Functor f => f (f a -> a) -> f a -loeb x = go - where - go = ($ go) <$> x +class Has a b where + hasLens :: Lens' a b + +instance Has a a where + hasLens f = f + +instance Has (a, b) a where + hasLens = _1 + +instance Has (a, b) b where + hasLens = _2 loebM :: (MonadFix m, Traversable t) => t (t a -> m a) -> m (t a) -- Sectioning here insures optimization happening. loebM f = mfix $ \a -> (`traverse` f) ($ a) {-# inline loebM #-} -para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a -para f = f . fmap (id &&& para f) . unFix - -paraM :: (Traversable f, Monad m) => (f (Fix f, a) -> m a) -> Fix f -> m a -paraM f = f <=< traverse (\x -> (x, ) <$> paraM f x) . unFix - -cataP :: Functor f => (Fix f -> f a -> a) -> Fix f -> a -cataP f x = f x . fmap (cataP f) . unFix $ x - -cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a -cataPM f x = f x <=< traverse (cataPM f) . unFix $ x - +-- 2021-08-21: NOTE: Someone needs to put in normal words, what this does. +-- This function is pretty spefic & used only once, in "Nix.Normal". lifted :: (MonadTransControl u, Monad (u m), Monad m) => ((a -> m (StT u b)) -> m (StT u b)) @@ -131,29 +134,12 @@ lifted f k = lftd <- liftWith (\run -> f (run . k)) restoreT $ pure lftd --- | Replace: --- @Pure a -> a@ --- @Free -> Fix@ -freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f -freeToFix f = go - where - go = - free - f - $ Fix . (go <$>) - --- | Replace: --- @a -> Pure a@ --- @Fix -> Free@ -fixToFree :: Functor f => Fix f -> Free f a -fixToFree = Free . go - where - go (Fix f) = Free . go <$> f - -- | adi is Abstracting Definitional Interpreters: -- -- https://arxiv.org/abs/1707.04755 -- +-- All ADI does is interleaves every layer of evaluation by inserting intermitten layers between them, in that way the evaluation can be extended/embelished in any way wanted. Look at its use to see great examples. +-- -- Essentially, it does for evaluation what recursion schemes do for -- representation: allows threading layers through existing structure, only -- in this case through behavior. @@ -165,53 +151,6 @@ adi -> a adi g f = g $ f . (adi g f <$>) . unFix -adiM - :: ( Traversable t - , Monad m - ) - => Transform t (m a) - -> AlgM t m a - -> Fix t - -> m a -adiM g f = g $ f <=< traverse (adiM g f) . unFix - - -class Has a b where - hasLens :: Lens' a b - -instance Has a a where - hasLens f = f - -instance Has (a, b) a where - hasLens = _1 - -instance Has (a, b) b where - hasLens = _2 - -toEncodingSorted :: A.Value -> A.Encoding -toEncodingSorted = \case - A.Object m -> - A.pairs - . mconcat - . ((\(k, v) -> A.pair k $ toEncodingSorted v) <$>) - . sortWith fst - $ M.toList m - A.Array l -> A.list toEncodingSorted $ V.toList l - v -> A.toEncoding v - -data NixPathEntryType = PathEntryPath | PathEntryURI deriving (Show, Eq) - --- | @NIX_PATH@ is colon-separated, but can also contain URLs, which have a colon --- (i.e. @https://...@) -uriAwareSplit :: Text -> [(Text, NixPathEntryType)] -uriAwareSplit txt = - case Text.break (== ':') txt of - (e1, e2) - | Text.null e2 -> [(e1, PathEntryPath)] - | "://" `Text.isPrefixOf` e2 -> - let ((suffix, _) : path) = uriAwareSplit (Text.drop 3 e2) in - (e1 <> "://" <> suffix, PathEntryURI) : path - | otherwise -> (e1, PathEntryPath) : uriAwareSplit (Text.drop 1 e2) -- | Analog for @bool@ or @maybe@, for list-like cons structures. list @@ -248,29 +187,6 @@ whenTrue = mempty {-# inline whenTrue #-} -whenFalse :: (Monoid a) - => a -> Bool -> a -whenFalse f = - bool - f - mempty -{-# inline whenFalse #-} - -whenFree :: (Monoid b) - => (f (Free f a) -> b) -> Free f a -> b -whenFree = - free - mempty -{-# inline whenFree #-} - -whenPure :: (Monoid b) - => (a -> b) -> Free f a -> b -whenPure f = - free - f - mempty -{-# inline whenPure #-} - -- | Apply a single function to both components of a pair. -- @@ -300,3 +216,5 @@ stub = pure mempty readFile :: Path -> IO Text readFile = Text.readFile . coerce + + From 92213d7759aa6b924df20ac2c765901286d715d1 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 15:30:49 +0300 Subject: [PATCH 12/21] treewide: use stub --- .hlint.yaml | 21 ++++++++++++++++----- main/Main.hs | 4 ++-- main/Repl.hs | 4 ++-- src/Nix/Convert.hs | 2 +- src/Nix/Utils.hs | 23 +++++++++++++++++++++-- src/Nix/Value/Equal.hs | 12 ++++++------ src/Prelude.hs | 3 ++- tests/Main.hs | 2 +- tests/NixLanguageTests.hs | 12 ++++++------ tests/ParserTests.hs | 2 +- 10 files changed, 58 insertions(+), 27 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 22ef402b2..dc83b19cd 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -20,12 +20,12 @@ name: Use Foldable.forM_ - hint: lhs: "pure ()" - note: "Use 'pass'" - rhs: pass + note: "Use 'stub'" + rhs: stub - hint: lhs: "return ()" - note: "Use 'pass'" - rhs: pass + note: "Use 'stub'" + rhs: stub - hint: lhs: "(: [])" note: "Use `one`" @@ -2667,11 +2667,22 @@ lhs: sum xs / length xs note: "Use `average` from `Relude.Extra.Foldable`" rhs: average xs + - hint: lhs: "\\a -> (a, a)" - note: "Use `dup` from `Relude.Extra.Tuple`" + note: "Use `dup`" rhs: dup - warn: lhs: "() <$ a" rhs: void a + +- hint: + lhs: "pass" + note: "Use 'stub'" + rhs: stub + +- warn: + lhs: "Data.Bool.bool True" + rhs: "Use `whenTrue` from HNix Prelude" + diff --git a/main/Main.hs b/main/Main.hs index 9d1c0b996..3388f5ad2 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -240,10 +240,10 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl liftIO $ Text.putStrLn path when descend $ maybe - pass + stub (\case NVSet _ s' -> go (path <> ".") s' - _ -> pass + _ -> stub ) mv ) diff --git a/main/Repl.hs b/main/Repl.hs index d7bce0aac..e44fa62f8 100644 --- a/main/Repl.hs +++ b/main/Repl.hs @@ -226,7 +226,7 @@ exec update source = do -- If the result value is a set, update our context with it case val of NVSet _ (coerce -> scope) -> put state { replCtx = scope <> replCtx state } - _ -> pass + _ -> stub pure $ pure val ) @@ -258,7 +258,7 @@ cmd source = do mVal <- exec True source maybe - pass + stub printValue mVal diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index b591c5950..600f93741 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -147,7 +147,7 @@ instance Convertible e t f m fromValueMay = pure . \case - NVConstant' NNull -> pass + NVConstant' NNull -> stub _ -> mempty fromValue = fromMayToValue TNull diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs index 0bfc731a8..960751561 100644 --- a/src/Nix/Utils.hs +++ b/src/Nix/Utils.hs @@ -15,10 +15,12 @@ module Nix.Utils , trace , traceM , stub + , pass , whenTrue , list , whenText , free + , whenJust , dup , mapPair , both @@ -30,7 +32,8 @@ module Nix.Utils ) where -import Relude hiding ( force +import Relude hiding ( pass + , force , readFile , whenJust , whenNothing @@ -66,7 +69,7 @@ trace :: String -> a -> a trace = const id {-# inline trace #-} traceM :: Monad m => String -> m () -traceM = const pass +traceM = const stub {-# inline traceM #-} #endif @@ -187,6 +190,17 @@ whenTrue = mempty {-# inline whenTrue #-} +whenJust + :: Monoid b + => (a -> b) + -> Maybe a + -> b +whenJust f ma = + maybe + mempty + f + ma + -- | Apply a single function to both components of a pair. -- @@ -214,6 +228,11 @@ stub :: (Applicative f, Monoid a) => f a stub = pure mempty {-# inline stub #-} +-- | Alias for @stub@, since @Relude@ has more specialized @pure ()@. +pass :: (Applicative f) => f () +pass = stub +{-# inline pass #-} + readFile :: Path -> IO Text readFile = Text.readFile . coerce diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs index fa5fb8bb7..ecb8c3095 100644 --- a/src/Nix/Value/Equal.hs +++ b/src/Nix/Value/Equal.hs @@ -31,12 +31,12 @@ checkComparable -> m () checkComparable x y = case (x, y) of - (NVConstant (NFloat _), NVConstant (NInt _)) -> pass - (NVConstant (NInt _), NVConstant (NFloat _)) -> pass - (NVConstant (NInt _), NVConstant (NInt _)) -> pass - (NVConstant (NFloat _), NVConstant (NFloat _)) -> pass - (NVStr _ , NVStr _ ) -> pass - (NVPath _ , NVPath _ ) -> pass + (NVConstant (NFloat _), NVConstant (NInt _)) -> stub + (NVConstant (NInt _), NVConstant (NFloat _)) -> stub + (NVConstant (NInt _), NVConstant (NInt _)) -> stub + (NVConstant (NFloat _), NVConstant (NFloat _)) -> stub + (NVStr _ , NVStr _ ) -> stub + (NVPath _ , NVPath _ ) -> stub _ -> throwError $ Comparison x y -- | Checks whether two containers are equal, using the given item equality diff --git a/src/Prelude.hs b/src/Prelude.hs index 994715e01..fb6f5fdfd 100644 --- a/src/Prelude.hs +++ b/src/Prelude.hs @@ -9,7 +9,8 @@ module Prelude ) where import Nix.Utils -import Relude hiding ( force +import Relude hiding ( pass + , force , readFile , whenJust , whenNothing diff --git a/tests/Main.hs b/tests/Main.hs index 1e2311296..c2e7e90d5 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -70,7 +70,7 @@ ensureNixpkgsCanParse = -- Parse and deepseq the resulting expression tree, to ensure the -- parser is fully executed. _ <- consider (coerce file) (parseNixFileLoc (coerce file)) $ Exc.evaluate . force - pass + stub v -> fail $ "Unexpected parse from default.nix: " <> show v where getExpr k m = let Just (Just r) = lookup k m in r diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index 57f974d5a..54f6367f2 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -109,15 +109,15 @@ assertParse _opts file = x <- parseNixFileLoc file either (\ err -> assertFailure $ "Failed to parse " <> coerce file <> ":\n" <> show err) - (const pass) -- pure $! runST $ void $ lint opts expr + (const stub) -- pure $! runST $ void $ lint opts expr x assertParseFail :: Options -> Path -> Assertion assertParseFail opts file = do eres <- parseNixFileLoc file - (`catch` \(_ :: SomeException) -> pass) + (`catch` \(_ :: SomeException) -> stub) (either - (const pass) + (const stub) (\ expr -> do _ <- pure $! runST $ void $ lint opts expr @@ -147,8 +147,8 @@ assertEval _opts files = [] -> void $ hnixEvalFile opts (name <> ".nix") [".exp" ] -> assertLangOk opts name [".exp.xml" ] -> assertLangOkXml opts name - [".exp.disabled" ] -> pass - [".exp-disabled" ] -> pass + [".exp.disabled" ] -> stub + [".exp-disabled" ] -> stub [".exp", ".flags"] -> do liftIO $ setEnv "NIX_PATH" "lang/dir4:lang/dir5" @@ -177,7 +177,7 @@ assertEval _opts files = fixup [] = mempty assertEvalFail :: Path -> Assertion -assertEvalFail file = (`catch` (\(_ :: SomeException) -> pass)) $ do +assertEvalFail file = (`catch` (\(_ :: SomeException) -> stub)) $ do time <- liftIO getCurrentTime evalResult <- printNix <$> hnixEvalFile (defaultOptions time) file evalResult `seq` assertFailure $ "File: ''" <> coerce file <> "'' should not evaluate.\nThe evaluation result was `" <> evalResult <> "`." diff --git a/tests/ParserTests.hs b/tests/ParserTests.hs index 026adfbb9..c869344a7 100644 --- a/tests/ParserTests.hs +++ b/tests/ParserTests.hs @@ -740,7 +740,7 @@ assertParseFile file expected = assertParseFail :: NixLang -> Assertion assertParseFail str = either - (const pass) + (const stub) (\ r -> assertFailure $ toString $ "\nUnexpected success parsing string ''" <> str <> "'':\n''Parsed value: ''" <> show r <> "''." ) From 08a91cddb9dedf2efd4b425c36f5442d74089046 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 15:50:10 +0300 Subject: [PATCH 13/21] treewide: use whenJust --- .hlint.yaml | 4 ++++ src/Nix/Builtins.hs | 5 +---- src/Nix/Pretty.hs | 25 +++++++++---------------- src/Nix/Render/Frame.hs | 5 +---- src/Nix/TH.hs | 4 ++-- src/Nix/Utils.hs | 5 ++--- src/Nix/XML.hs | 5 +---- 7 files changed, 20 insertions(+), 33 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index dc83b19cd..67cfcfe22 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -2686,3 +2686,7 @@ lhs: "Data.Bool.bool True" rhs: "Use `whenTrue` from HNix Prelude" +- hint: + lhs: "maybe mempty" + note: "Use `whenJust`" + rhs: whenJust diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index be8ea4c80..2bbf12f37 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -207,10 +207,7 @@ foldNixPath z f = go z $ (fromInclude . stringIgnoreContext <$> dirs) - <> maybe - mempty - uriAwareSplit - mPath + <> uriAwareSplit `whenJust` mPath <> [ fromInclude $ "nix=" <> toText dataDir <> "/nix/corepkgs" ] where diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index e53ffd193..de43bc782 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -132,15 +132,14 @@ prettyParams :: Params (NixDoc ann) -> Doc ann prettyParams (Param n ) = prettyVarName n prettyParams (ParamSet mname variadic pset) = prettyParamSet variadic pset <> - maybe + toDoc `whenJust` mname + where + toDoc :: VarName -> Doc ann + toDoc (coerce -> name) = + bool mempty - (\ (coerce -> name) -> - bool - mempty - ("@" <> pretty name) - (not (Text.null name)) - ) - mname + ("@" <> pretty name) + (not (Text.null name)) prettyParamSet :: Variadic -> ParamSet (NixDoc ann) -> Doc ann prettyParamSet variadic args = @@ -164,10 +163,7 @@ prettyBind (Inherit s ns _p) = "inherit " <> scope <> align (fillSep $ prettyVarName <$> ns) <> ";" where scope = - maybe - mempty - ((<> " ") . parens . withoutParens) - s + ((<> " ") . parens . withoutParens) `whenJust` s prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann prettyKeyName (StaticKey "") = "\"\"" @@ -255,10 +251,7 @@ exprFNixDoc = \case where r = mkNixDoc selectOp (wrapParens appOpNonAssoc r') ordoc = - maybe - mempty - ((" or " <>) . wrapParens appOpNonAssoc) - o + ((" or " <>) . wrapParens appOpNonAssoc) `whenJust` o NHasAttr r attr -> mkNixDoc hasAttrOp (wrapParens hasAttrOp r <> " ? " <> prettySelector attr) NEnvPath p -> simpleExpr $ pretty @String $ coerce $ "<" <> p <> ">" diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index 6c4937859..a9b2ca223 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -55,10 +55,7 @@ renderFrames (x : xs) = do where go :: NixFrame -> [Doc ann] go f = - maybe - mempty - (\ pos -> ["While evaluating at " <> pretty (sourcePosPretty pos) <> colon]) - (framePos @v @m f) + (\ pos -> ["While evaluating at " <> pretty (sourcePosPretty pos) <> colon]) `whenJust` framePos @v @m f framePos :: forall v (m :: Type -> Type) diff --git a/src/Nix/TH.hs b/src/Nix/TH.hs index 3ffc99d61..8671f5e72 100644 --- a/src/Nix/TH.hs +++ b/src/Nix/TH.hs @@ -68,7 +68,7 @@ freeVars e = case unFix e of Set.unions [ freeVars expr , pathFree path - , maybe mempty freeVars orExpr + , freeVars `whenJust` orExpr ] (NHasAttr expr path) -> freeVars expr <> pathFree path (NAbs (Param varname) expr) -> Set.delete varname (freeVars expr) @@ -79,7 +79,7 @@ freeVars e = case unFix e of Set.difference (Set.unions $ freeVars <$> mapMaybe snd pset) (Set.difference - (maybe mempty one varname) + (one `whenJust` varname) (Set.fromList $ fst <$> pset) ) (NLet bindings expr ) -> diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs index 960751561..de7e7f266 100644 --- a/src/Nix/Utils.hs +++ b/src/Nix/Utils.hs @@ -195,11 +195,10 @@ whenJust => (a -> b) -> Maybe a -> b -whenJust f ma = +whenJust = maybe mempty - f - ma +{-# inline whenJust #-} -- | Apply a single function to both components of a pair. diff --git a/src/Nix/XML.hs b/src/Nix/XML.hs index 295f2640a..1dcdd3401 100644 --- a/src/Nix/XML.hs +++ b/src/Nix/XML.hs @@ -111,10 +111,7 @@ paramsXML (ParamSet mname variadic pset) = [ Attr (unqual "ellipsis") "1" ] (variadic == Variadic) nattr = - maybe - mempty - ((: mempty) . Attr (unqual "name") . toString) - mname + ((: mempty) . Attr (unqual "name") . toString) `whenJust` mname paramSetXML :: ParamSet r -> [Content] paramSetXML = fmap (\(k, _) -> Elem $ mkEName "attr" (toString k)) From bf537f44a1aabb4605638beb468a4da71dd0dd01 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 16:14:39 +0300 Subject: [PATCH 14/21] treewide: use whenTrue, whenFalse --- .hlint.yaml | 16 +++++++++++----- main/Repl.hs | 2 +- src/Nix/Effects/Basic.hs | 11 ++--------- src/Nix/Expr/Shorthands.hs | 4 ++-- src/Nix/Pretty.hs | 7 ++----- src/Nix/Render.hs | 7 +++---- src/Nix/Render/Frame.hs | 5 +---- src/Nix/Utils.hs | 9 +++++++++ src/Nix/Value.hs | 5 +---- src/Nix/XML.hs | 5 +---- 10 files changed, 33 insertions(+), 38 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 67cfcfe22..d72405927 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -2682,11 +2682,17 @@ note: "Use 'stub'" rhs: stub -- warn: - lhs: "Data.Bool.bool True" - rhs: "Use `whenTrue` from HNix Prelude" +- hint: + lhs: "bool mempty a b" + note: "Use `whenTrue`" + rhs: a `whenTrue` b + +- hint: + lhs: "bool a mempty b" + note: "Use `whenFalse`" + rhs: a `whenFalse` b - hint: - lhs: "maybe mempty" + lhs: "maybe mempty a b" note: "Use `whenJust`" - rhs: whenJust + rhs: a `whenJust` b diff --git a/main/Repl.hs b/main/Repl.hs index e44fa62f8..162a4fe1e 100644 --- a/main/Repl.hs +++ b/main/Repl.hs @@ -248,7 +248,7 @@ exec update source = do (parseNixTextLoc i) toAttrSet i = - "{" <> i <> bool ";" mempty (Text.isSuffixOf ";" i) <> "}" + "{" <> i <> whenFalse ";" (Text.isSuffixOf ";" i) <> "}" cmd :: (MonadNix e t f m, MonadIO m) diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs index 915280ab8..6e304ca78 100644 --- a/src/Nix/Effects/Basic.hs +++ b/src/Nix/Effects/Basic.hs @@ -108,11 +108,7 @@ findEnvPathM name = do (toAbsolutePath @t @f $ coerce $ coerce absPath "default.nix") isDir exists <- doesFileExist absFile - pure $ - bool - mempty - (pure absFile) - exists + pure $ pure absFile `whenTrue` exists findPathBy :: forall e t f m @@ -147,10 +143,7 @@ findPathBy finder ls name = do case mns of Just (nsPfx :: NixString) -> let pfx = stringIgnoreContext nsPfx in - bool - mempty - (pure $ coerce $ toString pfx) - (not $ Text.null pfx) + pure $ coerce $ toString pfx `whenFalse` Text.null pfx _ -> mempty ) (M.lookup "prefix" s) diff --git a/src/Nix/Expr/Shorthands.hs b/src/Nix/Expr/Shorthands.hs index 6889782f2..9b1cc4e96 100644 --- a/src/Nix/Expr/Shorthands.hs +++ b/src/Nix/Expr/Shorthands.hs @@ -124,7 +124,7 @@ mkNamedVariadicParamSet name params = mkGeneralParamSet (pure name) params True -- > False -> {} -- @since 0.15.0 mkGeneralParamSet :: Maybe Text -> [(Text, Maybe NExpr)] -> Bool -> Params NExpr -mkGeneralParamSet mname params variadic = ParamSet (coerce mname) (bool mempty Variadic variadic) (coerce params) +mkGeneralParamSet mname params variadic = ParamSet (coerce mname) (Variadic `whenTrue` variadic) (coerce params) -- | > rec { .. } mkRecSet :: [Binding NExpr] -> NExpr @@ -444,4 +444,4 @@ mkBinop = mkOp2 -- * `mkVariadicSet` is for variadic; -- * `mkGeneralParamSet` a general constructor. mkParamset :: [(Text, Maybe NExpr)] -> Bool -> Params NExpr -mkParamset params variadic = ParamSet Nothing (bool mempty Variadic variadic) (coerce params) +mkParamset params variadic = ParamSet Nothing (Variadic `whenTrue` variadic) (coerce params) diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index de43bc782..05b361dbd 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -136,10 +136,7 @@ prettyParams (ParamSet mname variadic pset) = where toDoc :: VarName -> Doc ann toDoc (coerce -> name) = - bool - mempty - ("@" <> pretty name) - (not (Text.null name)) + ("@" <> pretty name) `whenFalse` Text.null name prettyParamSet :: Variadic -> ParamSet (NixDoc ann) -> Doc ann prettyParamSet variadic args = @@ -147,7 +144,7 @@ prettyParamSet variadic args = "{ " (align " }") sep - (fmap prettySetArg args <> bool mempty ["..."] (variadic == Variadic)) + (fmap prettySetArg args <> ["..."] `whenTrue` (variadic == Variadic)) where prettySetArg (n, maybeDef) = maybe diff --git a/src/Nix/Render.hs b/src/Nix/Render.hs index a37be7794..e18b4a6f1 100644 --- a/src/Nix/Render.hs +++ b/src/Nix/Render.hs @@ -119,14 +119,13 @@ sourceContext path (unPos -> begLine) (unPos -> _begCol) (unPos -> endLine) (unP | otherwise -> " " <> nsp <> " | " composeLine n l = [pretty (pad n) <> l] - <> bool mempty - [ pretty $ + <> ([ pretty $ Text.replicate (Text.length (pad n) - 3) " " <> "|" <> Text.replicate (_begCol + 1) " " <> Text.replicate (_endCol - _begCol) "^" - ] - (begLine == endLine && n == endLine) + ] `whenTrue` (begLine == endLine && n == endLine) + ) -- XXX: Consider inserting the message here when it is small enough. -- ATM some messages are so huge that they take prevalence over the source listing. -- ++ [ indent (length $ pad n) msg | n == endLine ] diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index a9b2ca223..fe2c27bd9 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -104,10 +104,7 @@ renderEvalFrame level f = do let scopeInfo = - bool - mempty - [pretty $ Text.show scope] - (showScopes opts) + [pretty $ Text.show scope] `whenTrue` showScopes opts fmap (\x -> scopeInfo <> [x]) $ renderLocation ann =<< diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs index de7e7f266..0386c0206 100644 --- a/src/Nix/Utils.hs +++ b/src/Nix/Utils.hs @@ -17,6 +17,7 @@ module Nix.Utils , stub , pass , whenTrue + , whenFalse , list , whenText , free @@ -190,6 +191,14 @@ whenTrue = mempty {-# inline whenTrue #-} +whenFalse :: (Monoid a) + => a -> Bool -> a +whenFalse f = + bool + f + mempty +{-# inline whenFalse #-} + whenJust :: Monoid b => (a -> b) diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index ca8555f85..400bf5a9e 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -729,10 +729,7 @@ valueType = NNull -> TNull NVStrF ns -> TString $ - bool - mempty - HasContext - (stringHasContext ns) + HasContext `whenTrue` stringHasContext ns NVListF{} -> TList NVSetF{} -> TSet NVClosureF{} -> TClosure diff --git a/src/Nix/XML.hs b/src/Nix/XML.hs index 1dcdd3401..e84f5fc8a 100644 --- a/src/Nix/XML.hs +++ b/src/Nix/XML.hs @@ -106,10 +106,7 @@ paramsXML (ParamSet mname variadic pset) = [Elem $ Element (unqual "attrspat") (battr <> nattr) (paramSetXML pset) Nothing] where battr = - bool - mempty - [ Attr (unqual "ellipsis") "1" ] - (variadic == Variadic) + [ Attr (unqual "ellipsis") "1" ] `whenTrue` (variadic == Variadic) nattr = ((: mempty) . Attr (unqual "name") . toString) `whenJust` mname From 4c3f421b310de7fe26d1426994f465b743cef62f Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 16:31:16 +0300 Subject: [PATCH 15/21] m use stub --- src/Nix/Convert.hs | 4 ++-- src/Nix/Lint.hs | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index 600f93741..eac90ece6 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -253,10 +253,10 @@ instance ( Convertible e t f m NVStr' ns -> pure $ coerce . toString <$> getStringNoContext ns NVSet' _ s -> maybe - (pure Nothing) + stub (fromValueMay @Path) (M.lookup "outPath" s) - _ -> pure Nothing + _ -> stub fromValue = fromMayToValue TPath diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 88fd3e638..3bb3f00b6 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -212,9 +212,9 @@ merge context = go mergeFunctions pl nl fl pr fr xs ys = do m <- sequenceA $ M.intersectionWith (\i j -> i >>= \i' -> j >>= \j' -> case (i', j') of - (Nothing, Nothing) -> pure $ pure Nothing - (_, Nothing) -> pure Nothing - (Nothing, _) -> pure Nothing + (Nothing, Nothing) -> stub + (_, Nothing) -> stub + (Nothing, _) -> stub (Just i'', Just j'') -> pure . pure <$> unify context i'' j'') (pure <$> pl) (pure <$> pr) @@ -478,7 +478,7 @@ runLintM opts action = do symbolicBaseEnv :: Monad m => m (Scopes m (Symbolic m)) -symbolicBaseEnv = pure mempty +symbolicBaseEnv = stub lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s)) lint opts expr = From f35982122be7e5ecedcc51084ff8b5a908030a41 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 17:36:55 +0300 Subject: [PATCH 16/21] Lint: merge: refactor go --- src/Nix/Lint.hs | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 3bb3f00b6..0e781bf6b 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -170,20 +170,19 @@ merge context = go -> m [NTypeF m (Symbolic m)] go [] _ = stub go _ [] = stub - go (x : xs) (y : ys) = case (x, y) of - (TStr , TStr ) -> (TStr :) <$> go xs ys - (TPath, TPath) -> (TPath :) <$> go xs ys + go xxs@(x : xs) yys@(y : ys) = case (x, y) of + (TStr , TStr ) -> (TStr :) <$> rest + (TPath, TPath) -> (TPath :) <$> rest (TConstant ls, TConstant rs) -> - (TConstant (ls `intersect` rs) :) <$> go xs ys + (TConstant (ls `intersect` rs) :) <$> rest (TList l, TList r) -> - (\l' -> - (\r' -> do - m <- defer $ unify context l' r' - (TList m :) <$> go xs ys - ) =<< demand r - ) =<< demand l - (TSet x , TSet Nothing ) -> (TSet x :) <$> go xs ys - (TSet Nothing , TSet x ) -> (TSet x :) <$> go xs ys + do + l' <- demand l + r' <- demand r + m <- defer $ unify context l' r' + (TList m :) <$> rest + (TSet x , TSet Nothing ) -> (TSet x :) <$> rest + (TSet Nothing , TSet x ) -> (TSet x :) <$> rest (TSet (Just l), TSet (Just r)) -> do m <- sequenceA $ M.intersectionWith (\ i j -> @@ -198,15 +197,18 @@ merge context = go id ((TSet (pure m) :) <$>) (not $ M.null m) - (go xs ys) + rest (TClosure{}, TClosure{}) -> throwError $ ErrorCall "Cannot unify functions" (TBuiltin _ _, TBuiltin _ _) -> throwError $ ErrorCall "Cannot unify builtin functions" - _ | compareTypes x y == LT -> go xs (y : ys) - | compareTypes x y == GT -> go (x : xs) ys + _ | compareTypes x y == LT -> go xs yys + | compareTypes x y == GT -> go xxs ys | otherwise -> error "impossible" + where + rest :: m [NTypeF m (Symbolic m)] + rest = go xs ys {- mergeFunctions pl nl fl pr fr xs ys = do From efbc844dd7c62521d22d0cf5e068646ab9f7d7c5 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 17:37:42 +0300 Subject: [PATCH 17/21] Lint: renderSymbolic: refactor --- src/Nix/Lint.hs | 67 +++++++++++++++++++++++++++++++------------------ 1 file changed, 42 insertions(+), 25 deletions(-) diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 0e781bf6b..4c01cc5ca 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -128,31 +128,48 @@ symerr :: forall e m a . MonadLint e m => Text -> m a symerr = evalError @(Symbolic m) . ErrorCall . toString renderSymbolic :: MonadLint e m => Symbolic m -> m Text -renderSymbolic = unpackSymbolic >=> \case - NAny -> pure "" - NMany xs -> fmap (Text.intercalate ", ") $ forM xs $ \case - TConstant ys -> fmap (Text.intercalate ", ") $ forM ys $ pure . \case - TInt -> "int" - TFloat -> "float" - TBool -> "bool" - TNull -> "null" - TStr -> pure "string" - TList r -> do - x <- renderSymbolic =<< demand r - pure $ "[" <> x <> "]" - TSet Nothing -> pure "" - TSet (Just s) -> do - x <- traverse (renderSymbolic <=< demand) s - pure $ "{" <> show x <> "}" - f@(TClosure p) -> do - (args, sym) <- do - f' <- mkSymbolic [f] - lintApp (NAbs (void p) ()) f' everyPossible - args' <- traverse renderSymbolic args - sym' <- renderSymbolic sym - pure $ "(" <> show args' <> " -> " <> sym' <> ")" - TPath -> pure "path" - TBuiltin _n _f -> pure "" +renderSymbolic = + (\case + NAny -> pure "" + NMany xs -> + Text.intercalate ", " <$> + traverse + (\case + TConstant ys -> + Text.intercalate ", " <$> + traverse + (pure . + \case + TInt -> "int" + TFloat -> "float" + TBool -> "bool" + TNull -> "null" + ) + ys + TStr -> pure "string" + TList r -> + do + x <- renderSymbolic =<< demand r + pure $ "[" <> x <> "]" + TSet Nothing -> pure "" + TSet (Just s) -> + do + x <- traverse (renderSymbolic <=< demand) s + pure $ "{" <> show x <> "}" + f@(TClosure p) -> + do + (args, sym) <- + do + f' <- mkSymbolic [f] + lintApp (NAbs p ()) f' everyPossible + args' <- traverse renderSymbolic args + sym' <- renderSymbolic sym + pure $ "(" <> show args' <> " -> " <> sym' <> ")" + TPath -> pure "path" + TBuiltin _n _f -> pure "" + ) + xs + ) <=< unpackSymbolic -- This function is order and uniqueness preserving (of types). merge From d1a7f75a0ead4f5a279122f8284b52fa9de61c19 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 17:50:36 +0300 Subject: [PATCH 18/21] Reduce: add reduceLayer --- src/Nix/Reduce.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs index 710b3d3f3..14248b5b7 100644 --- a/src/Nix/Reduce.hs +++ b/src/Nix/Reduce.hs @@ -208,7 +208,7 @@ reduce base@(NSelectAnnF _ _ _ attrs) inspectSet (unFix aset) attrs | otherwise = sId where - sId = Fix <$> sequence base + sId = reduceLayer base -- The selection AttrPath is composed of StaticKeys. sAttrPath (StaticKey _ : xs) = sAttrPath xs sAttrPath [] = True @@ -242,8 +242,8 @@ reduce e@(NSetAnnF ann NonRecursive binds) = binds bool - (Fix <$> sequence e) (clearScopes @NExprLoc $ NSetAnn ann mempty <$> traverse sequence binds) + (reduceLayer e) usesInherit -- Encountering a 'rec set' construction eliminates any hope of inlining @@ -299,7 +299,7 @@ reduce (NLetAnnF ann binds body) = reduce e@(NIfAnnF _ b t f) = (\case NConstantAnn _ (NBool b') -> bool f t b' - _ -> Fix <$> sequence e + _ -> reduceLayer e ) =<< b -- | Reduce an assert atom to its encapsulated @@ -322,7 +322,10 @@ reduce (NAbsAnnF ann params body) = do HM.fromList $ (\(k, _) -> (k, NSymAnn ann k)) <$> pset NAbsAnn ann params' <$> pushScope scope body -reduce v = Fix <$> sequence v +reduce v = reduceLayer v + +reduceLayer :: (Traversable f1, Applicative f2) => f1 (f2 (Fix f1)) -> f2 (Fix f1) +reduceLayer v = Fix <$> sequenceA v -- newtype FlaggedF f r = FlaggedF { flagged :: (IORef Bool, f r) } newtype FlaggedF f r = FlaggedF (IORef Bool, f r) From 9dc602d473dec56aaf15490e7f5d8449ee569cee Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 17:59:51 +0300 Subject: [PATCH 19/21] treewide: sequnce(->A) --- src/Nix/Builtins.hs | 2 +- src/Nix/Convert.hs | 6 +++--- src/Nix/Effects/Derivation.hs | 2 +- src/Nix/Eval.hs | 4 ++-- src/Nix/Exec.hs | 2 +- src/Nix/Reduce.hs | 18 +++++++++--------- src/Nix/Render/Frame.hs | 2 +- src/Nix/XML.hs | 4 ++-- 8 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 2bbf12f37..fec89b7df 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -1770,7 +1770,7 @@ langVersionNix = toValue (5 :: Int) -- ** @builtinsList@ builtinsList :: forall e t f m . MonadNix e t f m => m [Builtin (NValue t f m)] -builtinsList = sequence +builtinsList = sequenceA [ add0 Normal "nixVersion" nixVersionNix , add0 Normal "langVersion" langVersionNix , add TopLevel "abort" throwNix -- for now diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index eac90ece6..c6e53b555 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -277,7 +277,7 @@ instance ( Convertible e t f m => FromValue [a] m (Deeper (NValue' t f m (NValue t f m))) where fromValueMay = \case - Deeper (NVList' l) -> sequence <$> traverse fromValueMay l + Deeper (NVList' l) -> sequenceA <$> traverse fromValueMay l _ -> stub @@ -301,7 +301,7 @@ instance ( Convertible e t f m fromValueMay = \case - Deeper (NVSet' _ s) -> sequence <$> traverse fromValueMay s + Deeper (NVSet' _ s) -> sequenceA <$> traverse fromValueMay s _ -> stub fromValue = fromMayToDeeperValue TSet @@ -326,7 +326,7 @@ instance ( Convertible e t f m fromValueMay = \case - Deeper (NVSet' p s) -> fmap (, p) . sequence <$> traverse fromValueMay s + Deeper (NVSet' p s) -> fmap (, p) . sequenceA <$> traverse fromValueMay s _ -> stub fromValue = fromMayToDeeperValue TSet diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs index e3fab55f6..bceab4c07 100644 --- a/src/Nix/Effects/Derivation.hs +++ b/src/Nix/Effects/Derivation.hs @@ -272,7 +272,7 @@ defaultDerivationStrict val = do (Map.keys $ outputs drv) ) } - outputs' <- sequence $ Map.mapWithKey (\o _ -> makeOutputPath o hash drvName) $ outputs drv + outputs' <- sequenceA $ Map.mapWithKey (\o _ -> makeOutputPath o hash drvName) $ outputs drv pure $ drv { inputs , outputs = outputs' diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs index 9dfb70b48..08be554c8 100644 --- a/src/Nix/Eval.hs +++ b/src/Nix/Eval.hs @@ -244,7 +244,7 @@ attrSetAlter (k : ks) pos m p val = (\(st', _) -> (M.insert k - (toValue @(AttrSet v, PositionSet) =<< (, mempty) <$> sequence st') + (toValue @(AttrSet v, PositionSet) =<< (, mempty) <$> sequenceA st') m , M.insert (coerce k) pos p ) @@ -465,7 +465,7 @@ assembleString -> m (Maybe NixString) assembleString = fromParts . stringParts where - fromParts xs = (mconcat <$>) . sequence <$> traverse go xs + fromParts xs = (mconcat <$>) . sequenceA <$> traverse go xs go = runAntiquoted "\n" diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index dd9450f3e..1468084bf 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -500,7 +500,7 @@ addTracing k v = do depth <- ask guard $ depth < 2000 local succ $ do - v'@(AnnF span x) <- sequence v + v'@(AnnF span x) <- sequenceA v pure $ do opts :: Options <- asks $ view hasLens let diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs index 14248b5b7..1dfcafb78 100644 --- a/src/Nix/Reduce.hs +++ b/src/Nix/Reduce.hs @@ -204,7 +204,7 @@ reduce (NBinaryAnnF bann op larg rarg) = -- 3. The selected AttrPath exists in the set. reduce base@(NSelectAnnF _ _ _ attrs) | sAttrPath $ NE.toList attrs = do - (NSelectAnnF _ _ aset attrs) <- sequence base + (NSelectAnnF _ _ aset attrs) <- sequenceA base inspectSet (unFix aset) attrs | otherwise = sId where @@ -242,14 +242,14 @@ reduce e@(NSetAnnF ann NonRecursive binds) = binds bool - (clearScopes @NExprLoc $ NSetAnn ann mempty <$> traverse sequence binds) (reduceLayer e) + (clearScopes @NExprLoc $ NSetAnn ann mempty <$> traverse sequenceA binds) usesInherit -- Encountering a 'rec set' construction eliminates any hope of inlining -- definitions. reduce (NSetAnnF ann Recursive binds) = - clearScopes @NExprLoc $ NSetAnn ann Recursive <$> traverse sequence binds + clearScopes @NExprLoc $ NSetAnn ann Recursive <$> traverse sequenceA binds -- Encountering a 'with' construction eliminates any hope of inlining -- definitions. @@ -260,7 +260,7 @@ reduce (NWithAnnF ann scope body) = -- constants and strings to the body scope. reduce (NLetAnnF ann binds body) = do - binds' <- traverse sequence binds + binds' <- traverse sequenceA binds body' <- (`pushScope` body) . coerce . HM.fromList . catMaybes =<< traverse @@ -281,7 +281,7 @@ reduce (NLetAnnF ann binds body) = binds -- let names = gatherNames body' - -- binds' <- traverse sequence binds <&> \b -> flip filter b $ \case + -- binds' <- traverse sequenceA binds <&> \b -> flip filter b $ \case -- NamedVar (StaticKey name _ :| []) _ -> -- name `S.member` names -- _ -> True @@ -307,11 +307,11 @@ reduce e@(NIfAnnF _ b t f) = reduce e@(NAssertAnnF _ b body) = (\case NConstantAnn _ (NBool b') | b' -> body - _ -> Fix <$> sequence e + _ -> reduceLayer e ) =<< b reduce (NAbsAnnF ann params body) = do - params' <- sequence params + params' <- sequenceA params -- Make sure that variable definitions in scope do not override function -- arguments. let @@ -369,7 +369,7 @@ pruneTree opts = NSet recur binds -> pure $ NSet recur $ bool (fromMaybe annNNull <<$>>) - (mapMaybe sequence) + (mapMaybe sequenceA) (reduceSets opts) -- Reduce set members that aren't used; breaks if hasAttr is used binds @@ -410,7 +410,7 @@ pruneTree opts = NIf _ Nothing (Just (Ann _ f)) -> pure f NIf _ (Just (Ann _ t)) Nothing -> pure t - x -> sequence x + x -> sequenceA x pruneString :: NString (Maybe NExprLoc) -> NString NExprLoc pruneString (DoubleQuoted xs) = DoubleQuoted $ mapMaybe pruneAntiquotedText xs diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index fe2c27bd9..ca2b86c4d 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -123,7 +123,7 @@ renderEvalFrame level f = "While calling builtins." <> pretty name SynHole synfo -> - sequence $ + sequenceA $ let e@(Ann ann _) = _synHoleInfo_expr synfo in [ renderLocation ann =<< diff --git a/src/Nix/XML.hs b/src/Nix/XML.hs index e84f5fc8a..96c264481 100644 --- a/src/Nix/XML.hs +++ b/src/Nix/XML.hs @@ -47,7 +47,7 @@ toXML = runWithStringContext . fmap pp . iterNValueByDiscardWith cyc phi mkEVal "string" . toString <$> extractNixString str NVList' l -> do - els <- sequence l + els <- sequenceA l pure $ mkE "list" @@ -55,7 +55,7 @@ toXML = runWithStringContext . fmap pp . iterNValueByDiscardWith cyc phi NVSet' _ s -> do - kvs <- sequence s + kvs <- sequenceA s pure $ mkE "attrs" From 65c9137843f94345e47135c8269e16563e477f05 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 18:21:51 +0300 Subject: [PATCH 20/21] treewide: use traverseM --- src/Nix/Convert.hs | 29 ++++++++++++++++++++--------- src/Nix/Eval.hs | 2 +- src/Nix/Utils.hs | 13 ++++++++++++- 3 files changed, 33 insertions(+), 11 deletions(-) diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index c6e53b555..dc452ddfd 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -71,6 +71,14 @@ class FromValue a m v where fromValue :: v -> m a fromValueMay :: v -> m (Maybe a) +traverseFromM + :: ( Applicative m + , Traversable t + , FromValue b m a + ) + => t a + -> m (Maybe (t b)) +traverseFromM = traverseM fromValueMay -- Please, hide these helper function from export, to be sure they get optimized away. fromMayToValue @@ -277,7 +285,7 @@ instance ( Convertible e t f m => FromValue [a] m (Deeper (NValue' t f m (NValue t f m))) where fromValueMay = \case - Deeper (NVList' l) -> sequenceA <$> traverse fromValueMay l + Deeper (NVList' l) -> traverseFromM l _ -> stub @@ -301,7 +309,7 @@ instance ( Convertible e t f m fromValueMay = \case - Deeper (NVSet' _ s) -> sequenceA <$> traverse fromValueMay s + Deeper (NVSet' _ s) -> traverseFromM s _ -> stub fromValue = fromMayToDeeperValue TSet @@ -326,7 +334,7 @@ instance ( Convertible e t f m fromValueMay = \case - Deeper (NVSet' p s) -> fmap (, p) . sequenceA <$> traverse fromValueMay s + Deeper (NVSet' p s) -> (, p) <<$>> traverseFromM s _ -> stub fromValue = fromMayToDeeperValue TSet @@ -345,13 +353,15 @@ instance ( Convertible e t f m class ToValue a m v where toValue :: a -> m v -instance (Convertible e t f m, ToValue a m (NValue' t f m (NValue t f m))) +instance (Convertible e t f m + , ToValue a m (NValue' t f m (NValue t f m)) + ) => ToValue a m (NValue t f m) where toValue v = Free <$> toValue v instance ( Convertible e t f m - , ToValue a m (Deeper (NValue' t f m (NValue t f m))) - ) + , ToValue a m (Deeper (NValue' t f m (NValue t f m))) + ) => ToValue a m (Deeper (NValue t f m)) where toValue v = Free <<$>> toValue v @@ -395,8 +405,7 @@ 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 - ) +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 @@ -410,7 +419,9 @@ instance Convertible e t f m => ToValue [NValue t f m] m (NValue' t f m (NValue t f m)) where toValue = pure . nvList' -instance (Convertible e t f m, ToValue a m (NValue t f m)) +instance (Convertible e t f m + , ToValue a m (NValue t f m) + ) => ToValue [a] m (Deeper (NValue' t f m (NValue t f m))) where toValue l = Deeper . nvList' <$> traverse toValue l diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs index 08be554c8..fb197a432 100644 --- a/src/Nix/Eval.hs +++ b/src/Nix/Eval.hs @@ -465,7 +465,7 @@ assembleString -> m (Maybe NixString) assembleString = fromParts . stringParts where - fromParts xs = (mconcat <$>) . sequenceA <$> traverse go xs + fromParts xs = mconcat <<$>> traverseM go xs go = runAntiquoted "\n" diff --git a/src/Nix/Utils.hs b/src/Nix/Utils.hs index 0386c0206..29d28ee5b 100644 --- a/src/Nix/Utils.hs +++ b/src/Nix/Utils.hs @@ -26,6 +26,7 @@ module Nix.Utils , mapPair , both , readFile + , traverseM , lifted , loebM , adi @@ -244,4 +245,14 @@ pass = stub readFile :: Path -> IO Text readFile = Text.readFile . coerce - +traverseM + :: ( Applicative m + , Applicative f + , Traversable t + ) + => ( a + -> m (f b) + ) + -> t a + -> m (f (t b)) +traverseM f x = sequenceA <$> traverse f x From 0071387fa6a3eb616a448d325262858bfc8963d7 Mon Sep 17 00:00:00 2001 From: Anton-Latukha Date: Sat, 21 Aug 2021 18:29:53 +0300 Subject: [PATCH 21/21] Convert: add traverseToValue --- src/Nix/Convert.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index dc452ddfd..89224d62e 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -80,6 +80,9 @@ traverseFromM -> m (Maybe (t b)) traverseFromM = traverseM fromValueMay +traverseToValue :: ((Traversable t, Applicative f, ToValue a f b) => t a -> f (t b)) +traverseToValue = traverse toValue + -- Please, hide these helper function from export, to be sure they get optimized away. fromMayToValue :: forall t f m a e @@ -423,7 +426,7 @@ instance (Convertible e t f m , ToValue a m (NValue t f m) ) => ToValue [a] m (Deeper (NValue' t f m (NValue t f m))) where - toValue l = Deeper . nvList' <$> traverse toValue l + toValue l = Deeper . nvList' <$> traverseToValue l instance Convertible e t f m => ToValue (AttrSet (NValue t f m)) m (NValue' t f m (NValue t f m)) where @@ -433,7 +436,7 @@ 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 $ nvSet' s v) - (traverse toValue s) + (traverseToValue s) stub instance Convertible e t f m @@ -446,7 +449,7 @@ instance (Convertible e t f m, ToValue a m (NValue t f m)) (Deeper (NValue' t f m (NValue t f m))) where toValue (s, p) = liftA2 (\ v s -> Deeper $ nvSet' s v) - (traverse toValue s) + (traverseToValue s) (pure p) instance Convertible e t f m @@ -464,7 +467,7 @@ instance Convertible e t f m let outputs = mkNixStringWithoutContext <$> nlcvOutputs nlcv - ts :: [NValue t f m] <- traverse toValue outputs + ts :: [NValue t f m] <- traverseToValue outputs list (pure Nothing) (fmap pure . toValue)