Skip to content

Commit

Permalink
(#1027) mk mod Prelude NoImplicitPrelude, mv mod Prelude (->Nix.)
Browse files Browse the repository at this point in the history
  • Loading branch information
Anton-Latukha authored Jan 12, 2022
1 parent 27e357d commit 9bccd0f
Show file tree
Hide file tree
Showing 63 changed files with 102 additions and 69 deletions.
1 change: 1 addition & 0 deletions benchmarks/Main.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
module Main where

import Nix.Prelude
import Criterion.Main

import qualified ParserBench
Expand Down
1 change: 1 addition & 0 deletions benchmarks/ParserBench.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
module ParserBench (benchmarks) where

import Nix.Prelude
import Nix.Parser

import Criterion
Expand Down
26 changes: 9 additions & 17 deletions hnix.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -341,8 +341,8 @@ flag profiling

library
exposed-modules:
Prelude
Nix
Nix.Prelude
Nix.Utils
Nix.Atoms
Nix.Builtins
Expand Down Expand Up @@ -398,9 +398,6 @@ library
Paths_hnix
hs-source-dirs:
src
mixins:
base hiding (Prelude)
, relude
ghc-options:
-Wall
-fprint-potential-instances
Expand Down Expand Up @@ -469,7 +466,8 @@ library
, vector >= 0.12.0 && < 0.13
, xml >= 1.3.14 && < 1.4
default-extensions:
OverloadedStrings
NoImplicitPrelude
, OverloadedStrings
, DeriveGeneric
, DeriveDataTypeable
, DeriveFunctor
Expand Down Expand Up @@ -532,11 +530,9 @@ executable hnix
, serialise
, template-haskell
, time
mixins:
base hiding (Prelude)
, relude
default-extensions:
OverloadedStrings
NoImplicitPrelude
, OverloadedStrings
, DeriveGeneric
, DeriveDataTypeable
, DeriveFunctor
Expand Down Expand Up @@ -579,9 +575,6 @@ test-suite hnix-tests
PrettyTests
ReduceExprTests
TestCommon
mixins:
base hiding (Prelude)
, relude
hs-source-dirs:
tests
ghc-options:
Expand Down Expand Up @@ -615,7 +608,8 @@ test-suite hnix-tests
, time
, unix-compat
default-extensions:
OverloadedStrings
NoImplicitPrelude
, OverloadedStrings
, DeriveGeneric
, DeriveDataTypeable
, DeriveFunctor
Expand Down Expand Up @@ -650,9 +644,6 @@ benchmark hnix-benchmarks
ParserBench
hs-source-dirs:
benchmarks
mixins:
base hiding (Prelude)
, relude
ghc-options:
-Wall
build-depends:
Expand All @@ -668,7 +659,8 @@ benchmark hnix-benchmarks
, template-haskell
, time
default-extensions:
OverloadedStrings
NoImplicitPrelude
, OverloadedStrings
, DeriveGeneric
, DeriveDataTypeable
, DeriveFunctor
Expand Down
1 change: 1 addition & 0 deletions main/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@

module Main ( main ) where

import Nix.Prelude
import Relude as Prelude ( force )
import Control.Comonad ( extract )
import qualified Control.Exception as Exception
Expand Down
16 changes: 8 additions & 8 deletions main/Repl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,16 +14,16 @@ module Repl
, main'
) where

import Prelude hiding ( state )
import Nix.Prelude hiding ( state )
import Nix hiding ( exec )
import Nix.Scope
import Nix.Value.Monad ( demand )

import qualified Data.HashMap.Lazy as M
import qualified Data.HashMap.Lazy as M
import Data.Char ( isSpace )
import Data.List ( dropWhileEnd )
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Data.Version ( showVersion )
import Paths_hnix ( version )

Expand All @@ -33,7 +33,7 @@ import Prettyprinter ( Doc
, space
)
import qualified Prettyprinter
import qualified Prettyprinter.Render.Text as Prettyprinter
import qualified Prettyprinter.Render.Text as Prettyprinter

import System.Console.Haskeline.Completion
( Completion(isFinished)
Expand All @@ -49,9 +49,9 @@ import System.Console.Repline ( Cmd
, HaskelineT
, evalRepl
)
import qualified System.Console.Repline as Console
import qualified System.Exit as Exit
import qualified System.IO.Error as Error
import qualified System.Console.Repline as Console
import qualified System.Exit as Exit
import qualified System.IO.Error as Error

-- | Repl entry point
main :: (MonadNix e t f m, MonadIO m, MonadMask m) => m ()
Expand Down
2 changes: 1 addition & 1 deletion src/Nix.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@

module Nix
( module Nix.Cache
, module Nix.Exec
Expand All @@ -25,6 +24,7 @@ module Nix
)
where

import Nix.Prelude
import Relude.Unsafe ( (!!) )
import GHC.Err ( errorWithoutStackTrace )
import Data.Fix ( Fix )
Expand Down
5 changes: 3 additions & 2 deletions src/Nix/Atoms.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,9 @@
{-# language CPP #-}
{-# language DeriveAnyClass #-}
{-# language CPP #-}
{-# language DeriveAnyClass #-}

module Nix.Atoms where

import Nix.Prelude
import Codec.Serialise ( Serialise )

import Data.Data ( Data)
Expand Down
3 changes: 2 additions & 1 deletion src/Nix/Builtins.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,14 +13,15 @@

{-# options_ghc -fno-warn-name-shadowing #-}


-- | Code that implements Nix builtins. Lists the functions that are built into the Nix expression evaluator. Some built-ins (aka `derivation`), are always in the scope, so they can be accessed by the name. To keap the namespace clean, most built-ins are inside the `builtins` scope - a set that contains all what is a built-in.
module Nix.Builtins
( withNixContext
, builtins
)
where


import Nix.Prelude
import GHC.Exception ( ErrorCall(ErrorCall) )
import Control.Comonad ( Comonad )
import Control.Monad ( foldM )
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Cache.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
-- | Reading and writing Nix cache files
module Nix.Cache where

import Nix.Prelude
import qualified Data.ByteString.Lazy as BSL
import Nix.Expr.Types.Annotated

Expand Down
1 change: 1 addition & 0 deletions src/Nix/Cited.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@

module Nix.Cited where

import Nix.Prelude
import Control.Comonad
import Control.Comonad.Env
import Lens.Family2.TH
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Cited/Basic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@

module Nix.Cited.Basic where

import Nix.Prelude
import Control.Comonad ( Comonad )
import Control.Comonad.Env ( ComonadEnv )
import Control.Monad.Catch hiding ( catchJust )
Expand Down
2 changes: 1 addition & 1 deletion src/Nix/Context.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@

module Nix.Context where

import Nix.Prelude
import Nix.Options ( Options )
import Nix.Scope ( Scopes )
import Nix.Frames ( Frames )
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Convert.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@

module Nix.Convert where

import Nix.Prelude
import Control.Monad.Free
import qualified Data.HashMap.Lazy as M
import Nix.Atoms
Expand Down
3 changes: 2 additions & 1 deletion src/Nix/Effects.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,9 +12,10 @@

module Nix.Effects where

import Prelude hiding ( putStrLn
import Nix.Prelude hiding ( putStrLn
, print
)
import qualified Nix.Prelude as Prelude
import GHC.Exception ( ErrorCall(ErrorCall) )
import qualified Data.HashSet as HS
import qualified Data.Text as Text
Expand Down
2 changes: 1 addition & 1 deletion src/Nix/Effects/Basic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@

module Nix.Effects.Basic where

import Prelude hiding ( head
import Nix.Prelude hiding ( head
)
import Relude.Unsafe ( head )
import GHC.Exception ( ErrorCall(ErrorCall) )
Expand Down
2 changes: 1 addition & 1 deletion src/Nix/Effects/Derivation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@

module Nix.Effects.Derivation ( defaultDerivationStrict ) where

import Prelude hiding ( readFile )
import Nix.Prelude hiding ( readFile )
import GHC.Exception ( ErrorCall(ErrorCall) )
import Data.Char ( isAscii
, isAlphaNum
Expand Down
2 changes: 1 addition & 1 deletion src/Nix/Eval.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,9 @@
{-# language RankNTypes #-}



module Nix.Eval where

import Nix.Prelude
import Relude.Extra ( set )
import Control.Monad ( foldM )
import Control.Monad.Fix ( MonadFix )
Expand Down
4 changes: 2 additions & 2 deletions src/Nix/Exec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@

module Nix.Exec where

import Prelude hiding ( putStr
import Nix.Prelude hiding ( putStr
, putStrLn
, print
)
Expand Down Expand Up @@ -44,7 +44,7 @@ import Nix.Value.Monad
import Prettyprinter
import qualified Text.Show.Pretty as PS

#ifdef MIN_VERSION_ghc_datasize
#ifdef MIN_VERSION_ghc_datasize
import GHC.DataSize
#endif

Expand Down
2 changes: 1 addition & 1 deletion src/Nix/Expr/Shorthands.hs
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@

-- | Shorthands for making Nix expressions.
--
-- Functions with an @F@ suffix return a more general type (base functor @F a@) without the outer
-- 'Fix' wrapper that creates @a@.
module Nix.Expr.Shorthands where

import Nix.Prelude
import Data.Fix
import Nix.Atoms
import Nix.Expr.Types
Expand Down
2 changes: 1 addition & 1 deletion src/Nix/Expr/Strings.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@

-- | Functions for manipulating nix strings.
module Nix.Expr.Strings where

import Nix.Prelude
import Relude.Unsafe as Unsafe
-- Please, switch things to NonEmpty
import Data.List ( dropWhileEnd
Expand Down
3 changes: 2 additions & 1 deletion src/Nix/Expr/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,8 @@
-- (additiona info for dev): Big use of TemplateHaskell in the module requires proper (top-down) organization of declarations.
module Nix.Expr.Types where

import qualified Codec.Serialise as Serialise
import Nix.Prelude
import qualified Codec.Serialise as Serialise
import Codec.Serialise ( Serialise )
import Control.DeepSeq ( NFData1(..) )
import Data.Aeson
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Expr/Types/Annotated.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module Nix.Expr.Types.Annotated
)
where

import Nix.Prelude
import Codec.Serialise
import Control.DeepSeq
import Data.Aeson ( ToJSON(..)
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Frames.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ module Nix.Frames
)
where

import Nix.Prelude
import Data.Typeable hiding ( typeOf )
import Control.Monad.Catch ( MonadThrow(..) )
import qualified Text.Show
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Fresh.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@

module Nix.Fresh where

import Nix.Prelude
import Control.Monad.Base ( MonadBase(..) )
import Control.Monad.Catch ( MonadCatch
, MonadMask
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Fresh/Basic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module Nix.Fresh.Basic where
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Nix.Prelude
import Nix.Effects
import Nix.Render
import Nix.Fresh
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Json.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@

module Nix.Json where

import Nix.Prelude
import qualified Data.Aeson as A
import qualified Data.Aeson.Encoding as A
import qualified Data.Vector as V
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Lint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@

module Nix.Lint where

import Nix.Prelude
import Relude.Unsafe as Unsafe ( head )
import Control.Exception ( throw )
import GHC.Exception ( ErrorCall(ErrorCall) )
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Normal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@
-- And so do not converge into a normal form.
module Nix.Normal where

import Nix.Prelude
import Control.Monad.Free ( Free(..) )
import Data.Set ( member
, insert
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
-- | Definitions & defaults for the CLI options
module Nix.Options where

import Nix.Prelude
import Data.Time

-- 2021-07-15: NOTE: What these are? They need to be documented.
Expand Down
1 change: 1 addition & 0 deletions src/Nix/Options/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
-- | Code that configures presentation parser for the CLI options
module Nix.Options.Parser where

import Nix.Prelude
import Relude.Unsafe ( read )
import GHC.Err ( errorWithoutStackTrace )
import Data.Char ( isDigit )
Expand Down
Loading

0 comments on commit 9bccd0f

Please sign in to comment.