From 6c2149f76756d330324da76f21270de1717628ab Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Thu, 26 Apr 2018 17:13:22 -0700 Subject: [PATCH] Remove code TODOs, which have been changed into GitHub issues --- main/Main.hs | 2 -- src/Nix/Builtins.hs | 39 ++++++++++++++------------------------- src/Nix/Eval.hs | 5 ----- src/Nix/Exec.hs | 17 +---------------- src/Nix/Expr/Types.hs | 4 ++-- src/Nix/Frames.hs | 1 - src/Nix/Lint.hs | 5 ++--- src/Nix/Normal.hs | 6 +----- src/Nix/Pretty.hs | 1 - src/Nix/Reduce.hs | 12 ------------ src/Nix/Render/Frame.hs | 4 ---- src/Nix/Value.hs | 2 -- tests/Main.hs | 1 - tests/NixLanguageTests.hs | 2 -- tests/PrettyTests.hs | 1 - 15 files changed, 20 insertions(+), 82 deletions(-) diff --git a/main/Main.hs b/main/Main.hs index c073c0a..600cf33 100644 --- a/main/Main.hs +++ b/main/Main.hs @@ -73,8 +73,6 @@ main = do errorWithoutStackTrace . show =<< renderFrames @(NThunk (Lazy IO)) frames - -- jww (2018-04-24): This shouldn't be in IO, or else it can't - -- share the environment with the evaluation done above. when (repl opts) $ liftIO $ Repl.shell (pure ()) process opts mpath expr = do diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 49b90f1..68edf70 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -104,7 +104,6 @@ builtinsList = sequence [ , add0 TopLevel "__nixPath" nixPath , add TopLevel "abort" throw_ -- for now - -- jww (2018-04-09): Support floats for `add` and `sub` , add' Normal "add" (arity2 ((+) @Integer)) , add2 Normal "all" all_ , add2 Normal "any" any_ @@ -386,8 +385,6 @@ match_ :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue match_ pat str = fromValue pat >>= \p -> fromValue str >>= \s -> do - -- jww (2018-04-05): We should create a fundamental type for compiled - -- regular expressions if it turns out they get used often. let re = makeRegex (encodeUtf8 p) :: Regex case matchOnceText re (encodeUtf8 s) of Just ("", sarr, "") -> do @@ -457,14 +454,12 @@ catAttrs attrName xs = baseNameOf :: MonadNix e m => m (NValue m) -> m (NValue m) baseNameOf x = x >>= \case - --TODO: Only allow strings that represent absolute paths NVStr path ctx -> pure $ nvStr (Text.pack $ takeFileName $ Text.unpack path) ctx NVPath path -> pure $ nvPath $ takeFileName path v -> throwError @String $ "dirOf: expected string or path, got " ++ show v dirOf :: MonadNix e m => m (NValue m) -> m (NValue m) dirOf x = x >>= \case - --TODO: Only allow strings that represent absolute paths NVStr path ctx -> pure $ nvStr (Text.pack $ takeDirectory $ Text.unpack path) ctx NVPath path -> pure $ nvPath $ takeDirectory path v -> throwError @String $ "dirOf: expected string or path, got " ++ show v @@ -510,7 +505,6 @@ genList generator = fromValue @Integer >=> \n -> else throwError @String $ "builtins.genList: Expected a non-negative number, got " ++ show n ---TODO: Preserve string context replaceStrings :: MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m) -> m (NValue m) replaceStrings tfrom tto ts = fromNix tfrom >>= \(from :: [Text]) -> @@ -543,8 +537,8 @@ replaceStrings tfrom tto ts = removeAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m) removeAttrs set = fromNix >=> \(toRemove :: [Text]) -> - fromValue @(HashMap Text (NThunk m), - HashMap Text SourcePos) set >>= \(m, p) -> + fromValue @(AttrSet (NThunk m), + AttrSet SourcePos) set >>= \(m, p) -> toNix (go m toRemove, go p toRemove) where go = foldl' (flip M.delete) @@ -552,22 +546,19 @@ removeAttrs set = fromNix >=> \(toRemove :: [Text]) -> intersectAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) -> m (NValue m) intersectAttrs set1 set2 = - fromValue @(HashMap Text (NThunk m), - HashMap Text SourcePos) set1 >>= \(s1, p1) -> - fromValue @(HashMap Text (NThunk m), - HashMap Text SourcePos) set2 >>= \(s2, p2) -> + fromValue @(AttrSet (NThunk m), + AttrSet SourcePos) set1 >>= \(s1, p1) -> + fromValue @(AttrSet (NThunk m), + AttrSet SourcePos) set2 >>= \(s2, p2) -> return $ nvSet (s2 `M.intersection` s1) (p2 `M.intersection` p1) functionArgs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) functionArgs fun = fun >>= \case - NVClosure p _ -> - -- jww (2018-04-05): Should we preserve the location where the - -- function arguments were declared for __unsafeGetAttrPos? - toValue @(HashMap Text (NThunk m)) $ - valueThunk . nvConstant . NBool <$> - case p of - Param name -> M.singleton name False - ParamSet s _ _ -> isJust <$> M.fromList s + NVClosure p _ -> toValue @(AttrSet (NThunk m)) $ + valueThunk . nvConstant . NBool <$> + case p of + Param name -> M.singleton name False + ParamSet s _ _ -> isJust <$> M.fromList s v -> throwError @String $ "builtins.functionArgs: expected function, got " ++ show v @@ -577,7 +568,6 @@ toPath = fromValue @Path >=> toNix @Path pathExists_ :: MonadNix e m => m (NValue m) -> m (NValue m) pathExists_ path = path >>= \case NVPath p -> toNix =<< pathExists p - -- jww (2018-04-13): Should this ever be a string? NVStr s _ -> toNix =<< pathExists (Text.unpack s) v -> throwError @String $ "builtins.pathExists: expected path, got " ++ show v @@ -666,7 +656,7 @@ concatLists = fromValue @[NThunk m] listToAttrs :: forall e m. MonadNix e m => m (NValue m) -> m (NValue m) listToAttrs = fromValue @[NThunk m] >=> \l -> fmap (flip nvSet M.empty . M.fromList . reverse) $ - forM l $ fromValue @(HashMap Text (NThunk m)) >=> \s -> + forM l $ fromValue @(AttrSet (NThunk m)) >=> \s -> case (M.lookup "name" s, M.lookup "value" s) of (Just name, Just value) -> fromValue name <&> (, value) _ -> throwError $ @@ -694,7 +684,6 @@ absolutePathFromValue = \case NVPath path -> pure path v -> throwError @String $ "expected a path, got " ++ show v ---TODO: Move all liftIO things into MonadNixEnv or similar readFile_ :: MonadNix e m => m (NValue m) -> m (NValue m) readFile_ path = path >>= absolutePathFromValue >>= Nix.Render.readFile >>= toNix @@ -744,7 +733,7 @@ typeOf v = v >>= toNix @Text . \case NFloat _ -> "float" NBool _ -> "bool" NNull -> "null" - NUri _ -> "string" --TODO: Should we get rid of NUri? + NUri _ -> "string" NVStr _ _ -> "string" NVList _ -> "list" NVSet _ _ -> "set" @@ -813,7 +802,7 @@ partition_ fun xs = fun >>= \f -> selection <- traverse match l let (right, wrong) = partition fst selection let makeSide = valueThunk . nvList . map snd - toValue @(HashMap Text (NThunk m)) $ + toValue @(AttrSet (NThunk m)) $ M.fromList [("right", makeSide right), ("wrong", makeSide wrong)] currentSystem :: MonadNix e m => m (NValue m) diff --git a/src/Nix/Eval.hs b/src/Nix/Eval.hs index b28128b..74d46f3 100644 --- a/src/Nix/Eval.hs +++ b/src/Nix/Eval.hs @@ -170,8 +170,6 @@ eval (NAbs params body) = do -- body are forced during application. scope <- currentScopes @_ @t evalAbs (clearDefaults params) $ \arg -> - -- jww (2018-04-17): We need to use the bound library here, so that - -- the body is only evaluated once. withScopes @t scope $ do args <- buildArgument params arg pushScope args body @@ -210,7 +208,6 @@ attrSetAlter (p:ps) m val = case M.lookup p m of where go = return $ M.insert p val m - -- jww (2018-04-13): Need to record positions for attr paths as well recurse s = attrSetAlter ps s val <&> \m' -> M.insert p (toValue =<< fmap (value @_ @_ @m) <$> sequence m') m @@ -297,7 +294,6 @@ evalBinds allowDynamic recursive binds = do else traverse (thunk . withScopes scope) s return (res, foldl' go M.empty bindings) where - -- jww (2018-04-13): Need to record positions for attr paths as well go m ([k], Just pos, _) = M.insert k pos m go m _ = m @@ -358,7 +354,6 @@ evalKeyNameDynamicNotNull => NKeyName (m v) -> m (Text, Maybe SourcePos) evalKeyNameDynamicNotNull = evalKeyNameDynamicNullable >=> \case (Nothing, _) -> - -- jww (2018-04-24): This should be of Coercion ValueFrame type evalError @v ("value is null while a string was expected" :: String) (Just k, p) -> pure (k, p) diff --git a/src/Nix/Exec.hs b/src/Nix/Exec.hs index 810f321..4ee3711 100644 --- a/src/Nix/Exec.hs +++ b/src/Nix/Exec.hs @@ -114,8 +114,6 @@ instance MonadNix e m => MonadThunk (NValue m) (NThunk m) m where force (NThunk ps t) f = case ps of [] -> forceThunk t f - - -- jww (2018-04-25): Only report the inner-most layer for now. Provenance scope e@(Compose (Ann span _)):_ -> withFrame Info (ForcingExpr scope (wrapExprLoc span e)) (forceThunk t f) @@ -155,7 +153,6 @@ instance MonadNix e m => MonadEval (NValue m) m where evalString s d = do scope <- currentScopes span <- currentPos - -- jww (2018-04-22): Determine full provenance for the string? pure $ nvStrP (Provenance scope (NStr_ span (DoubleQuoted [Plain s]))) s d evalLiteralPath p = do @@ -181,8 +178,6 @@ instance MonadNix e m => MonadEval (NValue m) m where evalWith c b = do scope <- currentScopes span <- currentPos - -- jww (2018-04-23): What about the arguments to with? All this - -- preserves right now is the location. addProvenance (\b -> Provenance scope (NWith_ span Nothing (Just b))) <$> evalWithAttrSet c b @@ -241,13 +236,7 @@ execUnaryOp scope span op arg = do (NNot, NBool b) -> unaryOp $ NBool (not b) _ -> throwError $ "unsupported argument type for unary operator " ++ show op - x -> - -- jww (2018-04-22): Improve error reporting so that instead of - -- using 'show' to paste the textual form of the value into a - -- string, we use smarter pattern with typed elements, allowing us - -- to render specially based on the output device and verbosity - -- selections. - throwError $ "argument to unary operator" + x -> throwError $ "argument to unary operator" ++ " must evaluate to an atomic type: " ++ show x where unaryOp = pure . nvConstantP (Provenance scope (NUnary_ span op (Just arg))) @@ -277,8 +266,6 @@ execBinaryOp scope span NAnd larg rarg = fromNix larg >>= \l -> andOp r b = pure $ nvConstantP (Provenance scope (NBinary_ span NAnd (Just larg) r)) (NBool b) --- jww (2018-04-08): Refactor so that eval (NBinary ..) *always* dispatches --- based on operator first execBinaryOp scope span op lval rarg = do rval <- rarg let bin :: (Provenance m -> a) -> a @@ -361,7 +348,6 @@ execBinaryOp scope span op lval rarg = do _ -> nverr $ unsupportedTypes lval rval (NVPath p, NVStr s _) -> case op of - -- jww (2018-04-13): Do we need to make the path absolute here? NEq -> toBool $ p == Text.unpack s NNEq -> toBool $ p /= Text.unpack s NPlus -> bin nvPathP <$> makeAbsolutePath (p `mappend` Text.unpack s) @@ -475,7 +461,6 @@ instance (MonadFix m, MonadCatch m, MonadThrow m, MonadIO m, pathExists = liftIO . fileExist - -- jww (2018-03-29): Cache which files have been read in. importPath scope origPath = do path <- liftIO $ pathToDefaultNixFile origPath mres <- lookupVar @(Context (Lazy m) (NThunk (Lazy m))) diff --git a/src/Nix/Expr/Types.hs b/src/Nix/Expr/Types.hs index e975e8e..6439c5f 100644 --- a/src/Nix/Expr/Types.hs +++ b/src/Nix/Expr/Types.hs @@ -56,7 +56,7 @@ import qualified Type.Reflection as Reflection type VarName = Text -instance Hashable1 NonEmpty -- jww (2018-04-17): an unfortunate orphan +instance Hashable1 NonEmpty -- an unfortunate orphan -- | The main nix expression type. This is polymorphic so that it can be made -- a functor, which allows us to traverse expressions and map functions over @@ -230,7 +230,7 @@ instance Hashable SourcePos where salt `hashWithSalt` f `hashWithSalt` l `hashWithSalt` c instance Generic1 NKeyName where - type Rep1 NKeyName = NKeyName -- jww (2018-04-09): wrong + type Rep1 NKeyName = NKeyName from1 = id to1 = id diff --git a/src/Nix/Frames.hs b/src/Nix/Frames.hs index e18a122..969ff93 100644 --- a/src/Nix/Frames.hs +++ b/src/Nix/Frames.hs @@ -31,7 +31,6 @@ class (Typeable e, Show e) => Frame e where toFrame = SomeFrame fromFrame (SomeFrame e) = cast e --- jww (2018-04-24): These two are temporary instance for now. instance Frame [Char] instance Frame Doc diff --git a/src/Nix/Lint.hs b/src/Nix/Lint.hs index 5f101de..b899ceb 100644 --- a/src/Nix/Lint.hs +++ b/src/Nix/Lint.hs @@ -235,9 +235,8 @@ unify context (Symbolic x) (Symbolic y) = do writeVar y (NMany m) packSymbolic (NMany m) --- jww (2018-04-15): These aren't worth defining yet, because once we move to --- Hindley-Milner, we're not going to be managing Symbolic values this way --- anymore. +-- These aren't worth defining yet, because once we move to Hindley-Milner, +-- we're not going to be managing Symbolic values this way anymore. instance FromValue (Text, DList Text) m (Symbolic m) where diff --git a/src/Nix/Normal.hs b/src/Nix/Normal.hs index 444e144..d6314cf 100644 --- a/src/Nix/Normal.hs +++ b/src/Nix/Normal.hs @@ -80,15 +80,11 @@ valueText addPathsToStore = cata phi phi (NVStrF t c) = pure (t, c) phi v@(NVListF _) = coercionFailed v phi v@(NVSetF s _) - | Just asString <- - -- TODO: Should this be run through valueText recursively? - M.lookup "__asString" s = asString + | Just asString <- M.lookup "__asString" s = asString | otherwise = coercionFailed v phi v@NVClosureF {} = coercionFailed v phi (NVPathF originalPath) | addPathsToStore = do - -- TODO: Capture and use the path of the file being processed as the - -- base path storePath <- addPath originalPath pure (Text.pack $ unStorePath storePath, mempty) | otherwise = pure (Text.pack originalPath, mempty) diff --git a/src/Nix/Pretty.hs b/src/Nix/Pretty.hs index c447c2c..0dc89db 100644 --- a/src/Nix/Pretty.hs +++ b/src/Nix/Pretty.hs @@ -154,7 +154,6 @@ prettyOriginExpr = withoutParens . go render Nothing = simpleExpr $ text "_" render (Just (NValue (reverse -> p:_) _)) = go (originExpr p) render (Just (NValue _ _)) = simpleExpr $ text "?" - -- jww (2018-04-24): Needs work -- simpleExpr $ foldr ((<$>) . parens . indent 2 . withoutParens -- . go . originExpr) -- mempty (reverse ps) diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs index 079dfec..a5e0cd7 100644 --- a/src/Nix/Reduce.hs +++ b/src/Nix/Reduce.hs @@ -140,11 +140,8 @@ reduce (NBinary_ bann NApp fun arg) = fun >>= \case x <- arg pushScope (M.singleton name x) (cata reduce body) - -- jww (2018-04-19): Reduce function application on sets - f -> Fix . NBinary_ bann NApp f <$> arg --- jww (2018-04-19): Reduce more binary operations on constants reduce (NBinary_ bann op larg rarg) = do lval <- larg rval <- rarg @@ -153,11 +150,8 @@ reduce (NBinary_ bann op larg rarg) = do return $ Fix (NConstant_ ann (NInt (x + y))) _ -> pure $ Fix $ NBinary_ bann op lval rval --- jww (2018-04-19): Reduce selection if we can see it all -- reduce (NSelect aset attr alt) = do --- jww (2018-04-19): If aset is known to be a set, and attr is a static path, --- see if we can do the lookup now. -- reduce (NHasAttr aset attr) = reduce e@(NSet_ ann binds) = do @@ -180,8 +174,6 @@ reduce (NWith_ ann scope body) = clearScopes @NExprLoc $ fmap Fix $ NWith_ ann <$> scope <*> body reduce (NLet_ ann binds body) = do - -- We only handle in order definitions... - -- s <- go M.empty binds -- jww (2018-04-20): too slow s <- fmap (M.fromList . catMaybes) $ forM binds $ \case NamedVar (StaticKey name _ :| []) def -> def >>= \case d@(Fix NAbs_ {}) -> pure $ Just (name, d) @@ -191,7 +183,6 @@ reduce (NLet_ ann binds body) = do _ -> pure Nothing body' <- pushScope s body binds' <- traverse sequence binds - -- jww (2018-04-25): Need to also gather names from the bindings. -- let names = gatherNames body' -- binds' <- traverse sequence binds <&> \b -> flip filter b $ \case -- NamedVar (StaticKey name _ :| []) _ -> @@ -264,9 +255,6 @@ pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do NRecSet binds | reduceSets opts -> Just $ NRecSet (mapMaybe sequence binds) | otherwise -> Just $ NRecSet (map (fmap (fromMaybe nNull)) binds) - -- jww (2018-04-25): When we switch to a monadic NExpr, we can easily - -- determine which of the bindings of the let might be referred to. - -- Or, we could traverse and look for NSyms. NLet binds (Just body@(Fix (Compose (Ann _ x)))) -> Just $ case mapMaybe pruneBinding binds of [] -> x diff --git a/src/Nix/Render/Frame.hs b/src/Nix/Render/Frame.hs index d1726fc..251565f 100644 --- a/src/Nix/Render/Frame.hs +++ b/src/Nix/Render/Frame.hs @@ -78,8 +78,6 @@ renderFrame (NixFrame level f) | Just (_ :: NormalLoop m) <- fromFrame f = pure [text "<>"] | Just (e :: ExecFrame m) <- fromFrame f = renderExecFrame level e - -- jww (2018-04-25): Only render the string if it's level matches the - -- verbosity level. | Just (e :: String) <- fromFrame f = pure [text e] | Just (e :: Doc) <- fromFrame f = pure [e] | otherwise = error $ "Unrecognized frame: " ++ show f @@ -142,8 +140,6 @@ renderExecFrame _level f = do (:[]) <$> case f of Assertion v | values opts -> - -- jww (2018-04-24): Render value provenance differently - -- based on the verbosity. (text "Assertion failed:" ) <$> renderNValueProv v | otherwise -> pure $ text "Assertion failed" diff --git a/src/Nix/Value.hs b/src/Nix/Value.hs index 2644f5b..0c786cb 100644 --- a/src/Nix/Value.hs +++ b/src/Nix/Value.hs @@ -97,8 +97,6 @@ data NThunk m = NThunk , baseThunk :: Thunk m (NValue m) } --- jww (2018-04-22): Tracking value provenance may need to be a compile-time --- option. data NValue m = NValue { valueProvenance :: [Provenance m] , baseValue :: NValueF m (NThunk m) diff --git a/tests/Main.hs b/tests/Main.hs index 13fec6d..05ad3ef 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -77,7 +77,6 @@ ensureNixpkgsCanParse = NixException frames -> -- errorWithoutStackTrace . show -- =<< runReaderT (renderFrames frames) defaultOptions - -- jww (2018-04-24): errorWithoutStackTrace "FAILED" main :: IO () diff --git a/tests/NixLanguageTests.hs b/tests/NixLanguageTests.hs index b4fe8d0..ab8b6d6 100644 --- a/tests/NixLanguageTests.hs +++ b/tests/NixLanguageTests.hs @@ -77,7 +77,6 @@ genTests = do assertParse :: Options -> FilePath -> Assertion assertParse _opts file = parseNixFileLoc file >>= \case - -- jww (2018-04-10): TODO Success _expr -> return () -- pure $! runST $ void $ lint opts expr Failure err -> assertFailure $ "Failed to parse " ++ file ++ ":\n" ++ show err @@ -110,7 +109,6 @@ assertEval opts files = catch go $ \case NixException frames -> do -- msg <- runReaderT (renderFrames frames) opts -- error $ "Evaluation error: " ++ show msg - -- jww (2018-04-24): NYI error "Evaluation error" where go = case delete ".nix" $ sort $ map takeExtensions files of diff --git a/tests/PrettyTests.hs b/tests/PrettyTests.hs index ec89bde..df91a27 100644 --- a/tests/PrettyTests.hs +++ b/tests/PrettyTests.hs @@ -16,7 +16,6 @@ case_indented_antiquotation = do case_string_antiquotation :: Assertion case_string_antiquotation = do - -- TODO: plain $ doesn't need to be escaped here either assertPretty (mkStr "echo $foo") "\"echo \\$foo\"" assertPretty (mkStr "echo ${foo}") "\"echo \\${foo}\""