Skip to content

Commit 7d03180

Browse files
Anton-LatukhaAnton-Latukha
authored
Merge #972: VarName boundary; unflip {NVSetF, NSelect}; upd AttrSet; add PositionSet; coerce
2 parents 0f32a08 + ec559a1 commit 7d03180

39 files changed

+552
-461
lines changed

‎main/Main.hs‎

Lines changed: 111 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -8,22 +8,23 @@ module Main ( main ) where
88

99
import Nix.Utils
1010
import Control.Comonad ( extract )
11-
import qualified Control.DeepSeq as Deep
12-
import qualified Control.Exception as Exc
11+
import qualified Control.Exception as Exception
1312
import GHC.Err ( errorWithoutStackTrace )
1413
import Control.Monad.Free
1514
import Control.Monad.Ref ( MonadRef(readRef) )
1615
import Control.Monad.Catch
17-
import System.IO ( hPutStrLn, getContents )
16+
import System.IO ( hPutStrLn
17+
, getContents
18+
)
1819
import qualified Data.HashMap.Lazy as M
1920
import qualified Data.Map as Map
2021
import Data.Maybe ( fromJust )
2122
import qualified Data.String as String
2223
import Data.Time
2324
import qualified Data.Text.IO as Text
24-
import Nix
25+
import Text.Show.Pretty ( ppShow )
26+
import Nix hiding ( force )
2527
import Nix.Convert
26-
import qualified Nix.Eval as Eval
2728
import Nix.Fresh.Basic
2829
import Nix.Json
2930
import Nix.Options.Parser
@@ -35,11 +36,10 @@ import qualified Nix.Type.Infer as HM
3536
import Nix.Value.Monad
3637
import Options.Applicative hiding ( ParserResult(..) )
3738
import Prettyprinter hiding ( list )
38-
import Prettyprinter.Render.Text
39+
import Prettyprinter.Render.Text ( renderIO )
3940
import qualified Repl
4041
import System.FilePath
41-
import qualified Text.Show.Pretty as PS
42-
import Nix.Utils.Fix1 ( Fix1T )
42+
import Nix.Eval
4343

4444
main :: IO ()
4545
main =
@@ -50,45 +50,65 @@ main =
5050
main' opts
5151

5252
main' :: Options -> IO ()
53-
main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
53+
main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
5454
where
55+
-- 2021-07-15: NOTE: This logic should be weaved stronger through CLI options logic (OptParse-Applicative code)
56+
-- As this logic is not stated in the CLI documentation, for example. So user has no knowledge of these.
57+
execContentsFilesOrRepl :: StandardT (StdIdT IO) ()
5558
execContentsFilesOrRepl =
56-
firstJust
57-
-- The `--read` option: load expression from a serialized file.
58-
[ readFrom <&> \path -> do
59-
let file = addExtension (dropExtension path) "nixc"
60-
process (Just file) =<< liftIO (readCache path)
59+
fromMaybe
60+
loadFromCLIFilePathList
61+
( loadBinaryCacheFile <|>
62+
loadLiteralExpression <|>
63+
loadExpressionFromFile
64+
)
65+
where
66+
-- | The base case: read expressions from the last CLI directive (@[FILE]@) listed on the command line.
67+
loadFromCLIFilePathList =
68+
case filePaths of
69+
[] -> runRepl
70+
["-"] -> readExpressionFromStdin
71+
_paths -> processSeveralFiles _paths
72+
where
73+
-- | Fall back to running the REPL
74+
runRepl = withEmptyNixContext Repl.main
6175

62-
-- The `--expr` option: read expression from the argument string
63-
, expression <&> processText
76+
readExpressionFromStdin =
77+
do
78+
expr <- liftIO Text.getContents
79+
processExpr expr
6480

65-
-- The `--file` argument: read expressions from the files listed in the argument file
66-
, fromFile <&> \x ->
67-
-- We can start use Text as in the base case, requires changing FilePath -> Text
68-
traverse_ processFile . String.lines =<< liftIO
69-
(case x of
70-
"-" -> getContents
71-
fp -> readFile fp
72-
)
73-
]
74-
`orElse`
75-
-- The base case: read expressions from the files listed on the command line
76-
case filePaths of
77-
-- With no files, fall back to running the REPL
78-
[] -> withNixContext mempty Repl.main
79-
["-"] -> processText =<< liftIO Text.getContents
80-
_paths -> traverse_ processFile _paths
81+
processSeveralFiles files = traverse_ processFile files
82+
where
83+
processFile path = handleResult (pure path) =<< parseNixFileLoc path
8184

82-
firstJust :: [Maybe a] -> Maybe a
83-
firstJust = asum
85+
-- | The `--read` option: load expression from a serialized file.
86+
loadBinaryCacheFile =
87+
(\binaryCacheFile ->
88+
do
89+
let file = replaceExtension binaryCacheFile "nixc"
90+
processCLIOptions (Just file) =<< liftIO (readCache binaryCacheFile)
91+
) <$> readFrom
92+
93+
-- | The `--expr` option: read expression from the argument string
94+
loadLiteralExpression = processExpr <$> expression
8495

85-
orElse :: Maybe a -> a -> a
86-
orElse = flip fromMaybe
96+
-- | The `--file` argument: read expressions from the files listed in the argument file
97+
loadExpressionFromFile =
98+
-- We can start use Text as in the base case, requires changing FilePath -> Text
99+
-- But that is a gradual process:
100+
-- https://github.com/haskell-nix/hnix/issues/912
101+
(processSeveralFiles . String.lines <=< liftIO) .
102+
(\case
103+
"-" -> getContents
104+
_fp -> readFile _fp
105+
) <$> fromFile
87106

88-
processText text = handleResult Nothing $ parseNixTextLoc text
107+
processExpr text = handleResult Nothing $ parseNixTextLoc text
89108

90-
processFile path = handleResult (Just path) =<< parseNixFileLoc path
109+
withEmptyNixContext = withNixContext mempty
91110

111+
-- 2021-07-15: NOTE: @handleResult@ & @process@ - have atrocious size & compexity, they need to be decomposed & refactored.
92112
handleResult mpath =
93113
either
94114
(\ err ->
@@ -103,18 +123,18 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
103123
do
104124
when check $
105125
do
106-
expr' <- liftIO (reduceExpr mpath expr)
126+
expr' <- liftIO $ reduceExpr mpath expr
107127
either
108-
(\ err -> errorWithoutStackTrace $ "Type error: " <> PS.ppShow err)
109-
(\ ty -> liftIO $ putStrLn $ "Type of expression: " <> PS.ppShow
110-
(fromJust $ Map.lookup "it" (coerce ty :: Map Text [Scheme]))
128+
(\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err)
129+
(\ ty -> liftIO $ putStrLn $ "Type of expression: " <>
130+
ppShow (fromJust $ Map.lookup @VarName @[Scheme] "it" (coerce ty))
111131
)
112132
(HM.inferTop mempty [("it", stripAnnotation expr')])
113133

114134
-- liftIO $ putStrLn $ runST $
115135
-- runLintM opts . renderSymbolic =<< lint opts expr
116136

117-
catch (process mpath expr) $
137+
catch (processCLIOptions mpath expr) $
118138
\case
119139
NixException frames ->
120140
errorWithoutStackTrace . show =<<
@@ -124,50 +144,64 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
124144
frames
125145

126146
when repl $
127-
withNixContext mempty $
147+
withEmptyNixContext $
128148
bool
129149
Repl.main
130150
(do
131-
val <- Nix.nixEvalExprLoc mpath expr
151+
val <- nixEvalExprLoc mpath expr
132152
Repl.main' $ pure val
133153
)
134154
evaluate
135155
)
136156

137-
process mpath expr
157+
-- 2021-07-15: NOTE: Logic of CLI Option processing is scattered over several functions, needs to be consolicated.
158+
processCLIOptions :: Maybe FilePath -> NExprLoc -> StandardT (StdIdT IO) ()
159+
processCLIOptions mpath expr
138160
| evaluate =
139161
if
140-
| tracing -> evaluateExpression mpath Nix.nixTracingEvalExprLoc printer expr
141-
| Just path <- reduce -> evaluateExpression mpath (reduction path) printer expr
142-
| not (null arg && null argstr) -> evaluateExpression mpath Nix.nixEvalExprLoc printer expr
143-
| otherwise -> processResult printer =<< Nix.nixEvalExprLoc mpath expr
144-
| xml = fail "Rendering expression trees to XML is not yet implemented"
145-
| json = fail "Rendering expression trees to JSON is not implemented"
146-
| verbose >= DebugInfo = liftIO $ putStr $ PS.ppShow $ stripAnnotation expr
147-
| cache , Just path <- mpath = liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
148-
| parseOnly = void $ liftIO $ Exc.evaluate $ Deep.force expr
162+
| tracing -> evaluateExprWithEvaluator nixTracingEvalExprLoc expr
163+
| Just path <- reduce -> evaluateExprWithEvaluator (reduction path) expr
164+
| null arg || null argstr -> evaluateExprWithEvaluator nixEvalExprLoc expr
165+
| otherwise -> processResult printer <=< nixEvalExprLoc mpath $ expr
166+
| xml = fail "Rendering expression trees to XML is not yet implemented"
167+
| json = fail "Rendering expression trees to JSON is not implemented"
168+
| verbose >= DebugInfo = liftIO . putStr . ppShow . stripAnnotation $ expr
169+
| cache , Just path <- mpath = liftIO . writeCache (replaceExtension path "nixc") $ expr
170+
| parseOnly = void . liftIO . Exception.evaluate . force $ expr
149171
| otherwise =
150-
liftIO $
172+
liftIO .
151173
renderIO
152174
stdout
153175
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
154176
. prettyNix
155177
. stripAnnotation
156178
$ expr
157179
where
180+
evaluateExprWithEvaluator evaluator = evaluateExpression mpath evaluator printer
181+
158182
printer
159183
| finder = findAttrs <=< fromValue @(AttrSet (StdValue (StandardT (StdIdT IO))))
160-
| xml = liftIO . Text.putStrLn . stringIgnoreContext . toXML <=< normalForm
161-
-- 2021-05-27: NOTE: With naive fix of the #941
162-
-- This is overall a naive printer implementation, as options should interact/respect one another.
163-
-- A nice question: "Should respect one another to what degree?": Go full combinator way, for which
164-
-- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),
165-
-- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.
166-
| json = liftIO . Text.putStrLn . stringIgnoreContext <=< nvalueToJSONNixString <=< normalForm
167-
| strict = liftIO . print . prettyNValue <=< normalForm
168-
| values = liftIO . print . prettyNValueProv <=< removeEffects
169-
| otherwise = liftIO . print . prettyNValue <=< removeEffects
184+
| otherwise = printer'
170185
where
186+
printer'
187+
| xml = go (stringIgnoreContext . toXML) normalForm
188+
-- 2021-05-27: NOTE: With naive fix of the #941
189+
-- This is overall a naive printer implementation, as options should interact/respect one another.
190+
-- A nice question: "Should respect one another to what degree?": Go full combinator way, for which
191+
-- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),
192+
-- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.
193+
| json = go (stringIgnoreContext . mempty . nvalueToJSONNixString) normalForm
194+
| strict = go (show . prettyNValue) normalForm
195+
| values = go (show . prettyNValueProv) removeEffects
196+
| otherwise = go (show . prettyNValue) removeEffects
197+
where
198+
go
199+
:: (b -> Text)
200+
-> (a -> StandardT (StdIdT IO) b)
201+
-> a
202+
-> StandardT (StdIdT IO) ()
203+
go g f = liftIO . Text.putStrLn . g <=< f
204+
171205
findAttrs
172206
:: AttrSet (StdValue (StandardT (StdIdT IO)))
173207
-> StandardT (StdIdT IO) ()
@@ -200,7 +234,7 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
200234
(pure . pure . Free)
201235
nv
202236
)
203-
(sortWith fst $ M.toList s)
237+
(sortWith fst $ M.toList $ M.mapKeys coerce s)
204238
traverse_
205239
(\ (k, mv) ->
206240
do
@@ -214,7 +248,7 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
214248
maybe
215249
pass
216250
(\case
217-
NVSet s' _ -> go (path <> ".") s'
251+
NVSet _ s' -> go (path <> ".") s'
218252
_ -> pass
219253
)
220254
mv
@@ -239,10 +273,10 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
239273
_ -> (True , True )
240274

241275
forceEntry
242-
:: MonadValue a (Fix1T StandardTF (StdIdT IO))
276+
:: MonadValue a (StandardT (StdIdT IO))
243277
=> Text
244278
-> a
245-
-> Fix1T StandardTF (StdIdT IO) (Maybe a)
279+
-> StandardT (StdIdT IO) (Maybe a)
246280
forceEntry k v =
247281
catch
248282
(pure <$> demand v)
@@ -259,15 +293,15 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
259293
pure Nothing
260294
)
261295

262-
reduction path mp x =
296+
reduction path mpathToContext annExpr =
263297
do
264298
eres <-
265-
Nix.withNixContext
266-
mp
267-
(Nix.reducingEvalExpr
268-
Eval.evalContent
269-
mp
270-
x
299+
withNixContext
300+
mpathToContext
301+
(reducingEvalExpr
302+
evalContent
303+
mpathToContext
304+
annExpr
271305
)
272306
handleReduced path eres
273307

0 commit comments

Comments
 (0)