Skip to content

Commit 3727056

Browse files
Anton-LatukhaAnton-Latukha
committed
main: Main: processCLIOptions: refactor
Future would rehash this logic into more consice form.
1 parent 8954c5d commit 3727056

File tree

1 file changed

+45
-32
lines changed

1 file changed

+45
-32
lines changed

‎main/Main.hs‎

Lines changed: 45 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -8,20 +8,22 @@ 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
2628
import Nix.Fresh.Basic
2729
import Nix.Json
@@ -34,11 +36,9 @@ import qualified Nix.Type.Infer as HM
3436
import Nix.Value.Monad
3537
import Options.Applicative hiding ( ParserResult(..) )
3638
import Prettyprinter hiding ( list )
37-
import Prettyprinter.Render.Text
39+
import Prettyprinter.Render.Text ( renderIO )
3840
import qualified Repl
3941
import System.FilePath
40-
import qualified Text.Show.Pretty as PS
41-
import Nix.Utils.Fix1 ( Fix1T )
4242
import Nix.Eval
4343

4444
main :: IO ()
@@ -108,7 +108,7 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
108108

109109
withEmptyNixContext = withNixContext mempty
110110

111-
-- 2021-07-15: NOTE: @handleResult@ & @process@ - are atrocious size, they need to be decomposed & refactored.
111+
-- 2021-07-15: NOTE: @handleResult@ & @process@ - have atrocious size & compexity, they need to be decomposed & refactored.
112112
handleResult mpath =
113113
either
114114
(\ err ->
@@ -125,8 +125,8 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
125125
do
126126
expr' <- liftIO $ reduceExpr mpath expr
127127
either
128-
(\ err -> errorWithoutStackTrace $ "Type error: " <> PS.ppShow err)
129-
(\ ty -> liftIO $ putStrLn $ "Type of expression: " <> PS.ppShow
128+
(\ err -> errorWithoutStackTrace $ "Type error: " <> ppShow err)
129+
(\ ty -> liftIO $ putStrLn $ "Type of expression: " <> ppShow
130130
(fromJust $ Map.lookup "it" (coerce ty :: Map Text [Scheme]))
131131
)
132132
(HM.inferTop mempty [("it", stripAnnotation expr')])
@@ -155,40 +155,53 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
155155
)
156156

157157
-- 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) ()
158159
processCLIOptions mpath expr
159160
| evaluate =
160161
if
161-
| tracing -> evaluateExpression mpath nixTracingEvalExprLoc printer expr
162-
| Just path <- reduce -> evaluateExpression mpath (reduction path) printer expr
163-
| not (null arg && null argstr) -> evaluateExpression mpath nixEvalExprLoc printer expr
164-
| otherwise -> processResult printer =<< nixEvalExprLoc mpath expr
165-
| xml = fail "Rendering expression trees to XML is not yet implemented"
166-
| json = fail "Rendering expression trees to JSON is not implemented"
167-
| verbose >= DebugInfo = liftIO $ putStr $ PS.ppShow $ stripAnnotation expr
168-
| cache , Just path <- mpath = liftIO $ writeCache (replaceExtension path "nixc") expr
169-
| 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
170171
| otherwise =
171-
liftIO $
172+
liftIO .
172173
renderIO
173174
stdout
174175
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
175176
. prettyNix
176177
. stripAnnotation
177178
$ expr
178179
where
180+
evaluateExprWithEvaluator evaluator = evaluateExpression mpath evaluator printer
181+
179182
printer
180183
| finder = findAttrs <=< fromValue @(AttrSet (StdValue (StandardT (StdIdT IO))))
181-
| xml = liftIO . Text.putStrLn . stringIgnoreContext . toXML <=< normalForm
182-
-- 2021-05-27: NOTE: With naive fix of the #941
183-
-- This is overall a naive printer implementation, as options should interact/respect one another.
184-
-- A nice question: "Should respect one another to what degree?": Go full combinator way, for which
185-
-- old Nix CLI is nototrious for (and that would mean to reimplement the old Nix CLI),
186-
-- OR: https://github.com/haskell-nix/hnix/issues/172 and have some sane standart/default behaviour for (most) keys.
187-
| json = liftIO . Text.putStrLn . stringIgnoreContext <=< nvalueToJSONNixString <=< normalForm
188-
| strict = liftIO . print . prettyNValue <=< normalForm
189-
| values = liftIO . print . prettyNValueProv <=< removeEffects
190-
| otherwise = liftIO . print . prettyNValue <=< removeEffects
184+
| otherwise = printer'
191185
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+
192205
findAttrs
193206
:: AttrSet (StdValue (StandardT (StdIdT IO)))
194207
-> StandardT (StdIdT IO) ()
@@ -260,10 +273,10 @@ main' opts@Options{..} = runWithBasicEffectsIO opts execContentsFilesOrRepl
260273
_ -> (True , True )
261274

262275
forceEntry
263-
:: MonadValue a (Fix1T StandardTF (StdIdT IO))
276+
:: MonadValue a (StandardT (StdIdT IO))
264277
=> Text
265278
-> a
266-
-> Fix1T StandardTF (StdIdT IO) (Maybe a)
279+
-> StandardT (StdIdT IO) (Maybe a)
267280
forceEntry k v =
268281
catch
269282
(pure <$> demand v)

0 commit comments

Comments
 (0)