Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 4 additions & 4 deletions src/Nix/Builtins.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
1 change: 0 additions & 1 deletion src/Nix/Convert.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion src/Nix/Exec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,6 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

Expand Down
1 change: 0 additions & 1 deletion src/Nix/Lint.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
Expand Down
1 change: 0 additions & 1 deletion src/Nix/Thunk.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Nix.Thunk where

Expand Down
5 changes: 1 addition & 4 deletions src/Nix/Value/Equal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
3 changes: 1 addition & 2 deletions tests/EvalTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 0 additions & 2 deletions tests/PrettyParseTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,7 @@
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS -Wno-orphans#-}

module PrettyParseTests where

Expand Down