diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 9e0e90aef..caf1314d4 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -19,7 +19,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# 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. @@ -660,6 +659,7 @@ splitMatches numDropped (((_, (start, len)) : captures) : mts) haystack = caps = nvList (map f captures) f (a, (s, _)) = if s < 0 then nvConstant NNull else thunkStr a +thunkStr :: Applicative f => ByteString -> NValue t f m thunkStr s = nvStr (makeNixStringWithoutContext (decodeUtf8 s)) substring :: forall e t f m. MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString @@ -1513,16 +1513,16 @@ newtype Prim m a = Prim { runPrim :: m a } -- | Types that support conversion to nix in a particular monad class ToBuiltin t f m a | a -> m where - toBuiltin :: String -> a -> m (NValue t f m) + toBuiltin :: String -> a -> m (NValue t f m) instance (MonadNix e t f m, ToValue a m (NValue t f m)) - => ToBuiltin t f m (Prim m a) where + => ToBuiltin t f m (Prim m a) where toBuiltin _ p = toValue =<< runPrim p instance ( MonadNix e t f m , FromValue a m (Deeper (NValue t f m)) , ToBuiltin t f m b ) - => ToBuiltin t f m (a -> b) where + => ToBuiltin t f m (a -> b) where toBuiltin name f = pure $ nvBuiltin name (fromValue . Deeper >=> toBuiltin name . f) diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs index ec228c783..7fe84cfac 100644 --- a/src/Nix/Convert.hs +++ b/src/Nix/Convert.hs @@ -13,7 +13,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | Although there are a lot of instances in this file, really it's just a diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index c5bf60b74..855243059 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -15,7 +15,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 1b0e2317b..2efc53452 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveTraversable #-} diff --git a/src/Nix/Thunk.hs b/src/Nix/Thunk.hs index 30445d0d9..dfc51c4b1 100644 --- a/src/Nix/Thunk.hs +++ b/src/Nix/Thunk.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} module Nix.Thunk where diff --git a/src/Nix/Value/Equal.hs b/src/Nix/Value/Equal.hs index 1a8c16c4c..509c0317a 100644 --- a/src/Nix/Value/Equal.hs +++ b/src/Nix/Value/Equal.hs @@ -7,7 +7,6 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -19,11 +18,9 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-} module Nix.Value.Equal where @@ -90,7 +87,7 @@ isDerivationM f m = case M.lookup "type" m of Nothing -> pure False isDerivation :: Monad m => (t -> Maybe NixString) -> AttrSet t -> Bool -isDerivation f = runIdentity . isDerivationM (\x -> Identity (f x)) +isDerivation f = runIdentity . isDerivationM (Identity . f) valueFEqM :: Monad n diff --git a/tests/EvalTests.hs b/tests/EvalTests.hs index fb4afdb86..58a3f58bb 100644 --- a/tests/EvalTests.hs +++ b/tests/EvalTests.hs @@ -3,9 +3,8 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-signatures -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} module EvalTests (tests, genEvalCompareTests) where diff --git a/tests/PrettyParseTests.hs b/tests/PrettyParseTests.hs index 0589edf3b..984bcd294 100644 --- a/tests/PrettyParseTests.hs +++ b/tests/PrettyParseTests.hs @@ -5,9 +5,7 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS -Wno-orphans#-} module PrettyParseTests where