From 371380c98f8b49ba8e0c19f41ba6f1bc88b4cf5e Mon Sep 17 00:00:00 2001
From: John Wiegley <johnw@newartisans.com>
Date: Wed, 11 Apr 2018 21:31:48 -0700
Subject: [PATCH] Add support for the --attr/-A option

---
 main/Main.hs       | 48 +++++++++++++++++++++++++++++++++++++++-------
 src/Nix/Options.hs | 42 ++++++++++++++++++++++++++++++++--------
 2 files changed, 75 insertions(+), 15 deletions(-)

diff --git a/main/Main.hs b/main/Main.hs
index b423150..b8c7fe7 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 -- {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Main where
 
@@ -11,7 +13,9 @@ import           Control.Monad
 import           Control.Monad.ST
 import           Data.Fix
 import qualified Data.HashMap.Lazy as M
+import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
+import qualified Data.Text.Read as Text
 import qualified Nix
 import           Nix.Cache
 import           Nix.Exec (Lazy, runLazyM)
@@ -91,19 +95,49 @@ main = do
                          runLazyM $ normalForm =<< g argmap
                      _ -> pure f
 
+            result h = case attr opts of
+                Nothing -> h
+                Just (Text.splitOn "." -> keys) -> go keys
+              where
+                go [] v = h v
+                go ((Text.decimal -> Right (n,_)):ks) v = case v of
+                    Fix (V.NVList xs) -> case ks of
+                        [] -> h (xs !! n)
+                        _  -> go ks (xs !! n)
+                    _ -> errorWithoutStackTrace $
+                            "Expected a list for selector '" ++ show n
+                                ++ "', but got: " ++ show v
+                go (k:ks) v = case v of
+                    Fix (V.NVSet xs _) ->
+                        case M.lookup k xs of
+                            Nothing ->
+                                errorWithoutStackTrace $
+                                    "Set does not contain key '"
+                                        ++ Text.unpack k ++ "'"
+                            Just v' -> case ks of
+                                [] -> h v'
+                                _  -> go ks v'
+                    _ -> errorWithoutStackTrace $
+                        "Expected a set for selector '" ++ Text.unpack k
+                            ++ "', but got: " ++ show v
+
         if | evaluate opts, debug opts ->
-                 compute Nix.tracingEvalLoc expr print
+                 compute Nix.tracingEvalLoc expr (result print)
+
            | evaluate opts, not (null args) ->
-                 compute Nix.evalLoc expr (putStrLn . printNix)
+                 compute Nix.evalLoc expr (result (putStrLn . printNix))
+
            | evaluate opts ->
-                 putStrLn . printNix =<< Nix.evalLoc mpath expr
-           | debug opts ->
-                 print $ stripAnnotation expr
+                 result (putStrLn . printNix) =<< Nix.evalLoc mpath expr
+
+           | debug opts -> print $ stripAnnotation expr
+
            | cache opts, Just path <- mpath -> do
                 let file = addExtension (dropExtension path) "nixc"
                 writeCache file expr
-           | parseOnly opts ->
-                 void $ Exc.evaluate $ force expr
+
+           | parseOnly opts -> void $ Exc.evaluate $ force expr
+
            | otherwise ->
                  displayIO stdout
                      . renderPretty 0.4 80
diff --git a/src/Nix/Options.hs b/src/Nix/Options.hs
index 5f8d345..57712a6 100644
--- a/src/Nix/Options.hs
+++ b/src/Nix/Options.hs
@@ -9,12 +9,18 @@ import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
 data Options = Options
     { verbose      :: Bool
     , debug        :: Bool
+    , parse        :: Bool
+    , parseOnly    :: Bool
+    , findFile     :: Maybe FilePath
+    , strict       :: Bool
     , evaluate     :: Bool
+    -- , json         :: Bool
+    -- , xml          :: Bool
+    , attr         :: Maybe Text
+    , include      :: Maybe FilePath
     , check        :: Bool
     , readFrom     :: Maybe FilePath
     , cache        :: Bool
-    , parse        :: Bool
-    , parseOnly    :: Bool
     , ignoreErrors :: Bool
     , expression   :: Maybe Text
     , arg          :: [(Text, Text)]
@@ -40,9 +46,35 @@ nixOptions = Options
         (   short 'd'
          <> long "debug"
          <> help "Debug output")
+    <*> switch
+        (   long "parse"
+         <> help "Whether to parse the file (also the default right now)")
+    <*> switch
+        (   long "parse-only"
+         <> help "Whether to parse only, no pretty printing or checking")
+    <*> optional (strOption
+        (   long "find-file"
+         <> help "Look up the given files in Nix's search path"))
+    <*> switch
+        (   long "strict"
+         <> help "When used with --eval, recursively evaluate list elements and attributes")
     <*> switch
         (   long "eval"
          <> help "Whether to evaluate, or just pretty-print")
+    -- <*> switch
+    --     (   long "json"
+    --      <> help "Print the resulting value as an JSON representation of the abstract syntax tree")
+    -- <*> switch
+    --     (   long "xml"
+    --      <> help "Print the resulting value as an XML representation of the abstract syntax tree")
+    <*> optional (strOption
+        (   short 'A'
+         <> long "attr"
+         <> help "Select an attribute from the top-level Nix expression being evaluated"))
+    <*> optional (strOption
+        (   short 'I'
+         <> long "include"
+         <> help "Add a path to the Nix expression search path"))
     <*> switch
         (   long "check"
          <> help "Whether to check for syntax errors after parsing")
@@ -52,12 +84,6 @@ nixOptions = Options
     <*> switch
         (   long "cache"
          <> help "Write out the parsed expression tree to a binary cache")
-    <*> switch
-        (   long "parse"
-         <> help "Whether to parse the file (also the default right now)")
-    <*> switch
-        (   long "parse-only"
-         <> help "Whether to parse only, no pretty printing or checking")
     <*> switch
         (   long "ignore-errors"
          <> help "Continue parsing files, even if there are errors")