picnoir/hnix
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Merge remote-tracking branch 'origin/pending' into abstract-scopes

Browse source
This commit is contained in:
Ryan Trinkle 2018-11-18 15:04:30 -05:00
parent d60130c566 b47bd010e2
commit 0a82ab26ce
12 changed files with 196 additions and 123 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
.travis.yml
View file

@ -15,19 +15,13 @@ env:
- secure: "dm6I+M4+V+C7QMTpcSADdKPE633SvmToXZrTbZ7miNDGmMN+/SfHeN2ybi1+PW6oViMlbPN/7J/aEfiGjSJI8vLk72Y4uCWGmpSb8TXZLu6+whnxtZzzW8+z4tsM4048QJg7CF3N/25U8thRFgs3DqUub1Sf3nG9LrNWdz6ZcDQ="
matrix:
- GHCVERSION=ghc802 STRICT=false TRACING=false
- GHCVERSION=ghc802 STRICT=false TRACING=true
- GHCVERSION=ghc822 STRICT=true TRACING=false
- GHCVERSION=ghc822 STRICT=true TRACING=true
- GHCVERSION=ghc843 STRICT=false TRACING=false
- GHCVERSION=ghc843 STRICT=false TRACING=true
- GHCVERSION=ghcjs
matrix:
allow_failures:
- env: GHCVERSION=ghcjs
- env: GHCVERSION=ghc802 STRICT=false TRACING=false
- env: GHCVERSION=ghc802 STRICT=false TRACING=true
# - GHCVERSION=ghcjs
#
# matrix:
# allow_failures:
# - env: GHCVERSION=ghcjs
before_script:
- sudo mount -o remount,exec,size=4G,mode=755 /run/user || true

12
README.md
View file

@ -99,6 +99,8 @@ the specific dependencies used by hnix. Just use these commands:
## How you can help
### Issue Tracker Backlog
If you're looking for a way to help out, try taking a look
[here](https://github.com/haskell-nix/hnix/issues?q=is%3Aissue+is%3Aopen+label%3A%22help+wanted%22+no%3Aassignee).
When you find an issue that looks interesting to you, comment on the ticket to
@ -114,3 +116,13 @@ nix-shell --run "LANGUAGE_TESTS=yes cabal test"
Make sure that all the tests that were passing prior to your PR are still
passing afterwards; it's OK if no new tests are passing.
### Evaluating Nixpkgs with HNix
Currently the main high-level goal is to be able to evaluate all of nixpkgs. To
run this yourself, first build hnix with `nix-build`, then run the following
command:
```
./result/bin/hnix --eval -E "import <nixpkgs> {}" --find
```

10
default.nix
View file

@ -1,11 +1,11 @@
{ compiler ? "ghc822"
{ compiler ? "ghc843"
, doBenchmark ? false
, doTracing ? false
, doStrict ? false
, rev ? "d1ae60cbad7a49874310de91cd17708b042400c8"
, sha256 ? "0a1w4702jlycg2ab87m7n8frjjngf0cis40lyxm3vdwn7p4fxikz"
, rev ? "7c1b85cf6de1dc431e5736bff8adf01224e6abe5"
, sha256 ? "1i8nvc4r0zx263ch5k3b6nkg78sc9ggx2d4lzri6kmng315pcs05"
, pkgs ?
if builtins.compareVersions builtins.nixVersion "2.0" < 0
then abort "hnix requires at least nix 2.0"
@ -80,8 +80,8 @@ drv = haskellPackages.developPackage {
# .cabal file will be. Otherwise, Travis may error out claiming that
# the cabal file needs to be updated because the result is different
# that the version we committed to Git.
pkgs.haskell.packages.ghc822.hpack
pkgs.haskell.packages.ghc822.criterion
pkgs.haskell.packages.ghc843.hpack
pkgs.haskell.packages.ghc843.criterion
];
inherit doBenchmark;

29
src/Nix/Builtins.hs
View file

@ -324,7 +324,7 @@ nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
nvStr (hackyMakeNixStringWithoutContext $ Text.pack (fromMaybe "" mn))) ]) : rest
toString :: MonadNix e m => m (NValue m) -> m (NValue m)
toString str = str >>= coerceToString False True >>= toNix . Text.pack
toString str = str >>= coerceToString DontCopyToStore CoerceAny >>= toNix
hasAttr :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
hasAttr x y =
@ -388,9 +388,9 @@ div_ x y = x >>= \x' -> y >>= \y' -> case (x', y') of
toNix (floor (fromInteger x / fromInteger y :: Double) :: Integer)
(NVConstant (NFloat x), NVConstant (NInt y)) | y /= 0 ->
toNix (x / fromInteger y)
(NVConstant (NInt x), NVConstant (NFloat y)) | y /= 0 ->
(NVConstant (NInt x), NVConstant (NFloat y)) | y /= 0 ->
toNix (fromInteger x / y)
(NVConstant (NFloat x), NVConstant (NFloat y)) | y /= 0 ->
(NVConstant (NFloat x), NVConstant (NFloat y)) | y /= 0 ->
toNix (x / y)
(_, _) ->
throwError $ Division x' y'
@ -468,10 +468,9 @@ splitVersion s = case Text.uncons s of
in thisComponent : splitVersion rest
splitVersion_ :: MonadNix e m => m (NValue m) -> m (NValue m)
splitVersion_ = fromValue >=> \s -> do
let vals = flip map (splitVersion s) $ \c ->
valueThunk $ nvStr $ hackyMakeNixStringWithoutContext $ versionComponentToString c
return $ nvList vals
splitVersion_ = fromStringNoContext >=> \s ->
return $ nvList $ flip map (splitVersion s) $ \c ->
valueThunk $ nvStr $ principledMakeNixStringWithoutContext $ versionComponentToString c
compareVersions :: Text -> Text -> Ordering
compareVersions s1 s2 =
@ -482,12 +481,12 @@ compareVersions s1 s2 =
compareVersions_ :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m)
compareVersions_ t1 t2 =
fromValue t1 >>= \s1 ->
fromValue t2 >>= \s2 ->
return $ nvConstant $ NInt $ case compareVersions s1 s2 of
LT -> -1
EQ -> 0
GT -> 1
fromStringNoContext t1 >>= \s1 ->
fromStringNoContext t2 >>= \s2 ->
return $ nvConstant $ NInt $ case compareVersions s1 s2 of
LT -> -1
EQ -> 0
GT -> 1
splitDrvName :: Text -> (Text, Text)
splitDrvName s =
@ -601,7 +600,7 @@ catAttrs attrName xs =
baseNameOf :: MonadNix e m => m (NValue m) -> m (NValue m)
baseNameOf x = x >>= \case
NVStr ns -> pure $ nvStr (hackyModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)
NVStr ns -> pure $ nvStr (principledModifyNixContents (Text.pack . takeFileName . Text.unpack) ns)
NVPath path -> pure $ nvPath $ takeFileName path
v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v
@ -622,7 +621,7 @@ bitXor x y =
dirOf :: MonadNix e m => m (NValue m) -> m (NValue m)
dirOf x = x >>= \case
NVStr ns -> pure $ nvStr (hackyModifyNixContents (Text.pack . takeDirectory . Text.unpack) ns)
NVStr ns -> pure $ nvStr (principledModifyNixContents (Text.pack . takeDirectory . Text.unpack) ns)
NVPath path -> pure $ nvPath $ takeDirectory path
v -> throwError $ ErrorCall $ "dirOf: expected string or path, got " ++ show v

14
src/Nix/Convert.hs
View file

@ -148,7 +148,7 @@ instance Convertible e m
instance (Convertible e m, MonadEffects m)
=> FromValue Text m (NValueNF m) where
fromValueMay = \case
Free (NVStrF ns) -> pure $ hackyStringIgnoreContextMaybe ns
Free (NVStrF ns) -> pure $ hackyGetStringNoContext ns
Free (NVPathF p) -> Just . Text.pack . unStorePath <$> addPath p
Free (NVSetF s _) -> case M.lookup "outPath" s of
Nothing -> pure Nothing
@ -161,7 +161,7 @@ instance (Convertible e m, MonadEffects m)
instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
=> FromValue Text m (NValue m) where
fromValueMay = \case
NVStr ns -> pure $ hackyStringIgnoreContextMaybe ns
NVStr ns -> pure $ hackyGetStringNoContext ns
NVPath p -> Just . Text.pack . unStorePath <$> addPath p
NVSet s _ -> case M.lookup "outPath" s of
Nothing -> pure Nothing
@ -200,7 +200,7 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m, MonadEffects m)
instance Convertible e m
=> FromValue ByteString m (NValueNF m) where
fromValueMay = \case
Free (NVStrF ns) -> pure $ encodeUtf8 <$> hackyStringIgnoreContextMaybe ns
Free (NVStrF ns) -> pure $ encodeUtf8 <$> hackyGetStringNoContext ns
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
@ -209,7 +209,7 @@ instance Convertible e m
instance Convertible e m
=> FromValue ByteString m (NValue m) where
fromValueMay = \case
NVStr ns -> pure $ encodeUtf8 <$> hackyStringIgnoreContextMaybe ns
NVStr ns -> pure $ encodeUtf8 <$> hackyGetStringNoContext ns
_ -> pure Nothing
fromValue v = fromValueMay v >>= \case
Just b -> pure b
@ -221,7 +221,7 @@ newtype Path = Path { getPath :: FilePath }
instance Convertible e m => FromValue Path m (NValueNF m) where
fromValueMay = \case
Free (NVPathF p) -> pure $ Just (Path p)
Free (NVStrF ns) -> pure $ Path . Text.unpack <$> hackyStringIgnoreContextMaybe ns
Free (NVStrF ns) -> pure $ Path . Text.unpack <$> hackyGetStringNoContext ns
Free (NVSetF s _) -> case M.lookup "outPath" s of
Nothing -> pure Nothing
Just p -> fromValueMay @Path p
@ -234,7 +234,7 @@ instance (Convertible e m, MonadThunk (NValue m) (NThunk m) m)
=> FromValue Path m (NValue m) where
fromValueMay = \case
NVPath p -> pure $ Just (Path p)
NVStr ns -> pure $ Path . Text.unpack <$> hackyStringIgnoreContextMaybe ns
NVStr ns -> pure $ Path . Text.unpack <$> hackyGetStringNoContext ns
NVSet s _ -> case M.lookup "outPath" s of
Nothing -> pure Nothing
Just p -> fromValueMay @Path p
@ -322,7 +322,7 @@ instance (Convertible e m, MonadEffects m)
NFloat n -> toJSON n
NBool b -> toJSON b
NNull -> A.Null
Free (NVStrF ns) -> pure $ toJSON <$> hackyStringIgnoreContextMaybe ns
Free (NVStrF ns) -> pure $ toJSON <$> hackyGetStringNoContext ns
Free (NVListF l) ->
fmap (A.Array . V.fromList) . sequence
<$> traverse fromValueMay l

4
src/Nix/Eval.hs
View file

@ -320,9 +320,9 @@ assembleString = \case
Indented _ parts -> fromParts parts
DoubleQuoted parts -> fromParts parts
where
fromParts = fmap (fmap hackyStringMConcat . sequence) . traverse go
fromParts = fmap (fmap principledStringMConcat . sequence) . traverse go
go = runAntiquoted "\n" (pure . Just . hackyMakeNixStringWithoutContext) (>>= fromValueMay)
go = runAntiquoted "\n" (pure . Just . principledMakeNixStringWithoutContext) (>>= fromValueMay)
buildArgument :: forall v t m. MonadNixEval v t m
=> Params (m v) -> m v -> m (AttrSet t)

78
src/Nix/Exec.hs
View file

@ -326,7 +326,7 @@ execBinaryOp scope span op lval rarg = do
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(NVStr ls, NVStr rs) -> case op of
NPlus -> pure $ bin nvStrP (ls `hackyStringMappend` rs)
NPlus -> pure $ bin nvStrP (ls `principledStringMappend` rs)
NEq -> toBool =<< valueEq lval rval
NNEq -> toBool . not =<< valueEq lval rval
NLt -> toBool $ ls < rs
@ -336,13 +336,13 @@ execBinaryOp scope span op lval rarg = do
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(NVStr _, NVConstant NNull) -> case op of
NEq -> toBool =<< valueEq lval (nvStr (hackyMakeNixStringWithoutContext ""))
NNEq -> toBool . not =<< valueEq lval (nvStr (hackyMakeNixStringWithoutContext ""))
NEq -> toBool False
NNEq -> toBool True
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(NVConstant NNull, NVStr _) -> case op of
NEq -> toBool =<< valueEq (nvStr (hackyMakeNixStringWithoutContext "")) rval
NNEq -> toBool . not =<< valueEq (nvStr (hackyMakeNixStringWithoutContext "")) rval
NEq -> toBool False
NNEq -> toBool True
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(NVSet ls lp, NVSet rs rp) -> case op of
@ -364,15 +364,15 @@ execBinaryOp scope span op lval rarg = do
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(ls@NVSet {}, NVStr rs) -> case op of
NPlus -> (\ls -> bin nvStrP (hackyModifyNixContents (Text.pack ls `mappend`) rs))
<$> coerceToString False False ls
NPlus -> (\ls2 -> bin nvStrP (ls2 `principledStringMappend` rs))
<$> coerceToString DontCopyToStore CoerceStringy ls
NEq -> toBool =<< valueEq lval rval
NNEq -> toBool . not =<< valueEq lval rval
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(NVStr ls, rs@NVSet {}) -> case op of
NPlus -> (\rs -> bin nvStrP (hackyModifyNixContents (`mappend` Text.pack rs) ls))
<$> coerceToString False False rs
NPlus -> (\rs2 -> bin nvStrP (ls `principledStringMappend` rs2))
<$> coerceToString DontCopyToStore CoerceStringy rs
NEq -> toBool =<< valueEq lval rval
NNEq -> toBool . not =<< valueEq lval rval
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
@ -396,8 +396,8 @@ execBinaryOp scope span op lval rarg = do
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
(NVPath p, NVStr ns) -> case op of
NEq -> toBool $ Just p == fmap Text.unpack (hackyStringIgnoreContextMaybe ns)
NNEq -> toBool $ Just p /= fmap Text.unpack (hackyStringIgnoreContextMaybe ns)
NEq -> toBool $ Just p == fmap Text.unpack (hackyGetStringNoContext ns)
NNEq -> toBool $ Just p /= fmap Text.unpack (hackyGetStringNoContext ns)
NPlus -> bin nvPathP <$> makeAbsolutePath (p `mappend` Text.unpack (hackyStringIgnoreContext ns))
_ -> nverr $ ErrorCall $ unsupportedTypes lval rval
@ -433,21 +433,37 @@ execBinaryOp scope span op lval rarg = do
toInt = pure . bin nvConstantP . NInt
toFloat = pure . bin nvConstantP . NFloat
coerceToString :: MonadNix e m => Bool -> Bool -> NValue m -> m String
coerceToString copyToStore coerceMore = go
-- | Data type to avoid boolean blindness on what used to be called coerceMore
data CoercionLevel
= CoerceStringy
-- ^ Coerce only stringlike types: strings, paths, and appropriate sets
| CoerceAny
-- ^ Coerce everything but functions
deriving (Eq,Ord,Enum,Bounded)
-- | Data type to avoid boolean blindness on what used to be called copyToStore
data CopyToStoreMode
= CopyToStore
-- ^ Add paths to the store as they are encountered
| DontCopyToStore
-- ^ Add paths to the store as they are encountered
deriving (Eq,Ord,Enum,Bounded)
coerceToString :: MonadNix e m => CopyToStoreMode -> CoercionLevel -> NValue m -> m NixString
coerceToString ctsm clevel = go
where
go = \case
NVConstant (NBool b)
| b && coerceMore -> pure "1"
| coerceMore -> pure ""
NVConstant (NInt n) | coerceMore -> pure $ show n
NVConstant (NFloat n) | coerceMore -> pure $ show n
NVConstant NNull | coerceMore -> pure ""
NVStr ns -> pure $ Text.unpack (hackyStringIgnoreContext ns)
NVPath p | copyToStore -> unStorePath <$> addPath p
| otherwise -> pure p
NVList l | coerceMore -> unwords <$> traverse (`force` go) l
-- TODO Return a singleton for "" and "1"
| b && clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext "1"
| clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext ""
NVConstant (NInt n) | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
NVConstant (NFloat n) | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
NVConstant NNull | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext ""
NVStr ns -> pure ns
NVPath p | ctsm == CopyToStore -> storePathToNixString <$> addPath p
| otherwise -> pure $ principledMakeNixStringWithoutContext $ Text.pack p
NVList l | clevel == CoerceAny -> nixStringUnwords <$> traverse (`force` go) l
v@(NVSet s _) | Just p <- M.lookup "__toString" s ->
force p $ (`callFunc` pure v) >=> go
@ -457,6 +473,20 @@ coerceToString copyToStore coerceMore = go
v -> throwError $ ErrorCall $ "Expected a string, but saw: " ++ show v
nixStringUnwords = principledIntercalateNixString (principledMakeNixStringWithoutContext " ")
storePathToNixString :: StorePath -> NixString
storePathToNixString sp =
principledMakeNixStringWithSingletonContext t (StringContext t DirectPath)
where
t = Text.pack $ unStorePath sp
fromStringNoContext :: MonadNix e m => m (NValue m) -> m Text
fromStringNoContext =
fromValue >=> \s -> case principledGetStringNoContext s of
Just str -> return str
Nothing -> throwError $ ErrorCall
"expected string with no context"
newtype Lazy m a = Lazy
{ runLazy :: ReaderT (Context (Lazy m) (NThunk (Lazy m)))
(StateT (HashMap FilePath NExprLoc) m) a }
@ -570,7 +600,7 @@ instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
NVConstant NNull | ignoreNulls -> pure Nothing
v' -> Just <$> coerceNix v'
where
coerceNix = toNix . Text.pack <=< coerceToString True True
coerceNix = toNix <=< coerceToString CopyToStore CoerceAny
traceEffect = putStrLn

29
src/Nix/Normal.hs
View file

@ -108,32 +108,3 @@ embed (Free x) = case x of
NVClosureF p f -> return $ nvClosure p f
NVPathF fp -> return $ nvPath fp
NVBuiltinF n f -> return $ nvBuiltin n f
valueText :: forall e m. (Framed e m, MonadEffects m, Typeable m)
=> Bool -> NValueNF m -> m NixString
valueText addPathsToStore = iter phi . check
where
check :: NValueNF m -> Free (NValueF m) (m NixString)
check = fmap (const $ pure (hackyMakeNixStringWithoutContext "<CYCLE>"))
phi :: NValueF m (m NixString) -> m NixString
phi (NVConstantF a) = pure (hackyMakeNixStringWithoutContext (atomText a))
phi (NVStrF ns) = pure ns
phi v@(NVListF _) = coercionFailed v
phi v@(NVSetF s _)
| Just asString <- M.lookup "__asString" s = asString
| otherwise = coercionFailed v
phi v@NVClosureF {} = coercionFailed v
phi (NVPathF originalPath)
| addPathsToStore = do
storePath <- addPath originalPath
pure (hackyMakeNixStringWithoutContext $ Text.pack $ unStorePath storePath)
| otherwise = pure (hackyMakeNixStringWithoutContext (Text.pack originalPath))
phi v@(NVBuiltinF _ _) = coercionFailed v
coercionFailed v =
throwError $ Coercion @m (valueType v) TString
valueTextNoContext :: (Framed e m, MonadEffects m, Typeable m)
=> Bool -> NValueNF m -> m Text
valueTextNoContext addPathsToStore = fmap hackyStringIgnoreContext . valueText addPathsToStore

8
src/Nix/Pretty.hs
View file

@ -248,7 +248,7 @@ valueToExpr :: Functor m => NValueNF m -> NExpr
valueToExpr = transport go . check
where
check :: NValueNF m -> Fix (NValueF m)
check = fixate (const (NVStrF (hackyMakeNixStringWithoutContext "<CYCLE>")))
check = fixate $ const $ NVStrF $ principledMakeNixStringWithoutContext "<CYCLE>"
go (NVConstantF a) = NConstant a
go (NVStrF ns) = NStr (DoubleQuoted [Plain (hackyStringIgnoreContext ns)])
@ -284,7 +284,7 @@ removeEffects :: Functor m => NValueF m (NThunk m) -> NValueNF m
removeEffects = Free . fmap dethunk
where
dethunk (NThunk _ (Value v)) = removeEffects (_baseValue v)
dethunk (NThunk _ _) = Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
dethunk (NThunk _ _) = Free $ NVStrF $ principledMakeNixStringWithoutContext "<thunk>"
removeEffectsM :: MonadVar m => NValueF m (NThunk m) -> m (NValueNF m)
removeEffectsM = fmap Free . traverse dethunk
@ -316,11 +316,11 @@ dethunk = \case
NThunk _ (Thunk _ active ref) -> do
nowActive <- atomicModifyVar active (True,)
if nowActive
then pure $ Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
then pure $ Free $ NVStrF $ principledMakeNixStringWithoutContext "<thunk>"
else do
eres <- readVar ref
res <- case eres of
Computed v -> removeEffectsM (_baseValue v)
_ -> pure $ Free $ NVStrF (hackyMakeNixStringWithoutContext "<thunk>")
_ -> pure $ Free $ NVStrF $ principledMakeNixStringWithoutContext "<thunk>"
_ <- atomicModifyVar active (False,)
return res

93
src/Nix/String.hs
View file

@ -1,26 +1,37 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Nix.String (
NixString
, principledMempty
, StringContext(..)
, ContextFlavor(..)
, stringHasContext
, hackyStringIgnoreContextMaybe
, principledIntercalateNixString
, hackyGetStringNoContext
, principledGetStringNoContext
, principledStringIgnoreContext
, hackyStringIgnoreContext
, hackyMakeNixStringWithoutContext
, hackyModifyNixContents
, hackyStringMappend
, hackyStringMConcat
, principledMakeNixStringWithoutContext
, principledMakeNixStringWithSingletonContext
, principledModifyNixContents
, principledStringMappend
, principledStringMempty
, principledStringMConcat
) where
import qualified Data.HashSet as S
import Data.Hashable
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics
import Data.Semigroup
-- {-# WARNING hackyStringMappend, hackyStringMConcat, hackyStringIgnoreContextMaybe, hackyStringIgnoreContext, hackyMakeNixStringWithoutContext, hackyModifyNixContents "This NixString function needs to be replaced" #-}
-- {-# WARNING hackyGetStringNoContext, hackyStringIgnoreContext, hackyMakeNixStringWithoutContext "This NixString function needs to be replaced" #-}
-- | A 'ContextFlavor' describes the sum of possible derivations for string contexts
data ContextFlavor =
data ContextFlavor =
DirectPath
| DerivationOutput !Text
deriving (Show, Eq, Ord, Generic)
@ -28,27 +39,52 @@ data ContextFlavor =
instance Hashable ContextFlavor
-- | A 'StringContext' ...
data StringContext =
data StringContext =
StringContext { scPath :: !Text
, scFlavor :: !ContextFlavor
} deriving (Eq, Ord, Show, Generic)
} deriving (Eq, Ord, Show, Generic)
instance Hashable StringContext
data NixString = NixString
data NixString = NixString
{ nsContents :: !Text
, nsContext :: !(S.HashSet StringContext)
} deriving (Eq, Ord, Show, Generic)
} deriving (Eq, Ord, Show, Generic)
instance Hashable NixString
-- | Combine two NixStrings using mappend
-- | Combine two NixStrings using mappend
principledMempty :: NixString
principledMempty = NixString "" mempty
-- | Combine two NixStrings using mappend
principledStringMappend :: NixString -> NixString -> NixString
principledStringMappend (NixString s1 t1) (NixString s2 t2) = NixString (s1 <> s2) (t1 <> t2)
-- | Combine two NixStrings using mappend
hackyStringMappend :: NixString -> NixString -> NixString
hackyStringMappend (NixString s1 t1) (NixString s2 t2) = NixString (s1 <> s2) (t1 <> t2)
-- | Combine NixStrings using mconcat
-- | Combine NixStrings with a separator
principledIntercalateNixString :: NixString -> [NixString] -> NixString
principledIntercalateNixString _ [] = principledMempty
principledIntercalateNixString _ [ns] = ns
principledIntercalateNixString sep nss = NixString contents ctx
where
contents = Text.intercalate (nsContents sep) (map nsContents nss)
ctx = S.unions (nsContext sep : map nsContext nss)
-- | Combine NixStrings using mconcat
hackyStringMConcat :: [NixString] -> NixString
hackyStringMConcat = foldr hackyStringMappend (NixString mempty mempty)
hackyStringMConcat = foldr hackyStringMappend (NixString mempty mempty)
-- | Empty string with empty context.
principledStringMempty :: NixString
principledStringMempty = NixString mempty mempty
-- | Combine NixStrings using mconcat
principledStringMConcat :: [NixString] -> NixString
principledStringMConcat = foldr principledStringMappend (NixString mempty mempty)
--instance Semigroup NixString where
--NixString s1 t1 <> NixString s2 t2 = NixString (s1 <> s2) (t1 <> t2)
@ -57,10 +93,19 @@ hackyStringMConcat = foldr hackyStringMappend (NixString mempty mempty)
-- mempty = NixString mempty mempty
-- mappend = (<>)
-- | Extract the string contents from a NixString that has no context
hackyStringIgnoreContextMaybe :: NixString -> Maybe Text
hackyStringIgnoreContextMaybe (NixString s c) | null c = Just s
| otherwise = Nothing
-- | Extract the string contents from a NixString that has no context
hackyGetStringNoContext :: NixString -> Maybe Text
hackyGetStringNoContext (NixString s c) | null c = Just s
| otherwise = Nothing
-- | Extract the string contents from a NixString that has no context
principledGetStringNoContext :: NixString -> Maybe Text
principledGetStringNoContext (NixString s c) | null c = Just s
| otherwise = Nothing
-- | Extract the string contents from a NixString even if the NixString has an associated context
principledStringIgnoreContext :: NixString -> Text
principledStringIgnoreContext (NixString s _) = s
-- | Extract the string contents from a NixString even if the NixString has an associated context
hackyStringIgnoreContext :: NixString -> Text
@ -72,10 +117,16 @@ stringHasContext (NixString _ c) = not (null c)
-- | Constructs a NixString without a context
hackyMakeNixStringWithoutContext :: Text -> NixString
hackyMakeNixStringWithoutContext = flip NixString mempty
hackyMakeNixStringWithoutContext = flip NixString mempty
-- | Constructs a NixString without a context
principledMakeNixStringWithoutContext :: Text -> NixString
principledMakeNixStringWithoutContext = flip NixString mempty
-- | Modify the string part of the NixString -- ignores the context
hackyModifyNixContents :: (Text -> Text) -> NixString -> NixString
hackyModifyNixContents f (NixString s c) = NixString (f s) c
principledModifyNixContents :: (Text -> Text) -> NixString -> NixString
principledModifyNixContents f (NixString s c) = NixString (f s) c
-- | Create a NixString using a singleton context
principledMakeNixStringWithSingletonContext :: Text -> StringContext -> NixString
principledMakeNixStringWithSingletonContext s c = NixString s (S.singleton c)

14
src/Nix/Value.hs
View file

@ -249,15 +249,19 @@ isDerivation :: MonadThunk (NValue m) (NThunk m) m
=> AttrSet (NThunk m) -> m Bool
isDerivation m = case M.lookup "type" m of
Nothing -> pure False
Just t -> force t $ valueEq (nvStr (hackyMakeNixStringWithoutContext "derivation"))
Just t -> force t $ \case
-- We should probably really make sure the context is empty here but the
-- C++ implementation ignores it.
NVStr s -> pure $ principledStringIgnoreContext s == "derivation"
_ -> pure False
valueEq :: MonadThunk (NValue m) (NThunk m) m
=> NValue m -> NValue m -> m Bool
valueEq l r = case (l, r) of
valueEq = curry $ \case
(NVConstant lc, NVConstant rc) -> pure $ lc == rc
(NVStr ls, NVStr rs) -> pure (ls == rs)
(NVStr ns, NVConstant NNull) -> pure (hackyStringIgnoreContextMaybe ns == Just "")
(NVConstant NNull, NVStr ns) -> pure (Just "" == hackyStringIgnoreContextMaybe ns)
(NVStr ls, NVStr rs) -> pure $ principledStringIgnoreContext ls == principledStringIgnoreContext rs
(NVStr ns, NVConstant NNull) -> pure (hackyGetStringNoContext ns == Just "")
(NVConstant NNull, NVStr ns) -> pure (Just "" == hackyGetStringNoContext ns)
(NVList ls, NVList rs) -> alignEqM thunkEq ls rs
(NVSet lm _, NVSet rm _) -> do
let compareAttrs = alignEqM thunkEq lm rm

12
tests/EvalTests.hs
View file

@ -352,6 +352,18 @@ case_mapattrs_builtin =
})
|]
case_empty_string_equal_null_is_false =
constantEqualText "false" "\"\" == null"
case_null_equal_empty_string_is_false =
constantEqualText "false" "null == \"\""
case_empty_string_not_equal_null_is_true =
constantEqualText "true" "\"\" != null"
case_null_equal_not_empty_string_is_true =
constantEqualText "true" "null != \"\""
-----------------------
tests :: TestTree