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)
|
||||
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
|
||||
, add Normal "valueSize" getRecursiveSize
|
||||
, add Normal "getContext" getContext
|
||||
, add2 Normal "appendContext" appendContext
|
||||
|
||||
, add2 Normal "unsafeGetAttrPos" unsafeGetAttrPos
|
||||
--, add0 Normal "unsafeDiscardOutputDependency" unsafeDiscardOutputDependency
|
||||
, add Normal "unsafeDiscardStringContext" unsafeDiscardStringContext
|
||||
, add2 Normal "unsafeGetAttrPos" unsafeGetAttrPos
|
||||
, add Normal "valueSize" getRecursiveSize
|
||||
]
|
||||
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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -268,7 +268,7 @@ nixIf = annotateLocation1
|
|||
nixAssert :: Parser NExprLoc
|
||||
nixAssert = annotateLocation1
|
||||
( NAssert
|
||||
<$> (reserved "assert" *> nixExpr)
|
||||
<$> (reserved "assert" *> nixToplevelForm)
|
||||
<*> (semi *> nixToplevelForm)
|
||||
<?> "assert"
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue