Merge pull request #757 from layus/fix-a-lot
Various fixes and bugfixes encountered while testing
This commit is contained in:
commit
ead52c1719
|
@ -145,18 +145,19 @@ builtinsList = sequence
|
||||||
version <- toValue (5 :: Int)
|
version <- toValue (5 :: Int)
|
||||||
pure $ Builtin Normal ("langVersion", version)
|
pure $ Builtin Normal ("langVersion", version)
|
||||||
|
|
||||||
, add0 Normal "nixPath" nixPath
|
|
||||||
, add TopLevel "abort" throw_ -- for now
|
, add TopLevel "abort" throw_ -- for now
|
||||||
, add2 Normal "add" add_
|
, add2 Normal "add" add_
|
||||||
, add2 Normal "addErrorContext" addErrorContext
|
, add2 Normal "addErrorContext" addErrorContext
|
||||||
, add2 Normal "all" all_
|
, add2 Normal "all" all_
|
||||||
, add2 Normal "any" any_
|
, add2 Normal "any" any_
|
||||||
|
, add2 Normal "appendContext" appendContext
|
||||||
, add Normal "attrNames" attrNames
|
, add Normal "attrNames" attrNames
|
||||||
, add Normal "attrValues" attrValues
|
, add Normal "attrValues" attrValues
|
||||||
, add TopLevel "baseNameOf" baseNameOf
|
, add TopLevel "baseNameOf" baseNameOf
|
||||||
, add2 Normal "bitAnd" bitAnd
|
, add2 Normal "bitAnd" bitAnd
|
||||||
, add2 Normal "bitOr" bitOr
|
, add2 Normal "bitOr" bitOr
|
||||||
, add2 Normal "bitXor" bitXor
|
, add2 Normal "bitXor" bitXor
|
||||||
|
, add0 Normal "builtins" builtinsBuiltin
|
||||||
, add2 Normal "catAttrs" catAttrs
|
, add2 Normal "catAttrs" catAttrs
|
||||||
, add2 Normal "compareVersions" compareVersions_
|
, add2 Normal "compareVersions" compareVersions_
|
||||||
, add Normal "concatLists" concatLists
|
, add Normal "concatLists" concatLists
|
||||||
|
@ -205,15 +206,21 @@ builtinsList = sequence
|
||||||
, add2 Normal "elemAt" elemAt_
|
, add2 Normal "elemAt" elemAt_
|
||||||
, add Normal "exec" exec_
|
, add Normal "exec" exec_
|
||||||
, add0 Normal "false" (pure $ nvConstant $ NBool False)
|
, add0 Normal "false" (pure $ nvConstant $ NBool False)
|
||||||
|
--, add Normal "fetchGit" fetchGit
|
||||||
|
--, add Normal "fetchMercurial" fetchMercurial
|
||||||
, add Normal "fetchTarball" fetchTarball
|
, add Normal "fetchTarball" fetchTarball
|
||||||
, add Normal "fetchurl" fetchurl
|
, add Normal "fetchurl" fetchurl
|
||||||
, add2 Normal "filter" filter_
|
, add2 Normal "filter" filter_
|
||||||
|
--, add Normal "filterSource" filterSource
|
||||||
|
, add2 Normal "findFile" findFile_
|
||||||
, add3 Normal "foldl'" foldl'_
|
, add3 Normal "foldl'" foldl'_
|
||||||
, add Normal "fromJSON" fromJSON
|
, add Normal "fromJSON" fromJSON
|
||||||
|
--, add Normal "fromTOML" fromTOML
|
||||||
, add Normal "functionArgs" functionArgs
|
, add Normal "functionArgs" functionArgs
|
||||||
, add2 Normal "genList" genList
|
|
||||||
, add Normal "genericClosure" genericClosure
|
, add Normal "genericClosure" genericClosure
|
||||||
|
, add2 Normal "genList" genList
|
||||||
, add2 Normal "getAttr" getAttr
|
, add2 Normal "getAttr" getAttr
|
||||||
|
, add Normal "getContext" getContext
|
||||||
, add Normal "getEnv" getEnv_
|
, add Normal "getEnv" getEnv_
|
||||||
, add2 Normal "hasAttr" hasAttr
|
, add2 Normal "hasAttr" hasAttr
|
||||||
, add Normal "hasContext" hasContext
|
, add Normal "hasContext" hasContext
|
||||||
|
@ -236,14 +243,15 @@ builtinsList = sequence
|
||||||
, add2 TopLevel "mapAttrs" mapAttrs_
|
, add2 TopLevel "mapAttrs" mapAttrs_
|
||||||
, add2 Normal "match" match_
|
, add2 Normal "match" match_
|
||||||
, add2 Normal "mul" mul_
|
, add2 Normal "mul" mul_
|
||||||
|
, add0 Normal "nixPath" nixPath
|
||||||
, add0 Normal "null" (pure $ nvConstant NNull)
|
, add0 Normal "null" (pure $ nvConstant NNull)
|
||||||
, add Normal "parseDrvName" parseDrvName
|
, add Normal "parseDrvName" parseDrvName
|
||||||
, add2 Normal "partition" partition_
|
, add2 Normal "partition" partition_
|
||||||
|
--, add Normal "path" path
|
||||||
, add Normal "pathExists" pathExists_
|
, add Normal "pathExists" pathExists_
|
||||||
, add TopLevel "placeholder" placeHolder
|
, add TopLevel "placeholder" placeHolder
|
||||||
, add Normal "readDir" readDir_
|
, add Normal "readDir" readDir_
|
||||||
, add Normal "readFile" readFile_
|
, add Normal "readFile" readFile_
|
||||||
, add2 Normal "findFile" findFile_
|
|
||||||
, add2 TopLevel "removeAttrs" removeAttrs
|
, add2 TopLevel "removeAttrs" removeAttrs
|
||||||
, add3 Normal "replaceStrings" replaceStrings
|
, add3 Normal "replaceStrings" replaceStrings
|
||||||
, add2 TopLevel "scopedImport" scopedImport
|
, add2 TopLevel "scopedImport" scopedImport
|
||||||
|
@ -252,26 +260,25 @@ builtinsList = sequence
|
||||||
, add2 Normal "split" split_
|
, add2 Normal "split" split_
|
||||||
, add Normal "splitVersion" splitVersion_
|
, add Normal "splitVersion" splitVersion_
|
||||||
, add0 Normal "storeDir" (pure $ nvStr $ principledMakeNixStringWithoutContext "/nix/store")
|
, add0 Normal "storeDir" (pure $ nvStr $ principledMakeNixStringWithoutContext "/nix/store")
|
||||||
|
--, add Normal "storePath" storePath
|
||||||
, add' Normal "stringLength" (arity1 $ Text.length . principledStringIgnoreContext)
|
, add' Normal "stringLength" (arity1 $ Text.length . principledStringIgnoreContext)
|
||||||
, add' Normal "sub" (arity2 ((-) @Integer))
|
, add' Normal "sub" (arity2 ((-) @Integer))
|
||||||
, add' Normal "substring" (substring @e @t @f @m)
|
, add' Normal "substring" substring
|
||||||
, add Normal "tail" tail_
|
, add Normal "tail" tail_
|
||||||
, add0 Normal "true" (pure $ nvConstant $ NBool True)
|
|
||||||
, add TopLevel "throw" throw_
|
, add TopLevel "throw" throw_
|
||||||
, add Normal "toJSON" prim_toJSON
|
|
||||||
, add2 Normal "toFile" toFile
|
, add2 Normal "toFile" toFile
|
||||||
|
, add Normal "toJSON" prim_toJSON
|
||||||
, add Normal "toPath" toPath
|
, add Normal "toPath" toPath
|
||||||
, add TopLevel "toString" toString
|
, add TopLevel "toString" toString
|
||||||
, add Normal "toXML" toXML_
|
, add Normal "toXML" toXML_
|
||||||
, add2 TopLevel "trace" trace_
|
, add2 TopLevel "trace" trace_
|
||||||
|
, add0 Normal "true" (pure $ nvConstant $ NBool True)
|
||||||
, add Normal "tryEval" tryEval
|
, add Normal "tryEval" tryEval
|
||||||
, add Normal "typeOf" typeOf
|
, add Normal "typeOf" typeOf
|
||||||
, add Normal "valueSize" getRecursiveSize
|
--, add0 Normal "unsafeDiscardOutputDependency" unsafeDiscardOutputDependency
|
||||||
, add Normal "getContext" getContext
|
|
||||||
, add2 Normal "appendContext" appendContext
|
|
||||||
|
|
||||||
, add2 Normal "unsafeGetAttrPos" unsafeGetAttrPos
|
|
||||||
, add Normal "unsafeDiscardStringContext" unsafeDiscardStringContext
|
, add Normal "unsafeDiscardStringContext" unsafeDiscardStringContext
|
||||||
|
, add2 Normal "unsafeGetAttrPos" unsafeGetAttrPos
|
||||||
|
, add Normal "valueSize" getRecursiveSize
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
wrap :: BuiltinType -> Text -> v -> Builtin v
|
wrap :: BuiltinType -> Text -> v -> Builtin v
|
||||||
|
@ -652,13 +659,13 @@ splitMatches numDropped (((_, (start, len)) : captures) : mts) haystack =
|
||||||
thunkStr s = nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s))
|
thunkStr s = nvStr (hackyMakeNixStringWithoutContext (decodeUtf8 s))
|
||||||
|
|
||||||
substring :: forall e t f m. MonadNix e t f m => Int -> Int -> NixString -> Prim m NixString
|
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
|
substring start len str = Prim $
|
||||||
then
|
if start < 0
|
||||||
throwError
|
then throwError $ ErrorCall $ "builtins.substring: negative start position: " ++ show start
|
||||||
$ ErrorCall
|
else pure $ principledModifyNixContents (take . Text.drop start) str
|
||||||
$ "builtins.substring: negative start position: "
|
where
|
||||||
++ show start
|
--NOTE: negative values of 'len' are OK, and mean "take everything"
|
||||||
else pure $ principledModifyNixContents (Text.take len . Text.drop start) str
|
take = if len < 0 then id else Text.take len
|
||||||
|
|
||||||
attrNames
|
attrNames
|
||||||
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
:: 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
|
bitXor x y = fromValue @Integer x
|
||||||
>>= \a -> fromValue @Integer y >>= \b -> toValue (a `xor` b)
|
>>= \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 :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
||||||
dirOf x = demand x $ \case
|
dirOf x = demand x $ \case
|
||||||
NVStr ns -> pure $ nvStr
|
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)
|
:: 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]
|
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
|
isInt
|
||||||
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
||||||
isInt = hasKind @Int
|
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)
|
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
||||||
isNull = hasKind @()
|
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 :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
||||||
isFunction func = demand func $ \case
|
isFunction func = demand func $ \case
|
||||||
NVClosure{} -> toValue True
|
NVClosure{} -> toValue True
|
||||||
|
|
|
@ -145,7 +145,7 @@ instance MonadInstantiate IO where
|
||||||
++ err
|
++ err
|
||||||
|
|
||||||
pathExists :: MonadFile m => FilePath -> m Bool
|
pathExists :: MonadFile m => FilePath -> m Bool
|
||||||
pathExists = doesFileExist
|
pathExists = doesPathExist
|
||||||
|
|
||||||
class Monad m => MonadEnv m where
|
class Monad m => MonadEnv m where
|
||||||
getEnvVar :: String -> m (Maybe String)
|
getEnvVar :: String -> m (Maybe String)
|
||||||
|
|
|
@ -64,13 +64,13 @@ defaultMakeAbsolutePath origPath = do
|
||||||
Nothing -> getCurrentDirectory
|
Nothing -> getCurrentDirectory
|
||||||
Just v -> demand v $ \case
|
Just v -> demand v $ \case
|
||||||
NVPath s -> pure $ takeDirectory s
|
NVPath s -> pure $ takeDirectory s
|
||||||
v ->
|
val ->
|
||||||
throwError
|
throwError
|
||||||
$ ErrorCall
|
$ ErrorCall
|
||||||
$ "when resolving relative path,"
|
$ "when resolving relative path,"
|
||||||
++ " __cur_file is in scope,"
|
++ " __cur_file is in scope,"
|
||||||
++ " but is not a path; it is: "
|
++ " but is not a path; it is: "
|
||||||
++ show v
|
++ show val
|
||||||
pure $ cwd <///> origPathExpanded
|
pure $ cwd <///> origPathExpanded
|
||||||
removeDotDotIndirections <$> canonicalizePath absPath
|
removeDotDotIndirections <$> canonicalizePath absPath
|
||||||
|
|
||||||
|
@ -111,13 +111,13 @@ findEnvPathM name = do
|
||||||
where
|
where
|
||||||
nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
|
nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
|
||||||
nixFilePath path = do
|
nixFilePath path = do
|
||||||
path <- makeAbsolutePath @t @f path
|
absPath <- makeAbsolutePath @t @f path
|
||||||
exists <- doesDirectoryExist path
|
isDir <- doesDirectoryExist absPath
|
||||||
path' <- if exists
|
absFile <- if isDir
|
||||||
then makeAbsolutePath @t @f $ path </> "default.nix"
|
then makeAbsolutePath @t @f $ absPath </> "default.nix"
|
||||||
else pure path
|
else return absPath
|
||||||
exists <- doesFileExist path'
|
exists <- doesFileExist absFile
|
||||||
pure $ if exists then Just path' else Nothing
|
pure $ if exists then Just absFile else Nothing
|
||||||
|
|
||||||
findPathBy
|
findPathBy
|
||||||
:: forall e t f m
|
:: forall e t f m
|
||||||
|
@ -226,13 +226,13 @@ findPathM
|
||||||
=> [NValue t f m]
|
=> [NValue t f m]
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-> m FilePath
|
-> m FilePath
|
||||||
findPathM = findPathBy path
|
findPathM = findPathBy existingPath
|
||||||
where
|
where
|
||||||
path :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
|
existingPath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
|
||||||
path path = do
|
existingPath path = do
|
||||||
path <- makeAbsolutePath @t @f path
|
apath <- makeAbsolutePath @t @f path
|
||||||
exists <- doesPathExist path
|
exists <- doesPathExist apath
|
||||||
pure $ if exists then Just path else Nothing
|
pure $ if exists then Just apath else Nothing
|
||||||
|
|
||||||
defaultImportPath
|
defaultImportPath
|
||||||
:: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc) m)
|
:: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc) m)
|
||||||
|
|
|
@ -297,14 +297,12 @@ callFunc fun arg = demand fun $ \fun' -> do
|
||||||
when (length frames > 2000) $ throwError $ ErrorCall
|
when (length frames > 2000) $ throwError $ ErrorCall
|
||||||
"Function call stack exhausted"
|
"Function call stack exhausted"
|
||||||
case fun' of
|
case fun' of
|
||||||
NVClosure params f -> do
|
NVClosure _params f -> do
|
||||||
traceM $ "callFunc:NVFunction taking " ++ show params
|
|
||||||
f arg
|
f arg
|
||||||
NVBuiltin name f -> do
|
NVBuiltin name f -> do
|
||||||
span <- currentPos
|
span <- currentPos
|
||||||
withFrame Info (Calling @m @t name span) (f arg)
|
withFrame Info (Calling @m @t name span) (f arg)
|
||||||
s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do
|
s@(NVSet m _) | Just f <- M.lookup "__functor" m -> do
|
||||||
traceM "callFunc:__functor"
|
|
||||||
demand f $ (`callFunc` s) >=> (`callFunc` arg)
|
demand f $ (`callFunc` s) >=> (`callFunc` arg)
|
||||||
x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x
|
x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x
|
||||||
|
|
||||||
|
@ -316,7 +314,6 @@ execUnaryOp
|
||||||
-> NValue t f m
|
-> NValue t f m
|
||||||
-> m (NValue t f m)
|
-> m (NValue t f m)
|
||||||
execUnaryOp scope span op arg = do
|
execUnaryOp scope span op arg = do
|
||||||
traceM "NUnary"
|
|
||||||
case arg of
|
case arg of
|
||||||
NVConstant c -> case (op, c) of
|
NVConstant c -> case (op, c) of
|
||||||
(NNeg, NInt i ) -> unaryOp $ NInt (-i)
|
(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 :: Framed e m => NixString -> m Text
|
||||||
fromStringNoContext ns = case principledGetStringNoContext ns of
|
fromStringNoContext ns = case principledGetStringNoContext ns of
|
||||||
Just str -> pure str
|
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
|
addTracing
|
||||||
:: (MonadNix e t f m, Has e Options, MonadReader Int n, Alternative n)
|
:: (MonadNix e t f m, Has e Options, MonadReader Int n, Alternative n)
|
||||||
|
|
|
@ -268,7 +268,7 @@ nixIf = annotateLocation1
|
||||||
nixAssert :: Parser NExprLoc
|
nixAssert :: Parser NExprLoc
|
||||||
nixAssert = annotateLocation1
|
nixAssert = annotateLocation1
|
||||||
( NAssert
|
( NAssert
|
||||||
<$> (reserved "assert" *> nixExpr)
|
<$> (reserved "assert" *> nixToplevelForm)
|
||||||
<*> (semi *> nixToplevelForm)
|
<*> (semi *> nixToplevelForm)
|
||||||
<?> "assert"
|
<?> "assert"
|
||||||
)
|
)
|
||||||
|
|
|
@ -77,6 +77,9 @@ posAndMsg (SourcePos _ lineNo _) msg = FancyError
|
||||||
|
|
||||||
renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)
|
renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)
|
||||||
renderLocation (SrcSpan (SourcePos file begLine begCol) (SourcePos file' endLine endCol)) msg
|
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'
|
| file /= "<string>" && file == file'
|
||||||
= do
|
= do
|
||||||
exist <- doesFileExist file
|
exist <- doesFileExist file
|
||||||
|
|
|
@ -15,7 +15,6 @@ import Control.Exception hiding ( catch )
|
||||||
import Control.Monad.Catch
|
import Control.Monad.Catch
|
||||||
|
|
||||||
import Nix.Thunk
|
import Nix.Thunk
|
||||||
import Nix.Utils
|
|
||||||
import Nix.Var
|
import Nix.Var
|
||||||
|
|
||||||
data Deferred m v = Deferred (m v) | Computed v
|
data Deferred m v = Deferred (m v) | Computed v
|
||||||
|
@ -75,7 +74,6 @@ forceThunk (Thunk n active ref) k = do
|
||||||
if nowActive
|
if nowActive
|
||||||
then throwM $ ThunkLoop $ show n
|
then throwM $ ThunkLoop $ show n
|
||||||
else do
|
else do
|
||||||
traceM $ "Forcing " ++ show n
|
|
||||||
v <- catch action $ \(e :: SomeException) -> do
|
v <- catch action $ \(e :: SomeException) -> do
|
||||||
_ <- atomicModifyVar active (False, )
|
_ <- atomicModifyVar active (False, )
|
||||||
throwM e
|
throwM e
|
||||||
|
|
Loading…
Reference in a new issue