Skip to content

Commit

Permalink
Merge #830: Clean-up
Browse files Browse the repository at this point in the history
  • Loading branch information
Anton-Latukha authored Jan 21, 2021
2 parents eb709cc + e9958d8 commit 60abb7a
Show file tree
Hide file tree
Showing 8 changed files with 6 additions and 16 deletions.
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

0 comments on commit 60abb7a

Please sign in to comment.