Skip to content

Commit d24d41c

Browse files
Anton-LatukhaAnton-Latukha
authored
Merge #877: Some refactors, layouts; for(M->_), (mapM -> traverse)
Just sitting & cleaning up after the `demand` update (#850).
2 parents cfb9f8e + 7dbae73 commit d24d41c

File tree

13 files changed

+639
-495
lines changed

13 files changed

+639
-495
lines changed

‎main/Main.hs‎

Lines changed: 65 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE MultiWayIf #-}
12
{-# LANGUAGE FlexibleContexts #-}
23
{-# LANGUAGE LambdaCase #-}
34
{-# LANGUAGE OverloadedStrings #-}
@@ -37,7 +38,7 @@ import Nix.Utils
3738
import Nix.Var
3839
import Nix.Value.Monad
3940
import Options.Applicative hiding ( ParserResult(..) )
40-
import Prettyprinter
41+
import Prettyprinter hiding ( list )
4142
import Prettyprinter.Render.Text
4243
import qualified Repl
4344
import System.FilePath
@@ -48,25 +49,42 @@ main :: IO ()
4849
main = do
4950
time <- getCurrentTime
5051
opts <- execParser (nixOptionsInfo time)
51-
runWithBasicEffectsIO opts $
52-
case readFrom opts of
53-
Nothing -> case expression opts of
54-
Nothing -> case fromFile opts of
55-
Nothing -> case filePaths opts of
56-
[] -> withNixContext mempty Repl.main
57-
["-"] ->
58-
handleResult opts mempty
59-
. parseNixTextLoc
60-
=<< liftIO Text.getContents
61-
paths -> mapM_ (processFile opts) paths
62-
Just "-" -> mapM_ (processFile opts) . lines =<< liftIO getContents
63-
Just path ->
64-
mapM_ (processFile opts) . lines =<< liftIO (readFile path)
65-
Just s -> handleResult opts mempty (parseNixTextLoc s)
66-
Just path -> do
67-
let file = addExtension (dropExtension path) "nixc"
68-
process opts (pure file) =<< liftIO (readCache path)
52+
53+
runWithBasicEffectsIO opts $ execContentsFilesOrRepl opts
54+
6955
where
56+
execContentsFilesOrRepl opts =
57+
maybe
58+
(maybe
59+
(maybe
60+
(list
61+
(withNixContext mempty Repl.main) -- run REPL
62+
(\case
63+
["-"] -> handleResult opts mempty . parseNixTextLoc =<< liftIO Text.getContents
64+
_paths -> traverse_ (processFile opts) _paths
65+
)
66+
(filePaths opts)
67+
)
68+
(\ x ->
69+
-- We can start use Text as in the base case, requires changing FilePath -> Text
70+
traverse_ (processFile opts) . lines =<< liftIO
71+
(case x of
72+
"-" -> getContents -- get user input
73+
_path -> readFile _path
74+
)
75+
)
76+
(fromFile opts)
77+
)
78+
(handleResult opts mempty . parseNixTextLoc)
79+
(expression opts)
80+
)
81+
(\ path ->
82+
do
83+
let file = addExtension (dropExtension path) "nixc"
84+
process opts (pure file) =<< liftIO (readCache path)
85+
)
86+
(readFrom opts)
87+
7088
processFile opts path = do
7189
eres <- parseNixFileLoc path
7290
handleResult opts (pure path) eres
@@ -111,57 +129,36 @@ main = do
111129
(evaluate opts)
112130

113131
process opts mpath expr
114-
| evaluate opts
115-
, tracing opts
116-
= evaluateExpression mpath Nix.nixTracingEvalExprLoc printer expr
117-
| evaluate opts
118-
, Just path <- reduce opts
119-
= evaluateExpression mpath (reduction path) printer expr
120-
| evaluate opts
121-
, not (null (arg opts) && null (argstr opts))
122-
= evaluateExpression mpath Nix.nixEvalExprLoc printer expr
123-
| evaluate opts
124-
= processResult printer =<< Nix.nixEvalExprLoc mpath expr
125-
| xml opts
126-
= error "Rendering expression trees to XML is not yet implemented"
127-
| json opts
128-
= error "Rendering expression trees to JSON is not implemented"
129-
| verbose opts >= DebugInfo
130-
= liftIO $ putStr $ PS.ppShow $ stripAnnotation expr
132+
| evaluate opts =
133+
if
134+
| tracing opts -> evaluateExpression mpath Nix.nixTracingEvalExprLoc printer expr
135+
| Just path <- reduce opts -> evaluateExpression mpath (reduction path) printer expr
136+
| not ( null (arg opts)
137+
&& null (argstr opts)
138+
) -> evaluateExpression mpath Nix.nixEvalExprLoc printer expr
139+
| otherwise -> processResult printer =<< Nix.nixEvalExprLoc mpath expr
140+
| xml opts = error "Rendering expression trees to XML is not yet implemented"
141+
| json opts = error "Rendering expression trees to JSON is not implemented"
142+
| verbose opts >= DebugInfo = liftIO $ putStr $ PS.ppShow $ stripAnnotation expr
131143
| cache opts
132-
, Just path <- mpath
133-
= liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
134-
| parseOnly opts
135-
= void $ liftIO $ Exc.evaluate $ Deep.force expr
136-
| otherwise
137-
= liftIO
138-
$ renderIO stdout
139-
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
140-
. prettyNix
141-
. stripAnnotation
142-
$ expr
144+
, Just path <- mpath = liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
145+
| parseOnly opts = void $ liftIO $ Exc.evaluate $ Deep.force expr
146+
| otherwise =
147+
liftIO $
148+
renderIO
149+
stdout
150+
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
151+
. prettyNix
152+
. stripAnnotation $
153+
expr
143154
where
144155
printer
145-
| finder opts
146-
= fromValue @(AttrSet (StdValue (StandardT (StdIdT IO)))) >=> findAttrs
147-
| xml opts
148-
= liftIO
149-
. putStrLn
150-
. Text.unpack
151-
. stringIgnoreContext
152-
. toXML
153-
<=< normalForm
154-
| json opts
155-
= liftIO
156-
. Text.putStrLn
157-
. stringIgnoreContext
158-
<=< nvalueToJSONNixString
159-
| strict opts
160-
= liftIO . print . prettyNValue <=< normalForm
161-
| values opts
162-
= liftIO . print . prettyNValueProv <=< removeEffects
163-
| otherwise
164-
= liftIO . print . prettyNValue <=< removeEffects
156+
| finder opts = findAttrs <=< fromValue @(AttrSet (StdValue (StandardT (StdIdT IO))))
157+
| xml opts = liftIO . putStrLn . Text.unpack . stringIgnoreContext . toXML <=< normalForm
158+
| json opts = liftIO . Text.putStrLn . stringIgnoreContext <=< nvalueToJSONNixString
159+
| strict opts = liftIO . print . prettyNValue <=< normalForm
160+
| values opts = liftIO . print . prettyNValueProv <=< removeEffects
161+
| otherwise = liftIO . print . prettyNValue <=< removeEffects
165162
where
166163
findAttrs
167164
:: AttrSet (StdValue (StandardT (StdIdT IO)))
@@ -182,7 +179,7 @@ main = do
182179
)
183180
(\ v -> pure (k, pure (Free v)))
184181
nv
185-
forM_ xs $ \(k, mv) -> do
182+
for_ xs $ \(k, mv) -> do
186183
let path = prefix <> Text.unpack k
187184
(report, descend) = filterEntry path k
188185
when report $ do

‎main/Repl.hs‎

Lines changed: 27 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ main' iniVal = initState iniVal >>= \s -> flip evalStateT s
102102

103103
rcFile = do
104104
f <- liftIO $ Data.Text.IO.readFile ".hnixrc" `catch` handleMissing
105-
forM_ (fmap (words . Data.Text.unpack) $ Data.Text.lines f) $ \case
105+
for_ (words . Data.Text.unpack <$> Data.Text.lines f) $ \case
106106
((prefix:command) : xs) | prefix == commandPrefix -> do
107107
let arguments = unwords xs
108108
optMatcher command options arguments
@@ -126,9 +126,8 @@ main' iniVal = initState iniVal >>= \s -> flip evalStateT s
126126
| s `Data.List.isPrefixOf` x = m args
127127
| otherwise = optMatcher s xs args
128128

129-
---------------------------------------------------------------------------------
129+
130130
-- * Types
131-
---------------------------------------------------------------------------------
132131

133132
data IState t f m = IState
134133
{ replIt :: Maybe NExprLoc -- ^ Last expression entered
@@ -173,9 +172,8 @@ initState mIni = do
173172

174173
type Repl e t f m = HaskelineT (StateT (IState t f m) m)
175174

176-
---------------------------------------------------------------------------------
175+
177176
-- * Execution
178-
---------------------------------------------------------------------------------
179177

180178
exec
181179
:: forall e t f m
@@ -259,21 +257,20 @@ printValue val = do
259257
| cfgValues cfg -> liftIO . print . prettyNValueProv =<< removeEffects val
260258
| otherwise -> liftIO . print . prettyNValue =<< removeEffects val
261259

262-
---------------------------------------------------------------------------------
260+
263261
-- * Commands
264-
---------------------------------------------------------------------------------
265262

266-
-- :browse command
263+
-- | @:browse@ command
267264
browse :: (MonadNix e t f m, MonadIO m)
268265
=> String
269266
-> Repl e t f m ()
270267
browse _ = do
271268
st <- get
272-
forM_ (Data.HashMap.Lazy.toList $ replCtx st) $ \(k, v) -> do
269+
for_ (Data.HashMap.Lazy.toList $ replCtx st) $ \(k, v) -> do
273270
liftIO $ putStr $ Data.Text.unpack $ k <> " = "
274271
printValue v
275272

276-
-- :load command
273+
-- | @:load@ command
277274
load
278275
:: (MonadNix e t f m, MonadIO m)
279276
=> String
@@ -286,29 +283,33 @@ load args = do
286283
$ Data.Text.pack args
287284
void $ exec True contents
288285

289-
-- :type command
286+
-- | @:type@ command
290287
typeof
291288
:: (MonadNix e t f m, MonadIO m)
292289
=> String
293290
-> Repl e t f m ()
294291
typeof args = do
295292
st <- get
296-
mVal <- case Data.HashMap.Lazy.lookup line (replCtx st) of
297-
Just val -> pure $ pure val
298-
Nothing -> do
299-
exec False line
293+
mVal <-
294+
case Data.HashMap.Lazy.lookup line (replCtx st) of
295+
Nothing -> exec False line
296+
Just val -> pure $ pure val
300297

301-
forM_ mVal $ \val -> do
302-
s <- lift . lift . showValueType $ val
303-
liftIO $ putStrLn s
298+
traverse_ printValueType mVal
299+
300+
where
301+
line = Data.Text.pack args
302+
printValueType val =
303+
do
304+
s <- lift . lift . showValueType $ val
305+
liftIO $ putStrLn s
304306

305-
where line = Data.Text.pack args
306307

307-
-- :quit command
308+
-- | @:quit@ command
308309
quit :: (MonadNix e t f m, MonadIO m) => a -> Repl e t f m ()
309310
quit _ = liftIO System.Exit.exitSuccess
310311

311-
-- :set command
312+
-- | @:set@ command
312313
setConfig :: (MonadNix e t f m, MonadIO m) => String -> Repl e t f m ()
313314
setConfig args = case words args of
314315
[] -> liftIO $ putStrLn "No option to set specified"
@@ -317,11 +318,10 @@ setConfig args = case words args of
317318
[opt] -> modify (\s -> s { replCfg = helpSetOptionFunction opt (replCfg s) })
318319
_ -> liftIO $ putStrLn "No such option"
319320

320-
---------------------------------------------------------------------------------
321+
321322
-- * Interactive Shell
322-
---------------------------------------------------------------------------------
323323

324-
-- Prefix tab completer
324+
-- | Prefix tab completer
325325
defaultMatcher :: MonadIO m => [(String, CompletionFunc m)]
326326
defaultMatcher =
327327
[ (":load", System.Console.Repline.fileCompleter)
@@ -411,7 +411,7 @@ completeFunc reversedPrev word
411411
NVSet xs _ -> withMap xs
412412
_ -> pure mempty
413413

414-
-- HelpOption inspired by Dhall Repl
414+
-- | HelpOption inspired by Dhall Repl
415415
-- with `Doc` instead of String for syntax and doc
416416
data HelpOption e t f m = HelpOption
417417
{ helpOptionName :: String
@@ -466,7 +466,7 @@ helpOptions =
466466
setConfig
467467
]
468468

469-
-- Options for :set
469+
-- | Options for :set
470470
data HelpSetOption = HelpSetOption
471471
{ helpSetOptionName :: String
472472
, helpSetOptionSyntax :: Doc ()
@@ -525,7 +525,7 @@ help :: (MonadNix e t f m, MonadIO m)
525525
-> Repl e t f m ()
526526
help hs _ = do
527527
liftIO $ putStrLn "Available commands:\n"
528-
forM_ hs $ \h ->
528+
for_ hs $ \h ->
529529
liftIO .
530530
Data.Text.IO.putStrLn .
531531
Prettyprinter.Render.Text.renderStrict .

0 commit comments

Comments
 (0)