clean-up: (return -> pure)
M main/Main.hs M main/Repl.hs M src/Nix/Builtins.hs M src/Nix/Convert.hs M src/Nix/Effects.hs M src/Nix/Effects/Basic.hs M src/Nix/Eval.hs M src/Nix/Exec.hs M src/Nix/Expr/Types.hs M src/Nix/Json.hs M src/Nix/Lint.hs M src/Nix/Normal.hs M src/Nix/Options/Parser.hs M src/Nix/Parser.hs M src/Nix/Scope.hs M src/Nix/String.hs M src/Nix/TH.hs M src/Nix/Thunk/Basic.hs M src/Nix/Utils.hs M src/Nix/Value.hs M src/Nix/Value/Equal.hs M src/Nix/XML.hs M tests/EvalTests.hs M tests/Main.hs M tests/NixLanguageTests.hs M tests/ParserTests.hs M tests/TestCommon.hs
This commit is contained in:
Anton-Latukha
parent
dd6940fe7b
commit
0cb3946ee7
|
|
@ -183,10 +183,10 @@ main = do
|
|||
when report $ do
|
||||
liftIO $ putStrLn path
|
||||
when descend $ case mv of
|
||||
Nothing -> return ()
|
||||
Nothing -> pure ()
|
||||
Just v -> case v of
|
||||
NVSet s' _ -> go (path ++ ".") s'
|
||||
_ -> return ()
|
||||
_ -> pure ()
|
||||
where
|
||||
filterEntry path k = case (path, k) of
|
||||
("stdenv", "stdenv" ) -> (True, True)
|
||||
|
|
@ -216,7 +216,7 @@ main = do
|
|||
=<< renderFrames @(StdValue (StandardT (StdIdT IO)))
|
||||
@(StdThunk (StandardT (StdIdT IO)))
|
||||
frames
|
||||
return Nothing
|
||||
pure Nothing
|
||||
|
||||
reduction path mp x = do
|
||||
eres <- Nix.withNixContext mp
|
||||
|
|
@ -234,4 +234,4 @@ main = do
|
|||
writeFile path $ show $ prettyNix (stripAnnotation expr')
|
||||
case eres of
|
||||
Left err -> throwM err
|
||||
Right v -> return v
|
||||
Right v -> pure v
|
||||
|
|
|
|||
16
main/Repl.hs
16
main/Repl.hs
|
|
@ -96,7 +96,7 @@ main' iniVal = initState iniVal >>= \s -> flip evalStateT s
|
|||
<> ". For help type :help\n"
|
||||
finalizer = do
|
||||
liftIO $ putStrLn "Goodbye."
|
||||
return Exit
|
||||
pure Exit
|
||||
|
||||
rcFile = do
|
||||
f <- liftIO $ Data.Text.IO.readFile ".hnixrc" `catch` handleMissing
|
||||
|
|
@ -107,7 +107,7 @@ main' iniVal = initState iniVal >>= \s -> flip evalStateT s
|
|||
x -> cmd $ unwords x
|
||||
|
||||
handleMissing e
|
||||
| System.IO.Error.isDoesNotExistError e = return ""
|
||||
| System.IO.Error.isDoesNotExistError e = pure ""
|
||||
| otherwise = throwIO e
|
||||
|
||||
-- Replicated and slightly adjusted `optMatcher` from `System.Console.Repline`
|
||||
|
|
@ -193,7 +193,7 @@ exec update source = do
|
|||
case parseExprOrBinding source of
|
||||
(Failure err, _) -> do
|
||||
liftIO $ print err
|
||||
return Nothing
|
||||
pure Nothing
|
||||
(Success expr, isBinding) -> do
|
||||
|
||||
-- Type Inference ( returns Typing Environment )
|
||||
|
|
@ -209,7 +209,7 @@ exec update source = do
|
|||
case mVal of
|
||||
Left (NixException frames) -> do
|
||||
lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t frames
|
||||
return Nothing
|
||||
pure Nothing
|
||||
Right val -> do
|
||||
-- Update the interpreter state
|
||||
when (update && isBinding) $ do
|
||||
|
|
@ -219,9 +219,9 @@ exec update source = do
|
|||
-- If the result value is a set, update our context with it
|
||||
case val of
|
||||
NVSet xs _ -> put st { replCtx = Data.HashMap.Lazy.union xs (replCtx st) }
|
||||
_ -> return ()
|
||||
_ -> pure ()
|
||||
|
||||
return $ Just val
|
||||
pure $ Just val
|
||||
where
|
||||
-- If parsing fails, turn the input into singleton attribute set
|
||||
-- and try again.
|
||||
|
|
@ -245,7 +245,7 @@ cmd
|
|||
cmd source = do
|
||||
mVal <- exec True (Data.Text.pack source)
|
||||
case mVal of
|
||||
Nothing -> return ()
|
||||
Nothing -> pure ()
|
||||
Just val -> printValue val
|
||||
|
||||
printValue :: (MonadNix e t f m, MonadIO m)
|
||||
|
|
@ -294,7 +294,7 @@ typeof
|
|||
typeof args = do
|
||||
st <- get
|
||||
mVal <- case Data.HashMap.Lazy.lookup line (replCtx st) of
|
||||
Just val -> return $ Just val
|
||||
Just val -> pure $ Just val
|
||||
Nothing -> do
|
||||
exec False line
|
||||
|
||||
|
|
|
|||
|
|
@ -204,7 +204,7 @@ builtinsList = sequence
|
|||
, add2 Normal "elem" elem_
|
||||
, add2 Normal "elemAt" elemAt_
|
||||
, add Normal "exec" exec_
|
||||
, add0 Normal "false" (return $ nvConstant $ NBool False)
|
||||
, add0 Normal "false" (pure $ nvConstant $ NBool False)
|
||||
, add Normal "fetchTarball" fetchTarball
|
||||
, add Normal "fetchurl" fetchurl
|
||||
, add2 Normal "filter" filter_
|
||||
|
|
@ -236,7 +236,7 @@ builtinsList = sequence
|
|||
, add2 TopLevel "mapAttrs" mapAttrs_
|
||||
, add2 Normal "match" match_
|
||||
, add2 Normal "mul" mul_
|
||||
, add0 Normal "null" (return $ nvConstant NNull)
|
||||
, add0 Normal "null" (pure $ nvConstant NNull)
|
||||
, add Normal "parseDrvName" parseDrvName
|
||||
, add2 Normal "partition" partition_
|
||||
, add Normal "pathExists" pathExists_
|
||||
|
|
@ -251,12 +251,12 @@ builtinsList = sequence
|
|||
, add2 Normal "sort" sort_
|
||||
, add2 Normal "split" split_
|
||||
, add Normal "splitVersion" splitVersion_
|
||||
, add0 Normal "storeDir" (return $ nvStr $ principledMakeNixStringWithoutContext "/nix/store")
|
||||
, add0 Normal "storeDir" (pure $ nvStr $ principledMakeNixStringWithoutContext "/nix/store")
|
||||
, add' Normal "stringLength" (arity1 $ Text.length . principledStringIgnoreContext)
|
||||
, add' Normal "sub" (arity2 ((-) @Integer))
|
||||
, add' Normal "substring" (substring @e @t @f @m)
|
||||
, add Normal "tail" tail_
|
||||
, add0 Normal "true" (return $ nvConstant $ NBool True)
|
||||
, add0 Normal "true" (pure $ nvConstant $ NBool True)
|
||||
, add TopLevel "throw" throw_
|
||||
, add Normal "toJSON" prim_toJSON
|
||||
, add2 Normal "toFile" toFile
|
||||
|
|
@ -306,11 +306,11 @@ foldNixPath
|
|||
foldNixPath f z = do
|
||||
mres <- lookupVar "__includes"
|
||||
dirs <- case mres of
|
||||
Nothing -> return []
|
||||
Nothing -> pure []
|
||||
Just v -> demand v $ fromValue . Deeper
|
||||
mPath <- getEnvVar "NIX_PATH"
|
||||
mDataDir <- getEnvVar "NIX_DATA_DIR"
|
||||
dataDir <- maybe getDataDir return mDataDir
|
||||
dataDir <- maybe getDataDir pure mDataDir
|
||||
foldrM go z
|
||||
$ map (fromInclude . principledStringIgnoreContext) dirs
|
||||
++ case mPath of
|
||||
|
|
@ -438,10 +438,10 @@ div_ x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
|
|||
(_, _) -> throwError $ Division x' y'
|
||||
|
||||
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
|
||||
anyM _ [] = return False
|
||||
anyM _ [] = pure False
|
||||
anyM p (x : xs) = do
|
||||
q <- p x
|
||||
if q then return True else anyM p xs
|
||||
if q then pure True else anyM p xs
|
||||
|
||||
any_
|
||||
:: MonadNix e t f m
|
||||
|
|
@ -451,10 +451,10 @@ any_
|
|||
any_ f = toValue <=< anyM fromValue <=< mapM (f `callFunc`) <=< fromValue
|
||||
|
||||
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
|
||||
allM _ [] = return True
|
||||
allM _ [] = pure True
|
||||
allM p (x : xs) = do
|
||||
q <- p x
|
||||
if q then allM p xs else return False
|
||||
if q then allM p xs else pure False
|
||||
|
||||
all_
|
||||
:: MonadNix e t f m
|
||||
|
|
@ -481,7 +481,7 @@ head_ = fromValue >=> \case
|
|||
tail_ :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
||||
tail_ = fromValue >=> \case
|
||||
[] -> throwError $ ErrorCall "builtins.tail: empty list"
|
||||
_ : t -> return $ nvList t
|
||||
_ : t -> pure $ nvList t
|
||||
|
||||
data VersionComponent
|
||||
= VersionComponent_Pre -- ^ The string "pre"
|
||||
|
|
@ -525,7 +525,7 @@ splitVersion s = case Text.uncons s of
|
|||
|
||||
splitVersion_ :: MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
||||
splitVersion_ = fromValue >=> fromStringNoContext >=> \s ->
|
||||
return
|
||||
pure
|
||||
$ nvList
|
||||
$ flip map (splitVersion s)
|
||||
$ nvStr
|
||||
|
|
@ -546,7 +546,7 @@ compareVersions_
|
|||
-> m (NValue t f m)
|
||||
compareVersions_ t1 t2 = fromValue t1 >>= fromStringNoContext >>= \s1 ->
|
||||
fromValue t2 >>= fromStringNoContext >>= \s2 ->
|
||||
return $ nvConstant $ NInt $ case compareVersions s1 s2 of
|
||||
pure $ nvConstant $ NInt $ case compareVersions s1 s2 of
|
||||
LT -> -1
|
||||
EQ -> 0
|
||||
GT -> 1
|
||||
|
|
@ -624,7 +624,7 @@ split_ pat str = fromValue pat >>= fromStringNoContext >>= \p ->
|
|||
let s = principledStringIgnoreContext ns
|
||||
let re = makeRegex (encodeUtf8 p) :: Regex
|
||||
haystack = encodeUtf8 s
|
||||
return $ nvList $ splitMatches 0
|
||||
pure $ nvList $ splitMatches 0
|
||||
(map elems $ matchAllText re haystack)
|
||||
haystack
|
||||
|
||||
|
|
@ -925,7 +925,7 @@ replaceStrings tfrom tto ts = fromValue (Deeper tfrom) >>= \(nsFrom :: [NixStrin
|
|||
(prefix, replacement) <- find ((`Text.isPrefixOf` s) . fst)
|
||||
$ zip from nsTo
|
||||
let rest = Text.drop (Text.length prefix) s
|
||||
return (prefix, replacement, rest)
|
||||
pure (prefix, replacement, rest)
|
||||
finish b =
|
||||
principledMakeNixString (LazyText.toStrict $ Builder.toLazyText b)
|
||||
go orig result ctx = case lookupPrefix orig of
|
||||
|
|
@ -977,7 +977,7 @@ intersectAttrs
|
|||
intersectAttrs set1 set2 =
|
||||
fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set1 >>= \(s1, p1) ->
|
||||
fromValue @(AttrSet (NValue t f m), AttrSet SourcePos) set2 >>= \(s2, p2) ->
|
||||
return $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1)
|
||||
pure $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1)
|
||||
|
||||
functionArgs
|
||||
:: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
|
||||
|
|
@ -1086,10 +1086,10 @@ scopedImport asetArg pathArg = fromValue @(AttrSet (NValue t f m)) asetArg >>= \
|
|||
path' <- case mres of
|
||||
Nothing -> do
|
||||
traceM "No known current directory"
|
||||
return path
|
||||
pure path
|
||||
Just p -> demand p $ fromValue >=> \(Path p') -> do
|
||||
traceM $ "Current file being evaluated is: " ++ show p'
|
||||
return $ takeDirectory p' </> path
|
||||
pure $ takeDirectory p' </> path
|
||||
clearScopes @(NValue t f m)
|
||||
$ withNixContext (Just path')
|
||||
$ pushScope s
|
||||
|
|
@ -1416,7 +1416,7 @@ currentSystem :: MonadNix e t f m => m (NValue t f m)
|
|||
currentSystem = do
|
||||
os <- getCurrentSystemOS
|
||||
arch <- getCurrentSystemArch
|
||||
return $ nvStr $ principledMakeNixStringWithoutContext (arch <> "-" <> os)
|
||||
pure $ nvStr $ principledMakeNixStringWithoutContext (arch <> "-" <> os)
|
||||
|
||||
currentTime_ :: MonadNix e t f m => m (NValue t f m)
|
||||
currentTime_ = do
|
||||
|
|
@ -1451,12 +1451,12 @@ appendContext x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
|
|||
newContextValues <- forM attrs $ \attr -> demand attr $ \case
|
||||
NVSet attrs _ -> do
|
||||
-- TODO: Fail for unexpected keys.
|
||||
path <- maybe (return False) (demand ?? fromValue)
|
||||
path <- maybe (pure False) (demand ?? fromValue)
|
||||
$ M.lookup "path" attrs
|
||||
allOutputs <- maybe (return False) (demand ?? fromValue)
|
||||
allOutputs <- maybe (pure False) (demand ?? fromValue)
|
||||
$ M.lookup "allOutputs" attrs
|
||||
outputs <- case M.lookup "outputs" attrs of
|
||||
Nothing -> return []
|
||||
Nothing -> pure []
|
||||
Just os -> demand os $ \case
|
||||
NVList vs ->
|
||||
forM vs $ fmap principledStringIgnoreContext . fromValue
|
||||
|
|
@ -1465,7 +1465,7 @@ appendContext x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
|
|||
$ ErrorCall
|
||||
$ "Invalid types for context value outputs in builtins.appendContext: "
|
||||
++ show x
|
||||
return $ NixLikeContextValue path allOutputs outputs
|
||||
pure $ NixLikeContextValue path allOutputs outputs
|
||||
x ->
|
||||
throwError
|
||||
$ ErrorCall
|
||||
|
|
@ -1501,4 +1501,4 @@ instance ( MonadNix e t f m
|
|||
)
|
||||
=> ToBuiltin t f m (a -> b) where
|
||||
toBuiltin name f =
|
||||
return $ nvBuiltin name (fromValue . Deeper >=> toBuiltin name . f)
|
||||
pure $ nvBuiltin name (fromValue . Deeper >=> toBuiltin name . f)
|
||||
|
|
|
|||
|
|
@ -353,16 +353,16 @@ instance (Convertible e t f m, ToValue a m (NValue t f m))
|
|||
instance Convertible e t f m
|
||||
=> ToValue NixLikeContextValue m (NValue' t f m (NValue t f m)) where
|
||||
toValue nlcv = do
|
||||
path <- if nlcvPath nlcv then Just <$> toValue True else return Nothing
|
||||
path <- if nlcvPath nlcv then Just <$> toValue True else pure Nothing
|
||||
allOutputs <- if nlcvAllOutputs nlcv
|
||||
then Just <$> toValue True
|
||||
else return Nothing
|
||||
else pure Nothing
|
||||
outputs <- do
|
||||
let outputs =
|
||||
principledMakeNixStringWithoutContext <$> nlcvOutputs nlcv
|
||||
ts :: [NValue t f m] <- traverse toValue outputs
|
||||
case ts of
|
||||
[] -> return Nothing
|
||||
[] -> pure Nothing
|
||||
_ -> Just <$> toValue ts
|
||||
pure $ flip nvSet' M.empty $ M.fromList $ catMaybes
|
||||
[ ("path",) <$> path
|
||||
|
|
|
|||
|
|
@ -76,7 +76,7 @@ recursiveSize
|
|||
\_ -> return 0
|
||||
#endif
|
||||
#else
|
||||
\_ -> return 0
|
||||
\_ -> pure 0
|
||||
#endif
|
||||
|
||||
class Monad m => MonadExec m where
|
||||
|
|
@ -87,26 +87,26 @@ class Monad m => MonadExec m where
|
|||
|
||||
instance MonadExec IO where
|
||||
exec' = \case
|
||||
[] -> return $ Left $ ErrorCall "exec: missing program"
|
||||
[] -> pure $ Left $ ErrorCall "exec: missing program"
|
||||
(prog : args) -> do
|
||||
(exitCode, out, _) <- liftIO $ readProcessWithExitCode prog args ""
|
||||
let t = T.strip (T.pack out)
|
||||
let emsg = "program[" ++ prog ++ "] args=" ++ show args
|
||||
case exitCode of
|
||||
ExitSuccess -> if T.null t
|
||||
then return $ Left $ ErrorCall $ "exec has no output :" ++ emsg
|
||||
then pure $ Left $ ErrorCall $ "exec has no output :" ++ emsg
|
||||
else case parseNixTextLoc t of
|
||||
Failure err ->
|
||||
return
|
||||
pure
|
||||
$ Left
|
||||
$ ErrorCall
|
||||
$ "Error parsing output of exec: "
|
||||
++ show err
|
||||
++ " "
|
||||
++ emsg
|
||||
Success v -> return $ Right v
|
||||
Success v -> pure $ Right v
|
||||
err ->
|
||||
return
|
||||
pure
|
||||
$ Left
|
||||
$ ErrorCall
|
||||
$ "exec failed: "
|
||||
|
|
@ -129,14 +129,14 @@ instance MonadInstantiate IO where
|
|||
case exitCode of
|
||||
ExitSuccess -> case parseNixTextLoc (T.pack out) of
|
||||
Failure e ->
|
||||
return
|
||||
pure
|
||||
$ Left
|
||||
$ ErrorCall
|
||||
$ "Error parsing output of nix-instantiate: "
|
||||
++ show e
|
||||
Success v -> return $ Right v
|
||||
Success v -> pure $ Right v
|
||||
status ->
|
||||
return
|
||||
pure
|
||||
$ Left
|
||||
$ ErrorCall
|
||||
$ "nix-instantiate failed: "
|
||||
|
|
@ -161,10 +161,10 @@ class Monad m => MonadEnv m where
|
|||
instance MonadEnv IO where
|
||||
getEnvVar = lookupEnv
|
||||
|
||||
getCurrentSystemOS = return $ T.pack System.Info.os
|
||||
getCurrentSystemOS = pure $ T.pack System.Info.os
|
||||
|
||||
-- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4
|
||||
getCurrentSystemArch = return $ T.pack $ case System.Info.arch of
|
||||
getCurrentSystemArch = pure $ T.pack $ case System.Info.arch of
|
||||
"i386" -> "i686"
|
||||
arch -> arch
|
||||
|
||||
|
|
@ -194,7 +194,7 @@ instance MonadHttp IO where
|
|||
let status = statusCode (responseStatus response)
|
||||
if status /= 200
|
||||
then
|
||||
return
|
||||
pure
|
||||
$ Left
|
||||
$ ErrorCall
|
||||
$ "fail, got "
|
||||
|
|
@ -203,7 +203,7 @@ instance MonadHttp IO where
|
|||
++ urlstr
|
||||
else -- do
|
||||
-- let bstr = responseBody response
|
||||
return
|
||||
pure
|
||||
$ Left
|
||||
$ ErrorCall
|
||||
$ "success in downloading but hnix-store is not yet ready; url = "
|
||||
|
|
@ -239,9 +239,9 @@ instance MonadStore IO where
|
|||
case exitCode of
|
||||
ExitSuccess -> do
|
||||
let dropTrailingLinefeed p = take (length p - 1) p
|
||||
return $ Right $ StorePath $ dropTrailingLinefeed out
|
||||
pure $ Right $ StorePath $ dropTrailingLinefeed out
|
||||
_ ->
|
||||
return
|
||||
pure
|
||||
$ Left
|
||||
$ ErrorCall
|
||||
$ "addPath: failed: nix-store --add "
|
||||
|
|
@ -252,10 +252,10 @@ instance MonadStore IO where
|
|||
writeFile filepath content
|
||||
storepath <- addPath' filepath
|
||||
S.removeFile filepath
|
||||
return storepath
|
||||
pure storepath
|
||||
|
||||
addPath :: (Framed e m, MonadStore m) => FilePath -> m StorePath
|
||||
addPath p = either throwError return =<< addPath' p
|
||||
addPath p = either throwError pure =<< addPath' p
|
||||
|
||||
toFile_ :: (Framed e m, MonadStore m) => FilePath -> String -> m StorePath
|
||||
toFile_ p contents = either throwError return =<< toFile_' p contents
|
||||
toFile_ p contents = either throwError pure =<< toFile_' p contents
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ defaultMakeAbsolutePath origPath = do
|
|||
case mres of
|
||||
Nothing -> getCurrentDirectory
|
||||
Just v -> demand v $ \case
|
||||
NVPath s -> return $ takeDirectory s
|
||||
NVPath s -> pure $ takeDirectory s
|
||||
v ->
|
||||
throwError
|
||||
$ ErrorCall
|
||||
|
|
@ -76,7 +76,7 @@ defaultMakeAbsolutePath origPath = do
|
|||
|
||||
expandHomePath :: MonadFile m => FilePath -> m FilePath
|
||||
expandHomePath ('~' : xs) = flip (++) xs <$> getHomeDirectory
|
||||
expandHomePath p = return p
|
||||
expandHomePath p = pure p
|
||||
|
||||
-- | Incorrectly normalize paths by rewriting patterns like @a/b/..@ to @a@.
|
||||
-- This is incorrect on POSIX systems, because if @b@ is a symlink, its
|
||||
|
|
@ -115,9 +115,9 @@ findEnvPathM name = do
|
|||
exists <- doesDirectoryExist path
|
||||
path' <- if exists
|
||||
then makeAbsolutePath @t @f $ path </> "default.nix"
|
||||
else return path
|
||||
else pure path
|
||||
exists <- doesFileExist path'
|
||||
return $ if exists then Just path' else Nothing
|
||||
pure $ if exists then Just path' else Nothing
|
||||
|
||||
findPathBy
|
||||
:: forall e t f m
|
||||
|
|
@ -136,7 +136,7 @@ findPathBy finder l name = do
|
|||
++ name
|
||||
++ "' was not found in the Nix search path"
|
||||
++ " (add it's using $NIX_PATH or -I)"
|
||||
Just path -> return path
|
||||
Just path -> pure path
|
||||
where
|
||||
go :: Maybe FilePath -> NValue t f m -> m (Maybe FilePath)
|
||||
go p@(Just _) _ = pure p
|
||||
|
|
@ -158,7 +158,7 @@ findPathBy finder l name = do
|
|||
tryPath p _ = finder $ p <///> name
|
||||
|
||||
resolvePath s = case M.lookup "path" s of
|
||||
Just t -> return t
|
||||
Just t -> pure t
|
||||
Nothing -> case M.lookup "uri" s of
|
||||
Just ut -> defer $ fetchTarball ut
|
||||
Nothing ->
|
||||
|
|
@ -232,7 +232,7 @@ findPathM = findPathBy path
|
|||
path path = do
|
||||
path <- makeAbsolutePath @t @f path
|
||||
exists <- doesPathExist path
|
||||
return $ if exists then Just path else Nothing
|
||||
pure $ if exists then Just path else Nothing
|
||||
|
||||
defaultImportPath
|
||||
:: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc) m)
|
||||
|
|
@ -273,7 +273,7 @@ defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
|
|||
nixInstantiateExpr $ "derivationStrict " ++ show (prettyNValue v')
|
||||
where
|
||||
mapMaybeM :: (a -> m (Maybe b)) -> [a] -> m [b]
|
||||
mapMaybeM op = foldr f (return [])
|
||||
mapMaybeM op = foldr f (pure [])
|
||||
where f x xs = op x >>= (<$> xs) . (++) . maybeToList
|
||||
|
||||
handleEntry :: Bool -> (Text, NValue t f m) -> m (Maybe (Text, NValue t f m))
|
||||
|
|
|
|||
|
|
@ -201,7 +201,7 @@ attrSetAlter (k : ks) pos m p val = case M.lookup k m of
|
|||
-> x >>= fromValue @(AttrSet v, AttrSet SourcePos) >>= \(st, sp) ->
|
||||
recurse (demand ?? pure <$> st) sp
|
||||
where
|
||||
go = return (M.insert k val m, M.insert k pos p)
|
||||
go = pure (M.insert k val m, M.insert k pos p)
|
||||
|
||||
recurse st sp = attrSetAlter ks pos st sp val <&> \(st', _) ->
|
||||
( M.insert
|
||||
|
|
@ -257,7 +257,7 @@ evalBinds recursive binds = do
|
|||
go _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =
|
||||
finalValue >>= fromValue >>= \(o', p') ->
|
||||
-- jww (2018-05-09): What to do with the key position here?
|
||||
return $ map
|
||||
pure $ map
|
||||
(\(k, v) -> ([k], fromMaybe pos (M.lookup k p'), demand v pure))
|
||||
(M.toList o')
|
||||
|
||||
|
|
@ -306,7 +306,7 @@ evalBinds recursive binds = do
|
|||
buildResult scope bindings = do
|
||||
(s, p) <- foldM insert (M.empty, M.empty) bindings
|
||||
res <- if recursive then loebM (encapsulate <$> s) else traverse mkThunk s
|
||||
return (res, p)
|
||||
pure (res, p)
|
||||
where
|
||||
mkThunk = defer . withScopes scope
|
||||
|
||||
|
|
@ -331,7 +331,7 @@ evalSelect aset attr = do
|
|||
[] -> pure $ Right $ demand t pure
|
||||
y : ys -> demand t $ extract ?? (y :| ys)
|
||||
| otherwise -> Left . (, path) <$> toValue (s, p)
|
||||
Nothing -> return $ Left (x, path)
|
||||
Nothing -> pure $ Left (x, path)
|
||||
|
||||
-- | Evaluate a component of an attribute path in a context where we are
|
||||
-- *retrieving* a value
|
||||
|
|
|
|||
|
|
@ -477,7 +477,7 @@ execBinaryOpForced scope span op lval rval = case op of
|
|||
-- use 'throwError'.
|
||||
fromStringNoContext :: Framed e m => NixString -> m Text
|
||||
fromStringNoContext ns = case principledGetStringNoContext ns of
|
||||
Just str -> return str
|
||||
Just str -> pure str
|
||||
Nothing -> throwError $ ErrorCall "expected string with no context"
|
||||
|
||||
addTracing
|
||||
|
|
@ -489,7 +489,7 @@ addTracing k v = do
|
|||
guard (depth < 2000)
|
||||
local succ $ do
|
||||
v'@(Compose (Ann span x)) <- sequence v
|
||||
return $ do
|
||||
pure $ do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
let rendered = if verbose opts >= Chatty
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
|
|
@ -503,7 +503,7 @@ addTracing k v = do
|
|||
putStr $ show loc
|
||||
res <- k v'
|
||||
print $ msg rendered <> " ...done"
|
||||
return res
|
||||
pure res
|
||||
|
||||
evalExprLoc :: forall e t f m . MonadNix e t f m => NExprLoc -> m (NValue t f m)
|
||||
evalExprLoc expr = do
|
||||
|
|
|
|||
|
|
@ -601,7 +601,7 @@ ekey keys pos f e@(Fix x) | (NSet NNonRecursive xs, ann) <- fromNExpr x = case g
|
|||
j : js -> do
|
||||
NamedVar ns v _p <- xs
|
||||
guard $ (j : js) == (NE.toList ns ^.. traverse . _StaticKey)
|
||||
return (v, rest)
|
||||
pure (v, rest)
|
||||
|
||||
ekey _ _ f e = fromMaybe e <$> f Nothing
|
||||
|
||||
|
|
|
|||
|
|
@ -43,14 +43,14 @@ nvalueToJSON = \case
|
|||
NVList l ->
|
||||
A.Array
|
||||
. V.fromList
|
||||
<$> traverse (join . lift . flip demand (return . nvalueToJSON)) l
|
||||
<$> traverse (join . lift . flip demand (pure . nvalueToJSON)) l
|
||||
NVSet m _ -> case HM.lookup "outPath" m of
|
||||
Nothing ->
|
||||
A.Object
|
||||
<$> traverse (join . lift . flip demand (return . nvalueToJSON)) m
|
||||
Just outPath -> join $ lift $ demand outPath (return . nvalueToJSON)
|
||||
<$> traverse (join . lift . flip demand (pure . nvalueToJSON)) m
|
||||
Just outPath -> join $ lift $ demand outPath (pure . nvalueToJSON)
|
||||
NVPath p -> do
|
||||
fp <- lift $ unStorePath <$> addPath p
|
||||
addSingletonStringContext $ StringContext (Text.pack fp) DirectPath
|
||||
return $ A.toJSON fp
|
||||
pure $ A.toJSON fp
|
||||
v -> lift $ throwError $ CoercionToJson v
|
||||
|
|
|
|||
|
|
@ -130,30 +130,30 @@ symerr = evalError @(Symbolic m) . ErrorCall
|
|||
|
||||
renderSymbolic :: MonadLint e m => Symbolic m -> m String
|
||||
renderSymbolic = unpackSymbolic >=> \case
|
||||
NAny -> return "<any>"
|
||||
NAny -> pure "<any>"
|
||||
NMany xs -> fmap (intercalate ", ") $ forM xs $ \case
|
||||
TConstant ys -> fmap (intercalate ", ") $ forM ys $ \case
|
||||
TInt -> return "int"
|
||||
TFloat -> return "float"
|
||||
TBool -> return "bool"
|
||||
TNull -> return "null"
|
||||
TStr -> return "string"
|
||||
TInt -> pure "int"
|
||||
TFloat -> pure "float"
|
||||
TBool -> pure "bool"
|
||||
TNull -> pure "null"
|
||||
TStr -> pure "string"
|
||||
TList r -> do
|
||||
x <- demand r renderSymbolic
|
||||
return $ "[" ++ x ++ "]"
|
||||
TSet Nothing -> return "<any set>"
|
||||
pure $ "[" ++ x ++ "]"
|
||||
TSet Nothing -> pure "<any set>"
|
||||
TSet (Just s) -> do
|
||||
x <- traverse (`demand` renderSymbolic) s
|
||||
return $ "{" ++ show x ++ "}"
|
||||
pure $ "{" ++ show x ++ "}"
|
||||
f@(TClosure p) -> do
|
||||
(args, sym) <- do
|
||||
f' <- mkSymbolic [f]
|
||||
lintApp (NAbs (void p) ()) f' everyPossible
|
||||
args' <- traverse renderSymbolic args
|
||||
sym' <- renderSymbolic sym
|
||||
return $ "(" ++ show args' ++ " -> " ++ sym' ++ ")"
|
||||
TPath -> return "path"
|
||||
TBuiltin _n _f -> return "<builtin function>"
|
||||
pure $ "(" ++ show args' ++ " -> " ++ sym' ++ ")"
|
||||
TPath -> pure "path"
|
||||
TBuiltin _n _f -> pure "<builtin function>"
|
||||
|
||||
-- This function is order and uniqueness preserving (of types).
|
||||
merge
|
||||
|
|
@ -169,8 +169,8 @@ merge context = go
|
|||
:: [NTypeF m (Symbolic m)]
|
||||
-> [NTypeF m (Symbolic m)]
|
||||
-> m [NTypeF m (Symbolic m)]
|
||||
go [] _ = return []
|
||||
go _ [] = return []
|
||||
go [] _ = pure []
|
||||
go _ [] = pure []
|
||||
go (x : xs) (y : ys) = case (x, y) of
|
||||
(TStr , TStr ) -> (TStr :) <$> go xs ys
|
||||
(TPath, TPath) -> (TPath :) <$> go xs ys
|
||||
|
|
@ -188,8 +188,8 @@ merge context = go
|
|||
>>= \j' -> demand i'
|
||||
$ \i'' -> demand j' $ \j'' -> defer $ unify context i'' j''
|
||||
)
|
||||
(return <$> l)
|
||||
(return <$> r)
|
||||
(pure <$> l)
|
||||
(pure <$> r)
|
||||
if M.null m then go xs ys else (TSet (Just m) :) <$> go xs ys
|
||||
(TClosure{}, TClosure{}) ->
|
||||
throwError $ ErrorCall "Cannot unify functions"
|
||||
|
|
@ -232,10 +232,10 @@ unify context (SV x) (SV y) = do
|
|||
case (x', y') of
|
||||
(NAny, _) -> do
|
||||
writeVar x y'
|
||||
return $ SV y
|
||||
pure $ SV y
|
||||
(_, NAny) -> do
|
||||
writeVar y x'
|
||||
return $ SV x
|
||||
pure $ SV x
|
||||
(NMany xs, NMany ys) -> do
|
||||
m <- merge context xs ys
|
||||
if null m
|
||||
|
|
@ -321,7 +321,7 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
|
|||
evalWith scope body = do
|
||||
s <- defer scope
|
||||
pushWeakScope ?? body $ demand s $ unpackSymbolic >=> \case
|
||||
NMany [TSet (Just s')] -> return s'
|
||||
NMany [TSet (Just s')] -> pure s'
|
||||
NMany [TSet Nothing] -> error "NYI: with unknown"
|
||||
_ -> throwError $ ErrorCall "scope must be a set in with statement"
|
||||
|
||||
|
|
@ -437,7 +437,7 @@ runLintM opts action = do
|
|||
runFreshIdT i $ flip runReaderT (newContext opts) $ runLint action
|
||||
|
||||
symbolicBaseEnv :: Monad m => m (Scopes m (Symbolic m))
|
||||
symbolicBaseEnv = return emptyScopes
|
||||
symbolicBaseEnv = pure emptyScopes
|
||||
|
||||
lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))
|
||||
lint opts expr =
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ normalizeValue f = run . iterNValueM run go (fmap Free . sequenceNValue' run)
|
|||
go t k = do
|
||||
b <- seen t
|
||||
if b
|
||||
then return $ Pure t
|
||||
then pure $ Pure t
|
||||
else do
|
||||
i <- ask
|
||||
when (i > 2000)
|
||||
|
|
@ -69,7 +69,7 @@ normalizeValue f = run . iterNValueM run go (fmap Free . sequenceNValue' run)
|
|||
lift $ do
|
||||
res <- gets (member tid)
|
||||
unless res $ modify (insert tid)
|
||||
return res
|
||||
pure res
|
||||
|
||||
normalForm
|
||||
:: ( Framed e m
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ argPair :: Mod OptionFields (Text, Text) -> Parser (Text, Text)
|
|||
argPair = option $ str >>= \s -> case Text.findIndex (== '=') s of
|
||||
Nothing ->
|
||||
errorWithoutStackTrace "Format of --arg/--argstr in hnix is: name=expr"
|
||||
Just i -> return $ second Text.tail $ Text.splitAt i s
|
||||
Just i -> pure $ second Text.tail $ Text.splitAt i s
|
||||
|
||||
nixOptions :: UTCTime -> Parser Options
|
||||
nixOptions current =
|
||||
|
|
|
|||
|
|
@ -127,7 +127,7 @@ nixSelect term = do
|
|||
nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
|
||||
nixSelector = annotateLocation $ do
|
||||
(x : xs) <- keyName `sepBy1` selDot
|
||||
return $ x :| xs
|
||||
pure $ x :| xs
|
||||
|
||||
nixTerm :: Parser NExprLoc
|
||||
nixTerm = do
|
||||
|
|
@ -291,7 +291,7 @@ nixUri = lexeme $ annotateLocation1 $ try $ do
|
|||
_ <- string ":"
|
||||
address <- some $ satisfy $ \x ->
|
||||
isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)
|
||||
return $ NStr $ DoubleQuoted
|
||||
pure $ NStr $ DoubleQuoted
|
||||
[Plain $ pack $ start : protocol ++ ':' : address]
|
||||
|
||||
nixString' :: Parser (NString NExprLoc)
|
||||
|
|
@ -361,18 +361,18 @@ argExpr = msum [atLeft, onlyname, atRight] <* symbol ":" where
|
|||
atLeft = try $ do
|
||||
name <- identifier <* symbol "@"
|
||||
(variadic, params) <- params
|
||||
return $ ParamSet params variadic (Just name)
|
||||
pure $ ParamSet params variadic (Just name)
|
||||
|
||||
-- Parameters named by an identifier on the right, or none (`{x, y} @ args`)
|
||||
atRight = do
|
||||
(variadic, params) <- params
|
||||
name <- optional $ symbol "@" *> identifier
|
||||
return $ ParamSet params variadic name
|
||||
pure $ ParamSet params variadic name
|
||||
|
||||
-- Return the parameters set.
|
||||
params = do
|
||||
(args, dotdots) <- braces getParams
|
||||
return (dotdots, args)
|
||||
pure (dotdots, args)
|
||||
|
||||
-- Collects the parameters within curly braces. Returns the parameters and
|
||||
-- a boolean indicating if the parameters are variadic.
|
||||
|
|
@ -488,7 +488,7 @@ identifier = lexeme $ try $ do
|
|||
<$> satisfy (\x -> isAlpha x || x == '_')
|
||||
<*> takeWhileP Nothing identLetter
|
||||
guard (not (ident `HashSet.member` reservedNames))
|
||||
return ident
|
||||
pure ident
|
||||
where
|
||||
identLetter x = isAlpha x || isDigit x || x == '_' || x == '\'' || x == '-'
|
||||
|
||||
|
|
@ -520,7 +520,7 @@ data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
|
|||
parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a)
|
||||
parseFromFileEx p path = do
|
||||
txt <- decodeUtf8 <$> readFile path
|
||||
return $ either (Failure . pretty . errorBundlePretty) Success $ parse p
|
||||
pure $ either (Failure . pretty . errorBundlePretty) Success $ parse p
|
||||
path
|
||||
txt
|
||||
|
||||
|
|
@ -564,7 +564,7 @@ opWithLoc :: Text -> o -> (Ann SrcSpan o -> a) -> Parser a
|
|||
opWithLoc name op f = do
|
||||
Ann ann _ <- annotateLocation $ {- dbg (unpack name) $ -}
|
||||
operator name
|
||||
return $ f (Ann ann op)
|
||||
pure $ f (Ann ann op)
|
||||
|
||||
binaryN name op =
|
||||
(NBinaryDef name op NAssocNone, InfixN (opWithLoc name op nBinary))
|
||||
|
|
|
|||
|
|
@ -78,17 +78,17 @@ lookupVarReader
|
|||
lookupVarReader k = do
|
||||
mres <- asks (scopeLookup k . lexicalScopes @m . view hasLens)
|
||||
case mres of
|
||||
Just sym -> return $ Just sym
|
||||
Just sym -> pure $ Just sym
|
||||
Nothing -> do
|
||||
ws <- asks (dynamicScopes . view hasLens)
|
||||
foldr
|
||||
(\x rest -> do
|
||||
mres' <- M.lookup k . getScope <$> x
|
||||
case mres' of
|
||||
Just sym -> return $ Just sym
|
||||
Just sym -> pure $ Just sym
|
||||
Nothing -> rest
|
||||
)
|
||||
(return Nothing)
|
||||
(pure Nothing)
|
||||
ws
|
||||
|
||||
withScopes :: Scoped a m => Scopes m a -> m r -> m r
|
||||
|
|
|
|||
|
|
@ -224,7 +224,7 @@ addSingletonStringContext = WithStringContextT . tell . S.singleton
|
|||
|
||||
-- | Get the contents of a 'NixString' and write its context into the resulting set.
|
||||
extractNixString :: Monad m => NixString -> WithStringContextT m Text
|
||||
extractNixString (NixString s c) = WithStringContextT $ tell c >> return s
|
||||
extractNixString (NixString s c) = WithStringContextT $ tell c >> pure s
|
||||
|
||||
-- | Run an action producing a string with a context and put those into a 'NixString'.
|
||||
runWithStringContextT :: Monad m => WithStringContextT m Text -> m NixString
|
||||
|
|
|
|||
|
|
@ -26,14 +26,14 @@ quoteExprExp :: String -> ExpQ
|
|||
quoteExprExp s = do
|
||||
expr <- case parseNixText (Text.pack s) of
|
||||
Failure err -> fail $ show err
|
||||
Success e -> return e
|
||||
Success e -> pure e
|
||||
dataToExpQ (const Nothing `extQ` metaExp (freeVars expr)) expr
|
||||
|
||||
quoteExprPat :: String -> PatQ
|
||||
quoteExprPat s = do
|
||||
expr <- case parseNixText (Text.pack s) of
|
||||
Failure err -> fail $ show err
|
||||
Success e -> return e
|
||||
Success e -> pure e
|
||||
dataToPatQ (const Nothing `extQ` metaPat (freeVars expr)) expr
|
||||
|
||||
freeVars :: NExpr -> Set VarName
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@ queryThunk (Thunk _ active ref) n k = do
|
|||
Computed v -> k v
|
||||
_ -> n
|
||||
_ <- atomicModifyVar active (False, )
|
||||
return res
|
||||
pure res
|
||||
|
||||
forceThunk
|
||||
:: forall m v a
|
||||
|
|
@ -87,7 +87,7 @@ forceEffects :: MonadVar m => NThunkF m v -> (v -> m r) -> m r
|
|||
forceEffects (Thunk _ active ref) k = do
|
||||
nowActive <- atomicModifyVar active (True, )
|
||||
if nowActive
|
||||
then return $ error "Loop detected"
|
||||
then pure $ error "Loop detected"
|
||||
else do
|
||||
eres <- readVar ref
|
||||
case eres of
|
||||
|
|
@ -103,4 +103,4 @@ furtherThunk t@(Thunk _ _ ref) k = do
|
|||
_ <- atomicModifyVar ref $ \x -> case x of
|
||||
Computed _ -> (x, x)
|
||||
Deferred d -> (Deferred (k d), x)
|
||||
return t
|
||||
pure t
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ import Prelude as X
|
|||
trace :: String -> a -> a
|
||||
trace = const id
|
||||
traceM :: Monad m => String -> m ()
|
||||
traceM = const (return ())
|
||||
traceM = const (pure ())
|
||||
#endif
|
||||
|
||||
$(makeLensesBy (\n -> Just ("_" ++ n)) ''Fix)
|
||||
|
|
@ -95,7 +95,7 @@ lifted
|
|||
=> ((a -> m (StT u b)) -> m (StT u b))
|
||||
-> (a -> u m b)
|
||||
-> u m b
|
||||
lifted f k = liftWith (\run -> f (run . k)) >>= restoreT . return
|
||||
lifted f k = liftWith (\run -> f (run . k)) >>= restoreT . pure
|
||||
|
||||
freeToFix :: Functor f => (a -> Fix f) -> Free f a -> Fix f
|
||||
freeToFix f = go
|
||||
|
|
|
|||
|
|
@ -373,7 +373,7 @@ builtin
|
|||
=> String
|
||||
-> (NValue t f m -> m (NValue t f m))
|
||||
-> m (NValue t f m)
|
||||
builtin name f = return $ nvBuiltin name $ \a -> f a
|
||||
builtin name f = pure $ nvBuiltin name $ \a -> f a
|
||||
|
||||
builtin2
|
||||
:: (MonadThunk t m (NValue t f m), MonadDataContext f m)
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ alignEqM
|
|||
-> m Bool
|
||||
alignEqM eq fa fb = fmap (either (const False) (const True)) $ runExceptT $ do
|
||||
pairs <- forM (Data.Align.align fa fb) $ \case
|
||||
These a b -> return (a, b)
|
||||
These a b -> pure (a, b)
|
||||
_ -> throwE ()
|
||||
forM_ pairs $ \(a, b) -> guard =<< lift (eq a b)
|
||||
|
||||
|
|
@ -171,7 +171,7 @@ valueEqM (Free (NValue (extract -> x))) (Free (NValue (extract -> y))) =
|
|||
thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool
|
||||
thunkEqM lt rt = force lt $ \lv -> force rt $ \rv ->
|
||||
let unsafePtrEq = case (lt, rt) of
|
||||
(thunkId -> lid, thunkId -> rid) | lid == rid -> return True
|
||||
(thunkId -> lid, thunkId -> rid) | lid == rid -> pure True
|
||||
_ -> valueEqM lv rv
|
||||
in case (lv, rv) of
|
||||
(NVClosure _ _, NVClosure _ _) -> unsafePtrEq
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ import Text.XML.Light
|
|||
toXML :: forall t f m . MonadDataContext f m => NValue t f m -> NixString
|
||||
toXML = runWithStringContext . fmap pp . iterNValue (\_ _ -> cyc) phi
|
||||
where
|
||||
cyc = return $ mkElem "string" "value" "<CYCLE>"
|
||||
cyc = pure $ mkElem "string" "value" "<CYCLE>"
|
||||
|
||||
pp =
|
||||
("<?xml version='1.0' encoding='utf-8'?>\n" <>)
|
||||
|
|
@ -30,18 +30,18 @@ toXML = runWithStringContext . fmap pp . iterNValue (\_ _ -> cyc) phi
|
|||
phi :: NValue' t f m (WithStringContext Element) -> WithStringContext Element
|
||||
phi = \case
|
||||
NVConstant' a -> case a of
|
||||
NURI t -> return $ mkElem "string" "value" (Text.unpack t)
|
||||
NInt n -> return $ mkElem "int" "value" (show n)
|
||||
NFloat f -> return $ mkElem "float" "value" (show f)
|
||||
NBool b -> return $ mkElem "bool" "value" (if b then "true" else "false")
|
||||
NNull -> return $ Element (unqual "null") [] [] Nothing
|
||||
NURI t -> pure $ mkElem "string" "value" (Text.unpack t)
|
||||
NInt n -> pure $ mkElem "int" "value" (show n)
|
||||
NFloat f -> pure $ mkElem "float" "value" (show f)
|
||||
NBool b -> pure $ mkElem "bool" "value" (if b then "true" else "false")
|
||||
NNull -> pure $ Element (unqual "null") [] [] Nothing
|
||||
|
||||
NVStr' str ->
|
||||
mkElem "string" "value" . Text.unpack <$> extractNixString str
|
||||
NVList' l -> sequence l
|
||||
>>= \els -> return $ Element (unqual "list") [] (Elem <$> els) Nothing
|
||||
>>= \els -> pure $ Element (unqual "list") [] (Elem <$> els) Nothing
|
||||
|
||||
NVSet' s _ -> sequence s >>= \kvs -> return $ Element
|
||||
NVSet' s _ -> sequence s >>= \kvs -> pure $ Element
|
||||
(unqual "attrs")
|
||||
[]
|
||||
(map
|
||||
|
|
@ -57,9 +57,9 @@ toXML = runWithStringContext . fmap pp . iterNValue (\_ _ -> cyc) phi
|
|||
Nothing
|
||||
|
||||
NVClosure' p _ ->
|
||||
return $ Element (unqual "function") [] (paramsXML p) Nothing
|
||||
NVPath' fp -> return $ mkElem "path" "value" fp
|
||||
NVBuiltin' name _ -> return $ mkElem "function" "name" name
|
||||
pure $ Element (unqual "function") [] (paramsXML p) Nothing
|
||||
NVPath' fp -> pure $ mkElem "path" "value" fp
|
||||
NVBuiltin' name _ -> pure $ mkElem "function" "name" name
|
||||
_ -> error "Pattern synonyms mask coverage"
|
||||
|
||||
mkElem :: String -> String -> String -> Element
|
||||
|
|
|
|||
|
|
@ -441,7 +441,7 @@ genEvalCompareTests = do
|
|||
let unmaskedFiles = filter ((==".nix") . takeExtension) td
|
||||
let files = unmaskedFiles \\ maskedFiles
|
||||
|
||||
return $ testGroup "Eval comparison tests" $ map (mkTestCase testDir) files
|
||||
pure $ testGroup "Eval comparison tests" $ map (mkTestCase testDir) files
|
||||
where
|
||||
mkTestCase td f = testCase f $ assertEvalFileMatchesNix (td </> f)
|
||||
|
||||
|
|
@ -454,7 +454,7 @@ constantEqual expected actual = do
|
|||
expectedNF <- normalForm =<< nixEvalExprLoc Nothing expected
|
||||
actualNF <- normalForm =<< nixEvalExprLoc Nothing actual
|
||||
eq <- valueEqM expectedNF actualNF
|
||||
return (eq, expectedNF, actualNF)
|
||||
pure (eq, expectedNF, actualNF)
|
||||
let message =
|
||||
"Inequal normal forms:\n"
|
||||
<> "Expected: " <> printNix expectedNF <> "\n"
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ ensureNixpkgsCanParse =
|
|||
-- Parse and deepseq the resulting expression tree, to ensure the
|
||||
-- parser is fully executed.
|
||||
_ <- consider file (parseNixFileLoc file) $ Exc.evaluate . force
|
||||
return ()
|
||||
pure ()
|
||||
v -> error $ "Unexpected parse from default.nix: " ++ show v
|
||||
where
|
||||
getExpr k m = let Just (Just r) = lookup k m in r
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@ genTests = do
|
|||
let testsByName = groupBy (takeFileName . dropExtensions) testFiles
|
||||
let testsByType = groupBy testType (Map.toList testsByName)
|
||||
let testGroups = map mkTestGroup (Map.toList testsByType)
|
||||
return $ localOption (mkTimeout 2000000) $ testGroup
|
||||
pure $ localOption (mkTimeout 2000000) $ testGroup
|
||||
"Nix (upstream) language tests"
|
||||
testGroups
|
||||
where
|
||||
|
|
@ -105,7 +105,7 @@ genTests = do
|
|||
|
||||
assertParse :: Options -> FilePath -> Assertion
|
||||
assertParse _opts file = parseNixFileLoc file >>= \case
|
||||
Success _expr -> return () -- pure $! runST $ void $ lint opts expr
|
||||
Success _expr -> pure () -- pure $! runST $ void $ lint opts expr
|
||||
Failure err ->
|
||||
assertFailure $ "Failed to parse " ++ file ++ ":\n" ++ show err
|
||||
|
||||
|
|
@ -121,9 +121,9 @@ assertParseFail opts file = do
|
|||
++ file
|
||||
++ ":\nParsed value: "
|
||||
++ show expr
|
||||
Failure _ -> return ()
|
||||
Failure _ -> pure ()
|
||||
)
|
||||
$ \(_ :: SomeException) -> return ()
|
||||
$ \(_ :: SomeException) -> pure ()
|
||||
|
||||
assertLangOk :: Options -> FilePath -> Assertion
|
||||
assertLangOk opts file = do
|
||||
|
|
@ -147,8 +147,8 @@ assertEval _opts files = do
|
|||
[] -> () <$ hnixEvalFile opts (name ++ ".nix")
|
||||
[".exp" ] -> assertLangOk opts name
|
||||
[".exp.xml" ] -> assertLangOkXml opts name
|
||||
[".exp.disabled"] -> return ()
|
||||
[".exp-disabled"] -> return ()
|
||||
[".exp.disabled"] -> pure ()
|
||||
[".exp-disabled"] -> pure ()
|
||||
[".exp", ".flags"] -> do
|
||||
liftIO $ setEnv "NIX_PATH" "lang/dir4:lang/dir5"
|
||||
flags <- Text.readFile (name ++ ".flags")
|
||||
|
|
@ -179,7 +179,7 @@ assertEval _opts files = do
|
|||
fixup [] = []
|
||||
|
||||
assertEvalFail :: FilePath -> Assertion
|
||||
assertEvalFail file = catch ?? (\(_ :: SomeException) -> return ()) $ do
|
||||
assertEvalFail file = catch ?? (\(_ :: SomeException) -> pure ()) $ do
|
||||
time <- liftIO getCurrentTime
|
||||
evalResult <- printNix <$> hnixEvalFile (defaultOptions time) file
|
||||
evalResult
|
||||
|
|
|
|||
|
|
@ -383,7 +383,7 @@ assertParseFile file expected = do
|
|||
|
||||
assertParseFail :: Text -> Assertion
|
||||
assertParseFail str = case parseNixText str of
|
||||
Failure _ -> return ()
|
||||
Failure _ -> pure ()
|
||||
Success r ->
|
||||
assertFailure $ "Unexpected success parsing `"
|
||||
++ unpack str ++ ":\nParsed value: " ++ show r
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@ nixEvalString expr = do
|
|||
hClose h
|
||||
res <- nixEvalFile fp
|
||||
removeLink fp
|
||||
return res
|
||||
pure res
|
||||
|
||||
nixEvalFile :: FilePath -> IO String
|
||||
nixEvalFile fp = readProcess "nix-instantiate" ["--eval", "--strict", fp] ""
|
||||
|
|
|
|||
Loading…
Reference in New Issue