Skip to content

Commit 5a97223

Browse files
committed
main: Main: main': refactor
1 parent 0f32a08 commit 5a97223

File tree

4 files changed

+72
-48
lines changed

4 files changed

+72
-48
lines changed

main/Main.hs

Lines changed: 68 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ import Data.Time
2323
import qualified Data.Text.IO as Text
2424
import Nix
2525
import Nix.Convert
26-
import qualified Nix.Eval as Eval
2726
import Nix.Fresh.Basic
2827
import Nix.Json
2928
import Nix.Options.Parser
@@ -40,6 +39,7 @@ import qualified Repl
4039
import System.FilePath
4140
import qualified Text.Show.Pretty as PS
4241
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
84+
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
8192

82-
firstJust :: [Maybe a] -> Maybe a
83-
firstJust = asum
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@ - are atrocious size, they need to be decomposed & refactored.
92112
handleResult mpath =
93113
either
94114
(\ err ->
@@ -103,7 +123,7 @@ 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
108128
(\ err -> errorWithoutStackTrace $ "Type error: " <> PS.ppShow err)
109129
(\ ty -> liftIO $ putStrLn $ "Type of expression: " <> PS.ppShow
@@ -114,7 +134,7 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
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,27 +144,28 @@ 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 mpath expr
138159
| evaluate =
139160
if
140-
| tracing -> evaluateExpression mpath Nix.nixTracingEvalExprLoc printer expr
161+
| tracing -> evaluateExpression mpath nixTracingEvalExprLoc printer expr
141162
| 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
163+
| not (null arg && null argstr) -> evaluateExpression mpath nixEvalExprLoc printer expr
164+
| otherwise -> processResult printer =<< nixEvalExprLoc mpath expr
144165
| xml = fail "Rendering expression trees to XML is not yet implemented"
145166
| json = fail "Rendering expression trees to JSON is not implemented"
146167
| verbose >= DebugInfo = liftIO $ putStr $ PS.ppShow $ stripAnnotation expr
147-
| cache , Just path <- mpath = liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
168+
| cache , Just path <- mpath = liftIO $ writeCache (replaceExtension path "nixc") expr
148169
| parseOnly = void $ liftIO $ Exc.evaluate $ Deep.force expr
149170
| otherwise =
150171
liftIO $
@@ -259,15 +280,15 @@ main' (opts@Options{..}) = runWithBasicEffectsIO opts execContentsFilesOrRepl
259280
pure Nothing
260281
)
261282

262-
reduction path mp x =
283+
reduction path mpathToContext annExpr =
263284
do
264285
eres <-
265-
Nix.withNixContext
266-
mp
267-
(Nix.reducingEvalExpr
268-
Eval.evalContent
269-
mp
270-
x
286+
withNixContext
287+
mpathToContext
288+
(reducingEvalExpr
289+
evalContent
290+
mpathToContext
291+
annExpr
271292
)
272293
handleReduced path eres
273294

src/Nix/Expr/Types/Annotated.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -194,6 +194,7 @@ nullSpan = SrcSpan nullPos nullPos
194194

195195
-- | Pattern systems for matching on NExprLocF constructions.
196196

197+
-- 2021-07-15: NOTE: Make versions of these for NExprLoc, since source code actually uses just fixed versions of these shorthands.
197198
pattern NConstant_ :: SrcSpan -> NAtom -> NExprLocF r
198199
pattern NConstant_ ann x = AnnFP ann (NConstant x)
199200

src/Nix/Options.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ module Nix.Options where
55

66
import Data.Time
77

8+
-- 2021-07-15: NOTE: What these are? They need to be documented.
9+
-- Also need better names. Foe example, Maybes & lists names need to show their type in the name.
810
data Options = Options
911
{ verbose :: Verbosity
1012
, tracing :: Bool

src/Nix/Reduce.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -337,7 +337,7 @@ type Flagged f = Fix (FlaggedF f)
337337
flagExprLoc :: (MonadIO n, Traversable f) => Fix f -> n (Flagged f)
338338
flagExprLoc = foldFixM $ \x -> do
339339
flag <- liftIO $ newIORef False
340-
pure $ Fix $ FlaggedF (flag, x)
340+
pure $ coerce (flag, x)
341341

342342
-- stripFlags :: Functor f => Flagged f -> Fix f
343343
-- stripFlags = foldFix $ Fix . snd . flagged

0 commit comments

Comments
 (0)