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

Merge pull request #757 from layus/fix-a-lot 

Various fixes and bugfixes encountered while testing
This commit is contained in:
Guillaume Maudoux 2020-11-18 10:24:00 +01:00 committed by GitHub
parent 6bc278c859 2af45ba385
commit ead52c1719
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 59 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
src/Nix/Builtins.hs
View File

@ -145,18 +145,19 @@ builtinsList = sequence
version <- toValue (5 :: Int)
pure $ Builtin Normal ("langVersion", version)
, add0 Normal "nixPath" nixPath
, add TopLevel "abort" throw_ -- for now
, add2 Normal "add" add_
, add2 Normal "addErrorContext" addErrorContext
, add2 Normal "all" all_
, add2 Normal "any" any_
, add2 Normal "appendContext" appendContext
, add Normal "attrNames" attrNames
, add Normal "attrValues" attrValues
, add TopLevel "baseNameOf" baseNameOf
, add2 Normal "bitAnd" bitAnd
, add2 Normal "bitOr" bitOr
, add2 Normal "bitXor" bitXor
, add0 Normal "builtins" builtinsBuiltin
, add2 Normal "catAttrs" catAttrs
, add2 Normal "compareVersions" compareVersions_
, add Normal "concatLists" concatLists
@ -205,15 +206,21 @@ builtinsList = sequence
, add2 Normal "elemAt" elemAt_
, add Normal "exec" exec_
, add0 Normal "false" (pure $ nvConstant $ NBool False)
--, add Normal "fetchGit" fetchGit
--, add Normal "fetchMercurial" fetchMercurial
, add Normal "fetchTarball" fetchTarball
, add Normal "fetchurl" fetchurl
, add2 Normal "filter" filter_
--, add Normal "filterSource" filterSource
, add2 Normal "findFile" findFile_
, add3 Normal "foldl'" foldl'_
, add Normal "fromJSON" fromJSON
--, add Normal "fromTOML" fromTOML
, add Normal "functionArgs" functionArgs
, add2 Normal "genList" genList
, add Normal "genericClosure" genericClosure
, add2 Normal "genList" genList
, add2 Normal "getAttr" getAttr
, add Normal "getContext" getContext
, add Normal "getEnv" getEnv_
, add2 Normal "hasAttr" hasAttr
, add Normal "hasContext" hasContext
@ -236,14 +243,15 @@ builtinsList = sequence
, add2 TopLevel "mapAttrs" mapAttrs_
, add2 Normal "match" match_
, add2 Normal "mul" mul_
, add0 Normal "nixPath" nixPath
, add0 Normal "null" (pure $ nvConstant NNull)
, add Normal "parseDrvName" parseDrvName
, add2 Normal "partition" partition_
--, add Normal "path" path
, add Normal "pathExists" pathExists_
, add TopLevel "placeholder" placeHolder
, add Normal "readDir" readDir_
, add Normal "readFile" readFile_
, add2 Normal "findFile" findFile_
, add2 TopLevel "removeAttrs" removeAttrs
, add3 Normal "replaceStrings" replaceStrings
, add2 TopLevel "scopedImport" scopedImport
@ -252,26 +260,25 @@ builtinsList = sequence
, add2 Normal "split" split_
, add Normal "splitVersion" splitVersion_
, add0 Normal "storeDir" (pure $ nvStr $ principledMakeNixStringWithoutContext "/nix/store")
--, add Normal "storePath" storePath
, add' Normal "stringLength" (arity1 $ Text.length . principledStringIgnoreContext)
, add' Normal "sub" (arity2 ((-) @Integer))
, add' Normal "substring" (substring @e @t @f @m)
, add' Normal "substring" substring
, add Normal "tail" tail_
, add0 Normal "true" (pure $ nvConstant $ NBool True)
, add TopLevel "throw" throw_
, add Normal "toJSON" prim_toJSON
, add2 Normal "toFile" toFile
, add Normal "toJSON" prim_toJSON
, add Normal "toPath" toPath
, add TopLevel "toString" toString
, add Normal "toXML" toXML_
, add2 TopLevel "trace" trace_
, add0 Normal "true" (pure $ nvConstant $ NBool True)
, add Normal "tryEval" tryEval
, add Normal "typeOf" typeOf
--, add0 Normal "unsafeDiscardOutputDependency" unsafeDiscardOutputDependency
, add Normal "unsafeDiscardStringContext" unsafeDiscardStringContext
, add2 Normal "unsafeGetAttrPos" unsafeGetAttrPos
, add Normal "valueSize" getRecursiveSize
, add Normal "getContext" getContext
, add2 Normal "appendContext" appendContext
, add2 Normal "unsafeGetAttrPos" unsafeGetAttrPos
, add Normal "unsafeDiscardStringContext" unsafeDiscardStringContext
]
where
wrap :: BuiltinType -> Text -> v -> Builtin v
@ -652,13 +659,13 @@ splitMatches numDropped (((_, (start, len)) : captures) : mts) haystack =
thunkStr s = nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s))
substring :: forall e t f m. MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString
substring start len str = Prim $ if start < 0 --NOTE: negative values of 'len' are OK
then
throwError
$ ErrorCall
$ "builtins.substring: negative start position: "
++ show start
else pure $ principledModifyNixContents (Text.take len . Text.drop start) str
substring start len str = Prim $
if start < 0
then throwError $ ErrorCall $ "builtins.substring: negative start position: " ++ show start
else pure $ principledModifyNixContents (take . Text.drop start) str
where
--NOTE: negative values of 'len' are OK, and mean "take everything"
take = if len < 0 then id else Text.take len
attrNames
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
@ -766,6 +773,12 @@ bitXor
bitXor x y = fromValue @Integer x
>>= \a -> fromValue @Integer y >>= \b -> toValue (a `xor` b)
builtinsBuiltin
:: forall e t f m
. MonadNix e t f m
=> m (NValue t f m)
builtinsBuiltin = (throwError $ ErrorCall "HNix does not provide builtins.builtins at the moment. Using builtins directly should be preferred")
dirOf :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
dirOf x = demand x $ \case
NVStr ns -> pure $ nvStr
@ -1040,10 +1053,6 @@ isList
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
isList = hasKind @[NValue t f m]
isString
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
isString = hasKind @NixString
isInt
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
isInt = hasKind @Int
@ -1060,6 +1069,12 @@ isNull
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
isNull = hasKind @()
-- isString cannot use `hasKind` because it coerces derivations to strings.
isString :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
isString v = demand v $ \case
NVStr{} -> toValue True
_ -> toValue False
isFunction :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
isFunction func = demand func $ \case
NVClosure{} -> toValue True

2
src/Nix/Effects.hs
View File

@ -145,7 +145,7 @@ instance MonadInstantiate IO where
++ err
pathExists :: MonadFile m => FilePath -> m Bool
pathExists = doesFileExist
pathExists = doesPathExist
class Monad m => MonadEnv m where
getEnvVar :: String -> m (Maybe String)

30
src/Nix/Effects/Basic.hs
View File

@ -64,13 +64,13 @@ defaultMakeAbsolutePath origPath = do
Nothing -> getCurrentDirectory
Just v -> demand v $ \case
NVPath s -> pure $ takeDirectory s
v ->
val ->
throwError
$ ErrorCall
$ "when resolving relative path,"
++ " __cur_file is in scope,"
++ " but is not a path; it is: "
++ show v
++ show val
pure $ cwd <///> origPathExpanded
removeDotDotIndirections <$> canonicalizePath absPath
@ -111,13 +111,13 @@ findEnvPathM name = do
where
nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
nixFilePath path = do
path <- makeAbsolutePath @t @f path
exists <- doesDirectoryExist path
path' <- if exists
then makeAbsolutePath @t @f $ path </> "default.nix"
else pure path
exists <- doesFileExist path'
pure $ if exists then Just path' else Nothing
absPath <- makeAbsolutePath @t @f path
isDir <- doesDirectoryExist absPath
absFile <- if isDir
then makeAbsolutePath @t @f $ absPath </> "default.nix"
else return absPath
exists <- doesFileExist absFile
pure $ if exists then Just absFile else Nothing
findPathBy
:: forall e t f m
@ -226,13 +226,13 @@ findPathM
=> [NValue t f m]
-> FilePath
-> m FilePath
findPathM = findPathBy path
findPathM = findPathBy existingPath
where
path :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
path path = do
path <- makeAbsolutePath @t @f path
exists <- doesPathExist path
pure $ if exists then Just path else Nothing
existingPath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
existingPath path = do
apath <- makeAbsolutePath @t @f path
exists <- doesPathExist apath
pure $ if exists then Just apath else Nothing
defaultImportPath
:: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc) m)

7
src/Nix/Exec.hs
View File

@ -297,14 +297,12 @@ callFunc fun arg = demand fun $ \fun' -> do
when (length frames > 2000) $ throwError $ ErrorCall
"Function call stack exhausted"
case fun' of
NVClosure params f -> do
traceM $ "callFunc:NVFunction taking " ++ show params
NVClosure _params f -> do
f arg
NVBuiltin name f -> do
span <- currentPos
withFrame Info (Calling @m @t name span) (f arg)
s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do
traceM "callFunc:__functor"
demand f $ (`callFunc` s) >=> (`callFunc` arg)
x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x
@ -316,7 +314,6 @@ execUnaryOp
-> NValue t f m
-> m (NValue t f m)
execUnaryOp scope span op arg = do
traceM "NUnary"
case arg of
NVConstant c -> case (op, c) of
(NNeg, NInt i ) -> unaryOp $ NInt (-i)
@ -478,7 +475,7 @@ execBinaryOpForced scope span op lval rval = case op of
fromStringNoContext :: Framed e m => NixString -> m Text
fromStringNoContext ns = case principledGetStringNoContext ns of
Just str -> pure str
Nothing -> throwError $ ErrorCall "expected string with no context"
Nothing -> throwError $ ErrorCall $ "expected string with no context, but got " ++ show ns
addTracing
:: (MonadNix e t f m, Has e Options, MonadReader Int n, Alternative n)

2
src/Nix/Parser.hs
View File

@ -268,7 +268,7 @@ nixIf = annotateLocation1
nixAssert :: Parser NExprLoc
nixAssert = annotateLocation1
( NAssert
<$> (reserved "assert" *> nixExpr)
<$> (reserved "assert" *> nixToplevelForm)
<*> (semi *> nixToplevelForm)
<?> "assert"
)

3
src/Nix/Render.hs
View File

@ -77,6 +77,9 @@ posAndMsg (SourcePos _ lineNo _) msg = FancyError
renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)
renderLocation (SrcSpan (SourcePos file begLine begCol) (SourcePos file' endLine endCol)) msg
| file == file' && file == "<string>" && begLine == endLine
= pure $ "In raw input string at position " <> pretty (unPos begCol)
| file /= "<string>" && file == file'
= do
exist <- doesFileExist file

2
src/Nix/Thunk/Basic.hs
View File

@ -15,7 +15,6 @@ import Control.Exception hiding ( catch )
import Control.Monad.Catch
import Nix.Thunk
import Nix.Utils
import Nix.Var
data Deferred m v = Deferred (m v) | Computed v
@ -75,7 +74,6 @@ forceThunk (Thunk n active ref) k = do
if nowActive
then throwM $ ThunkLoop $ show n
else do
traceM $ "Forcing " ++ show n
v <- catch action $ \(e :: SomeException) -> do
_ <- atomicModifyVar active (False, )
throwM e