Initial version of the attribute finder, still needs tweaking
```
hnix -I nix=$PWD/data/nix/corepkgs --find \
--eval --expr "import $HOME/src/nix/nixpkgs {}" \
-A pkgs.haskellPackages
```
This commit is contained in:
John Wiegley
parent
fa25415cb7
commit
b8307d2fb5
145
main/Main.hs
145
main/Main.hs
|
|
@ -1,8 +1,8 @@
|
|||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Main where
|
||||
|
|
@ -15,6 +15,9 @@ import Control.Monad.IO.Class
|
|||
import Control.Monad.ST
|
||||
import qualified Data.Aeson.Encoding as A
|
||||
import qualified Data.Aeson.Text as A
|
||||
import qualified Data.HashMap.Lazy as M
|
||||
import Data.List (sortOn)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.IO as Text
|
||||
import qualified Data.Text.Lazy.Encoding as TL
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
|
|
@ -75,58 +78,114 @@ main = do
|
|||
|
||||
when (repl opts) $ Repl.shell (pure ())
|
||||
|
||||
process opts mpath expr = do
|
||||
let printer :: (MonadNix e m, MonadIO m) => NValue m -> m ()
|
||||
printer | xml opts =
|
||||
liftIO . putStrLn . toXML <=< normalForm
|
||||
| json opts =
|
||||
liftIO . TL.putStrLn
|
||||
. TL.decodeUtf8
|
||||
. A.encodingToLazyByteString
|
||||
. toEncodingSorted
|
||||
<=< fromNix
|
||||
| normalize opts =
|
||||
liftIO . print . prettyNValueNF <=< normalForm
|
||||
| values opts =
|
||||
liftIO . print <=< prettyNValueProv
|
||||
| otherwise =
|
||||
liftIO . print <=< prettyNValue
|
||||
process opts mpath expr
|
||||
| evaluate opts, tracing opts =
|
||||
evaluateExpression mpath
|
||||
Nix.nixTracingEvalExprLoc printer expr
|
||||
|
||||
if | evaluate opts, tracing opts ->
|
||||
evaluateExpression mpath
|
||||
Nix.nixTracingEvalExprLoc printer expr
|
||||
| evaluate opts, Just path <- reduce opts =
|
||||
evaluateExpression mpath (reduction path) printer expr
|
||||
|
||||
| evaluate opts, Just path <- reduce opts ->
|
||||
evaluateExpression mpath (reduction path) printer expr
|
||||
| evaluate opts, not (null (arg opts) && null (argstr opts)) =
|
||||
evaluateExpression mpath
|
||||
Nix.nixEvalExprLoc printer expr
|
||||
|
||||
| evaluate opts, not (null (arg opts) && null (argstr opts)) ->
|
||||
evaluateExpression mpath
|
||||
Nix.nixEvalExprLoc printer expr
|
||||
| evaluate opts =
|
||||
processResult printer =<< Nix.nixEvalExprLoc mpath expr
|
||||
|
||||
| evaluate opts ->
|
||||
processResult printer =<< Nix.nixEvalExprLoc mpath expr
|
||||
| xml opts =
|
||||
error "Rendering expression trees to XML is not yet implemented"
|
||||
|
||||
| xml opts ->
|
||||
error "Rendering expression trees to XML is not yet implemented"
|
||||
| json opts =
|
||||
liftIO $ TL.putStrLn $
|
||||
A.encodeToLazyText (stripAnnotation expr)
|
||||
|
||||
| json opts ->
|
||||
liftIO $ TL.putStrLn $
|
||||
A.encodeToLazyText (stripAnnotation expr)
|
||||
| verbose opts >= DebugInfo =
|
||||
liftIO $ print $ stripAnnotation expr
|
||||
|
||||
| verbose opts >= DebugInfo ->
|
||||
liftIO $ print $ stripAnnotation expr
|
||||
| cache opts, Just path <- mpath =
|
||||
liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
|
||||
|
||||
| cache opts, Just path <- mpath ->
|
||||
liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
|
||||
| parseOnly opts =
|
||||
void $ liftIO $ Exc.evaluate $ Deep.force expr
|
||||
|
||||
| parseOnly opts ->
|
||||
void $ liftIO $ Exc.evaluate $ Deep.force expr
|
||||
| otherwise =
|
||||
liftIO $ displayIO stdout
|
||||
. renderPretty 0.4 80
|
||||
. prettyNix
|
||||
. stripAnnotation $ expr
|
||||
where
|
||||
printer :: forall e m. (MonadNix e m, MonadIO m, Typeable m)
|
||||
=> NValue m -> m ()
|
||||
printer
|
||||
| finder opts =
|
||||
fromValue @(AttrSet (NThunk m)) >=> findAttrs
|
||||
| xml opts =
|
||||
liftIO . putStrLn . toXML <=< normalForm
|
||||
| json opts =
|
||||
liftIO . TL.putStrLn
|
||||
. TL.decodeUtf8
|
||||
. A.encodingToLazyByteString
|
||||
. toEncodingSorted
|
||||
<=< fromNix
|
||||
| normalize opts =
|
||||
liftIO . print . prettyNValueNF <=< normalForm
|
||||
| values opts =
|
||||
liftIO . print <=< prettyNValueProv
|
||||
| otherwise =
|
||||
liftIO . print <=< prettyNValue
|
||||
where
|
||||
findAttrs = go ""
|
||||
where
|
||||
go prefix s = do
|
||||
xs <- forM (sortOn fst (M.toList s))
|
||||
$ \(k, nv@(NThunk _ t)) -> case t of
|
||||
Value v -> pure (k, Just v)
|
||||
Thunk _ _ ref -> do
|
||||
let path = prefix ++ Text.unpack k
|
||||
(_, descend) = filterEntry path k
|
||||
val <- readVar ref
|
||||
case val of
|
||||
Computed _ -> pure (k, Nothing)
|
||||
_ | descend -> (k,) <$> forceEntry path nv
|
||||
| otherwise -> pure (k, Nothing)
|
||||
|
||||
| otherwise ->
|
||||
liftIO $ displayIO stdout
|
||||
. renderPretty 0.4 80
|
||||
. prettyNix
|
||||
. stripAnnotation $ expr
|
||||
forM_ xs $ \(k, mv) -> do
|
||||
let path = prefix ++ Text.unpack k
|
||||
(report, descend) = filterEntry path k
|
||||
when report $ do
|
||||
liftIO $ putStrLn path
|
||||
when descend $ case mv of
|
||||
Nothing -> return ()
|
||||
Just v -> case v of
|
||||
NVSet s' _ -> go (path ++ ".") s'
|
||||
_ -> return ()
|
||||
where
|
||||
filterEntry path k = case (path, k) of
|
||||
("stdenv", "stdenv") -> (True, True)
|
||||
(_, "stdenv") -> (False, False)
|
||||
(_, "out") -> (True, False)
|
||||
(_, "src") -> (True, False)
|
||||
(_, "mirrorsFile") -> (True, False)
|
||||
(_, "buildPhase") -> (True, False)
|
||||
(_, "builder") -> (False, False)
|
||||
(_, "drvPath") -> (False, False)
|
||||
(_, "outPath") -> (False, False)
|
||||
(_, "__impureHostDeps") -> (False, False)
|
||||
(_, "__sandboxProfile") -> (False, False)
|
||||
("pkgs", "pkgs") -> (True, True)
|
||||
(_, "pkgs") -> (False, False)
|
||||
(_, "drvAttrs") -> (False, False)
|
||||
_ -> (True, True)
|
||||
|
||||
forceEntry k v = catch (Just <$> force v pure)
|
||||
$ \(NixException frames) -> do
|
||||
liftIO . putStrLn
|
||||
. ("Exception forcing " ++)
|
||||
. (k ++)
|
||||
. (": " ++) . show
|
||||
=<< renderFrames @(NThunk (Lazy IO)) frames
|
||||
return Nothing
|
||||
|
||||
reduction path mp x = do
|
||||
eres <- Nix.withNixContext mp $
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@ data Options = Options
|
|||
, reduceLists :: Bool
|
||||
, parse :: Bool
|
||||
, parseOnly :: Bool
|
||||
, finder :: Bool
|
||||
, findFile :: Maybe FilePath
|
||||
, strict :: Bool
|
||||
, normalize :: Bool
|
||||
|
|
@ -50,6 +51,7 @@ defaultOptions = Options
|
|||
, reduceLists = False
|
||||
, parse = False
|
||||
, parseOnly = False
|
||||
, finder = False
|
||||
, findFile = Nothing
|
||||
, strict = False
|
||||
, normalize = False
|
||||
|
|
@ -129,6 +131,9 @@ nixOptions = Options
|
|||
<*> switch
|
||||
( long "parse-only"
|
||||
<> help "Whether to parse only, no pretty printing or checking")
|
||||
<*> switch
|
||||
( long "find"
|
||||
<> help "If selected, find paths within attr trees")
|
||||
<*> optional (strOption
|
||||
( long "find-file"
|
||||
<> help "Look up the given files in Nix's search path"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue