Reformat all sources with Brittany, to restore consistency

benchmarks/Main.hs

@@ -5,6 +5,4 @@ import Criterion.Main
 import qualified ParserBench
 
 main :: IO ()
-main = defaultMain
+main = defaultMain [ParserBench.benchmarks]
-  [ ParserBench.benchmarks
-  ]

benchmarks/ParserBench.hs

@@ -9,7 +9,8 @@ benchFile :: FilePath -> Benchmark
 benchFile = bench <*> whnfIO . parseNixFile . ("data/" ++)
 
 benchmarks :: Benchmark
-benchmarks = bgroup "Parser"
+benchmarks = bgroup
+  "Parser"
   [ benchFile "nixpkgs-all-packages.nix"
   , benchFile "nixpkgs-all-packages-pretty.nix"
   , benchFile "let-comments.nix"

main/Main.hs

@@ -17,8 +17,8 @@ import           Control.Monad.IO.Class
 import qualified Data.Aeson.Text               as A
 import qualified Data.HashMap.Lazy             as M
 import qualified Data.Map                      as Map
-import           Data.List (sortOn)
+import           Data.List                      ( sortOn )
-import           Data.Maybe (fromJust)
+import           Data.Maybe                     ( fromJust )
 import           Data.Time
 import qualified Data.Text                     as Text
 import qualified Data.Text.IO                  as Text
@@ -38,7 +38,7 @@ import qualified Nix.Type.Env as Env
 import qualified Nix.Type.Infer                as HM
 import           Nix.Utils
 import           Nix.Var
-import           Options.Applicative hiding (ParserResult(..))
+import           Options.Applicative     hiding ( ParserResult(..) )
 import qualified Repl
 import           System.FilePath
 import           System.IO
@@ -55,19 +55,16 @@ main = do
     Nothing -> case expression opts of
       Just s  -> handleResult opts Nothing (parseNixTextLoc s)
       Nothing -> case fromFile opts of
-                Just "-" ->
+        Just "-" -> mapM_ (processFile opts) =<< (lines <$> liftIO getContents)
-                    mapM_ (processFile opts)
-                        =<< (lines <$> liftIO getContents)
         Just path ->
-                    mapM_ (processFile opts)
+          mapM_ (processFile opts) =<< (lines <$> liftIO (readFile path))
-                        =<< (lines <$> liftIO (readFile path))
         Nothing -> case filePaths opts of
           [] -> withNixContext Nothing $ Repl.main
           ["-"] ->
-                        handleResult opts Nothing . parseNixTextLoc
+            handleResult opts Nothing
+              .   parseNixTextLoc
               =<< liftIO Text.getContents
-                    paths ->
+          paths -> mapM_ (processFile opts) paths
-                        mapM_ (processFile opts) paths
  where
   processFile opts path = do
     eres <- parseNixFileLoc path
@@ -77,90 +74,88 @@ main = do
     Failure err ->
       (if ignoreErrors opts
           then liftIO . hPutStrLn stderr
-             else errorWithoutStackTrace) $ "Parse failed: " ++ show err
+          else errorWithoutStackTrace
+        )
+        $  "Parse failed: "
+        ++ show err
 
     Success expr -> do
       when (check opts) $ do
         expr' <- liftIO (reduceExpr mpath expr)
         case HM.inferTop Env.empty [("it", stripAnnotation expr')] of
-                    Left err ->
+          Left  err -> errorWithoutStackTrace $ "Type error: " ++ PS.ppShow err
-                        errorWithoutStackTrace $ "Type error: " ++ PS.ppShow err
+          Right ty  -> liftIO $ putStrLn $ "Type of expression: " ++ PS.ppShow
-                    Right ty ->
+            (fromJust (Map.lookup "it" (Env.types ty)))
-                        liftIO $ putStrLn $ "Type of expression: "
-                            ++ PS.ppShow (fromJust (Map.lookup "it" (Env.types ty)))
 
           -- liftIO $ putStrLn $ runST $
           --     runLintM opts . renderSymbolic =<< lint opts expr
 
       catch (process opts mpath expr) $ \case
         NixException frames ->
-                    errorWithoutStackTrace . show
+          errorWithoutStackTrace
+            .   show
             =<< renderFrames @(StdValue IO) @(StdThunk IO) frames
 
-            when (repl opts) $
+      when (repl opts) $ withNixContext Nothing $ Repl.main
-                withNixContext Nothing $ Repl.main
 
   process opts mpath expr
-        | evaluate opts, tracing opts =
+    | evaluate opts
-              evaluateExpression mpath
+    , tracing opts
-                  Nix.nixTracingEvalExprLoc printer expr
+    = evaluateExpression mpath Nix.nixTracingEvalExprLoc printer expr
-
+    | evaluate opts
-        | evaluate opts, Just path <- reduce opts =
+    , Just path <- reduce opts
-              evaluateExpression mpath (reduction path) printer expr
+    = evaluateExpression mpath (reduction path) printer expr
-
+    | evaluate opts
-        | evaluate opts, not (null (arg opts) && null (argstr opts)) =
+    , not (null (arg opts) && null (argstr opts))
-              evaluateExpression mpath
+    = evaluateExpression mpath Nix.nixEvalExprLoc printer expr
-                  Nix.nixEvalExprLoc printer expr
+    | evaluate opts
-
+    = processResult printer =<< Nix.nixEvalExprLoc mpath expr
-        | evaluate opts =
+    | xml opts
-              processResult printer =<< Nix.nixEvalExprLoc mpath expr
+    = error "Rendering expression trees to XML is not yet implemented"
-
+    | json opts
-        | xml opts =
+    = liftIO $ TL.putStrLn $ A.encodeToLazyText (stripAnnotation expr)
-              error "Rendering expression trees to XML is not yet implemented"
+    | verbose opts >= DebugInfo
-
+    = liftIO $ putStr $ PS.ppShow $ stripAnnotation expr
-        | json opts =
+    | cache opts
-              liftIO $ TL.putStrLn $
+    , Just path <- mpath
-                  A.encodeToLazyText (stripAnnotation expr)
+    = liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
-
+    | parseOnly opts
-        | verbose opts >= DebugInfo =
+    = void $ liftIO $ Exc.evaluate $ Deep.force expr
-              liftIO $ putStr $ PS.ppShow $ stripAnnotation expr
+    | otherwise
-
+    = liftIO
-        | cache opts, Just path <- mpath =
+      $ renderIO stdout
-              liftIO $ writeCache (addExtension (dropExtension path) "nixc") expr
-
-        | parseOnly opts =
-              void $ liftIO $ Exc.evaluate $ Deep.force expr
-
-        | otherwise =
-              liftIO $ renderIO stdout
       . layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
       . prettyNix
-                  . stripAnnotation $ expr
+      . stripAnnotation
+      $ expr
    where
     printer
-            | finder opts =
+      | finder opts
-              fromValue @(AttrSet (StdThunk IO)) >=> findAttrs
+      = fromValue @(AttrSet (StdThunk IO)) >=> findAttrs
-            | xml opts =
+      | xml opts
-              liftIO . putStrLn
+      = liftIO
+        .   putStrLn
         .   Text.unpack
         .   principledStringIgnoreContext
         .   toXML
         <=< normalForm
-            | json opts =
+      | json opts
-              liftIO . Text.putStrLn
+      = liftIO
+        .   Text.putStrLn
         .   principledStringIgnoreContext
         <=< nvalueToJSONNixString
-            | strict opts =
+      | strict opts
-              liftIO . print . prettyNValueNF <=< normalForm
+      = liftIO . print . prettyNValueNF <=< normalForm
-            | values opts  =
+      | values opts
-              liftIO . print <=< prettyNValueProv
+      = liftIO . print <=< prettyNValueProv
-            | otherwise  =
+      | otherwise
-              liftIO . print <=< prettyNValue
+      = liftIO . print <=< prettyNValue
      where
       findAttrs = go ""
        where
         go prefix s = do
-                    xs <- forM (sortOn fst (M.toList s))
+          xs <-
+            forM (sortOn fst (M.toList s))
               $ \(k, nv@(StdThunk (StdCited (NCited _ t)))) -> case t of
                   Value v       -> pure (k, Just v)
                   Thunk _ _ ref -> do
@@ -169,7 +164,7 @@ main = do
                     val <- readVar @(StdLazy IO) ref
                     case val of
                       Computed _ -> pure (k, Nothing)
-                                    _ | descend   -> (k,) <$> forceEntry path nv
+                      _ | descend   -> (k, ) <$> forceEntry path nv
                         | otherwise -> pure (k, Nothing)
 
           forM_ xs $ \(k, mv) -> do
@@ -180,42 +175,44 @@ main = do
               when descend $ case mv of
                 Nothing -> return ()
                 Just v  -> case v of
-                                    NVSet s' _ ->
+                  NVSet s' _ -> go (path ++ ".") s'
-                                        go (path ++ ".") s'
                   _          -> return ()
          where
           filterEntry path k = case (path, k) of
-                        ("stdenv", "stdenv")           -> (True,  True)
+            ("stdenv", "stdenv"          ) -> (True, True)
-                        (_,        "stdenv")           -> (False, False)
+            (_       , "stdenv"          ) -> (False, False)
-                        (_,        "out")              -> (True,  False)
+            (_       , "out"             ) -> (True, False)
-                        (_,        "src")              -> (True,  False)
+            (_       , "src"             ) -> (True, False)
-                        (_,        "mirrorsFile")      -> (True,  False)
+            (_       , "mirrorsFile"     ) -> (True, False)
-                        (_,        "buildPhase")       -> (True,  False)
+            (_       , "buildPhase"      ) -> (True, False)
-                        (_,        "builder")          -> (False,  False)
+            (_       , "builder"         ) -> (False, False)
-                        (_,        "drvPath")          -> (False,  False)
+            (_       , "drvPath"         ) -> (False, False)
-                        (_,        "outPath")          -> (False,  False)
+            (_       , "outPath"         ) -> (False, False)
-                        (_,        "__impureHostDeps") -> (False,  False)
+            (_       , "__impureHostDeps") -> (False, False)
-                        (_,        "__sandboxProfile") -> (False,  False)
+            (_       , "__sandboxProfile") -> (False, False)
-                        ("pkgs",   "pkgs")             -> (True,  True)
+            ("pkgs"  , "pkgs"            ) -> (True, True)
-                        (_,        "pkgs")             -> (False, False)
+            (_       , "pkgs"            ) -> (False, False)
-                        (_,        "drvAttrs")         -> (False, False)
+            (_       , "drvAttrs"        ) -> (False, False)
             _                              -> (True, True)
 
-                    forceEntry k v = catch (Just <$> force v pure)
+          forceEntry k v =
-                        $ \(NixException frames) -> do
+            catch (Just <$> force v pure) $ \(NixException frames) -> do
-                              liftIO . putStrLn
+              liftIO
+                .   putStrLn
                 .   ("Exception forcing " ++)
                 .   (k ++)
-                                     . (": " ++) . show
+                .   (": " ++)
+                .   show
                 =<< renderFrames @(StdValue IO) @(StdThunk IO) frames
               return Nothing
 
   reduction path mp x = do
-        eres <- Nix.withNixContext mp $
+    eres <- Nix.withNixContext mp
-            Nix.reducingEvalExpr (Eval.eval . annotated . getCompose) mp x
+      $ Nix.reducingEvalExpr (Eval.eval . annotated . getCompose) mp x
     handleReduced path eres
 
-    handleReduced :: (MonadThrow m, MonadIO m)
+  handleReduced
+    :: (MonadThrow m, MonadIO m)
     => FilePath
     -> (NExprLoc, Either SomeException (NValue t f m))
     -> m (NValue t f m)

main/Repl.hs

@@ -22,8 +22,10 @@
 
 module Repl where
 
-import           Nix hiding (exec, try)
+import           Nix                     hiding ( exec
-import           Nix.Builtins (MonadBuiltins)
+                                                , try
+                                                )
+import           Nix.Builtins                   ( MonadBuiltins )
 import           Nix.Cited
 import           Nix.Convert
 import           Nix.Eval
@@ -34,14 +36,18 @@ import           Nix.Utils
 
 import           Control.Comonad
 import qualified Data.HashMap.Lazy             as M
-import           Data.List (isPrefixOf, foldl')
+import           Data.List                      ( isPrefixOf
+                                                , foldl'
+                                                )
 import qualified Data.Map                      as Map
 import           Data.Monoid
-import           Data.Text (unpack, pack)
+import           Data.Text                      ( unpack
+                                                , pack
+                                                )
 import qualified Data.Text                     as Text
 import qualified Data.Text.IO                  as Text
-import           Data.Version (showVersion)
+import           Data.Version                   ( showVersion )
-import           Paths_hnix (version)
+import           Paths_hnix                     ( version )
 
 import           Control.Monad.Catch
 import           Control.Monad.Identity
@@ -55,15 +61,20 @@ import           System.Exit
 
 
 main :: (MonadBuiltins e t f m, MonadIO m, MonadException m) => m ()
-main = flip evalStateT initState $
+main = flip evalStateT initState
 #if MIN_VERSION_repline(0, 2, 0)
-    evalRepl (return prefix) cmd options (Just ':') completer welcomeText
+    $ evalRepl (return prefix) cmd options (Just ':') completer welcomeText
 #else
-    evalRepl prefix cmd options completer welcomeText
+    $ evalRepl prefix cmd options completer welcomeText
 #endif
  where
   prefix = "hnix> "
-      welcomeText = liftIO $ putStrLn $ "Welcome to hnix " <> showVersion version <> ". For help type :help\n"
+  welcomeText =
+    liftIO
+      $  putStrLn
+      $  "Welcome to hnix "
+      <> showVersion version
+      <> ". For help type :help\n"
 
 -------------------------------------------------------------------------------
 -- Types
@@ -87,8 +98,12 @@ hoistErr (Failure err) = do
 -- Execution
 -------------------------------------------------------------------------------
 
-exec :: forall e t f m. (MonadBuiltins e t f m, MonadIO m, MonadException m)
+exec
-     => Bool -> Text.Text -> Repl e t f m (NValue t f m)
+  :: forall e t f m
+   . (MonadBuiltins e t f m, MonadIO m, MonadException m)
+  => Bool
+  -> Text.Text
+  -> Repl e t f m (NValue t f m)
 exec update source = do
   -- Get the current interpreter state
   st   <- get
@@ -105,29 +120,28 @@ exec update source = do
 
   case mVal of
     Left (NixException frames) -> do
-      lift $ lift $ liftIO . print
+      lift $ lift $ liftIO . print =<< renderFrames @(NValue t f m) @t frames
-        =<< renderFrames @(NValue t f m) @t frames
       abort
     Right val -> do
       -- Update the interpreter state
       when update $ do
         -- Create the new environment
-        put st { tmctx = tmctx st -- TODO: M.insert key val (tmctx st)
+        put st { tmctx = tmctx st } -- TODO: M.insert key val (tmctx st)
-               }
       return val
 
 
-cmd :: (MonadBuiltins e t f m, MonadIO m, MonadException m) => String -> Repl e t f m ()
+cmd
+  :: (MonadBuiltins e t f m, MonadIO m, MonadException m)
+  => String
+  -> Repl e t f m ()
 cmd source = do
   val <- exec True (Text.pack source)
   lift $ lift $ do
     opts :: Nix.Options <- asks (view hasLens)
-    if | strict opts ->
+    if
-         liftIO . print . prettyNValueNF =<< normalForm val
+      | strict opts -> liftIO . print . prettyNValueNF =<< normalForm val
-       | values opts ->
+      | values opts -> liftIO . print =<< prettyNValueProv val
-         liftIO . print =<< prettyNValueProv val
+      | otherwise   -> liftIO . print =<< prettyNValue val
-       | otherwise ->
-         liftIO . print =<< prettyNValue val
 -------------------------------------------------------------------------------
 -- Commands
 -------------------------------------------------------------------------------
@@ -140,21 +154,26 @@ browse _ = do
   -- liftIO $ mapM_ putStrLn $ ppenv (tyctx st)
 
 -- :load command
-load :: (MonadBuiltins e t f m, MonadIO m, MonadException m) => [String] -> Repl e t f m ()
+load
+  :: (MonadBuiltins e t f m, MonadIO m, MonadException m)
+  => [String]
+  -> Repl e t f m ()
 load args = do
   contents <- liftIO $ Text.readFile (unwords args)
   void $ exec True contents
 
 -- :type command
-typeof :: (MonadBuiltins e t f m, MonadException m, MonadIO m) => [String] -> Repl e t f m ()
+typeof
+  :: (MonadBuiltins e t f m, MonadException m, MonadIO m)
+  => [String]
+  -> Repl e t f m ()
 typeof args = do
   st  <- get
   val <- case M.lookup line (tmctx st) of
     Just val -> return val
     Nothing  -> exec False line
   liftIO $ putStrLn $ describeValue . valueType . extract . _nValue $ val
-  where
+  where line = Text.pack (unwords args)
-    line = Text.pack (unwords args)
 
 -- :quit command
 quit :: (MonadBuiltins e t f m, MonadIO m) => a -> Repl e t f m ()
@@ -166,8 +185,8 @@ quit _ = liftIO exitSuccess
 
 -- Prefix tab completer
 defaultMatcher :: MonadIO m => [(String, CompletionFunc m)]
-defaultMatcher = [
+defaultMatcher =
-    (":load"  , fileCompleter)
+  [(":load", fileCompleter)
   --, (":type"  , values)
                            ]
 
@@ -177,24 +196,35 @@ comp n = do
   let cmds = [":load", ":type", ":browse", ":quit"]
   -- Env.TypeEnv ctx <- gets tyctx
   -- let defs = map unpack $ Map.keys ctx
-  return $ filter (isPrefixOf n) (cmds {-++ defs-})
+  return $ filter (isPrefixOf n) (cmds {-++ defs-}
+                                      )
 
-options :: (MonadBuiltins e t f m, MonadIO m, MonadException m)
+options
+  :: (MonadBuiltins e t f m, MonadIO m, MonadException m)
   => [(String, [String] -> Repl e t f m ())]
-options = [
+options =
-    ("load"   , load)
+  [ ( "load"
+    , load
+    )
   --, ("browse" , browse)
-  , ("quit"   , quit)
+  , ("quit", quit)
-  , ("type"   , typeof)
+  , ("type", typeof)
-  , ("help"   , help)
+  , ("help", help)
   ]
 
-help :: forall e t f m . (MonadBuiltins e t f m, MonadIO m, MonadException m)
+help
-     => [String] -> Repl e t f m ()
+  :: forall e t f m
+   . (MonadBuiltins e t f m, MonadIO m, MonadException m)
+  => [String]
+  -> Repl e t f m ()
 help _ = liftIO $ do
   putStrLn "Available commands:\n"
   mapM_ putStrLn $ map (\o -> ":" ++ (fst o)) (options @e @t @f @m)
 
-completer :: (MonadBuiltins e t f m, MonadIO m)
+completer
+  :: (MonadBuiltins e t f m, MonadIO m)
   => CompleterStyle (StateT (IState t f m) m)
 completer = Prefix (wordCompleter comp) defaultMatcher
+
+
+

src/Nix.hs

@@ -4,26 +4,32 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 
-module Nix (module Nix.Cache,
+module Nix
-            module Nix.Exec,
+  ( module Nix.Cache
-            module Nix.Expr,
+  , module Nix.Exec
-            module Nix.Frames,
+  , module Nix.Expr
-            module Nix.Render.Frame,
+  , module Nix.Frames
-            module Nix.Normal,
+  , module Nix.Render.Frame
-            module Nix.Options,
+  , module Nix.Normal
-            module Nix.String,
+  , module Nix.Options
-            module Nix.Parser,
+  , module Nix.String
-            module Nix.Pretty,
+  , module Nix.Parser
-            module Nix.Reduce,
+  , module Nix.Pretty
-            module Nix.Thunk,
+  , module Nix.Reduce
-            module Nix.Value,
+  , module Nix.Thunk
-            module Nix.XML,
+  , module Nix.Value
-            withNixContext,
+  , module Nix.XML
-            nixEvalExpr, nixEvalExprLoc, nixTracingEvalExprLoc,
+  , withNixContext
-            evaluateExpression, processResult) where
+  , nixEvalExpr
+  , nixEvalExprLoc
+  , nixTracingEvalExprLoc
+  , evaluateExpression
+  , processResult
+  )
+where
 
 import           Control.Applicative
-import           Control.Arrow (second)
+import           Control.Arrow                  ( second )
 import           Control.Monad.Reader
 import           Data.Fix
 import qualified Data.HashMap.Lazy             as M
@@ -50,20 +56,33 @@ import           Nix.XML
 -- | This is the entry point for all evaluations, whatever the expression tree
 --   type. It sets up the common Nix environment and applies the
 --   transformations, allowing them to be easily composed.
-nixEval :: (MonadBuiltins e t f m, Has e Options, Functor g)
+nixEval
-    => Maybe FilePath -> Transform g (m a) -> Alg g (m a) -> Fix g -> m a
+  :: (MonadBuiltins e t f m, Has e Options, Functor g)
+  => Maybe FilePath
+  -> Transform g (m a)
+  -> Alg g (m a)
+  -> Fix g
+  -> m a
 nixEval mpath xform alg = withNixContext mpath . adi alg xform
 
 -- | Evaluate a nix expression in the default context
-nixEvalExpr :: (MonadBuiltins e t f m, Has e Options)
+nixEvalExpr
-            => Maybe FilePath -> NExpr -> m (NValue t f m)
+  :: (MonadBuiltins e t f m, Has e Options)
+  => Maybe FilePath
+  -> NExpr
+  -> m (NValue t f m)
 nixEvalExpr mpath = nixEval mpath id Eval.eval
 
 -- | Evaluate a nix expression in the default context
-nixEvalExprLoc :: forall e t f m. (MonadBuiltins e t f m, Has e Options)
+nixEvalExprLoc
-               => Maybe FilePath -> NExprLoc -> m (NValue t f m)
+  :: forall e t f m
-nixEvalExprLoc mpath =
+   . (MonadBuiltins e t f m, Has e Options)
-    nixEval mpath (Eval.addStackFrames @t . Eval.addSourcePositions)
+  => Maybe FilePath
+  -> NExprLoc
+  -> m (NValue t f m)
+nixEvalExprLoc mpath = nixEval
+  mpath
+  (Eval.addStackFrames @t . Eval.addSourcePositions)
   (Eval.eval . annotated . getCompose)
 
 -- | Evaluate a nix expression with tracing in the default context. Note that
@@ -73,7 +92,9 @@ nixEvalExprLoc mpath =
 --   context.
 nixTracingEvalExprLoc
   :: (MonadBuiltins e t f m, Has e Options, MonadIO m, Alternative m)
-    => Maybe FilePath -> NExprLoc -> m (NValue t f m)
+  => Maybe FilePath
+  -> NExprLoc
+  -> m (NValue t f m)
 nixTracingEvalExprLoc mpath = withNixContext mpath . evalExprLoc
 
 evaluateExpression
@@ -85,9 +106,9 @@ evaluateExpression
   -> m a
 evaluateExpression mpath evaluator handler expr = do
   opts :: Options <- asks (view hasLens)
-    args <- traverse (traverse eval') $
+  args <- traverse (traverse eval') $ map (second parseArg) (arg opts) ++ map
-        map (second parseArg) (arg opts) ++
+    (second mkStr)
-        map (second mkStr) (argstr opts)
+    (argstr opts)
   compute evaluator expr (argmap args) handler
  where
   parseArg s = case parseNixText s of
@@ -97,8 +118,7 @@ evaluateExpression mpath evaluator handler expr = do
   eval' = (normalForm =<<) . nixEvalExpr mpath
 
   argmap args = pure $ nvSet (M.fromList args') mempty
-      where
+    where args' = map (fmap (wrapValue . nValueFromNF)) args
-        args' = map (fmap (wrapValue . nValueFromNF)) args
 
   compute ev x args p = do
     f :: NValue t f m <- ev mpath x
@@ -106,8 +126,12 @@ evaluateExpression mpath evaluator handler expr = do
       NVClosure _ g -> force ?? pure =<< g args
       _             -> pure f
 
-processResult :: forall e t f m a. (MonadNix e t f m, Has e Options)
+processResult
-              => (NValue t f m -> m a) -> NValue t f m -> m a
+  :: forall e t f m a
+   . (MonadNix e t f m, Has e Options)
+  => (NValue t f m -> m a)
+  -> NValue t f m
+  -> m a
 processResult h val = do
   opts :: Options <- asks (view hasLens)
   case attr opts of
@@ -116,22 +140,29 @@ processResult h val = do
  where
   go :: [Text.Text] -> NValue t f m -> m a
   go [] v = h v
-    go ((Text.decimal -> Right (n,"")):ks) v = case v of
+  go ((Text.decimal -> Right (n,"")) : ks) v = case v of
     NVList xs -> case ks of
       [] -> force @t @m @(NValue t f m) (xs !! n) h
       _  -> force (xs !! n) (go ks)
-        _ -> errorWithoutStackTrace $
+    _ ->
-                "Expected a list for selector '" ++ show n
+      errorWithoutStackTrace
-                    ++ "', but got: " ++ show v
+        $  "Expected a list for selector '"
-    go (k:ks) v = case v of
+        ++ show n
+        ++ "', but got: "
+        ++ show v
+  go (k : ks) v = case v of
     NVSet xs _ -> case M.lookup k xs of
       Nothing ->
-                errorWithoutStackTrace $
+        errorWithoutStackTrace
-                    "Set does not contain key '"
+          $  "Set does not contain key '"
-                        ++ Text.unpack k ++ "'"
+          ++ Text.unpack k
+          ++ "'"
       Just v' -> case ks of
         [] -> force v' h
         _  -> force v' (go ks)
-        _ -> errorWithoutStackTrace $
+    _ ->
-            "Expected a set for selector '" ++ Text.unpack k
+      errorWithoutStackTrace
-                ++ "', but got: " ++ show v
+        $  "Expected a set for selector '"
+        ++ Text.unpack k
+        ++ "', but got: "
+        ++ show v

src/Nix/Atoms.hs

@@ -12,7 +12,9 @@ import Codec.Serialise
 import           Control.DeepSeq
 import           Data.Data
 import           Data.Hashable
-import Data.Text (Text, pack)
+import           Data.Text                      ( Text
+                                                , pack
+                                                )
 import           GHC.Generics
 
 -- | Atoms are values that evaluate to themselves. This means that
@@ -41,3 +43,11 @@ atomText (NInt i)   = pack (show i)
 atomText (NFloat f) = pack (show f)
 atomText (NBool  b) = if b then "true" else "false"
 atomText NNull      = "null"
+
+
+
+
+
+
+
+

src/Nix/Cited.hs

@@ -14,7 +14,7 @@ module Nix.Cited where
 
 import           Control.Comonad
 import           Control.Comonad.Env
-import Data.Typeable (Typeable)
+import           Data.Typeable                  ( Typeable )
 import           GHC.Generics
 import           Lens.Family2.TH
 
@@ -40,7 +40,6 @@ data NCited t f m a = NCited
 
 instance Applicative (NCited t f m) where
   pure = NCited []
-  -- jww (2019-03-11): ??
   NCited xs f <*> NCited ys x = NCited (xs <> ys) (f x)
 
 instance Comonad (NCited t f m) where

src/Nix/Context.hs

@@ -8,7 +8,9 @@ import Nix.Options
 import           Nix.Scope
 import           Nix.Frames
 import           Nix.Utils
-import Nix.Expr.Types.Annotated (SrcSpan, nullSpan)
+import           Nix.Expr.Types.Annotated       ( SrcSpan
+                                                , nullSpan
+                                                )
 
 data Context m t = Context
     { scopes  :: Scopes m t

src/Nix/Convert.hs

@@ -29,11 +29,13 @@ module Nix.Convert where
 
 import           Control.Monad
 import           Data.ByteString
-import           Data.HashMap.Lazy (HashMap)
+import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
-import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
+import           Data.Text.Encoding             ( encodeUtf8
+                                                , decodeUtf8
+                                                )
 import           Nix.Atoms
 import           Nix.Effects
 import           Nix.Expr.Types
@@ -60,8 +62,8 @@ class FromValue a m v where
     fromValue    :: v -> m a
     fromValueMay :: v -> m (Maybe a)
 
-type Convertible e t f m =
+type Convertible e t f m
-    (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m)
+  = (Framed e m, MonadThunk t m (NValue t f m), MonadDataErrorContext t f m)
 
 instance Convertible e t f m => FromValue () m (NValueNF t f m) where
   fromValueMay = \case
@@ -150,8 +152,11 @@ instance (Convertible e t f m, MonadEffects t f m)
   fromValueMay = \case
     NVStrNF ns -> pure $ Just ns
     NVPathNF p ->
-            Just . hackyMakeNixStringWithoutContext
+      Just
-                 . Text.pack . unStorePath <$> addPath p
+        .   hackyMakeNixStringWithoutContext
+        .   Text.pack
+        .   unStorePath
+        <$> addPath p
     NVSetNF s _ -> case M.lookup "outPath" s of
       Nothing -> pure Nothing
       Just p  -> fromValueMay p
@@ -165,8 +170,11 @@ instance (Convertible e t f m, MonadEffects t f m, FromValue NixString m t)
   fromValueMay = \case
     NVStr ns -> pure $ Just ns
     NVPath p ->
-            Just . hackyMakeNixStringWithoutContext
+      Just
-                 . Text.pack . unStorePath <$> addPath p
+        .   hackyMakeNixStringWithoutContext
+        .   Text.pack
+        .   unStorePath
+        <$> addPath p
     NVSet s _ -> case M.lookup "outPath" s of
       Nothing -> pure Nothing
       Just p  -> fromValueMay p
@@ -344,8 +352,9 @@ instance Convertible e t f m => ToValue SourcePos m (NValue t f m) where
     c' <- toValue (unPos c)
     let pos = M.fromList
           [ ("file" :: Text, wrapValue f')
-                , ("line",        wrapValue l')
+          , ("line"        , wrapValue l')
-                , ("column",      wrapValue c') ]
+          , ("column"      , wrapValue c')
+          ]
     pure $ nvSet pos mempty
 
 instance (Convertible e t f m, ToValue a m (NValueNF t f m))
@@ -376,8 +385,8 @@ instance Convertible e t f m => ToValue Bool m (NExprF r) where
 instance Convertible e t f m => ToValue () m (NExprF r) where
   toValue _ = pure . NConstant $ NNull
 
-whileForcingThunk :: forall t f m s e r. (Exception s, Convertible e t f m)
+whileForcingThunk
-                  => s -> m r -> m r
+  :: forall t f m s e r . (Exception s, Convertible e t f m) => s -> m r -> m r
 whileForcingThunk frame =
   withFrame Debug (ForcingThunk @t @f @m) . withFrame Debug frame
 
@@ -450,15 +459,15 @@ instance (Convertible e t f m, ToNix a m (NValue t f m))
       => ToNix [a] m (NValue t f m) where
   toNix = fmap nvList . traverse (thunk . go)
    where
-        go = (\v -> whileForcingThunk @t @f @m (ConcerningValue v) (pure v))
+    go =
-            <=< toNix
+      (\v -> whileForcingThunk @t @f @m (ConcerningValue v) (pure v)) <=< toNix
 
 instance (Convertible e t f m, ToNix a m (NValue t f m))
       => ToNix (HashMap Text a) m (NValue t f m) where
   toNix = fmap (flip nvSet M.empty) . traverse (thunk . go)
    where
-        go = (\v -> whileForcingThunk @t @f @m (ConcerningValue v) (pure v))
+    go =
-            <=< toNix
+      (\v -> whileForcingThunk @t @f @m (ConcerningValue v) (pure v)) <=< toNix
 
 instance Convertible e t f m => ToNix () m (NValueNF t f m) where
 instance Convertible e t f m => ToNix () m (NValue t f m) where
@@ -494,5 +503,5 @@ instance (Convertible e t f m, ToNix a m (NValueNF t f m))
   => ToNix [a] m (NValueNF t f m) where
   toNix = fmap nvListNF . traverse toNix
 
-convertNix :: forall a t m v. (FromNix a m t, ToNix a m v, Monad m) => t -> m v
+convertNix :: forall a t m v . (FromNix a m t, ToNix a m v, Monad m) => t -> m v
 convertNix = fromNix @a >=> toNix

src/Nix/Effects.hs

@@ -10,13 +10,16 @@
 
 module Nix.Effects where
 
-import           Prelude hiding (putStr, putStrLn, print)
+import           Prelude                 hiding ( putStr
+                                                , putStrLn
+                                                , print
+                                                )
 import qualified Prelude
 
 import           Control.Monad.Trans
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as T
-import           Network.HTTP.Client hiding (path)
+import           Network.HTTP.Client     hiding ( path )
 import           Network.HTTP.Client.TLS
 import           Network.HTTP.Types
 import           Nix.Expr
@@ -66,9 +69,9 @@ instance MonadIntrospect IO where
   recursiveSize =
 #ifdef MIN_VERSION_ghc_datasize
 #if MIN_VERSION_ghc_datasize(0,2,0) && __GLASGOW_HASKELL__ >= 804
-        recursiveSize
+recursiveSize
 #else
-        \_ -> return 0
+\_ -> return 0
 #endif
 #else
     \_ -> return 0
@@ -82,22 +85,31 @@ class Monad m => MonadExec m where
 instance MonadExec IO where
   exec' = \case
     []            -> return $ Left $ ErrorCall "exec: missing program"
-      (prog:args) -> do
+    (prog : args) -> do
-        (exitCode, out, _) <-
+      (exitCode, out, _) <- liftIO $ readProcessWithExitCode prog args ""
-            liftIO $ readProcessWithExitCode prog args ""
       let t    = T.strip (T.pack out)
       let emsg = "program[" ++ prog ++ "] args=" ++ show args
       case exitCode of
-          ExitSuccess ->
+        ExitSuccess -> if T.null t
-            if T.null t
           then return $ Left $ ErrorCall $ "exec has no output :" ++ emsg
           else case parseNixTextLoc t of
             Failure err ->
-                return $ Left $ ErrorCall $
+              return
-                    "Error parsing output of exec: " ++ show err ++ " " ++ emsg
+                $  Left
+                $  ErrorCall
+                $  "Error parsing output of exec: "
+                ++ show err
+                ++ " "
+                ++ emsg
             Success v -> return $ Right v
-          err -> return $ Left $ ErrorCall $
+        err ->
-                    "exec  failed: " ++ show err ++ " " ++ emsg
+          return
+            $  Left
+            $  ErrorCall
+            $  "exec  failed: "
+            ++ show err
+            ++ " "
+            ++ emsg
 
 class Monad m => MonadInstantiate m where
     instantiateExpr :: String -> m (Either ErrorCall NExprLoc)
@@ -106,20 +118,28 @@ class Monad m => MonadInstantiate m where
 
 instance MonadInstantiate IO where
   instantiateExpr expr = do
-        traceM $ "Executing: "
+    traceM $ "Executing: " ++ show
-            ++ show ["nix-instantiate", "--eval", "--expr ", expr]
+      ["nix-instantiate", "--eval", "--expr ", expr]
-        (exitCode, out, err) <-
+    (exitCode, out, err) <- readProcessWithExitCode "nix-instantiate"
-            readProcessWithExitCode "nix-instantiate"
+                                                    ["--eval", "--expr", expr]
-                [ "--eval", "--expr", expr] ""
+                                                    ""
     case exitCode of
       ExitSuccess -> case parseNixTextLoc (T.pack out) of
         Failure e ->
-                    return $ Left $ ErrorCall $
+          return
-                        "Error parsing output of nix-instantiate: " ++ show e
+            $  Left
+            $  ErrorCall
+            $  "Error parsing output of nix-instantiate: "
+            ++ show e
         Success v -> return $ Right v
       status ->
-                return $ Left $ ErrorCall $ "nix-instantiate failed: " ++ show status
+        return
-                    ++ ": " ++ err
+          $  Left
+          $  ErrorCall
+          $  "nix-instantiate failed: "
+          ++ show status
+          ++ ": "
+          ++ err
 
 pathExists :: MonadFile m => FilePath -> m Bool
 pathExists = doesFileExist
@@ -140,7 +160,7 @@ instance MonadEnv IO where
 
   getCurrentSystemOS   = return $ T.pack System.Info.os
 
-    -- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4
+-- Invert the conversion done by GHC_CONVERT_CPU in GHC's aclocal.m4
   getCurrentSystemArch = return $ T.pack $ case System.Info.arch of
     "i386" -> "i686"
     arch   -> arch
@@ -155,20 +175,28 @@ instance MonadHttp IO where
     let urlstr = T.unpack url
     traceM $ "fetching HTTP URL: " ++ urlstr
     req     <- parseRequest urlstr
-        manager <-
+    manager <- if secure req
-          if secure req
       then newTlsManager
       else newManager defaultManagerSettings
     -- print req
     response <- httpLbs (req { method = "GET" }) manager
     let status = statusCode (responseStatus response)
     if status /= 200
-          then return $ Left $ ErrorCall $
+      then
-                 "fail, got " ++ show status ++ " when fetching url:" ++ urlstr
+        return
+        $  Left
+        $  ErrorCall
+        $  "fail, got "
+        ++ show status
+        ++ " when fetching url:"
+        ++ urlstr
       else -- do
         -- let bstr = responseBody response
-            return $ Left $ ErrorCall $
+        return
-              "success in downloading but hnix-store is not yet ready; url = " ++ urlstr
+        $  Left
+        $  ErrorCall
+        $  "success in downloading but hnix-store is not yet ready; url = "
+        ++ urlstr
 
 
 class Monad m => MonadPutStr m where
@@ -179,7 +207,7 @@ class Monad m => MonadPutStr m where
     putStr = lift . putStr
 
 putStrLn :: MonadPutStr m => String -> m ()
-putStrLn = putStr . (++"\n")
+putStrLn = putStr . (++ "\n")
 
 print :: (MonadPutStr m, Show a) => a -> m ()
 print = putStrLn . show
@@ -196,16 +224,19 @@ class Monad m => MonadStore m where
 
 instance MonadStore IO where
   addPath' path = do
-        (exitCode, out, _) <-
+    (exitCode, out, _) <- readProcessWithExitCode "nix-store" ["--add", path] ""
-            readProcessWithExitCode "nix-store" ["--add", path] ""
     case exitCode of
       ExitSuccess -> do
         let dropTrailingLinefeed p = take (length p - 1) p
         return $ Right $ StorePath $ dropTrailingLinefeed out
-          _ -> return $ Left $ ErrorCall $
+      _ ->
-                  "addPath: failed: nix-store --add " ++ show path
+        return
+          $  Left
+          $  ErrorCall
+          $  "addPath: failed: nix-store --add "
+          ++ show path
 
-    --TODO: Use a temp directory so we don't overwrite anything important
+--TODO: Use a temp directory so we don't overwrite anything important
   toFile_' filepath content = do
     writeFile filepath content
     storepath <- addPath' filepath
@@ -217,3 +248,10 @@ addPath p = either throwError return =<< addPath' p
 
 toFile_ :: (Framed e m, MonadStore m) => FilePath -> String -> m StorePath
 toFile_ p contents = either throwError return =<< toFile_' p contents
+
+
+
+
+
+
+

src/Nix/Eval.hs

@@ -18,24 +18,26 @@ import           Control.Monad
 import           Control.Monad.Fix
 import           Control.Monad.Reader
 import           Control.Monad.State.Strict
-import           Data.Align.Key (alignWithKey)
+import           Data.Align.Key                 ( alignWithKey )
-import           Data.Either (isRight)
+import           Data.Either                    ( isRight )
-import           Data.Fix (Fix(Fix))
+import           Data.Fix                       ( Fix(Fix) )
-import           Data.HashMap.Lazy (HashMap)
+import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
-import           Data.List (partition)
+import           Data.List                      ( partition )
-import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.List.NonEmpty             ( NonEmpty(..) )
-import           Data.Maybe (fromMaybe, catMaybes)
+import           Data.Maybe                     ( fromMaybe
-import           Data.Text (Text)
+                                                , catMaybes
-import           Data.These (These(..))
+                                                )
-import           Data.Traversable (for)
+import           Data.Text                      ( Text )
+import           Data.These                     ( These(..) )
+import           Data.Traversable               ( for )
 import           Nix.Atoms
 import           Nix.Convert
 import           Nix.Expr
 import           Nix.Frames
 import           Nix.String
 import           Nix.Scope
-import           Nix.Strings (runAntiquoted)
+import           Nix.Strings                    ( runAntiquoted )
 import           Nix.Thunk
 import           Nix.Utils
 
@@ -77,16 +79,17 @@ class (Show v, Monad m) => MonadEval v m where
 -}
     evalError :: Exception s => s -> m a
 
-type MonadNixEval v t m =
+type MonadNixEval v t m
-    (MonadEval v m,
+  = ( MonadEval v m
-     Scoped t m,
+  , Scoped t m
-     MonadThunk t m v,
+  , MonadThunk t m v
-     MonadFix m,
+  , MonadFix m
-     ToValue Bool m v,
+  , ToValue Bool m v
-     ToValue [t] m v,
+  , ToValue [t] m v
-     FromValue NixString m v,
+  , FromValue NixString m v
-     ToValue (AttrSet t, AttrSet SourcePos) m v,
+  , ToValue (AttrSet t, AttrSet SourcePos) m v
-     FromValue (AttrSet t, AttrSet SourcePos) m v)
+  , FromValue (AttrSet t, AttrSet SourcePos) m v
+  )
 
 data EvalFrame m t
     = EvaluatingExpr (Scopes m t) NExprLoc
@@ -104,18 +107,18 @@ data SynHoleInfo m t = SynHoleInfo
 
 instance (Typeable m, Typeable t) => Exception (SynHoleInfo m t)
 
-eval :: forall v t m. MonadNixEval v t m => NExprF (m v) -> m v
+eval :: forall v t m . MonadNixEval v t m => NExprF (m v) -> m v
 
 eval (NSym "__curPos") = evalCurPos
 
-eval (NSym var) =
+eval (NSym var       ) = (lookupVar var :: m (Maybe t))
-    (lookupVar var :: m (Maybe t)) >>= maybe (freeVariable var) (force ?? evaledSym var)
+  >>= maybe (freeVariable var) (force ?? evaledSym var)
 
-eval (NConstant x)    = evalConstant x
+eval (NConstant    x      ) = evalConstant x
-eval (NStr str)       = evalString str
+eval (NStr         str    ) = evalString str
-eval (NLiteralPath p) = evalLiteralPath p
+eval (NLiteralPath p      ) = evalLiteralPath p
-eval (NEnvPath p)     = evalEnvPath p
+eval (NEnvPath     p      ) = evalEnvPath p
-eval (NUnary op arg)  = evalUnary op =<< arg
+eval (NUnary op arg       ) = evalUnary op =<< arg
 
 eval (NBinary NApp fun arg) = do
   scope <- currentScopes :: m (Scopes m t)
@@ -123,13 +126,12 @@ eval (NBinary NApp fun arg) = do
 
 eval (NBinary op   larg rarg) = larg >>= evalBinary op ?? rarg
 
-eval (NSelect aset attr alt) = evalSelect aset attr >>= either go id
+eval (NSelect aset attr alt ) = evalSelect aset attr >>= either go id
-  where
+  where go (s, ks) = fromMaybe (attrMissing ks (Just s)) alt
-    go (s, ks) = fromMaybe (attrMissing ks (Just s)) alt
 
 eval (NHasAttr aset attr) = evalSelect aset attr >>= toValue . isRight
 
-eval (NList l) = do
+eval (NList l           ) = do
   scope <- currentScopes
   for l (thunk @t @m @v . withScopes @t scope) >>= toValue
 
@@ -139,9 +141,9 @@ eval (NSet binds) =
 eval (NRecSet binds) =
   evalBinds True (desugarBinds (eval . NSet) binds) >>= toValue
 
-eval (NLet binds body) = evalBinds True binds >>= (pushScope ?? body) . fst
+eval (NLet binds body    ) = evalBinds True binds >>= (pushScope ?? body) . fst
 
-eval (NIf cond t f) = cond >>= \v -> evalIf v t f
+eval (NIf cond t f       ) = cond >>= \v -> evalIf v t f
 
 eval (NWith   scope  body) = evalWith scope body
 
@@ -161,7 +163,7 @@ eval (NSynHole name) = synHole name
 
 -- | If you know that the 'scope' action will result in an 'AttrSet t', then
 --   this implementation may be used as an implementation for 'evalWith'.
-evalWithAttrSet :: forall v t m. MonadNixEval v t m => m v -> m v -> m v
+evalWithAttrSet :: forall v t m . MonadNixEval v t m => m v -> m v -> m v
 evalWithAttrSet aset body = do
     -- The scope is deliberately wrapped in a thunk here, since it is
     -- evaluated each time a name is looked up within the weak scope, and
@@ -169,10 +171,15 @@ evalWithAttrSet aset body = do
     -- its value is only computed once.
   scope <- currentScopes :: m (Scopes m t)
   s     <- thunk @t @m @v $ withScopes scope aset
-    pushWeakScope ?? body $ force s $
+  pushWeakScope
-        fmap fst . fromValue @(AttrSet t, AttrSet SourcePos)
+    ?? body
+    $  force s
+    $  fmap fst
+    .  fromValue @(AttrSet t, AttrSet SourcePos)
 
-attrSetAlter :: forall v t m. MonadNixEval v t m
+attrSetAlter
+  :: forall v t m
+   . MonadNixEval v t m
   => [Text]
   -> SourcePos
   -> AttrSet (m v)
@@ -182,48 +189,59 @@ attrSetAlter :: forall v t m. MonadNixEval v t m
 attrSetAlter [] _ _ _ _ =
   evalError @v $ ErrorCall "invalid selector with no components"
 
-attrSetAlter (k:ks) pos m p val = case M.lookup k m of
+attrSetAlter (k : ks) pos m p val = case M.lookup k m of
   Nothing | null ks   -> go
           | otherwise -> recurse M.empty M.empty
-    Just x  | null ks   -> go
+  Just x
-            | otherwise ->
+    | null ks
-                x >>= fromValue @(AttrSet t, AttrSet SourcePos)
+    -> go
-                  >>= \(st, sp) -> recurse (force ?? pure <$> st) sp
+    | otherwise
+    -> x >>= fromValue @(AttrSet t, AttrSet SourcePos) >>= \(st, sp) ->
+      recurse (force ?? pure <$> st) sp
  where
   go = return (M.insert k val m, M.insert k pos p)
 
   recurse st sp = attrSetAlter ks pos st sp val <&> \(st', _) ->
-        ( M.insert k (toValue @(AttrSet t, AttrSet SourcePos)
+    ( M.insert
-                         =<< (, mempty) . fmap wrapValue <$> sequence st') st
+      k
-        , M.insert k pos sp )
+      (   toValue @(AttrSet t, AttrSet SourcePos)
+      =<< (, mempty)
+      .   fmap wrapValue
+      <$> sequence st'
+      )
+      st
+    , M.insert k pos sp
+    )
 
-desugarBinds :: forall r. ([Binding r] -> r) -> [Binding r] -> [Binding r]
+desugarBinds :: forall r . ([Binding r] -> r) -> [Binding r] -> [Binding r]
 desugarBinds embed binds = evalState (mapM (go <=< collect) binds) M.empty
  where
-    collect :: Binding r
+  collect
-            -> State (HashMap VarName (SourcePos, [Binding r]))
+    :: Binding r
+    -> State
+         (HashMap VarName (SourcePos, [Binding r]))
          (Either VarName (Binding r))
-    collect (NamedVar (StaticKey x :| y:ys) val p) = do
+  collect (NamedVar (StaticKey x :| y : ys) val p) = do
     m <- get
     put $ M.insert x ?? m $ case M.lookup x m of
-            Nothing     -> (p, [NamedVar (y:|ys) val p])
+      Nothing     -> (p, [NamedVar (y :| ys) val p])
-            Just (q, v) -> (q, NamedVar (y:|ys) val q : v)
+      Just (q, v) -> (q, NamedVar (y :| ys) val q : v)
     pure $ Left x
   collect x = pure $ Right x
 
-    go :: Either VarName (Binding r)
+  go
-       -> State (HashMap VarName (SourcePos, [Binding r]))
+    :: Either VarName (Binding r)
-                (Binding r)
+    -> State (HashMap VarName (SourcePos, [Binding r])) (Binding r)
   go (Right x) = pure x
   go (Left  x) = do
     maybeValue <- gets (M.lookup x)
     case maybeValue of
-          Nothing ->
+      Nothing     -> fail ("No binding " ++ show x)
-            fail ("No binding " ++ show x)
+      Just (p, v) -> pure $ NamedVar (StaticKey x :| []) (embed v) p
-          Just (p, v) ->
-            pure $ NamedVar (StaticKey x :| []) (embed v) p
 
-evalBinds :: forall v t m. MonadNixEval v t m
+evalBinds
+  :: forall v t m
+   . MonadNixEval v t m
   => Bool
   -> [Binding (m v)]
   -> m (AttrSet t, AttrSet SourcePos)
@@ -231,17 +249,18 @@ evalBinds recursive binds = do
   scope <- currentScopes :: m (Scopes m t)
   buildResult scope . concat =<< mapM (go scope) (moveOverridesLast binds)
  where
-    moveOverridesLast = uncurry (++) .
+  moveOverridesLast = uncurry (++) . partition
-        partition (\case
+    (\case
       NamedVar (StaticKey "__overrides" :| []) _ _pos -> False
-            _ -> True)
+      _ -> True
+    )
 
   go :: Scopes m t -> Binding (m v) -> m [([Text], SourcePos, m v)]
   go _ (NamedVar (StaticKey "__overrides" :| []) finalValue pos) =
     finalValue >>= fromValue >>= \(o', p') ->
           -- jww (2018-05-09): What to do with the key position here?
-            return $ map (\(k, v) -> ([k], fromMaybe pos (M.lookup k p'),
+                                              return $ map
-                                     force @t @m @v v pure))
+      (\(k, v) -> ([k], fromMaybe pos (M.lookup k p'), force @t @m @v v pure))
       (M.toList o')
 
   go _ (NamedVar pathExpr finalValue pos) = do
@@ -249,13 +268,15 @@ evalBinds recursive binds = do
         go = \case
           h :| t -> evalSetterKeyName h >>= \case
             Nothing ->
-                        pure ([], nullPos,
+              pure
-                              toValue @(AttrSet t, AttrSet SourcePos)
+                ( []
-                                  (mempty, mempty))
+                , nullPos
+                , toValue @(AttrSet t, AttrSet SourcePos) (mempty, mempty)
+                )
             Just k -> case t of
               []     -> pure ([k], pos, finalValue)
-                        x:xs -> do
+              x : xs -> do
-                            (restOfPath, _, v) <- go (x:|xs)
+                (restOfPath, _, v) <- go (x :| xs)
                 pure (k : restOfPath, pos, v)
     go pathExpr <&> \case
         -- When there are no path segments, e.g. `${null} = 5;`, we don't
@@ -263,28 +284,30 @@ evalBinds recursive binds = do
       ([], _, _) -> []
       result     -> [result]
 
-    go scope (Inherit ms names pos) = fmap catMaybes $ forM names $
+  go scope (Inherit ms names pos) =
-        evalSetterKeyName >=> \case
+    fmap catMaybes $ forM names $ evalSetterKeyName >=> \case
       Nothing  -> pure Nothing
-            Just key -> pure $ Just ([key], pos, do
+      Just key -> pure $ Just
+        ( [key]
+        , pos
+        , do
           mv <- case ms of
             Nothing -> withScopes scope $ lookupVar key
-                    Just s -> s
+            Just s ->
-                        >>= fromValue @(AttrSet t, AttrSet SourcePos)
+              s >>= fromValue @(AttrSet t, AttrSet SourcePos) >>= \(s, _) ->
-                        >>= \(s, _) ->
                 clearScopes @t $ pushScope s $ lookupVar key
           case mv of
             Nothing -> attrMissing (key :| []) Nothing
-                    Just v -> force v pure)
+            Just v  -> force v pure
+        )
 
-    buildResult :: Scopes m t
+  buildResult
+    :: Scopes m t
     -> [([Text], SourcePos, m v)]
     -> m (AttrSet t, AttrSet SourcePos)
   buildResult scope bindings = do
     (s, p) <- foldM insert (M.empty, M.empty) bindings
-        res <- if recursive
+    res <- if recursive then loebM (encapsulate <$> s) else traverse mkThunk s
-               then loebM (encapsulate <$> s)
-               else traverse mkThunk s
     return (res, p)
    where
     mkThunk = thunk . withScopes scope
@@ -293,7 +316,9 @@ evalBinds recursive binds = do
 
     insert (m, p) (path, pos, value) = attrSetAlter path pos m p value
 
-evalSelect :: forall v t m. MonadNixEval v t m
+evalSelect
+  :: forall v t m
+   . MonadNixEval v t m
   => m v
   -> NAttrPath (m v)
   -> m (Either (v, NonEmpty Text) (m v))
@@ -302,92 +327,116 @@ evalSelect aset attr = do
   path <- traverse evalGetterKeyName attr
   extract s path
  where
-    extract x path@(k:|ks) = fromValueMay x >>= \case
+  extract x path@(k :| ks) = fromValueMay x >>= \case
     Just (s :: AttrSet t, p :: AttrSet SourcePos)
       | Just t <- M.lookup k s -> case ks of
         []     -> pure $ Right $ force t pure
-                y:ys -> force t $ extract ?? (y:|ys)
+        y : ys -> force t $ extract ?? (y :| ys)
       | otherwise -> Left . (, path) <$> toValue (s, p)
     Nothing -> return $ Left (x, path)
 
 -- | Evaluate a component of an attribute path in a context where we are
 -- *retrieving* a value
-evalGetterKeyName :: forall v m. (MonadEval v m, FromValue NixString m v)
+evalGetterKeyName
-                  => NKeyName (m v) -> m Text
+  :: forall v m
+   . (MonadEval v m, FromValue NixString m v)
+  => NKeyName (m v)
+  -> m Text
 evalGetterKeyName = evalSetterKeyName >=> \case
   Just k -> pure k
-    Nothing -> evalError @v $ ErrorCall "value is null while a string was expected"
+  Nothing ->
+    evalError @v $ ErrorCall "value is null while a string was expected"
 
 -- | Evaluate a component of an attribute path in a context where we are
 -- *binding* a value
-evalSetterKeyName :: (MonadEval v m, FromValue NixString m v)
+evalSetterKeyName
-                  => NKeyName (m v) -> m (Maybe Text)
+  :: (MonadEval v m, FromValue NixString m v)
+  => NKeyName (m v)
+  -> m (Maybe Text)
 evalSetterKeyName = \case
   StaticKey k -> pure (Just k)
   DynamicKey k ->
-        runAntiquoted "\n" assembleString (>>= fromValueMay) k <&>
+    runAntiquoted "\n" assembleString (>>= fromValueMay) k <&> \case
-            \case Just ns -> Just (hackyStringIgnoreContext ns)
+      Just ns -> Just (hackyStringIgnoreContext ns)
       _       -> Nothing
 
-assembleString :: forall v m. (MonadEval v m, FromValue NixString m v)
+assembleString
-               => NString (m v) -> m (Maybe NixString)
+  :: forall v m
+   . (MonadEval v m, FromValue NixString m v)
+  => NString (m v)
+  -> m (Maybe NixString)
 assembleString = \case
   Indented _ parts   -> fromParts parts
   DoubleQuoted parts -> fromParts parts
  where
   fromParts = fmap (fmap principledStringMConcat . sequence) . traverse go
 
-    go = runAntiquoted "\n" (pure . Just . principledMakeNixStringWithoutContext) (>>= fromValueMay)
+  go = runAntiquoted "\n"
+                     (pure . Just . principledMakeNixStringWithoutContext)
+                     (>>= fromValueMay)
 
-buildArgument :: forall v t m. MonadNixEval v t m
+buildArgument
-              => Params (m v) -> m v -> m (AttrSet t)
+  :: forall v t m . MonadNixEval v t m => Params (m v) -> m v -> m (AttrSet t)
 buildArgument params arg = do
   scope <- currentScopes :: m (Scopes m t)
   case params of
     Param name -> M.singleton name <$> thunk (withScopes scope arg)
     ParamSet s isVariadic m ->
-            arg >>= fromValue @(AttrSet t, AttrSet SourcePos)
+      arg >>= fromValue @(AttrSet t, AttrSet SourcePos) >>= \(args, _) -> do
-                >>= \(args, _) -> do
         let inject = case m of
               Nothing -> id
-                        Just n -> M.insert n $ const $
+              Just n  -> M.insert n $ const $ thunk (withScopes scope arg)
-                            thunk (withScopes scope arg)
+        loebM
-                loebM (inject $ M.mapMaybe id $ alignWithKey (assemble scope isVariadic)
+          (inject $ M.mapMaybe id $ alignWithKey (assemble scope isVariadic)
-                                             args (M.fromList s))
+                                                 args
+                                                 (M.fromList s)
+          )
  where
-    assemble :: Scopes m t
+  assemble
+    :: Scopes m t
     -> Bool
     -> Text
     -> These t (Maybe (m v))
     -> Maybe (AttrSet t -> m t)
   assemble scope isVariadic k = \case
-        That Nothing  -> Just $
+    That Nothing ->
-            const $ evalError @v $ ErrorCall $
+      Just
-                "Missing value for parameter: " ++ show k
+        $  const
-        That (Just f) -> Just $ \args ->
+        $  evalError @v
-            thunk $ withScopes scope $ pushScope args f
+        $  ErrorCall
-        This _ | isVariadic -> Nothing
+        $  "Missing value for parameter: "
-               | otherwise  -> Just $
+        ++ show k
-                 const $ evalError @v $ ErrorCall $
+    That (Just f) ->
-                     "Unexpected parameter: " ++ show k
+      Just $ \args -> thunk $ withScopes scope $ pushScope args f
+    This _
+      | isVariadic
+      -> Nothing
+      | otherwise
+      -> Just
+        $  const
+        $  evalError @v
+        $  ErrorCall
+        $  "Unexpected parameter: "
+        ++ show k
     These x _ -> Just (const (pure x))
 
-addSourcePositions :: (MonadReader e m, Has e SrcSpan)
+addSourcePositions
-                   => Transform NExprLocF (m a)
+  :: (MonadReader e m, Has e SrcSpan) => Transform NExprLocF (m a)
 addSourcePositions f v@(Fix (Compose (Ann ann _))) =
   local (set hasLens ann) (f v)
 
 addStackFrames
-    :: forall t e m a. (Scoped t m, Framed e m, Typeable t, Typeable m)
+  :: forall t e m a
+   . (Scoped t m, Framed e m, Typeable t, Typeable m)
   => Transform NExprLocF (m a)
 addStackFrames f v = do
   scopes <- currentScopes :: m (Scopes m t)
   withFrame Info (EvaluatingExpr scopes v) (f v)
 
 framedEvalExprLoc
-    :: forall t e v m.
+  :: forall t e v m
-      (MonadNixEval v t m, Framed e m, Has e SrcSpan,
+   . (MonadNixEval v t m, Framed e m, Has e SrcSpan, Typeable t, Typeable m)
-       Typeable t, Typeable m)
+  => NExprLoc
-    => NExprLoc -> m v
+  -> m v
-framedEvalExprLoc = adi (eval . annotated . getCompose)
+framedEvalExprLoc =
-                        (addStackFrames @t . addSourcePositions)
+  adi (eval . annotated . getCompose) (addStackFrames @t . addSourcePositions)

src/Nix/Exec.hs

@@ -26,25 +26,29 @@
 
 module Nix.Exec where
 
-import           Prelude hiding (putStr, putStrLn, print)
+import           Prelude                 hiding ( putStr
+                                                , putStrLn
+                                                , print
+                                                )
 
 import           Control.Applicative
 import           Control.Monad
-import           Control.Monad.Catch hiding (catchJust)
+import           Control.Monad.Catch     hiding ( catchJust )
 import           Control.Monad.Fix
 import           Control.Monad.Reader
 import           Control.Monad.Ref
 import           Control.Monad.State.Strict
-import           Control.Monad.Trans.Reader (ReaderT(..))
+import           Control.Monad.Trans.Reader     ( ReaderT(..) )
-import           Control.Monad.Trans.State.Strict (StateT(..))
+import           Control.Monad.Trans.State.Strict
+                                                ( StateT(..) )
 import           Data.Fix
-import           Data.HashMap.Lazy (HashMap)
+import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
 import           Data.List
 import qualified Data.List.NonEmpty            as NE
 import           Data.List.Split
-import           Data.Maybe (maybeToList)
+import           Data.Maybe                     ( maybeToList )
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
 import           Data.Text.Prettyprint.Doc
 import           Data.Typeable
@@ -67,7 +71,7 @@ import           Nix.Thunk
 import           Nix.Utils
 import           Nix.Value
 #ifdef MIN_VERSION_haskeline
-import           System.Console.Haskeline.MonadException hiding (catch)
+import           System.Console.Haskeline.MonadException hiding(catch)
 #endif
 import           System.FilePath
 #ifdef MIN_VERSION_pretty_show
@@ -80,54 +84,52 @@ import           GHC.DataSize
 #endif
 #endif
 
-type Cited t f m =
+type Cited t f m = (HasCitations1 t f m, MonadDataContext f m)
-    ( HasCitations1 t f m
-    , MonadDataContext f m
-    )
 
-nvConstantP :: Cited t f m
+nvConstantP :: Cited t f m => Provenance t f m -> NAtom -> NValue t f m
-            => Provenance t f m -> NAtom -> NValue t f m
 nvConstantP p x = addProvenance p (nvConstant x)
 
-nvStrP :: Cited t f m
+nvStrP :: Cited t f m => Provenance t f m -> NixString -> NValue t f m
-       => Provenance t f m -> NixString -> NValue t f m
 nvStrP p ns = addProvenance p (nvStr ns)
 
-nvPathP :: Cited t f m
+nvPathP :: Cited t f m => Provenance t f m -> FilePath -> NValue t f m
-        => Provenance t f m -> FilePath -> NValue t f m
 nvPathP p x = addProvenance p (nvPath x)
 
-nvListP :: Cited t f m
+nvListP :: Cited t f m => Provenance t f m -> [t] -> NValue t f m
-        => Provenance t f m -> [t] -> NValue t f m
 nvListP p l = addProvenance p (nvList l)
 
-nvSetP :: Cited t f m
+nvSetP
-       => Provenance t f m -> AttrSet t -> AttrSet SourcePos
+  :: Cited t f m
+  => Provenance t f m
+  -> AttrSet t
+  -> AttrSet SourcePos
   -> NValue t f m
 nvSetP p s x = addProvenance p (nvSet s x)
 
-nvClosureP :: Cited t f m
+nvClosureP
+  :: Cited t f m
   => Provenance t f m
   -> Params ()
   -> (m (NValue t f m) -> m t)
   -> NValue t f m
 nvClosureP p x f = addProvenance p (nvClosure x f)
 
-nvBuiltinP :: Cited t f m
+nvBuiltinP
+  :: Cited t f m
   => Provenance t f m
   -> String
   -> (m (NValue t f m) -> m t)
   -> NValue t f m
 nvBuiltinP p name f = addProvenance p (nvBuiltin name f)
 
-type MonadCitedThunks t f m =
+type MonadCitedThunks t f m
-    ( MonadThunk t m (NValue t f m)
+  = ( MonadThunk t m (NValue t f m)
   , MonadDataErrorContext t f m
   , HasCitations1 t f m
   )
 
-type MonadNix e t f m =
+type MonadNix e t f m
-    ( Has e SrcSpan
+  = ( Has e SrcSpan
   , Has e Options
   , Scoped t m
   , Framed e m
@@ -145,12 +147,13 @@ data ExecFrame t f m = Assertion SrcSpan (NValue t f m)
 instance MonadDataErrorContext t f m => Exception (ExecFrame t f m)
 
 nverr
-    :: forall e t f s m a.
+  :: forall e t f s m a
-    (MonadNix e t f m, FromValue NixString m t, Exception s)
+   . (MonadNix e t f m, FromValue NixString m t, Exception s)
-    => s -> m a
+  => s
+  -> m a
 nverr = evalError @(NValue t f m)
 
-currentPos :: forall e m. (MonadReader e m, Has e SrcSpan) => m SrcSpan
+currentPos :: forall e m . (MonadReader e m, Has e SrcSpan) => m SrcSpan
 currentPos = asks (view hasLens)
 
 wrapExprLoc :: SrcSpan -> NExprLocF r -> NExprLoc
@@ -159,8 +162,12 @@ wrapExprLoc span x = Fix (Fix (NSym_ span "<?>") <$ x)
 instance ( MonadNix e t f m
          , FromValue NixString m t
          ) => MonadEval (NValue t f m) m where
-    freeVariable var = nverr @e @t @f $
+  freeVariable var =
-        ErrorCall $ "Undefined variable '" ++ Text.unpack var ++ "'"
+    nverr @e @t @f
+      $  ErrorCall
+      $  "Undefined variable '"
+      ++ Text.unpack var
+      ++ "'"
 
   synHole name = do
     span  <- currentPos
@@ -171,15 +178,19 @@ instance ( MonadNix e t f m
       }
 
   attrMissing ks Nothing =
-        evalError @(NValue t f m) $ ErrorCall $
+    evalError @(NValue t f m)
-            "Inheriting unknown attribute: "
+      $  ErrorCall
+      $  "Inheriting unknown attribute: "
       ++ intercalate "." (map Text.unpack (NE.toList ks))
 
   attrMissing ks (Just s) = do
     s' <- prettyNValue s
-        evalError @(NValue t f m) $ ErrorCall $ "Could not look up attribute "
+    evalError @(NValue t f m)
+      $  ErrorCall
+      $  "Could not look up attribute "
       ++ intercalate "." (map Text.unpack (NE.toList ks))
-            ++ " in " ++ show s'
+      ++ " in "
+      ++ show s'
 
   evalCurPos = do
     scope                  <- currentScopes
@@ -201,14 +212,19 @@ instance ( MonadNix e t f m
     Just ns -> do
       scope <- currentScopes
       span  <- currentPos
-            pure $ nvStrP (Provenance scope
+      pure $ nvStrP
-                           (NStr_ span (DoubleQuoted [Plain (hackyStringIgnoreContext ns)]))) ns
+        (Provenance
+          scope
+          (NStr_ span (DoubleQuoted [Plain (hackyStringIgnoreContext ns)]))
+        )
+        ns
     Nothing -> nverr $ ErrorCall "Failed to assemble string"
 
   evalLiteralPath p = do
     scope <- currentScopes
     span  <- currentPos
-        nvPathP (Provenance scope (NLiteralPath_ span p)) <$> makeAbsolutePath @t @f @m p
+    nvPathP (Provenance scope (NLiteralPath_ span p))
+      <$> makeAbsolutePath @t @f @m p
 
   evalEnvPath p = do
     scope <- currentScopes
@@ -234,17 +250,29 @@ instance ( MonadNix e t f m
   evalIf c t f = do
     scope <- currentScopes
     span  <- currentPos
-        fromValue c >>= \b ->
+    fromValue c >>= \b -> if b
-            if b
+      then
-            then (\t -> addProvenance (Provenance scope (NIf_ span (Just c) (Just t) Nothing)) t) <$> t
+        (\t -> addProvenance
-            else (\f -> addProvenance (Provenance scope (NIf_ span (Just c) Nothing (Just f))) f) <$> f
+            (Provenance scope (NIf_ span (Just c) (Just t) Nothing))
+            t
+          )
+          <$> t
+      else
+        (\f -> addProvenance
+            (Provenance scope (NIf_ span (Just c) Nothing (Just f)))
+            f
+          )
+          <$> f
 
   evalAssert c body = fromValue c >>= \b -> do
     span <- currentPos
     if b
       then do
         scope <- currentScopes
-                (\b -> addProvenance (Provenance scope (NAssert_ span (Just c) (Just b))) b) <$> body
+        (\b ->
+            addProvenance (Provenance scope (NAssert_ span (Just c) (Just b))) b
+          )
+          <$> body
       else nverr $ Assertion span c
 
   evalApp f x = do
@@ -256,18 +284,24 @@ instance ( MonadNix e t f m
   evalAbs p k = do
     scope <- currentScopes
     span  <- currentPos
-        pure $ nvClosureP (Provenance scope (NAbs_ span (Nothing <$ p) Nothing))
+    pure $ nvClosureP
-            (void p) (\arg -> wrapValue . snd <$> k arg (\_ b -> ((),) <$> b))
+      (Provenance scope (NAbs_ span (Nothing <$ p) Nothing))
+      (void p)
+      (\arg -> wrapValue . snd <$> k arg (\_ b -> ((), ) <$> b))
 
   evalError = throwError
 
 infixl 1 `callFunc`
-callFunc :: forall e t f m. MonadNix e t f m
+callFunc
-         => NValue t f m -> m (NValue t f m) -> m (NValue t f m)
+  :: forall e t f m
+   . MonadNix e t f m
+  => NValue t f m
+  -> m (NValue t f m)
+  -> m (NValue t f m)
 callFunc fun arg = do
   frames :: Frames <- asks (view hasLens)
-    when (length frames > 2000) $
+  when (length frames > 2000) $ throwError $ ErrorCall
-        throwError $ ErrorCall "Function call stack exhausted"
+    "Function call stack exhausted"
   case fun of
     NVClosure params f -> do
       traceM $ "callFunc:NVFunction taking " ++ show params
@@ -280,28 +314,37 @@ callFunc fun arg = do
       force f $ (`callFunc` pure s) >=> (`callFunc` arg)
     x -> throwError $ ErrorCall $ "Attempt to call non-function: " ++ show x
 
-execUnaryOp :: (Framed e m, Cited t f m, Show t)
+execUnaryOp
-            => Scopes m t -> SrcSpan -> NUnaryOp -> NValue t f m
+  :: (Framed e m, Cited t f m, Show t)
+  => Scopes m t
+  -> SrcSpan
+  -> NUnaryOp
+  -> NValue t f m
   -> m (NValue t f m)
 execUnaryOp scope span op arg = do
   traceM "NUnary"
   case arg of
     NVConstant c -> case (op, c) of
-            (NNeg, NInt   i) -> unaryOp $ NInt   (-i)
+      (NNeg, NInt i  ) -> unaryOp $ NInt (-i)
       (NNeg, NFloat f) -> unaryOp $ NFloat (-f)
-            (NNot, NBool  b) -> unaryOp $ NBool  (not b)
+      (NNot, NBool b ) -> unaryOp $ NBool (not b)
-            _ -> throwError $ ErrorCall $
+      _ ->
-                "unsupported argument type for unary operator " ++ show op
+        throwError
-        x -> throwError $ ErrorCall $ "argument to unary operator"
+          $  ErrorCall
-                ++ " must evaluate to an atomic type: " ++ show x
+          $  "unsupported argument type for unary operator "
+          ++ show op
+    x ->
+      throwError
+        $  ErrorCall
+        $  "argument to unary operator"
+        ++ " must evaluate to an atomic type: "
+        ++ show x
  where
   unaryOp = pure . nvConstantP (Provenance scope (NUnary_ span op (Just arg)))
 
 execBinaryOp
-    :: forall e t f m.
+  :: forall e t f m
-    (MonadNix e t f m,
+   . (MonadNix e t f m, FromValue NixString m t, MonadEval (NValue t f m) m)
-     FromValue NixString m t,
-     MonadEval (NValue t f m) m)
   => Scopes m t
   -> SrcSpan
   -> NBinaryOp
@@ -309,21 +352,21 @@ execBinaryOp
   -> m (NValue t f m)
   -> m (NValue t f m)
 
-execBinaryOp scope span NOr larg rarg = fromNix larg >>= \l ->
+execBinaryOp scope span NOr larg rarg = fromNix larg >>= \l -> if l
-    if l
   then orOp Nothing True
   else rarg >>= \rval -> fromNix @Bool rval >>= orOp (Just rval)
  where
-    orOp r b = pure $
+  orOp r b = pure $ nvConstantP
-        nvConstantP (Provenance scope (NBinary_ span NOr (Just larg) r)) (NBool b)
+    (Provenance scope (NBinary_ span NOr (Just larg) r))
+    (NBool b)
 
-execBinaryOp scope span NAnd larg rarg = fromNix larg >>= \l ->
+execBinaryOp scope span NAnd larg rarg = fromNix larg >>= \l -> if l
-    if l
   then rarg >>= \rval -> fromNix @Bool rval >>= andOp (Just rval)
   else andOp Nothing False
  where
-    andOp r b = pure $
+  andOp r b = pure $ nvConstantP
-        nvConstantP (Provenance scope (NBinary_ span NAnd (Just larg) r)) (NBool b)
+    (Provenance scope (NBinary_ span NAnd (Just larg) r))
+    (NBool b)
 
 execBinaryOp scope span op lval rarg = do
   rval <- rarg
@@ -332,22 +375,21 @@ execBinaryOp scope span op lval rarg = do
       toBool = pure . bin nvConstantP . NBool
   case (lval, rval) of
     (NVConstant lc, NVConstant rc) -> case (op, lc, rc) of
-            (NEq,  _, _)       -> toBool =<< valueEqM lval rval
+      (NEq , _, _) -> toBool =<< valueEqM lval rval
       (NNEq, _, _) -> toBool . not =<< valueEqM lval rval
-            (NLt,  l, r)       -> toBool $ l <  r
+      (NLt , l, r) -> toBool $ l < r
       (NLte, l, r) -> toBool $ l <= r
-            (NGt,  l, r)       -> toBool $ l >  r
+      (NGt , l, r) -> toBool $ l > r
       (NGte, l, r) -> toBool $ l >= r
       (NAnd, _, _) ->
         nverr $ ErrorCall "should be impossible: && is handled above"
       (NOr, _, _) ->
         nverr $ ErrorCall "should be impossible: || is handled above"
-            (NPlus,  l, r)     -> numBinOp bin (+) l r
+      (NPlus , l      , r      ) -> numBinOp bin (+) l r
-            (NMinus, l, r)     -> numBinOp bin (-) l r
+      (NMinus, l      , r      ) -> numBinOp bin (-) l r
-            (NMult,  l, r)     -> numBinOp bin (*) l r
+      (NMult , l      , r      ) -> numBinOp bin (*) l r
-            (NDiv,   l, r)     -> numBinOp' bin div (/) l r
+      (NDiv  , l      , r      ) -> numBinOp' bin div (/) l r
-            (NImpl,
+      (NImpl , NBool l, NBool r) -> toBool $ not l || r
-             NBool l, NBool r) -> toBool $ not l || r
       _ -> nverr $ ErrorCall $ unsupportedTypes lval rval
 
     (NVStr ls, NVStr rs) -> case op of
@@ -388,15 +430,17 @@ execBinaryOp scope span op lval rarg = do
       NNEq    -> toBool . not =<< valueEqM (nvSet M.empty M.empty) rval
       _       -> nverr $ ErrorCall $ unsupportedTypes lval rval
 
-        (ls@NVSet {}, NVStr rs) -> case op of
+    (ls@NVSet{}, NVStr rs) -> case op of
-            NPlus   -> (\ls2 -> bin nvStrP (ls2 `principledStringMappend` rs))
+      NPlus ->
+        (\ls2 -> bin nvStrP (ls2 `principledStringMappend` rs))
           <$> coerceToString DontCopyToStore CoerceStringy ls
       NEq  -> toBool =<< valueEqM lval rval
       NNEq -> toBool . not =<< valueEqM lval rval
       _    -> nverr $ ErrorCall $ unsupportedTypes lval rval
 
-        (NVStr ls, rs@NVSet {}) -> case op of
+    (NVStr ls, rs@NVSet{}) -> case op of
-            NPlus   -> (\rs2 -> bin nvStrP (ls `principledStringMappend` rs2))
+      NPlus ->
+        (\rs2 -> bin nvStrP (ls `principledStringMappend` rs2))
           <$> coerceToString DontCopyToStore CoerceStringy rs
       NEq  -> toBool =<< valueEqM lval rval
       NNEq -> toBool . not =<< valueEqM lval rval
@@ -439,20 +483,31 @@ execBinaryOp scope span op lval rarg = do
   unsupportedTypes :: Show a => a -> a -> String
   unsupportedTypes lval rval =
     "Unsupported argument types for binary operator "
-            ++ show op ++ ": " ++ show lval ++ ", " ++ show rval
+      ++ show op
+      ++ ": "
+      ++ show lval
+      ++ ", "
+      ++ show rval
 
-    numBinOp :: (forall r. (Provenance t f m -> r) -> r)
+  numBinOp
-             -> (forall a. Num a => a -> a -> a) -> NAtom -> NAtom -> m (NValue t f m)
+    :: (forall r . (Provenance t f m -> r) -> r)
+    -> (forall a . Num a => a -> a -> a)
+    -> NAtom
+    -> NAtom
+    -> m (NValue t f m)
   numBinOp bin f = numBinOp' bin f f
 
-    numBinOp' :: (forall r. (Provenance t f m -> r) -> r)
+  numBinOp'
+    :: (forall r . (Provenance t f m -> r) -> r)
     -> (Integer -> Integer -> Integer)
     -> (Float -> Float -> Float)
-              -> NAtom -> NAtom -> m (NValue t f m)
+    -> NAtom
+    -> NAtom
+    -> m (NValue t f m)
   numBinOp' bin intF floatF l r = case (l, r) of
-        (NInt   li, NInt   ri) -> toInt   $             li `intF`               ri
+    (NInt   li, NInt ri  ) -> toInt $ li `intF` ri
     (NInt   li, NFloat rf) -> toFloat $ fromInteger li `floatF` rf
-        (NFloat lf, NInt   ri) -> toFloat $             lf `floatF` fromInteger ri
+    (NFloat lf, NInt ri  ) -> toFloat $ lf `floatF` fromInteger ri
     (NFloat lf, NFloat rf) -> toFloat $ lf `floatF` rf
     _                      -> nverr $ ErrorCall $ unsupportedTypes l r
    where
@@ -475,43 +530,53 @@ data CopyToStoreMode
   -- ^ Add paths to the store as they are encountered
   deriving (Eq,Ord,Enum,Bounded)
 
-coerceToString :: MonadNix e t f m => CopyToStoreMode -> CoercionLevel -> NValue t f m -> m NixString
+coerceToString
+  :: MonadNix e t f m
+  => CopyToStoreMode
+  -> CoercionLevel
+  -> NValue t f m
+  -> m NixString
 coerceToString ctsm clevel = go
  where
   go = \case
     NVConstant (NBool b)
+      |
         -- TODO Return a singleton for "" and "1"
-            | b && clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext "1"
+        b && clevel == CoerceAny -> pure
+      $  principledMakeNixStringWithoutContext "1"
       | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext ""
-        NVConstant (NInt n)   | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
+    NVConstant (NInt n) | clevel == CoerceAny ->
-        NVConstant (NFloat n) | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
+      pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
-        NVConstant NNull      | clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext ""
+    NVConstant (NFloat n) | clevel == CoerceAny ->
+      pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
+    NVConstant NNull | clevel == CoerceAny ->
+      pure $ principledMakeNixStringWithoutContext ""
     NVStr ns -> pure ns
-        NVPath p  | ctsm == CopyToStore -> storePathToNixString <$> addPath p
+    NVPath p
+      | ctsm == CopyToStore -> storePathToNixString <$> addPath p
       | otherwise -> pure $ principledMakeNixStringWithoutContext $ Text.pack p
-        NVList l | clevel == CoerceAny -> nixStringUnwords <$> traverse (`force` go) l
+    NVList l | clevel == CoerceAny ->
+      nixStringUnwords <$> traverse (`force` go) l
 
     v@(NVSet s _) | Just p <- M.lookup "__toString" s ->
       force p $ (`callFunc` pure v) >=> go
 
-        NVSet s _ | Just p <- M.lookup "outPath" s ->
+    NVSet s _ | Just p <- M.lookup "outPath" s -> force p go
-            force p go
 
     v -> throwError $ ErrorCall $ "Expected a string, but saw: " ++ show v
 
-    nixStringUnwords = principledIntercalateNixString (principledMakeNixStringWithoutContext " ")
+  nixStringUnwords =
+    principledIntercalateNixString (principledMakeNixStringWithoutContext " ")
   storePathToNixString :: StorePath -> NixString
-    storePathToNixString sp =
+  storePathToNixString sp = principledMakeNixStringWithSingletonContext
-        principledMakeNixStringWithSingletonContext t (StringContext t DirectPath)
+    t
-      where
+    (StringContext t DirectPath)
-        t = Text.pack $ unStorePath sp
+    where t = Text.pack $ unStorePath sp
 
 fromStringNoContext :: MonadNix e t f m => NixString -> m Text
-fromStringNoContext ns =
+fromStringNoContext ns = case principledGetStringNoContext ns of
-  case principledGetStringNoContext ns of
   Just str -> return str
-    Nothing -> throwError $ ErrorCall
+  Nothing  -> throwError $ ErrorCall "expected string with no context"
-      "expected string with no context"
 
 newtype Lazy t (f :: * -> *) m a = Lazy
     { runLazy :: ReaderT (Context (Lazy t f m) t)
@@ -542,8 +607,8 @@ instance MonadAtomicRef m => MonadAtomicRef (Lazy t f m) where
 instance (MonadFile m, Monad m) => MonadFile (Lazy t f m)
 
 instance MonadCatch m => MonadCatch (Lazy t f m) where
-    catch (Lazy (ReaderT m)) f = Lazy $ ReaderT $ \e ->
+  catch (Lazy (ReaderT m)) f =
-        catch (m e) ((`runReaderT` e) . runLazy . f)
+    Lazy $ ReaderT $ \e -> catch (m e) ((`runReaderT` e) . runLazy . f)
 
 instance MonadThrow m => MonadThrow (Lazy t f m) where
   throwM = Lazy . throwM
@@ -591,21 +656,26 @@ instance ( MonadFix m
          => MonadEffects t f (Lazy t f m) where
   makeAbsolutePath origPath = do
     origPathExpanded <- expandHomePath origPath
-        absPath <- if isAbsolute origPathExpanded then pure origPathExpanded else do
+    absPath          <- if isAbsolute origPathExpanded
+      then pure origPathExpanded
+      else do
         cwd <- do
           mres <- lookupVar "__cur_file"
           case mres of
             Nothing -> getCurrentDirectory
             Just v  -> force v $ \case
               NVPath s -> return $ takeDirectory s
-                        v -> throwError $ ErrorCall $ "when resolving relative path,"
+              v ->
+                throwError
+                  $  ErrorCall
+                  $  "when resolving relative path,"
                   ++ " __cur_file is in scope,"
                   ++ " but is not a path; it is: "
                   ++ show v
         pure $ cwd <///> origPathExpanded
     removeDotDotIndirections <$> canonicalizePath absPath
 
-    -- Given a path, determine the nix file to load
+-- Given a path, determine the nix file to load
   pathToDefaultNix = pathToDefaultNixFile
 
   findEnvPath      = findEnvPathM
@@ -621,20 +691,19 @@ instance ( MonadFix m
           eres <- parseNixFileLoc path
           case eres of
             Failure err ->
-                            throwError $ ErrorCall . show $ fillSep $
+              throwError
-                                [ "Parse during import failed:"
+                $ ErrorCall
-                                , err
+                . show
-                                ]
+                $ fillSep
+                $ ["Parse during import failed:", err]
             Success expr -> do
-                            Lazy $ ReaderT $ const $
+              Lazy $ ReaderT $ const $ modify (M.insert path expr)
-                                modify (M.insert path expr)
               pure expr
 
   derivationStrict = fromValue @(AttrSet t) >=> \s -> do
     nn <- maybe (pure False) fromNix (M.lookup "__ignoreNulls" s)
     s' <- M.fromList <$> mapMaybeM (handleEntry nn) (M.toList s)
-        v' <- normalForm
+    v' <- normalForm =<< toValue @(AttrSet t) @_ @(NValue t f (Lazy t f m)) s'
-            =<< toValue @(AttrSet t) @_ @(NValue t f (Lazy t f m)) s'
     nixInstantiateExpr $ "derivationStrict " ++ show (prettyNValueNF v')
    where
     mapMaybeM :: (a -> Lazy t f m (Maybe b)) -> [a] -> Lazy t f m [b]
@@ -642,7 +711,7 @@ instance ( MonadFix m
       where f x xs = op x >>= (<$> xs) . (++) . maybeToList
 
     handleEntry :: Bool -> (Text, t) -> Lazy t f m (Maybe (Text, t))
-        handleEntry ignoreNulls (k, v) = fmap (k,) <$> case k of
+    handleEntry ignoreNulls (k, v) = fmap (k, ) <$> case k of
         -- The `args' attribute is special: it supplies the command-line
         -- arguments to the builder.
         -- TODO This use of coerceToString is probably not right and may
@@ -655,8 +724,7 @@ instance ( MonadFix m
      where
       coerceNix = toNix <=< coerceToString CopyToStore CoerceAny
       coerceNixList =
-                toNix <=< traverse (\x -> force x coerceNix)
+        toNix <=< traverse (\x -> force x coerceNix) <=< fromValue @[t]
-                      <=< fromValue @[t]
 
   traceEffect = putStrLn
 
@@ -664,9 +732,8 @@ getRecursiveSize :: (MonadIntrospect m, Applicative f) => a -> m (NValue t f m)
 getRecursiveSize = fmap (nvConstant . NInt . fromIntegral) . recursiveSize
 
 runLazyM :: Options -> MonadIO m => Lazy t f m a -> m a
-runLazyM opts = (`evalStateT` M.empty)
+runLazyM opts =
-              . (`runReaderT` newContext opts)
+  (`evalStateT` M.empty) . (`runReaderT` newContext opts) . runLazy
-              . runLazy
 
 -- | Incorrectly normalize paths by rewriting patterns like @a/b/..@ to @a@.
 --   This is incorrect on POSIX systems, because if @b@ is a symlink, its
@@ -674,9 +741,10 @@ runLazyM opts = (`evalStateT` M.empty)
 --   https://hackage.haskell.org/package/directory-1.3.1.5/docs/System-Directory.html#v:canonicalizePath
 removeDotDotIndirections :: FilePath -> FilePath
 removeDotDotIndirections = intercalate "/" . go [] . splitOn "/"
-    where go s [] = reverse s
+ where
-          go (_:s) ("..":rest) = go s rest
+  go s       []            = reverse s
-          go s (this:rest) = go (this:s) rest
+  go (_ : s) (".." : rest) = go s rest
+  go s       (this : rest) = go (this : s) rest
 
 expandHomePath :: MonadFile m => FilePath -> m FilePath
 expandHomePath ('~' : xs) = flip (++) xs <$> getHomeDirectory
@@ -694,30 +762,33 @@ x <///> y | isAbsolute y || "." `isPrefixOf` y = x </> y
           | otherwise                          = joinByLargestOverlap x y
  where
   joinByLargestOverlap (splitDirectories -> xs) (splitDirectories -> ys) =
-        joinPath $ head [ xs ++ drop (length tx) ys
+    joinPath $ head
-                        | tx <- tails xs, tx `elem` inits ys ]
+      [ xs ++ drop (length tx) ys | tx <- tails xs, tx `elem` inits ys ]
 
 findPathBy
-    :: forall e t f m.
+  :: forall e t f m
-    (MonadNix e t f m, FromValue NixString m t, FromValue Path m t)
+   . (MonadNix e t f m, FromValue NixString m t, FromValue Path m t)
   => (FilePath -> m (Maybe FilePath))
-    -> [t] -> FilePath -> m FilePath
+  -> [t]
+  -> FilePath
+  -> m FilePath
 findPathBy finder l name = do
   mpath <- foldM go Nothing l
   case mpath of
     Nothing ->
-            throwError $ ErrorCall $ "file '" ++ name
+      throwError
+        $  ErrorCall
+        $  "file '"
+        ++ name
         ++ "' was not found in the Nix search path"
         ++ " (add it using $NIX_PATH or -I)"
     Just path -> return path
  where
   go :: Maybe FilePath -> t -> m (Maybe FilePath)
   go p@(Just _) _ = pure p
-      go Nothing    l = force l $ fromValue >=>
+  go Nothing    l = force l $ fromValue >=> \(s :: HashMap Text t) -> do
-        \(s :: HashMap Text t) -> do
     p <- resolvePath s
-          force p $ fromValue >=> \(Path path) ->
+    force p $ fromValue >=> \(Path path) -> case M.lookup "prefix" s of
-              case M.lookup "prefix" s of
       Nothing -> tryPath path Nothing
       Just pf -> force pf $ fromValueMay >=> \case
         Just (nsPfx :: NixString) ->
@@ -727,7 +798,7 @@ findPathBy finder l name = do
                 else tryPath path Nothing
         _ -> tryPath path Nothing
 
-      tryPath p (Just n) | n':ns <- splitDirectories name, n == n' =
+  tryPath p (Just n) | n' : ns <- splitDirectories name, n == n' =
     finder $ p <///> joinPath ns
   tryPath p _ = finder $ p <///> name
 
@@ -736,13 +807,18 @@ findPathBy finder l name = do
     Nothing -> case M.lookup "uri" s of
       Just ut -> thunk $ fetchTarball (force ut pure)
       Nothing ->
-                  throwError $ ErrorCall $ "__nixPath must be a list of attr sets"
+        throwError
-                      ++ " with 'path' elements, but saw: " ++ show s
+          $  ErrorCall
+          $  "__nixPath must be a list of attr sets"
+          ++ " with 'path' elements, but saw: "
+          ++ show s
 
 findPathM
-    :: forall e t f m.
+  :: forall e t f m
-    (MonadNix e t f m, FromValue NixString m t, FromValue Path m t)
+   . (MonadNix e t f m, FromValue NixString m t, FromValue Path m t)
-    => [t] -> FilePath -> m FilePath
+  => [t]
+  -> FilePath
+  -> m FilePath
 findPathM l name = findPathBy path l name
  where
   path :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
@@ -752,15 +828,16 @@ findPathM l name = findPathBy path l name
     return $ if exists then Just path else Nothing
 
 findEnvPathM
-    :: forall e t f m.
+  :: forall e t f m
-    (MonadNix e t f m, FromValue NixString m t, FromValue Path m t)
+   . (MonadNix e t f m, FromValue NixString m t, FromValue Path m t)
-    => FilePath -> m FilePath
+  => FilePath
+  -> m FilePath
 findEnvPathM name = do
   mres <- lookupVar "__nixPath"
   case mres of
     Nothing -> error "impossible"
-        Just x -> force x $ fromValue >=> \(l :: [t]) ->
+    Just x ->
-          findPathBy nixFilePath l name
+      force x $ fromValue >=> \(l :: [t]) -> findPathBy nixFilePath l name
  where
   nixFilePath :: MonadEffects t f m => FilePath -> m (Maybe FilePath)
   nixFilePath path = do
@@ -772,9 +849,10 @@ findEnvPathM name = do
     exists <- doesFileExist path'
     return $ if exists then Just path' else Nothing
 
-addTracing :: (MonadNix e t f m, Has e Options,
+addTracing
-              MonadReader Int n, Alternative n)
+  :: (MonadNix e t f m, Has e Options, MonadReader Int n, Alternative n)
-           => Alg NExprLocF (m a) -> Alg NExprLocF (n (m a))
+  => Alg NExprLocF (m a)
+  -> Alg NExprLocF (n (m a))
 addTracing k v = do
   depth <- ask
   guard (depth < 2000)
@@ -782,8 +860,7 @@ addTracing k v = do
     v'@(Compose (Ann span x)) <- sequence v
     return $ do
       opts :: Options <- asks (view hasLens)
-            let rendered =
+      let rendered = if verbose opts >= Chatty
-                    if verbose opts >= Chatty
 #ifdef MIN_VERSION_pretty_show
                      then pretty $ PS.ppShow (void x)
 #else
@@ -798,14 +875,15 @@ addTracing k v = do
       return res
 
 evalExprLoc
-    :: forall e t f m.
+  :: forall e t f m
-    (MonadNix e t f m, FromValue NixString m t, Has e Options)
+   . (MonadNix e t f m, FromValue NixString m t, Has e Options)
-    => NExprLoc -> m (NValue t f m)
+  => NExprLoc
+  -> m (NValue t f m)
 evalExprLoc expr = do
   opts :: Options <- asks (view hasLens)
   if tracing opts
-        then join . (`runReaderT` (0 :: Int)) $
+    then join . (`runReaderT` (0 :: Int)) $ adi
-             adi (addTracing phi)
+      (addTracing phi)
       (raise (addStackFrames @t . addSourcePositions))
       expr
     else adi phi (addStackFrames @t . addSourcePositions) expr
@@ -814,23 +892,30 @@ evalExprLoc expr = do
   raise k f x = ReaderT $ \e -> k (\t -> runReaderT (f t) e) x
 
 fetchTarball
-    :: forall e t f m.
+  :: forall e t f m
-    (MonadNix e t f m, FromValue NixString m t)
+   . (MonadNix e t f m, FromValue NixString m t)
-    => m (NValue t f m) -> m (NValue t f m)
+  => m (NValue t f m)
+  -> m (NValue t f m)
 fetchTarball v = v >>= \case
   NVSet s _ -> case M.lookup "url" s of
-        Nothing -> throwError $ ErrorCall
+    Nothing ->
-                      "builtins.fetchTarball: Missing url attribute"
+      throwError $ ErrorCall "builtins.fetchTarball: Missing url attribute"
     Just url -> force url $ go (M.lookup "sha256" s)
-    v@NVStr {} -> go Nothing v
+  v@NVStr{} -> go Nothing v
-    v -> throwError $ ErrorCall $
+  v ->
-            "builtins.fetchTarball: Expected URI or set, got " ++ show v
+    throwError
+      $  ErrorCall
+      $  "builtins.fetchTarball: Expected URI or set, got "
+      ++ show v
  where
   go :: Maybe t -> NValue t f m -> m (NValue t f m)
   go msha = \case
     NVStr ns -> fetch (hackyStringIgnoreContext ns) msha
-        v -> throwError $ ErrorCall $
+    v ->
-                "builtins.fetchTarball: Expected URI or string, got " ++ show v
+      throwError
+        $  ErrorCall
+        $  "builtins.fetchTarball: Expected URI or string, got "
+        ++ show v
 
 {- jww (2018-04-11): This should be written using pipes in another module
     fetch :: Text -> Maybe (NThunk m) -> m (NValue t f m)
@@ -846,28 +931,26 @@ fetchTarball v = v >>= \case
 
   fetch :: Text -> Maybe t -> m (NValue t f m)
   fetch uri Nothing =
-        nixInstantiateExpr $ "builtins.fetchTarball \"" ++
+    nixInstantiateExpr $ "builtins.fetchTarball \"" ++ Text.unpack uri ++ "\""
-            Text.unpack uri ++ "\""
   fetch url (Just m) = fromValue m >>= \nsSha ->
     let sha = hackyStringIgnoreContext nsSha
-         in nixInstantiateExpr $ "builtins.fetchTarball { "
+    in  nixInstantiateExpr
-              ++ "url    = \"" ++ Text.unpack url ++ "\"; "
+          $  "builtins.fetchTarball { "
-              ++ "sha256 = \"" ++ Text.unpack sha ++ "\"; }"
+          ++ "url    = \""
+          ++ Text.unpack url
+          ++ "\"; "
+          ++ "sha256 = \""
+          ++ Text.unpack sha
+          ++ "\"; }"
 
 exec
-  :: ( MonadNix e t f m
+  :: (MonadNix e t f m, MonadInstantiate m, FromValue NixString m t)
-    , MonadInstantiate m
-    , FromValue NixString m t
-    )
   => [String]
   -> m (NValue t f m)
 exec args = either throwError evalExprLoc =<< exec' args
 
 nixInstantiateExpr
-  :: ( MonadNix e t f m
+  :: (MonadNix e t f m, MonadInstantiate m, FromValue NixString m t)
-    , MonadInstantiate m
-    , FromValue NixString m t
-    )
   => String
   -> m (NValue t f m)
 nixInstantiateExpr s = either throwError evalExprLoc =<< instantiateExpr s
@@ -877,3 +960,10 @@ instance Monad m => Scoped t (Lazy t f m) where
   clearScopes   = clearScopesReader @(Lazy t f m) @t
   pushScopes    = pushScopesReader
   lookupVar     = lookupVarReader
+
+
+
+
+
+
+

src/Nix/Expr.hs

@@ -1,9 +1,10 @@
 -- | Wraps the expression submodules.
-module Nix.Expr (
+module Nix.Expr
-  module Nix.Expr.Types,
+  ( module Nix.Expr.Types
-  module Nix.Expr.Types.Annotated,
+  , module Nix.Expr.Types.Annotated
-  module Nix.Expr.Shorthands
+  , module Nix.Expr.Shorthands
-  ) where
+  )
+where
 
 import           Nix.Expr.Types
 import           Nix.Expr.Shorthands

src/Nix/Expr/Shorthands.hs

@@ -8,11 +8,11 @@
 module Nix.Expr.Shorthands where
 
 import           Data.Fix
-import Data.List.NonEmpty (NonEmpty(..))
+import           Data.List.NonEmpty             ( NonEmpty(..) )
-import Data.Text (Text)
+import           Data.Text                      ( Text )
 import           Nix.Atoms
 import           Nix.Expr.Types
-import Text.Megaparsec.Pos (SourcePos)
+import           Text.Megaparsec.Pos            ( SourcePos )
 
 -- | Make an integer literal expression.
 mkInt :: Integer -> NExpr
@@ -201,8 +201,7 @@ mkBinop :: NBinaryOp -> NExpr -> NExpr -> NExpr
 mkBinop op e1 e2 = Fix (NBinary op e1 e2)
 
 -- | Various nix binary operators
-($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->),
+($==), ($!=), ($<), ($<=), ($>), ($>=), ($&&), ($||), ($->), ($//), ($+), ($-), ($*), ($/), ($++)
-  ($//), ($+), ($-), ($*), ($/), ($++)
   :: NExpr -> NExpr -> NExpr
 e1 $== e2 = mkBinop NEq e1 e2
 e1 $!= e2 = mkBinop NNEq e1 e2

src/Nix/Expr/Types.hs

@@ -28,7 +28,7 @@
 module Nix.Expr.Types where
 
 #ifdef MIN_VERSION_serialise
-import           Codec.Serialise (Serialise)
+import           Codec.Serialise                ( Serialise )
 import qualified Codec.Serialise               as Ser
 #endif
 import           Control.Applicative
@@ -36,7 +36,7 @@ import           Control.DeepSeq
 import           Control.Monad
 import           Data.Aeson
 import           Data.Aeson.TH
-import           Data.Binary (Binary)
+import           Data.Binary                    ( Binary )
 import qualified Data.Binary                   as Bin
 import           Data.Data
 import           Data.Eq.Deriving
@@ -46,12 +46,17 @@ import           Data.Hashable
 #if MIN_VERSION_hashable(1, 2, 5)
 import           Data.Hashable.Lifted
 #endif
-import           Data.List (inits, tails)
+import           Data.List                      ( inits
-import           Data.List.NonEmpty (NonEmpty(..))
+                                                , tails
+                                                )
+import           Data.List.NonEmpty             ( NonEmpty(..) )
 import qualified Data.List.NonEmpty            as NE
-import           Data.Maybe (fromMaybe)
+import           Data.Maybe                     ( fromMaybe )
 import           Data.Ord.Deriving
-import           Data.Text (Text, pack, unpack)
+import           Data.Text                      ( Text
+                                                , pack
+                                                , unpack
+                                                )
 import           Data.Traversable
 import           GHC.Exts
 import           GHC.Generics
@@ -64,7 +69,7 @@ import           Text.Megaparsec.Pos
 import           Text.Read.Deriving
 import           Text.Show.Deriving
 #if MIN_VERSION_base(4, 10, 0)
-import           Type.Reflection (eqTypeRep)
+import           Type.Reflection                ( eqTypeRep )
 import qualified Type.Reflection               as Reflection
 #endif
 
@@ -245,10 +250,8 @@ data Antiquoted (v :: *) (r :: *) = Plain !v | EscapedNewline | Antiquoted !r
 instance Hashable v => Hashable1 (Antiquoted v)
 
 instance Hashable2 Antiquoted where
-    liftHashWithSalt2 ha _ salt (Plain a) =
+  liftHashWithSalt2 ha _ salt (Plain a) = ha (salt `hashWithSalt` (0 :: Int)) a
-        ha (salt `hashWithSalt` (0 :: Int)) a
+  liftHashWithSalt2 _ _ salt EscapedNewline = salt `hashWithSalt` (1 :: Int)
-    liftHashWithSalt2 _ _ salt EscapedNewline =
-        salt `hashWithSalt` (1 :: Int)
   liftHashWithSalt2 _ hb salt (Antiquoted b) =
     hb (salt `hashWithSalt` (2 :: Int)) b
 #endif
@@ -342,8 +345,8 @@ instance Generic1 NKeyName where
 
 #if MIN_VERSION_deepseq(1, 4, 3)
 instance NFData1 NKeyName where
-    liftRnf _ (StaticKey !_) = ()
+  liftRnf _ (StaticKey  !_            ) = ()
-    liftRnf _ (DynamicKey (Plain !_)) = ()
+  liftRnf _ (DynamicKey (Plain !_)    ) = ()
   liftRnf _ (DynamicKey EscapedNewline) = ()
   liftRnf k (DynamicKey (Antiquoted r)) = k r
 #endif
@@ -369,7 +372,11 @@ instance Hashable1 NKeyName where
 -- occurs not only as last argument in @Antiquoted (NString r) r@
 instance Show1 NKeyName where
   liftShowsPrec sp sl p = \case
-    DynamicKey a -> showsUnaryWith (liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl) "DynamicKey" p a
+    DynamicKey a -> showsUnaryWith
+      (liftShowsPrec2 (liftShowsPrec sp sl) (liftShowList sp sl) sp sl)
+      "DynamicKey"
+      p
+      a
     StaticKey t -> showsUnaryWith showsPrec "StaticKey" p t
 
 -- Deriving this instance automatically is not possible because @r@
@@ -387,7 +394,7 @@ instance Foldable NKeyName where
 instance Traversable NKeyName where
   traverse f = \case
     DynamicKey (Plain      str) -> DynamicKey . Plain <$> traverse f str
-    DynamicKey (Antiquoted e) -> DynamicKey . Antiquoted <$> f e
+    DynamicKey (Antiquoted e  ) -> DynamicKey . Antiquoted <$> f e
     DynamicKey EscapedNewline   -> pure $ DynamicKey EscapedNewline
     StaticKey  key              -> pure (StaticKey key)
 
@@ -431,7 +438,7 @@ instance Serialise NBinaryOp
 
 -- | Get the name out of the parameter (there might be none).
 paramName :: Params r -> Maybe VarName
-paramName (Param n) = Just n
+paramName (Param n       ) = Just n
 paramName (ParamSet _ _ n) = n
 
 #if !MIN_VERSION_deepseq(1, 4, 3)
@@ -526,14 +533,14 @@ class NExprAnn ann g | g -> ann where
     fromNExpr :: g r -> (NExprF r, ann)
     toNExpr :: (NExprF r, ann) -> g r
 
-ekey :: NExprAnn ann g
+ekey
+  :: NExprAnn ann g
   => NonEmpty Text
   -> SourcePos
   -> Lens' (Fix g) (Maybe (Fix g))
-ekey keys pos f e@(Fix x) | (NSet xs, ann) <- fromNExpr x =
+ekey keys pos f e@(Fix x) | (NSet xs, ann) <- fromNExpr x = case go xs of
-    case go xs of
+  ((v, []      ) : _) -> fromMaybe e <$> f (Just v)
-        ((v, []):_) -> fromMaybe e <$> f (Just v)
+  ((v, r : rest) : _) -> ekey (r :| rest) pos f v
-        ((v, r:rest):_) -> ekey (r :| rest) pos f v
 
   _                   -> f Nothing <&> \case
     Nothing -> e
@@ -546,9 +553,9 @@ ekey keys pos f e@(Fix x) | (NSet xs, ann) <- fromNExpr x =
     (ks, rest) <- zip (inits keys') (tails keys')
     case ks of
       []     -> empty
-            j:js -> do
+      j : js -> do
         NamedVar ns v _p <- xs
-                guard $ (j:js) == (NE.toList ns ^.. traverse._StaticKey)
+        guard $ (j : js) == (NE.toList ns ^.. traverse . _StaticKey)
         return (v, rest)
 
 ekey _ _ f e = fromMaybe e <$> f Nothing
@@ -556,8 +563,8 @@ ekey _ _ f e = fromMaybe e <$> f Nothing
 stripPositionInfo :: NExpr -> NExpr
 stripPositionInfo = transport phi
  where
-    phi (NSet binds)         = NSet (map go binds)
+  phi (NSet    binds  ) = NSet (map go binds)
-    phi (NRecSet binds)      = NRecSet (map go binds)
+  phi (NRecSet binds  ) = NRecSet (map go binds)
   phi (NLet binds body) = NLet (map go binds) body
   phi x                 = x
 
@@ -566,3 +573,6 @@ stripPositionInfo = transport phi
 
 nullPos :: SourcePos
 nullPos = SourcePos "<string>" (mkPos 1) (mkPos 1)
+
+
+

src/Nix/Expr/Types/Annotated.hs

@@ -18,32 +18,41 @@
 module Nix.Expr.Types.Annotated
   ( module Nix.Expr.Types.Annotated
   , module Data.Functor.Compose
-  , SourcePos(..), unPos, mkPos
+  , SourcePos(..)
-  ) where
+  , unPos
+  , mkPos
+  )
+where
 
 #ifdef MIN_VERSION_serialise
 import           Codec.Serialise
 #endif
 import           Control.DeepSeq
-import Data.Aeson (ToJSON(..), FromJSON(..))
+import           Data.Aeson                     ( ToJSON(..)
+                                                , FromJSON(..)
+                                                )
 import           Data.Aeson.TH
-import Data.Binary (Binary(..))
+import           Data.Binary                    ( Binary(..) )
 import           Data.Data
 import           Data.Eq.Deriving
 import           Data.Fix
-import Data.Function (on)
+import           Data.Function                  ( on )
 import           Data.Functor.Compose
 import           Data.Hashable
 #if MIN_VERSION_hashable(1, 2, 5)
 import           Data.Hashable.Lifted
 #endif
 import           Data.Ord.Deriving
-import Data.Text (Text, pack)
+import           Data.Text                      ( Text
+                                                , pack
+                                                )
 import           GHC.Generics
 import           Nix.Atoms
 import           Nix.Expr.Types
-import Text.Megaparsec (unPos, mkPos)
+import           Text.Megaparsec                ( unPos
-import Text.Megaparsec.Pos (SourcePos(..))
+                                                , mkPos
+                                                )
+import           Text.Megaparsec.Pos            ( SourcePos(..) )
 import           Text.Read.Deriving
 import           Text.Show.Deriving
 
@@ -93,8 +102,7 @@ $(deriveJSON1 defaultOptions ''Ann)
 $(deriveJSON2 defaultOptions ''Ann)
 
 instance Semigroup SrcSpan where
-  s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2)
+  s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2) ((max `on` spanEnd) s1 s2)
-                     ((max `on` spanEnd) s1 s2)
 
 type AnnF ann f = Compose (Ann ann) f
 
@@ -153,8 +161,8 @@ nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =
   AnnE (s1 <> s2 <> s3) (NBinary b e1 e2)
 nBinary _ _ _ = error "nBinary: unexpected"
 
-nSelectLoc :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc
+nSelectLoc
-           -> NExprLoc
+  :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc -> NExprLoc
 nSelectLoc e1@(AnnE s1 _) (Ann s2 ats) d = case d of
   Nothing               -> AnnE (s1 <> s2) (NSelect e1 ats Nothing)
   Just (e2@(AnnE s3 _)) -> AnnE (s1 <> s2 <> s3) (NSelect e1 ats (Just e2))

src/Nix/Frames.hs

@@ -4,15 +4,25 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Nix.Frames (NixLevel(..), Frames, Framed, NixFrame(..),
+module Nix.Frames
-                   NixException(..), withFrame, throwError,
+  ( NixLevel(..)
-                   module Data.Typeable,
+  , Frames
-                   module Control.Exception) where
+  , Framed
+  , NixFrame(..)
+  , NixException(..)
+  , withFrame
+  , throwError
+  , module Data.Typeable
+  , module Control.Exception
+  )
+where
 
-import Control.Exception hiding (catch, evaluate)
+import           Control.Exception       hiding ( catch
+                                                , evaluate
+                                                )
 import           Control.Monad.Catch
 import           Control.Monad.Reader
-import Data.Typeable hiding (typeOf)
+import           Data.Typeable           hiding ( typeOf )
 import           Nix.Utils
 
 data NixLevel = Fatal | Error | Warning | Info | Debug
@@ -25,7 +35,7 @@ data NixFrame = NixFrame
 
 instance Show NixFrame where
   show (NixFrame level f) =
-        "Nix frame at level " ++ show level ++ ": "++ show f
+    "Nix frame at level " ++ show level ++ ": " ++ show f
 
 type Frames = [NixFrame]
 
@@ -36,11 +46,13 @@ newtype NixException = NixException Frames
 
 instance Exception NixException
 
-withFrame :: forall s e m a. (Framed e m, Exception s) => NixLevel -> s -> m a -> m a
+withFrame
+  :: forall s e m a . (Framed e m, Exception s) => NixLevel -> s -> m a -> m a
 withFrame level f = local (over hasLens (NixFrame level (toException f) :))
 
-throwError :: forall s e m a. (Framed e m, Exception s, MonadThrow m) => s -> m a
+throwError
+  :: forall s e m a . (Framed e m, Exception s, MonadThrow m) => s -> m a
 throwError err = do
   context <- asks (view hasLens)
   traceM "Throwing error..."
-    throwM $ NixException (NixFrame Error (toException err):context)
+  throwM $ NixException (NixFrame Error (toException err) : context)

src/Nix/Fresh.hs

@@ -25,7 +25,7 @@ import Control.Monad.State.Strict
 import           Control.Monad.Writer
 import           Data.Typeable
 #ifdef MIN_VERSION_haskeline
-import System.Console.Haskeline.MonadException hiding (catch)
+import System.Console.Haskeline.MonadException hiding(catch)
 #endif
 
 import           Nix.Var
@@ -104,3 +104,10 @@ instance MonadAtomicRef (ST s) where
     let (a, b) = f v
     writeRef r $! a
     return b
+
+
+
+
+
+
+

src/Nix/Json.hs

@@ -23,10 +23,14 @@ import           Nix.Utils
 import           Nix.Value
 
 nvalueToJSONNixString :: MonadNix e t f m => NValue t f m -> m NixString
-nvalueToJSONNixString = runWithStringContextT
+nvalueToJSONNixString =
-  . fmap (TL.toStrict . TL.decodeUtf8
+  runWithStringContextT
+    . fmap
+        ( TL.toStrict
+        . TL.decodeUtf8
         . A.encodingToLazyByteString
-                      . toEncodingSorted)
+        . toEncodingSorted
+        )
     . nvalueToJSON
 
 nvalueToJSON :: MonadNix e t f m => NValue t f m -> WithStringContextT m A.Value
@@ -37,11 +41,12 @@ nvalueToJSON = \case
   NVConstant NNull      -> pure $ A.Null
   NVStr      ns         -> A.toJSON <$> extractNixString ns
   NVList l ->
-    A.Array . V.fromList
+    A.Array
+      .   V.fromList
       <$> traverse (join . lift . flip force (return . nvalueToJSON)) l
   NVSet m _ -> case HM.lookup "outPath" m of
-    Nothing -> A.Object
+    Nothing ->
-          <$> traverse (join . lift . flip force (return . nvalueToJSON)) m
+      A.Object <$> traverse (join . lift . flip force (return . nvalueToJSON)) m
     Just outPath -> join $ lift $ force outPath (return . nvalueToJSON)
   NVPath p -> do
     fp <- lift $ unStorePath <$> addPath p

src/Nix/Lint.hs

@@ -27,21 +27,21 @@ module Nix.Lint where
 import           Control.Monad
 import           Control.Monad.Catch
 import           Control.Monad.Fix
-import           Control.Monad.Reader (MonadReader)
+import           Control.Monad.Reader           ( MonadReader )
 import           Control.Monad.Ref
 import           Control.Monad.ST
 import           Control.Monad.Trans.Reader
 import           Data.Coerce
-import           Data.HashMap.Lazy (HashMap)
+import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
 import           Data.List
 import qualified Data.List.NonEmpty            as NE
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
 import           Nix.Atoms
 import           Nix.Context
 import           Nix.Convert
-import           Nix.Eval (MonadEval(..))
+import           Nix.Eval                       ( MonadEval(..) )
 import qualified Nix.Eval                      as Eval
 import           Nix.Expr
 import           Nix.Frames
@@ -84,9 +84,9 @@ compareTypes _               (TList _)       = GT
 compareTypes (TSet _)       (TSet  _)      = EQ
 compareTypes (TSet _)       _              = LT
 compareTypes _              (TSet _)       = GT
-compareTypes TClosure {}     TClosure {}     = EQ
+compareTypes TClosure{}     TClosure{}     = EQ
-compareTypes TClosure {}     _               = LT
+compareTypes TClosure{}     _              = LT
-compareTypes _               TClosure {}     = GT
+compareTypes _              TClosure{}     = GT
 compareTypes TPath          TPath          = EQ
 compareTypes TPath          _              = LT
 compareTypes _              TPath          = GT
@@ -111,18 +111,17 @@ everyPossible = packSymbolic NAny
 mkSymbolic :: MonadVar m => [NTypeF m (SThunk m)] -> m (Symbolic m)
 mkSymbolic xs = packSymbolic (NMany xs)
 
-packSymbolic :: MonadVar m
+packSymbolic :: MonadVar m => NSymbolicF (NTypeF m (SThunk m)) -> m (Symbolic m)
-             => NSymbolicF (NTypeF m (SThunk m)) -> m (Symbolic m)
 packSymbolic = fmap coerce . newVar
 
-unpackSymbolic :: MonadVar m
+unpackSymbolic
-               => Symbolic m -> m (NSymbolicF (NTypeF m (SThunk m)))
+  :: MonadVar m => Symbolic m -> m (NSymbolicF (NTypeF m (SThunk m)))
 unpackSymbolic = readVar . coerce
 
-type MonadLint e m = (Scoped (SThunk m) m, Framed e m, MonadVar m,
+type MonadLint e m
-                      MonadCatch m, MonadThunkId m)
+  = (Scoped (SThunk m) m, Framed e m, MonadVar m, MonadCatch m, MonadThunkId m)
 
-symerr :: forall e m a. MonadLint e m => String -> m a
+symerr :: forall e m a . MonadLint e m => String -> m a
 symerr = evalError @(Symbolic m) . ErrorCall
 
 renderSymbolic :: MonadLint e m => Symbolic m -> m String
@@ -153,40 +152,45 @@ renderSymbolic = unpackSymbolic >=> \case
     TBuiltin _n _f -> return "<builtin function>"
 
 -- This function is order and uniqueness preserving (of types).
-merge :: forall e m. MonadLint e m
+merge
-      => NExprF () -> [NTypeF m (SThunk m)] -> [NTypeF m (SThunk m)]
+  :: forall e m
+   . MonadLint e m
+  => NExprF ()
+  -> [NTypeF m (SThunk m)]
+  -> [NTypeF m (SThunk m)]
   -> m [NTypeF m (SThunk m)]
 merge context = go
  where
-    go :: [NTypeF m (SThunk m)] -> [NTypeF m (SThunk m)]
+  go
-       -> m [NTypeF m (SThunk m)]
+    :: [NTypeF m (SThunk m)] -> [NTypeF m (SThunk m)] -> m [NTypeF m (SThunk m)]
   go []       _        = return []
   go _        []       = return []
-    go (x:xs) (y:ys) = case (x, y) of
+  go (x : xs) (y : ys) = case (x, y) of
-        (TStr,  TStr)  -> (TStr :)  <$> go xs ys
+    (TStr , TStr ) -> (TStr :) <$> go xs ys
     (TPath, TPath) -> (TPath :) <$> go xs ys
     (TConstant ls, TConstant rs) ->
       (TConstant (ls `intersect` rs) :) <$> go xs ys
     (TList l, TList r) -> force l $ \l' -> force r $ \r' -> do
       m <- thunk $ unify context l' r'
       (TList m :) <$> go xs ys
-        (TSet x, TSet Nothing) -> (TSet x :) <$> go xs ys
+    (TSet x       , TSet Nothing ) -> (TSet x :) <$> go xs ys
-        (TSet Nothing, TSet x) -> (TSet x :) <$> go xs ys
+    (TSet Nothing , TSet x       ) -> (TSet x :) <$> go xs ys
     (TSet (Just l), TSet (Just r)) -> do
       m <- sequenceA $ M.intersectionWith
-                (\i j -> i >>= \i' -> j >>= \j' ->
+        (\i j -> i >>= \i' ->
-                        force i' $ \i'' -> force j' $ \j'' ->
+          j
-                            thunk $ unify context i'' j'')
+            >>= \j' -> force i'
-                (return <$> l) (return <$> r)
+                  $ \i'' -> force j' $ \j'' -> thunk $ unify context i'' j''
-            if M.null m
+        )
-                then go xs ys
+        (return <$> l)
-                else (TSet (Just m) :) <$> go xs ys
+        (return <$> r)
-        (TClosure {}, TClosure {}) ->
+      if M.null m then go xs ys else (TSet (Just m) :) <$> go xs ys
+    (TClosure{}, TClosure{}) ->
       throwError $ ErrorCall "Cannot unify functions"
     (TBuiltin _ _, TBuiltin _ _) ->
       throwError $ ErrorCall "Cannot unify builtin functions"
-        _ | compareTypes x y == LT -> go xs (y:ys)
+    _ | compareTypes x y == LT -> go xs (y : ys)
-          | compareTypes x y == GT -> go (x:xs) ys
+      | compareTypes x y == GT -> go (x : xs) ys
       | otherwise              -> error "impossible"
 
 {-
@@ -209,8 +213,13 @@ merge context = go
 -}
 
 -- | unify raises an error if the result is would be 'NMany []'.
-unify :: forall e m. MonadLint e m
+unify
-      => NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
+  :: forall e m
+   . MonadLint e m
+  => NExprF ()
+  -> Symbolic m
+  -> Symbolic m
+  -> m (Symbolic m)
 unify context (Symbolic x) (Symbolic y) = do
   x' <- readVar x
   y' <- readVar y
@@ -259,18 +268,21 @@ instance MonadLint e m => MonadThunk (SThunk m) m (Symbolic m) where
   getValue  = getValue . getSThunk
 
 instance MonadLint e m => MonadEval (Symbolic m) m where
-    freeVariable var = symerr $
+  freeVariable var = symerr $ "Undefined variable '" ++ Text.unpack var ++ "'"
-        "Undefined variable '" ++ Text.unpack var ++ "'"
 
   attrMissing ks Nothing =
-        evalError @(Symbolic m) $ ErrorCall $
+    evalError @(Symbolic m)
-            "Inheriting unknown attribute: "
+      $  ErrorCall
+      $  "Inheriting unknown attribute: "
       ++ intercalate "." (map Text.unpack (NE.toList ks))
 
   attrMissing ks (Just s) =
-        evalError @(Symbolic m) $ ErrorCall $ "Could not look up attribute "
+    evalError @(Symbolic m)
+      $  ErrorCall
+      $  "Could not look up attribute "
       ++ intercalate "." (map Text.unpack (NE.toList ks))
-            ++ " in " ++ show s
+      ++ " in "
+      ++ show s
 
   evalCurPos = do
     f <- wrapValue <$> mkSymbolic [TPath]
@@ -279,9 +291,7 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
     mkSymbolic [TSet (Just (M.fromList (go f l c)))]
    where
     go f l c =
-            [ (Text.pack "file", f)
+      [(Text.pack "file", f), (Text.pack "line", l), (Text.pack "col", c)]
-            , (Text.pack "line", l)
-            , (Text.pack "col",  c) ]
 
   evalConstant c = mkSymbolic [TConstant [go c]]
    where
@@ -296,16 +306,15 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
   evalEnvPath     = const $ mkSymbolic [TPath]
 
   evalUnary op arg =
-        unify (void (NUnary op arg)) arg
+    unify (void (NUnary op arg)) arg =<< mkSymbolic [TConstant [TInt, TBool]]
-            =<< mkSymbolic [TConstant [TInt, TBool]]
 
   evalBinary = lintBinaryOp
 
+  -- The scope is deliberately wrapped in a thunk here, since it is evaluated
+  -- each time a name is looked up within the weak scope, and we want to be
+  -- sure the action it evaluates is to force a thunk, so its value is only
+  -- computed once.
   evalWith scope body = do
-        -- The scope is deliberately wrapped in a thunk here, since it is
-        -- evaluated each time a name is looked up within the weak scope, and
-        -- we want to be sure the action it evaluates is to force a thunk, so
-        -- its value is only computed once.
     s <- thunk @(SThunk m) @m @(Symbolic m) scope
     pushWeakScope ?? body $ force s $ unpackSymbolic >=> \case
       NMany [TSet (Just s')] -> return s'
@@ -331,38 +340,38 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
   evalError = throwError
 
 lintBinaryOp
-    :: forall e m. (MonadLint e m, MonadEval (Symbolic m) m)
+  :: forall e m
-    => NBinaryOp -> Symbolic m -> m (Symbolic m) -> m (Symbolic m)
+   . (MonadLint e m, MonadEval (Symbolic m) m)
+  => NBinaryOp
+  -> Symbolic m
+  -> m (Symbolic m)
+  -> m (Symbolic m)
 lintBinaryOp op lsym rarg = do
   rsym <- rarg
   y    <- thunk everyPossible
   case op of
     NApp    -> symerr "lintBinaryOp:NApp: should never get here"
-        NEq    -> check lsym rsym [ TConstant [TInt, TBool, TNull]
+    NEq     -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y]
-                                 , TStr
+    NNEq    -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y]
-                                 , TList y ]
-        NNEq   -> check lsym rsym [ TConstant [TInt, TBool, TNull]
-                                 , TStr
-                                 , TList y ]
 
-        NLt    -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]
+    NLt     -> check lsym rsym [TConstant [TInt, TBool, TNull]]
-        NLte   -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]
+    NLte    -> check lsym rsym [TConstant [TInt, TBool, TNull]]
-        NGt    -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]
+    NGt     -> check lsym rsym [TConstant [TInt, TBool, TNull]]
-        NGte   -> check lsym rsym [ TConstant [TInt, TBool, TNull] ]
+    NGte    -> check lsym rsym [TConstant [TInt, TBool, TNull]]
 
-        NAnd   -> check lsym rsym [ TConstant [TBool] ]
+    NAnd    -> check lsym rsym [TConstant [TBool]]
-        NOr    -> check lsym rsym [ TConstant [TBool] ]
+    NOr     -> check lsym rsym [TConstant [TBool]]
-        NImpl  -> check lsym rsym [ TConstant [TBool] ]
+    NImpl   -> check lsym rsym [TConstant [TBool]]
 
     -- jww (2018-04-01): NYI: Allow Path + Str
-        NPlus  -> check lsym rsym [ TConstant [TInt], TStr, TPath ]
+    NPlus   -> check lsym rsym [TConstant [TInt], TStr, TPath]
-        NMinus -> check lsym rsym [ TConstant [TInt] ]
+    NMinus  -> check lsym rsym [TConstant [TInt]]
-        NMult  -> check lsym rsym [ TConstant [TInt] ]
+    NMult   -> check lsym rsym [TConstant [TInt]]
-        NDiv   -> check lsym rsym [ TConstant [TInt] ]
+    NDiv    -> check lsym rsym [TConstant [TInt]]
 
-        NUpdate -> check lsym rsym [ TSet Nothing ]
+    NUpdate -> check lsym rsym [TSet Nothing]
 
-        NConcat -> check lsym rsym [ TList y ]
+    NConcat -> check lsym rsym [TList y]
  where
   check lsym rsym xs = do
     let e = NBinary op lsym rsym
@@ -372,12 +381,16 @@ lintBinaryOp op lsym rarg = do
     unify (void e) lsym rsym
 
 infixl 1 `lintApp`
-lintApp :: forall e m. MonadLint e m
+lintApp
-        => NExprF () -> Symbolic m -> m (Symbolic m)
+  :: forall e m
+   . MonadLint e m
+  => NExprF ()
+  -> Symbolic m
+  -> m (Symbolic m)
   -> m (HashMap VarName (Symbolic m), Symbolic m)
 lintApp context fun arg = unpackSymbolic fun >>= \case
-    NAny -> throwError $ ErrorCall
+  NAny ->
-        "Cannot apply something not known to be a function"
+    throwError $ ErrorCall "Cannot apply something not known to be a function"
   NMany xs -> do
     (args, ys) <- fmap unzip $ forM xs $ \case
       TClosure _params -> arg >>= unpackSymbolic >>= \case
@@ -393,7 +406,7 @@ lintApp context fun arg = unpackSymbolic fun >>= \case
       _x            -> throwError $ ErrorCall "Attempt to call non-function"
 
     y <- everyPossible
-        (head args,) <$> foldM (unify context) y ys
+    (head args, ) <$> foldM (unify context) y ys
 
 newtype Lint s a = Lint
   { runLint :: ReaderT (Context (Lint s) (SThunk (Lint s))) (FreshIdT Int (ST s)) a }
@@ -423,11 +436,13 @@ symbolicBaseEnv :: Monad m => m (Scopes m (SThunk m))
 symbolicBaseEnv = return emptyScopes
 
 lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))
-lint opts expr = runLintM opts $
+lint opts expr =
-    symbolicBaseEnv
+  runLintM opts
-        >>= (`pushScopes`
+    $   symbolicBaseEnv
-                adi (Eval.eval . annotated . getCompose)
+    >>= (`pushScopes` adi (Eval.eval . annotated . getCompose)
-                    Eval.addSourcePositions expr)
+                          Eval.addSourcePositions
+                          expr
+        )
 
 instance Scoped (SThunk (Lint s)) (Lint s) where
   currentScopes = currentScopesReader

src/Nix/Normal.hs

@@ -28,13 +28,13 @@ newtype NormalLoop t f m = NormalLoop (NValue t f m)
 instance MonadDataErrorContext t f m => Exception (NormalLoop t f m)
 
 normalForm'
-    :: forall e t m f.
+  :: forall e t m f
-    ( Framed e m
+   . ( Framed e m
      , MonadThunk t m (NValue t f m)
      , MonadDataErrorContext t f m
      , Ord (ThunkId m)
      )
-    => (forall r. t -> (NValue t f m -> m r) -> m r)
+  => (forall r . t -> (NValue t f m -> m r) -> m r)
   -> NValue t f m
   -> m (NValueNF t f m)
 normalForm' f = run . nValueToNFM run go
@@ -45,9 +45,11 @@ normalForm' f = run . nValueToNFM run go
   run :: ReaderT Int (StateT (Set (ThunkId m)) m) r -> m r
   run = (`evalStateT` table) . (`runReaderT` start)
 
-    go :: t
+  go
-       -> (NValue t f m
+    :: t
-              -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValueNF t f m))
+    -> (  NValue t f m
+       -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValueNF t f m)
+       )
     -> ReaderT Int (StateT (Set (ThunkId m)) m) (NValueNF t f m)
   go t k = do
     b <- seen t
@@ -55,8 +57,8 @@ normalForm' f = run . nValueToNFM run go
       then return $ pure t
       else do
         i <- ask
-                when (i > 2000) $
+        when (i > 2000)
-                    error "Exceeded maximum normalization depth of 2000 levels"
+          $ error "Exceeded maximum normalization depth of 2000 levels"
         s         <- lift get
         (res, s') <- lift $ lift $ f t $ \v ->
           (`runStateT` s) . (`runReaderT` i) $ local succ $ k v
@@ -68,8 +70,7 @@ normalForm' f = run . nValueToNFM run go
       res <- gets (member tid)
       unless res $ modify (insert tid)
       return res
-        Nothing ->
+    Nothing -> return False
-            return False
 
 normalForm
   :: ( Framed e m
@@ -77,7 +78,8 @@ normalForm
      , MonadDataErrorContext t f m
      , Ord (ThunkId m)
      )
-    => NValue t f m -> m (NValueNF t f m)
+  => NValue t f m
+  -> m (NValueNF t f m)
 normalForm = normalForm' force
 
 normalForm_
@@ -86,21 +88,28 @@ normalForm_
      , MonadDataErrorContext t f m
      , Ord (ThunkId m)
      )
-    => NValue t f m -> m ()
+  => NValue t f m
+  -> m ()
 normalForm_ = void <$> normalForm' forceEff
 
-removeEffects :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+removeEffects
-              => NValue t f m -> NValueNF t f m
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+  => NValue t f m
+  -> NValueNF t f m
 removeEffects = nValueToNF (flip query opaque)
 
-removeEffectsM :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+removeEffectsM
-               => NValue t f m -> m (NValueNF t f m)
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+  => NValue t f m
+  -> m (NValueNF t f m)
 removeEffectsM = nValueToNFM id (flip queryM (pure opaque))
 
-opaque :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+opaque
-       => NValueNF t f m
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m) => NValueNF t f m
 opaque = nvStrNF $ principledMakeNixStringWithoutContext "<thunk>"
 
-dethunk :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+dethunk
-        => t -> m (NValueNF t f m)
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+  => t
+  -> m (NValueNF t f m)
 dethunk t = queryM t (pure opaque) removeEffectsM

src/Nix/Options.hs

@@ -1,6 +1,6 @@
 module Nix.Options where
 
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import           Data.Time
 
 data Options = Options
@@ -37,8 +37,7 @@ data Options = Options
     deriving Show
 
 defaultOptions :: UTCTime -> Options
-defaultOptions current = Options
+defaultOptions current = Options { verbose      = ErrorsOnly
-    { verbose      = ErrorsOnly
                                  , tracing      = False
                                  , thunks       = False
                                  , values       = False

src/Nix/Options/Parser.hs

@@ -1,13 +1,13 @@
 module Nix.Options.Parser where
 
-import           Control.Arrow (second)
+import           Control.Arrow                  ( second )
-import           Data.Char (isDigit)
+import           Data.Char                      ( isDigit )
-import           Data.Maybe (fromMaybe)
+import           Data.Maybe                     ( fromMaybe )
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
 import           Data.Time
 import           Nix.Options
-import           Options.Applicative hiding (ParserResult(..))
+import           Options.Applicative     hiding ( ParserResult(..) )
 
 decodeVerbosity :: Int -> Verbosity
 decodeVerbosity 0 = ErrorsOnly
@@ -18,112 +18,149 @@ decodeVerbosity 4 = DebugInfo
 decodeVerbosity _ = Vomit
 
 argPair :: Mod OptionFields (Text, Text) -> Parser (Text, Text)
-argPair = option $ str >>= \s ->
+argPair = option $ str >>= \s -> case Text.findIndex (== '=') s of
-    case Text.findIndex (== '=') s of
+  Nothing ->
-        Nothing -> errorWithoutStackTrace
+    errorWithoutStackTrace "Format of --arg/--argstr in hnix is: name=expr"
-            "Format of --arg/--argstr in hnix is: name=expr"
   Just i -> return $ second Text.tail $ Text.splitAt i s
 
 nixOptions :: UTCTime -> Parser Options
-nixOptions current = Options
+nixOptions current =
-    <$> (fromMaybe Informational <$>
+  Options
-         optional
+    <$> (fromMaybe Informational <$> optional
-           (option (do a <- str
+          (option
+            (do
+              a <- str
               if all isDigit a
                 then pure $ decodeVerbosity (read a)
-                       else fail "Argument to -v/--verbose must be a number")
+                else fail "Argument to -v/--verbose must be a number"
-            (   short 'v'
+            )
-             <> long "verbose"
+            (short 'v' <> long "verbose" <> help "Verbose output")
-             <> help "Verbose output")))
+          )
+        )
     <*> switch
           (  long "trace"
-         <> help "Enable tracing code (even more can be seen if built with --flags=tracing)")
+          <> help
+               "Enable tracing code (even more can be seen if built with --flags=tracing)"
+          )
     <*> switch
-        (   long "thunks"
+          (long "thunks" <> help
-         <> help "Enable reporting of thunk tracing as well as regular evaluation")
+            "Enable reporting of thunk tracing as well as regular evaluation"
+          )
     <*> switch
           (  long "values"
-         <> help "Enable reporting of value provenance in error messages")
+          <> help "Enable reporting of value provenance in error messages"
+          )
     <*> switch
           (  long "scopes"
-         <> help "Enable reporting of scopes in evaluation traces")
+          <> help "Enable reporting of scopes in evaluation traces"
-    <*> optional (strOption
+          )
+    <*> optional
+          (strOption
             (  long "reduce"
-         <> help "When done evaluating, output the evaluated part of the expression to FILE"))
+            <> help
+                 "When done evaluating, output the evaluated part of the expression to FILE"
+            )
+          )
     <*> switch
-        (   long "reduce-sets"
+          (long "reduce-sets" <> help
-         <> help "Reduce set members that aren't used; breaks if hasAttr is used")
+            "Reduce set members that aren't used; breaks if hasAttr is used"
+          )
     <*> switch
-        (   long "reduce-lists"
+          (long "reduce-lists" <> help
-         <> help "Reduce list members that aren't used; breaks if elemAt is used")
+            "Reduce list members that aren't used; breaks if elemAt is used"
+          )
     <*> switch
           (  long "parse"
-         <> help "Whether to parse the file (also the default right now)")
+          <> 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")
+          <> help "Whether to parse only, no pretty printing or checking"
-    <*> switch
+          )
-        (   long "find"
+    <*> switch (long "find" <> help "If selected, find paths within attr trees")
-         <> help "If selected, find paths within attr trees")
+    <*> optional
-    <*> optional (strOption
+          (strOption
             (  long "find-file"
-         <> help "Look up the given files in Nix's search path"))
+            <> 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")
+          <> help
-    <*> switch
+               "When used with --eval, recursively evaluate list elements and attributes"
-        (   long "eval"
+          )
-         <> help "Whether to evaluate, or just pretty-print")
+    <*> switch (long "eval" <> help "Whether to evaluate, or just pretty-print")
     <*> switch
           (  long "json"
-         <> help "Print the resulting value as an JSON representation")
+          <> help "Print the resulting value as an JSON representation"
+          )
     <*> switch
           (  long "xml"
-         <> help "Print the resulting value as an XML representation")
+          <> help "Print the resulting value as an XML representation"
-    <*> optional (strOption
+          )
+    <*> optional
+          (strOption
             (  short 'A'
             <> long "attr"
-         <> help "Select an attribute from the top-level Nix expression being evaluated"))
+            <> help
-    <*> many (strOption
+                 "Select an attribute from the top-level Nix expression being evaluated"
-        (   short 'I'
+            )
-         <> long "include"
+          )
-         <> help "Add a path to the Nix expression search path"))
+    <*> many
+          (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")
+          <> help "Whether to check for syntax errors after parsing"
-    <*> optional (strOption
+          )
+    <*> optional
+          (strOption
             (  long "read"
-         <> help "Read in an expression tree from a binary cache"))
+            <> help "Read in an expression tree from a binary cache"
+            )
+          )
     <*> switch
           (  long "cache"
-         <> help "Write out the parsed expression tree to a binary cache")
+          <> help "Write out the parsed expression tree to a binary cache"
+          )
     <*> switch
           (  long "repl"
-         <> help "After performing any indicated actions, enter the REPL")
+          <> help "After performing any indicated actions, enter the REPL"
+          )
     <*> switch
           (  long "ignore-errors"
-         <> help "Continue parsing files, even if there are errors")
+          <> help "Continue parsing files, even if there are errors"
-    <*> optional (strOption
+          )
-        (   short 'E'
+    <*> optional
-         <> long "expr"
+          (strOption
-         <> help "Expression to parse or evaluate"))
+            (short 'E' <> long "expr" <> help "Expression to parse or evaluate")
-    <*> many (argPair
+          )
-        (   long "arg"
+    <*> many
-         <> help "Argument to pass to an evaluated lambda"))
+          (argPair
-    <*> many (argPair
+            (long "arg" <> help "Argument to pass to an evaluated lambda")
+          )
+    <*> many
+          (argPair
             (  long "argstr"
-         <> help "Argument string to pass to an evaluated lambda"))
+            <> help "Argument string to pass to an evaluated lambda"
-    <*> optional (strOption
+            )
-        (   short 'f'
+          )
-         <> long "file"
+    <*> optional
-         <> help "Parse all of the files given in FILE; - means stdin"))
+          (strOption
-    <*> option (parseTimeOrError True defaultTimeLocale "%Y/%m/%d %H:%M:%S" <$> str)
+            (short 'f' <> long "file" <> help
-        (   long "now"
+              "Parse all of the files given in FILE; - means stdin"
-         <> value current
+            )
-         <> help "Set current time for testing purposes")
+          )
+    <*> option
+          (parseTimeOrError True defaultTimeLocale "%Y/%m/%d %H:%M:%S" <$> str)
+          (long "now" <> value current <> help
+            "Set current time for testing purposes"
+          )
     <*> many (strArgument (metavar "FILE" <> help "Path of file to parse"))
 
 nixOptionsInfo :: UTCTime -> ParserInfo Options
-nixOptionsInfo current =
+nixOptionsInfo current = info (helper <*> nixOptions current)
-    info (helper <*> nixOptions current)
                               (fullDesc <> progDesc "" <> header "hnix")

src/Nix/Parser.hs

@@ -26,13 +26,11 @@ module Nix.Parser
   , getUnaryOperator
   , getBinaryOperator
   , getSpecialOperator
-
   , nixToplevelForm
   , nixExpr
   , nixSet
   , nixBinders
   , nixSelector
-
   , nixSym
   , nixPath
   , nixString
@@ -44,32 +42,45 @@ module Nix.Parser
   , nixNull
   , symbol
   , whiteSpace
-    ) where
+  )
+where
 
-import           Prelude hiding (readFile)
+import           Prelude                 hiding ( readFile )
 
-import           Control.Applicative hiding (many, some)
+import           Control.Applicative     hiding ( many
+                                                , some
+                                                )
 import           Control.DeepSeq
 import           Control.Monad
 import           Control.Monad.Combinators.Expr
-import           Data.Char (isAlpha, isDigit, isSpace)
+import           Data.Char                      ( isAlpha
-import           Data.Data (Data(..))
+                                                , isDigit
-import           Data.Foldable (concat)
+                                                , isSpace
+                                                )
+import           Data.Data                      ( Data(..) )
+import           Data.Foldable                  ( concat )
 import           Data.Functor
 import           Data.Functor.Identity
-import           Data.HashSet (HashSet)
+import           Data.HashSet                   ( HashSet )
 import qualified Data.HashSet                  as HashSet
-import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.List.NonEmpty             ( NonEmpty(..) )
 import qualified Data.List.NonEmpty            as NE
 import qualified Data.Map                      as Map
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
-import           Data.Text hiding (map, foldr1, concat, concatMap, zipWith)
+import           Data.Text               hiding ( map
-import           Data.Text.Prettyprint.Doc (Doc, pretty)
+                                                , foldr1
+                                                , concat
+                                                , concatMap
+                                                , zipWith
+                                                )
+import           Data.Text.Prettyprint.Doc      ( Doc
+                                                , pretty
+                                                )
 import           Data.Text.Encoding
-import           Data.Typeable (Typeable)
+import           Data.Typeable                  ( Typeable )
 import           Data.Void
-import           GHC.Generics hiding (Prefix)
+import           GHC.Generics            hiding ( Prefix )
-import           Nix.Expr hiding (($>))
+import           Nix.Expr                hiding ( ($>) )
 import           Nix.Render
 import           Nix.Strings
 import           Text.Megaparsec
@@ -90,8 +101,10 @@ antiStart = symbol "${" <?> show ("${" :: String)
 
 nixAntiquoted :: Parser a -> Parser (Antiquoted a NExprLoc)
 nixAntiquoted p =
-        Antiquoted <$> (antiStart *> nixToplevelForm <* symbol "}")
+  Antiquoted
-    <+> Plain <$> p
+    <$> (antiStart *> nixToplevelForm <* symbol "}")
+    <+> Plain
+    <$> p
     <?> "anti-quotation"
 
 selDot :: Parser ()
@@ -99,38 +112,45 @@ selDot = try (symbol "." *> notFollowedBy nixPath) <?> "."
 
 nixSelect :: Parser NExprLoc -> Parser NExprLoc
 nixSelect term = do
-    res <- build
+  res <- build <$> term <*> optional
-        <$> term
+    ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixTerm))
-        <*> optional ((,) <$> (selDot *> nixSelector)
-                          <*> optional (reserved "or" *> nixTerm))
   continues <- optional $ lookAhead selDot
   case continues of
     Nothing -> pure res
     Just _  -> nixSelect (pure res)
  where
-  build :: NExprLoc
+  build
+    :: NExprLoc
     -> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc)
     -> NExprLoc
   build t Nothing       = t
-  build t (Just (s,o)) = nSelectLoc t s o
+  build t (Just (s, o)) = nSelectLoc t s o
 
 nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
 nixSelector = annotateLocation $ do
-    (x:xs) <- keyName `sepBy1` selDot
+  (x : xs) <- keyName `sepBy1` selDot
   return $ x :| xs
 
 nixTerm :: Parser NExprLoc
 nixTerm = do
   c <- try $ lookAhead $ satisfy $ \x ->
-        pathChar x ||
+    pathChar x
-        x == '(' ||
+      || x
-        x == '{' ||
+      == '('
-        x == '[' ||
+      || x
-        x == '<' ||
+      == '{'
-        x == '/' ||
+      || x
-        x == '"' ||
+      == '['
-        x == '\''||
+      || x
-        x == '^'
+      == '<'
+      || x
+      == '/'
+      || x
+      == '"'
+      || x
+      == '\''
+      || x
+      == '^'
   case c of
     '('  -> nixSelect nixParens
     '{'  -> nixSelect nixSet
@@ -140,21 +160,21 @@ nixTerm = do
     '"'  -> nixString
     '\'' -> nixString
     '^'  -> nixSynHole
-        _    -> msum $
+    _ ->
-            [ nixSelect nixSet | c == 'r' ] ++
+      msum
-            [ nixPath | pathChar c ] ++
+        $  [ nixSelect nixSet | c == 'r' ]
-            if isDigit c
+        ++ [ nixPath | pathChar c ]
-            then [ nixFloat
+        ++ if isDigit c
-                 , nixInt ]
+             then [nixFloat, nixInt]
-            else [ nixUri | isAlpha c ] ++
+             else
-                 [ nixBool | c == 't' || c == 'f' ] ++
+               [ nixUri | isAlpha c ]
-                 [ nixNull | c == 'n' ] ++
+               ++ [ nixBool | c == 't' || c == 'f' ]
-                 [ nixSelect nixSym ]
+               ++ [ nixNull | c == 'n' ]
+               ++ [nixSelect nixSym]
 
 nixToplevelForm :: Parser NExprLoc
 nixToplevelForm = keywords <+> nixLambda <+> nixExpr
-  where
+  where keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith
-    keywords = nixLet <+> nixIf <+> nixAssert <+> nixWith
 
 nixSym :: Parser NExprLoc
 nixSym = annotateLocation1 $ mkSymF <$> identifier
@@ -166,12 +186,13 @@ nixInt :: Parser NExprLoc
 nixInt = annotateLocation1 (mkIntF <$> integer <?> "integer")
 
 nixFloat :: Parser NExprLoc
-nixFloat = annotateLocation1 (try (mkFloatF . realToFrac <$> float) <?> "float")
+nixFloat =
+  annotateLocation1 (try (mkFloatF . realToFrac <$> float) <?> "float")
 
 nixBool :: Parser NExprLoc
-nixBool = annotateLocation1 (bool "true" True <+>
+nixBool =
-                             bool "false" False) <?> "bool" where
+  annotateLocation1 (bool "true" True <+> bool "false" False) <?> "bool"
-  bool str b = mkBoolF b <$ reserved str
+  where bool str b = mkBoolF b <$ reserved str
 
 nixNull :: Parser NExprLoc
 nixNull = annotateLocation1 (mkNullF <$ reserved "null" <?> "null")
@@ -183,57 +204,80 @@ nixList :: Parser NExprLoc
 nixList = annotateLocation1 (brackets (NList <$> many nixTerm) <?> "list")
 
 pathChar :: Char -> Bool
-pathChar x = isAlpha x || isDigit x || x == '.' || x == '_' || x == '-' || x == '+' || x == '~'
+pathChar x =
+  isAlpha x
+    || isDigit x
+    || x
+    == '.'
+    || x
+    == '_'
+    || x
+    == '-'
+    || x
+    == '+'
+    || x
+    == '~'
 
 slash :: Parser Char
-slash = try (char '/' <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x)))
+slash =
+  try
+      (  char '/'
+      <* notFollowedBy (satisfy (\x -> x == '/' || x == '*' || isSpace x))
+      )
     <?> "slash"
 
 -- | A path surrounded by angle brackets, indicating that it should be
 -- looked up in the NIX_PATH environment variable at evaluation.
 nixSearchPath :: Parser NExprLoc
 nixSearchPath = annotateLocation1
-    (mkPathF True <$> try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")
+  (   mkPathF True
-         <?> "spath")
+  <$> try (char '<' *> many (satisfy pathChar <+> slash) <* symbol ">")
+  <?> "spath"
+  )
 
 pathStr :: Parser FilePath
-pathStr = lexeme $ liftM2 (++) (many (satisfy pathChar))
+pathStr = lexeme $ liftM2
+  (++)
+  (many (satisfy pathChar))
   (Prelude.concat <$> some (liftM2 (:) slash (some (satisfy pathChar))))
 
 nixPath :: Parser NExprLoc
 nixPath = annotateLocation1 (try (mkPathF False <$> pathStr) <?> "path")
 
 nixLet :: Parser NExprLoc
-nixLet = annotateLocation1 (reserved "let"
+nixLet = annotateLocation1
-    *> (letBody <+> letBinders)
+  (reserved "let" *> (letBody <+> letBinders) <?> "let block")
-    <?> "let block")
  where
-    letBinders = NLet
+  letBinders = NLet <$> nixBinders <*> (reserved "in" *> nixToplevelForm)
-        <$> nixBinders
-        <*> (reserved "in" *> nixToplevelForm)
   -- Let expressions `let {..., body = ...}' are just desugared
   -- into `(rec {..., body = ...}).body'.
   letBody    = (\x -> NSelect x (StaticKey "body" :| []) Nothing) <$> aset
   aset       = annotateLocation1 $ NRecSet <$> braces nixBinders
 
 nixIf :: Parser NExprLoc
-nixIf = annotateLocation1 (NIf
+nixIf = annotateLocation1
+  (   NIf
   <$> (reserved "if" *> nixExpr)
   <*> (reserved "then" *> nixToplevelForm)
   <*> (reserved "else" *> nixToplevelForm)
-     <?> "if")
+  <?> "if"
+  )
 
 nixAssert :: Parser NExprLoc
-nixAssert = annotateLocation1 (NAssert
+nixAssert = annotateLocation1
+  (   NAssert
   <$> (reserved "assert" *> nixExpr)
   <*> (semi *> nixToplevelForm)
-  <?> "assert")
+  <?> "assert"
+  )
 
 nixWith :: Parser NExprLoc
-nixWith = annotateLocation1 (NWith
+nixWith = annotateLocation1
+  (   NWith
   <$> (reserved "with" *> nixToplevelForm)
   <*> (semi *> nixToplevelForm)
-  <?> "with")
+  <?> "with"
+  )
 
 nixLambda :: Parser NExprLoc
 nixLambda = nAbs <$> annotateLocation (try argExpr) <*> nixToplevelForm
@@ -249,27 +293,33 @@ nixUri = annotateLocation1 $ lexeme $ try $ do
   _       <- string ":"
   address <- some $ satisfy $ \x ->
     isAlpha x || isDigit x || x `elem` ("%/?:@&=+$,-_.!~*'" :: String)
-    return $ NStr $
+  return $ NStr $ DoubleQuoted
-        DoubleQuoted [Plain $ pack $ start : protocol ++ ':' : address]
+    [Plain $ pack $ start : protocol ++ ':' : address]
 
 nixString' :: Parser (NString NExprLoc)
 nixString' = lexeme (doubleQuoted <+> indented <?> "string")
  where
   doubleQuoted :: Parser (NString NExprLoc)
-    doubleQuoted = DoubleQuoted . removePlainEmpty . mergePlain
+  doubleQuoted =
-                <$> (doubleQ *> many (stringChar doubleQ (void $ char '\\')
+    DoubleQuoted
-                                                 doubleEscape)
+      .   removePlainEmpty
-                             <* doubleQ)
+      .   mergePlain
+      <$> (  doubleQ
+          *> many (stringChar doubleQ (void $ char '\\') doubleEscape)
+          <* doubleQ
+          )
       <?> "double quoted string"
 
   doubleQ      = void (char '"')
   doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode)
 
   indented :: Parser (NString NExprLoc)
-    indented = stripIndent
+  indented =
-            <$> (indentedQ *> many (stringChar indentedQ indentedQ
+    stripIndent
-                                               indentedEscape)
+      <$> (  indentedQ
-                           <* indentedQ)
+          *> many (stringChar indentedQ indentedQ indentedEscape)
+          <* indentedQ
+          )
       <?> "indented string"
 
   indentedQ      = void (string "''" <?> "\"''\"")
@@ -278,20 +328,23 @@ nixString' = lexeme (doubleQuoted <+> indented <?> "string")
     (Plain <$> ("''" <$ char '\'' <+> "$" <$ char '$')) <+> do
       _ <- char '\\'
       c <- escapeCode
-            pure $ if c == '\n'
+      pure $ if c == '\n' then EscapedNewline else Plain $ singleton c
-                   then EscapedNewline
-                   else Plain $ singleton c
 
   stringChar end escStart esc =
-            Antiquoted <$> (antiStart *> nixToplevelForm <* char '}')
+    Antiquoted
-        <+> Plain . singleton <$> char '$'
+      <$> (antiStart *> nixToplevelForm <* char '}')
+      <+> Plain
+      .   singleton
+      <$> char '$'
       <+> esc
-        <+> Plain . pack <$> some plainChar
+      <+> Plain
+      .   pack
+      <$> some plainChar
    where
     plainChar =
       notFollowedBy (end <+> void (char '$') <+> escStart) *> anySingle
 
-    escapeCode = msum [ c <$ char e | (c,e) <- escapeCodes ] <+> anySingle
+  escapeCode = msum [ c <$ char e | (c, e) <- escapeCodes ] <+> anySingle
 
 -- | Gets all of the arguments for a function.
 argExpr :: Parser (Params NExprLoc)
@@ -300,8 +353,11 @@ argExpr = msum [atLeft, onlyname, atRight] <* symbol ":" where
   -- in the case of, for example `x:y`. Is it a lambda function `x: y`, or
   -- a URI `x:y`? Nix syntax says it's the latter. So we need to fail if
   -- there's a valid URI parse here.
-  onlyname = msum [nixUri >> unexpected (Label ('v' NE.:| "alid uri")),
+  onlyname =
-                     Param <$> identifier]
+    msum
+      [ nixUri >> unexpected (Label ('v' NE.:| "alid uri"))
+      , Param <$> identifier
+      ]
 
   -- Parameters named by an identifier on the left (`args @ {x, y}`)
   atLeft = try $ do
@@ -348,7 +404,8 @@ nixBinders = (inherit <+> namedVar) `endBy` semi where
     Inherit x <$> many keyName <*> pure p <?> "inherited binding"
   namedVar = do
     p <- getSourcePos
-      NamedVar <$> (annotated <$> nixSelector)
+    NamedVar
+      <$> (annotated <$> nixSelector)
       <*> (equals *> nixToplevelForm)
       <*> pure p
       <?> "variable binding"
@@ -360,9 +417,8 @@ keyName = dynamicKey <+> staticKey where
   dynamicKey = DynamicKey <$> nixAntiquoted nixString'
 
 nixSet :: Parser NExprLoc
-nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set") where
+nixSet = annotateLocation1 ((isRec <*> braces nixBinders) <?> "set")
-  isRec = (reserved "rec" $> NRecSet <?> "recursive set")
+  where isRec = (reserved "rec" $> NRecSet <?> "recursive set") <+> pure NSet
-       <+> pure NSet
 
 parseNixFile :: MonadFile m => FilePath -> m (Result NExpr)
 parseNixFile =
@@ -381,8 +437,7 @@ parseNixTextLoc = parseFromText (whiteSpace *> nixToplevelForm <* eof)
 {- Parser.Library -}
 
 skipLineComment' :: Tokens Text -> Parser ()
-skipLineComment' prefix =
+skipLineComment' prefix = string prefix
-  string prefix
   *> void (takeWhileP (Just "character") (\x -> x /= '\n' && x /= '\r'))
 
 whiteSpace :: Parser ()
@@ -398,18 +453,41 @@ symbol :: Text -> Parser Text
 symbol = lexeme . string
 
 reservedEnd :: Char -> Bool
-reservedEnd x = isSpace x ||
+reservedEnd x =
-    x == '{' || x == '(' || x == '[' ||
+  isSpace x
-    x == '}' || x == ')' || x == ']' ||
+    || x
-    x == ';' || x == ':' || x == '.' ||
+    == '{'
-    x == '"' || x == '\'' || x == ','
+    || x
+    == '('
+    || x
+    == '['
+    || x
+    == '}'
+    || x
+    == ')'
+    || x
+    == ']'
+    || x
+    == ';'
+    || x
+    == ':'
+    || x
+    == '.'
+    || x
+    == '"'
+    || x
+    == '\''
+    || x
+    == ','
 
 reserved :: Text -> Parser ()
-reserved n = lexeme $ try $
+reserved n =
-    string n *> lookAhead (void (satisfy reservedEnd) <|> eof)
+  lexeme $ try $ string n *> lookAhead (void (satisfy reservedEnd) <|> eof)
 
 identifier = lexeme $ try $ do
-    ident <- cons <$> satisfy (\x -> isAlpha x || x == '_')
+  ident <-
+    cons
+    <$> satisfy (\x -> isAlpha x || x == '_')
     <*> takeWhileP Nothing identLetter
   guard (not (ident `HashSet.member` reservedNames))
   return ident
@@ -435,12 +513,7 @@ float = lexeme L.float
 
 reservedNames :: HashSet Text
 reservedNames = HashSet.fromList
-    [ "let", "in"
+  ["let", "in", "if", "then", "else", "assert", "with", "rec", "inherit"]
-    , "if", "then", "else"
-    , "assert"
-    , "with"
-    , "rec"
-    , "inherit" ]
 
 type Parser = ParsecT Void Text Identity
 
@@ -449,13 +522,13 @@ data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
 parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a)
 parseFromFileEx p path = do
   txt <- decodeUtf8 <$> readFile path
-    return $ either (Failure . pretty . errorBundlePretty) Success
+  return $ either (Failure . pretty . errorBundlePretty) Success $ parse p
-           $ parse p path txt
+                                                                         path
+                                                                         txt
 
 parseFromText :: Parser a -> Text -> Result a
 parseFromText p txt =
-    either (Failure . pretty . errorBundlePretty) Success $
+  either (Failure . pretty . errorBundlePretty) Success $ parse p "<string>" txt
-        parse p "<string>" txt
 
 {- Parser.Operators -}
 
@@ -491,17 +564,18 @@ operator n   = symbol n
 
 opWithLoc :: Text -> o -> (Ann SrcSpan o -> a) -> Parser a
 opWithLoc name op f = do
-    Ann ann _ <- annotateLocation $ {- dbg (unpack name) $ -} operator name
+  Ann ann _ <- annotateLocation $ {- dbg (unpack name) $ -}
+                                  operator name
   return $ f (Ann ann op)
 
-binaryN name op = (NBinaryDef name op NAssocNone,
+binaryN name op =
-                   InfixN  (opWithLoc name op nBinary))
+  (NBinaryDef name op NAssocNone, InfixN (opWithLoc name op nBinary))
-binaryL name op = (NBinaryDef name op NAssocLeft,
+binaryL name op =
-                   InfixL  (opWithLoc name op nBinary))
+  (NBinaryDef name op NAssocLeft, InfixL (opWithLoc name op nBinary))
-binaryR name op = (NBinaryDef name op NAssocRight,
+binaryR name op =
-                   InfixR  (opWithLoc name op nBinary))
+  (NBinaryDef name op NAssocRight, InfixR (opWithLoc name op nBinary))
-prefix  name op = (NUnaryDef name op,
+prefix name op =
-                   Prefix  (manyUnaryOp (opWithLoc name op nUnary)))
+  (NUnaryDef name op, Prefix (manyUnaryOp (opWithLoc name op nUnary)))
 -- postfix name op = (NUnaryDef name op,
 --                    Postfix (opWithLoc name op nUnary))
 
@@ -521,28 +595,40 @@ nixOperators selector =
     --                    mor <- optional (reserved "or" *> term)
     --                    return $ \x -> nSelectLoc x sel mor) ]
 
-    {-  2 -} [ (NBinaryDef " " NApp NAssocLeft,
+    {-  2 -}
+    [ ( NBinaryDef " " NApp NAssocLeft
+      ,
                 -- Thanks to Brent Yorgey for showing me this trick!
-                InfixL $ nApp <$ symbol "") ]
+        InfixL $ nApp <$ symbol ""
-  , {-  3 -} [ prefix  "-"  NNeg ]
+      )
-  , {-  4 -} [ (NSpecialDef "?" NHasAttrOp NAssocLeft,
+    ]
-                Postfix $ symbol "?" *> (flip nHasAttr <$> selector)) ]
+  , {-  3 -}
-  , {-  5 -} [ binaryR "++" NConcat ]
+    [prefix "-" NNeg]
-  , {-  6 -} [ binaryL "*"  NMult
+  , {-  4 -}
-             , binaryL "/"  NDiv ]
+    [ ( NSpecialDef "?" NHasAttrOp NAssocLeft
-  , {-  7 -} [ binaryL "+"  NPlus
+      , Postfix $ symbol "?" *> (flip nHasAttr <$> selector)
-             , binaryL "-"  NMinus ]
+      )
-  , {-  8 -} [ prefix  "!"  NNot ]
+    ]
-  , {-  9 -} [ binaryR "//" NUpdate ]
+  , {-  5 -}
-  , {- 10 -} [ binaryL "<"  NLt
+    [binaryR "++" NConcat]
-             , binaryL ">"  NGt
+  , {-  6 -}
-             , binaryL "<=" NLte
+    [binaryL "*" NMult, binaryL "/" NDiv]
-             , binaryL ">=" NGte ]
+  , {-  7 -}
-  , {- 11 -} [ binaryN "==" NEq
+    [binaryL "+" NPlus, binaryL "-" NMinus]
-             , binaryN "!=" NNEq ]
+  , {-  8 -}
-  , {- 12 -} [ binaryL "&&" NAnd ]
+    [prefix "!" NNot]
-  , {- 13 -} [ binaryL "||" NOr ]
+  , {-  9 -}
-  , {- 14 -} [ binaryN "->" NImpl ]
+    [binaryR "//" NUpdate]
+  , {- 10 -}
+    [binaryL "<" NLt, binaryL ">" NGt, binaryL "<=" NLte, binaryL ">=" NGte]
+  , {- 11 -}
+    [binaryN "==" NEq, binaryN "!=" NNEq]
+  , {- 12 -}
+    [binaryL "&&" NAnd]
+  , {- 13 -}
+    [binaryL "||" NOr]
+  , {- 14 -}
+    [binaryN "->" NImpl]
   ]
 
 data OperatorInfo = OperatorInfo
@@ -553,7 +639,8 @@ data OperatorInfo = OperatorInfo
 
 getUnaryOperator :: NUnaryOp -> OperatorInfo
 getUnaryOperator = (m Map.!) where
-  m = Map.fromList $ concat $ zipWith buildEntry [1..]
+  m = Map.fromList $ concat $ zipWith buildEntry
+                                      [1 ..]
                                       (nixOperators (error "unused"))
   buildEntry i = concatMap $ \case
     (NUnaryDef name op, _) -> [(op, OperatorInfo i NAssocNone name)]
@@ -561,7 +648,8 @@ getUnaryOperator = (m Map.!) where
 
 getBinaryOperator :: NBinaryOp -> OperatorInfo
 getBinaryOperator = (m Map.!) where
-  m = Map.fromList $ concat $ zipWith buildEntry [1..]
+  m = Map.fromList $ concat $ zipWith buildEntry
+                                      [1 ..]
                                       (nixOperators (error "unused"))
   buildEntry i = concatMap $ \case
     (NBinaryDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
@@ -570,8 +658,17 @@ getBinaryOperator = (m Map.!) where
 getSpecialOperator :: NSpecialOp -> OperatorInfo
 getSpecialOperator NSelectOp = OperatorInfo 1 NAssocLeft "."
 getSpecialOperator o         = m Map.! o where
-  m = Map.fromList $ concat $ zipWith buildEntry [1..]
+  m = Map.fromList $ concat $ zipWith buildEntry
+                                      [1 ..]
                                       (nixOperators (error "unused"))
   buildEntry i = concatMap $ \case
     (NSpecialDef name op assoc, _) -> [(op, OperatorInfo i assoc name)]
     _                              -> []
+
+
+
+
+
+
+
+

src/Nix/Pretty.hs

@@ -16,17 +16,25 @@
 
 module Nix.Pretty where
 
-import           Control.Applicative ((<|>))
+import           Control.Applicative            ( (<|>) )
 import           Control.Comonad
 import           Data.Fix
-import           Data.HashMap.Lazy (toList)
+import           Data.HashMap.Lazy              ( toList )
 import qualified Data.HashMap.Lazy             as M
 import qualified Data.HashSet                  as HashSet
-import           Data.List (isPrefixOf, sort)
+import           Data.List                      ( isPrefixOf
-import           Data.List.NonEmpty (NonEmpty(..))
+                                                , sort
+                                                )
+import           Data.List.NonEmpty             ( NonEmpty(..) )
 import qualified Data.List.NonEmpty            as NE
-import           Data.Maybe (isJust, fromMaybe)
+import           Data.Maybe                     ( isJust
-import           Data.Text (pack, unpack, replace, strip)
+                                                , fromMaybe
+                                                )
+import           Data.Text                      ( pack
+                                                , unpack
+                                                , replace
+                                                , strip
+                                                )
 import qualified Data.Text                     as Text
 import           Data.Text.Prettyprint.Doc
 import           Nix.Atoms
@@ -40,11 +48,11 @@ import           Nix.Thunk
 #if ENABLE_TRACING
 import           Nix.Utils
 #else
-import           Nix.Utils hiding ((<$>))
+import           Nix.Utils               hiding ( (<$>) )
 #endif
 import           Nix.Value
-import           Prelude hiding ((<$>))
+import           Prelude                 hiding ( (<$>) )
-import           Text.Read (readMaybe)
+import           Text.Read                      ( readMaybe )
 
 -- | This type represents a pretty printed nix expression
 -- together with some information about the expression.
@@ -96,29 +104,35 @@ hasAttrOp = getSpecialOperator NHasAttrOp
 
 wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann
 wrapParens op sub
-  | precedence (rootOp sub) < precedence op = withoutParens sub
+  | precedence (rootOp sub) < precedence op
-  | precedence (rootOp sub) == precedence op
+  = withoutParens sub
-    && associativity (rootOp sub) == associativity op
+  | precedence (rootOp sub)
-    && associativity op /= NAssocNone = withoutParens sub
+    == precedence op
-  | otherwise = parens $ withoutParens sub
+    && associativity (rootOp sub)
+    == associativity op
+    && associativity op
+    /= NAssocNone
+  = withoutParens sub
+  | otherwise
+  = parens $ withoutParens sub
 
 -- Used in the selector case to print a path in a selector as
 -- "${./abc}"
 wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann
-wrapPath op sub =
+wrapPath op sub = if wasPath sub
-  if wasPath sub
   then dquotes $ "$" <> braces (withoutParens sub)
   else wrapParens op sub
 
-prettyString :: NString (NixDoc ann)-> Doc ann
+prettyString :: NString (NixDoc ann) -> Doc ann
 prettyString (DoubleQuoted parts) = dquotes . hcat . map prettyPart $ parts
-  where prettyPart (Plain t)      = pretty . concatMap escape . unpack $ t
+ where
+  prettyPart (Plain t)      = pretty . concatMap escape . unpack $ t
   prettyPart EscapedNewline = "''\\n"
   prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
   escape '"' = "\\\""
-        escape x = maybe [x] (('\\':) . (:[])) $ toEscapeCode x
+  escape x   = maybe [x] (('\\' :) . (: [])) $ toEscapeCode x
-prettyString (Indented _ parts)
+prettyString (Indented _ parts) = group $ nest 2 $ vcat
-  = group $ nest 2 $ vcat [dsquote, content, dsquote]
+  [dsquote, content, dsquote]
  where
   dsquote = squote <> squote
   content = vsep . map prettyLine . stripLastIfEmpty . splitLines $ parts
@@ -126,42 +140,48 @@ prettyString (Indented _ parts)
     f ([Plain t] : xs) | Text.null (strip t) = xs
     f xs = xs
   prettyLine = hcat . map prettyPart
-  prettyPart (Plain t) = pretty . unpack . replace "${" "''${" . replace "''" "'''" $ t
+  prettyPart (Plain t) =
+    pretty . unpack . replace "${" "''${" . replace "''" "'''" $ t
   prettyPart EscapedNewline = "\\n"
   prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
 
 prettyParams :: Params (NixDoc ann) -> Doc ann
-prettyParams (Param n) = pretty $ unpack n
+prettyParams (Param n           ) = pretty $ unpack n
 prettyParams (ParamSet s v mname) = prettyParamSet s v <> case mname of
   Nothing -> mempty
   Just name | Text.null name -> mempty
             | otherwise      -> "@" <> pretty (unpack name)
 
 prettyParamSet :: ParamSet (NixDoc ann) -> Bool -> Doc ann
-prettyParamSet args var =
+prettyParamSet args var = encloseSep
-    encloseSep (lbrace <> space) (align (space <> rbrace)) sep (map prettySetArg args ++ prettyVariadic)
+  (lbrace <> space)
+  (align (space <> rbrace))
+  sep
+  (map prettySetArg args ++ prettyVariadic)
  where
   prettySetArg (n, maybeDef) = case maybeDef of
     Nothing -> pretty (unpack n)
     Just v  -> pretty (unpack n) <+> "?" <+> withoutParens v
-    prettyVariadic = ["..." | var]
+  prettyVariadic = [ "..." | var ]
   sep            = align (comma <> space)
 
 prettyBind :: Binding (NixDoc ann) -> Doc ann
 prettyBind (NamedVar n v _p) =
   prettySelector n <+> equals <+> withoutParens v <> semi
-prettyBind (Inherit s ns _p)
+prettyBind (Inherit s ns _p) =
-  = "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi
+  "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi
   where scope = maybe mempty ((<> space) . parens . withoutParens) s
 
 prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann
 prettyKeyName (StaticKey "") = dquotes ""
-prettyKeyName (StaticKey key)
+prettyKeyName (StaticKey key) | HashSet.member key reservedNames =
-  | HashSet.member key reservedNames = dquotes $ pretty $ unpack key
+  dquotes $ pretty $ unpack key
 prettyKeyName (StaticKey  key) = pretty . unpack $ key
-prettyKeyName (DynamicKey key) =
+prettyKeyName (DynamicKey key) = runAntiquoted
-    runAntiquoted (DoubleQuoted [Plain "\n"])
+  (DoubleQuoted [Plain "\n"])
-        prettyString (("$" <>) . braces . withoutParens) key
+  prettyString
+  (("$" <>) . braces . withoutParens)
+  key
 
 prettySelector :: NAttrPath (NixDoc ann) -> Doc ann
 prettySelector = hcat . punctuate dot . map prettyKeyName . NE.toList
@@ -177,8 +197,11 @@ instance HasCitations1 t f m
   citations (NValue f) = citations1 f
   addProvenance x (NValue f) = NValue (addProvenance1 x f)
 
-prettyOriginExpr :: forall t f m ann. HasCitations1 t f m
+prettyOriginExpr
-                 => NExprLocF (Maybe (NValue t f m)) -> Doc ann
+  :: forall t f m ann
+   . HasCitations1 t f m
+  => NExprLocF (Maybe (NValue t f m))
+  -> Doc ann
 prettyOriginExpr = withoutParens . go
  where
   go = exprFNixDoc . annotated . getCompose . fmap render
@@ -197,27 +220,34 @@ exprFNixDoc = \case
   NConstant atom -> prettyAtom atom
   NStr      str  -> simpleExpr $ prettyString str
   NList     []   -> simpleExpr $ lbracket <> rbracket
-    NList xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
+  NList xs ->
-        [ [lbracket]
+    simpleExpr
-        , map (wrapParens appOpNonAssoc) xs
+      $ group
-        , [rbracket]
+      $ nest 2
-        ]
+      $ vsep
+      $ concat
+      $ [[lbracket], map (wrapParens appOpNonAssoc) xs, [rbracket]]
   NSet [] -> simpleExpr $ lbrace <> rbrace
-    NSet xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
+  NSet xs ->
-        [ [lbrace]
+    simpleExpr
-        , map prettyBind xs
+      $ group
-        , [rbrace]
+      $ nest 2
-        ]
+      $ vsep
+      $ concat
+      $ [[lbrace], map prettyBind xs, [rbrace]]
   NRecSet [] -> simpleExpr $ recPrefix <> lbrace <> rbrace
-    NRecSet xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
+  NRecSet xs ->
-        [ [recPrefix <> lbrace]
+    simpleExpr
-        , map prettyBind xs
+      $ group
-        , [rbrace]
+      $ nest 2
-        ]
+      $ vsep
-    NAbs args body -> leastPrecedence $ nest 2 $ vsep $
+      $ concat
-        [ prettyParams args <> colon
+      $ [[recPrefix <> lbrace], map prettyBind xs, [rbrace]]
-        , withoutParens body
+  NAbs args body ->
-        ]
+    leastPrecedence
+      $ nest 2
+      $ vsep
+      $ [prettyParams args <> colon, withoutParens body]
   NBinary NApp fun arg ->
     mkNixDoc (wrapParens appOp fun <+> wrapParens appOpNonAssoc arg) appOp
   NBinary op r1 r2 -> flip mkNixDoc opInfo $ hsep
@@ -229,12 +259,16 @@ exprFNixDoc = \case
     opInfo = getBinaryOperator op
     f x | associativity opInfo /= x = opInfo { associativity = NAssocNone }
         | otherwise                 = opInfo
-    NUnary op r1 ->
+  NUnary op r1 -> mkNixDoc
-        mkNixDoc (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1) opInfo
+    (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1)
+    opInfo
     where opInfo = getUnaryOperator op
   NSelect r' attr o ->
-      (if isJust o then leastPrecedence else flip mkNixDoc selectOp) $
+    (if isJust o then leastPrecedence else flip mkNixDoc selectOp)
-          wrapPath selectOp r <> dot <> prettySelector attr <> ordoc
+      $  wrapPath selectOp r
+      <> dot
+      <> prettySelector attr
+      <> ordoc
    where
     r     = flip mkNixDoc selectOp $ wrapParens appOpNonAssoc r'
     ordoc = maybe mempty (((space <> "or") <+>) . wrapParens appOpNonAssoc) o
@@ -251,43 +285,49 @@ exprFNixDoc = \case
         | "../" `isPrefixOf` txt -> txt
         | otherwise              -> "./" ++ txt
   NSym name -> simpleExpr $ pretty (unpack name)
-    NLet binds body -> leastPrecedence $ group $ vsep $
+  NLet binds body ->
-      [ "let"
+    leastPrecedence
+      $ group
+      $ vsep
+      $ [ "let"
         , indent 2 (vsep (map prettyBind binds))
         , "in" <+> withoutParens body
         ]
-    NIf cond trueBody falseBody -> leastPrecedence $
+  NIf cond trueBody falseBody ->
-        group $ nest 2 $ vsep $
+    leastPrecedence
-          [ "if" <+> withoutParens cond
+      $ group
+      $ nest 2
+      $ vsep
+      $ [ "if" <+> withoutParens cond
         , align ("then" <+> withoutParens trueBody)
         , align ("else" <+> withoutParens falseBody)
         ]
-    NWith scope body -> leastPrecedence $ vsep $
+  NWith scope body ->
-        [ "with"  <+> withoutParens scope <> semi
+    leastPrecedence
-        , align $ withoutParens body
+      $ vsep
-        ]
+      $ ["with" <+> withoutParens scope <> semi, align $ withoutParens body]
-    NAssert cond body -> leastPrecedence $ vsep $
+  NAssert cond body ->
-        [ "assert" <+> withoutParens cond <> semi
+    leastPrecedence
-        , align $ withoutParens body
+      $ vsep
-        ]
+      $ ["assert" <+> withoutParens cond <> semi, align $ withoutParens body]
   NSynHole name -> simpleExpr $ pretty ("^" <> unpack name)
-  where
+  where recPrefix = "rec" <> space
-    recPrefix = "rec" <> space
 
-valueToExpr :: forall t f m. MonadDataContext f m => NValueNF t f m -> NExpr
+valueToExpr :: forall t f m . MonadDataContext f m => NValueNF t f m -> NExpr
 valueToExpr = iterNValueNF
   (const (mkStr (principledMakeNixStringWithoutContext "<CYCLE>")))
   phi
  where
   phi :: NValue' t f m NExpr -> NExpr
-    phi (NVConstant a)     = Fix $ NConstant a
+  phi (NVConstant a ) = Fix $ NConstant a
   phi (NVStr      ns) = mkStr ns
-    phi (NVList l)         = Fix $ NList l
+  phi (NVList     l ) = Fix $ NList l
-    phi (NVSet s p)        = Fix $ NSet
+  phi (NVSet s p    ) = Fix $ NSet
     [ NamedVar (StaticKey k :| []) v (fromMaybe nullPos (M.lookup k p))
-        | (k, v) <- toList s ]
+    | (k, v) <- toList s
-    phi (NVClosure _ _)    = Fix . NSym . pack $ "<closure>"
+    ]
-    phi (NVPath p)         = Fix $ NLiteralPath p
+  phi (NVClosure _ _   ) = Fix . NSym . pack $ "<closure>"
+  phi (NVPath p        ) = Fix $ NLiteralPath p
   phi (NVBuiltin name _) = Fix . NSym . pack $ "builtins." ++ name
   phi _                  = error "Pattern synonyms foil completeness check"
 
@@ -296,67 +336,88 @@ valueToExpr = iterNValueNF
 prettyNValueNF :: MonadDataContext f m => NValueNF t f m -> Doc ann
 prettyNValueNF = prettyNix . valueToExpr
 
-printNix :: forall t f m. MonadDataContext f m => NValueNF t f m -> String
+printNix :: forall t f m . MonadDataContext f m => NValueNF t f m -> String
 printNix = iterNValueNF (const "<CYCLE>") phi
  where
   phi :: NValue' t f m String -> String
-    phi (NVConstant a) = unpack $ atomText a
+  phi (NVConstant a ) = unpack $ atomText a
   phi (NVStr      ns) = show $ hackyStringIgnoreContext ns
-    phi (NVList l) = "[ " ++ unwords l ++ " ]"
+  phi (NVList     l ) = "[ " ++ unwords l ++ " ]"
   phi (NVSet s _) =
-        "{ " ++ concat [ check (unpack k) ++ " = " ++ v ++ "; "
+    "{ "
-                       | (k, v) <- sort $ toList s ] ++ "}"
+      ++ concat
+           [ check (unpack k) ++ " = " ++ v ++ "; "
+           | (k, v) <- sort $ toList s
+           ]
+      ++ "}"
    where
-        check v =
+    check v = fromMaybe
-            fromMaybe v
+      v
-            ((fmap (surround . show) (readMaybe v :: Maybe Int))
+      (   (fmap (surround . show) (readMaybe v :: Maybe Int))
-             <|> (fmap (surround . show) (readMaybe v :: Maybe Float)))
+      <|> (fmap (surround . show) (readMaybe v :: Maybe Float))
-          where
+      )
-            surround s = "\"" ++ s ++ "\""
+      where surround s = "\"" ++ s ++ "\""
-    phi NVClosure {} = "<<lambda>>"
+  phi NVClosure{}        = "<<lambda>>"
-    phi (NVPath fp) = fp
+  phi (NVPath fp       ) = fp
   phi (NVBuiltin name _) = "<<builtin " ++ name ++ ">>"
   phi _                  = error "Pattern synonyms foil completeness check"
 
 prettyNValue
   :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
-    => NValue t f m -> m (Doc ann)
+  => NValue t f m
+  -> m (Doc ann)
 prettyNValue = fmap prettyNValueNF . removeEffectsM
 
 prettyNValueProv
-    :: forall t f m ann.
+  :: forall t f m ann
-    ( HasCitations1 t f m
+   . ( HasCitations1 t f m
      , MonadThunk t m (NValue t f m)
      , MonadDataContext f m
      )
-    => NValue t f m -> m (Doc ann)
+  => NValue t f m
+  -> m (Doc ann)
 prettyNValueProv v@(NValue nv) = do
   let ps = citations1 @t @f @m nv
   case ps of
     [] -> prettyNValue v
     ps -> do
       v' <- prettyNValue v
-            pure $ fillSep $
+      pure
-              [ v'
+        $ fillSep
-              , indent 2 $ parens $ mconcat
+        $ [ v'
+          , indent 2
+          $ parens
+          $ mconcat
           $ "from: "
           : map (prettyOriginExpr . _originExpr) ps
           ]
 
 prettyNThunk
-    :: forall t f m ann.
+  :: forall t f m ann
-    ( HasCitations t f m t
+   . ( HasCitations t f m t
      , HasCitations1 t f m
      , MonadThunk t m (NValue t f m)
      , MonadDataContext f m
      )
-    => t -> m (Doc ann)
+  => t
+  -> m (Doc ann)
 prettyNThunk t = do
   let ps = citations @t @f @m @t t
   v' <- prettyNValueNF <$> dethunk t
-    pure $ fillSep $
+  pure
-      [ v'
+    $ fillSep
-      , indent 2 $ parens $ mconcat
+    $ [ v'
+      , indent 2
+      $ parens
+      $ mconcat
       $ "thunk from: "
       : map (prettyOriginExpr . _originExpr) ps
       ]
+
+
+
+
+
+
+
+

src/Nix/Reduce.hs

@@ -32,7 +32,7 @@
 module Nix.Reduce (reduceExpr, reducingEvalExpr) where
 
 import           Control.Applicative
-import           Control.Arrow (second)
+import           Control.Arrow                  ( second )
 import           Control.Monad
 import           Control.Monad.Catch
 import           Control.Monad.Fail
@@ -40,24 +40,31 @@ import           Control.Monad.Fix
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Control.Monad.State.Strict
-import           Control.Monad.Trans.Reader (ReaderT(..))
+import           Control.Monad.Trans.Reader     ( ReaderT(..) )
-import           Control.Monad.Trans.State.Strict (StateT(..))
+import           Control.Monad.Trans.State.Strict
+                                                ( StateT(..) )
 import           Data.Fix
 -- import           Data.Foldable
-import           Data.HashMap.Lazy (HashMap)
+import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
 -- import           Data.HashSet (HashSet)
 -- import qualified Data.HashSet as S
 import           Data.IORef
-import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.List.NonEmpty             ( NonEmpty(..) )
 import qualified Data.List.NonEmpty            as NE
-import           Data.Maybe (fromMaybe, mapMaybe, catMaybes)
+import           Data.Maybe                     ( fromMaybe
-import           Data.Text (Text)
+                                                , mapMaybe
+                                                , catMaybes
+                                                )
+import           Data.Text                      ( Text )
 import           Nix.Atoms
 import           Nix.Exec
 import           Nix.Expr
 import           Nix.Frames
-import           Nix.Options (Options, reduceSets, reduceLists)
+import           Nix.Options                    ( Options
+                                                , reduceSets
+                                                , reduceLists
+                                                )
 import           Nix.Parser
 import           Nix.Scope
 import           Nix.Utils
@@ -73,11 +80,16 @@ newtype Reducer m a = Reducer
               MonadState (HashMap FilePath NExprLoc))
 
 staticImport
-    :: forall m.
+  :: forall m
-      (MonadIO m, Scoped NExprLoc m, MonadFail m,
+   . ( MonadIO m
-       MonadReader (Maybe FilePath, Scopes m NExprLoc) m,
+     , Scoped NExprLoc m
-       MonadState (HashMap FilePath NExprLoc) m)
+     , MonadFail m
-    => SrcSpan -> FilePath -> m NExprLoc
+     , MonadReader (Maybe FilePath, Scopes m NExprLoc) m
+     , MonadState (HashMap FilePath NExprLoc) m
+     )
+  => SrcSpan
+  -> FilePath
+  -> m NExprLoc
 staticImport pann path = do
   mfile <- asks fst
   path  <- liftIO $ pathToDefaultNixFile path
@@ -96,10 +108,12 @@ staticImport pann path = do
     case eres of
       Failure err -> error $ "Parse failed: " ++ show err
       Success x   -> do
-                let pos  = SourcePos "Reduce.hs" (mkPos 1) (mkPos 1)
+        let
+          pos  = SourcePos "Reduce.hs" (mkPos 1) (mkPos 1)
           span = SrcSpan pos pos
           cur  = NamedVar (StaticKey "__cur_file" :| [])
-                        (Fix (NLiteralPath_ pann path)) pos
+                          (Fix (NLiteralPath_ pann path))
+                          pos
           x' = Fix (NLet_ span [cur] x)
         modify (M.insert path x')
         local (const (Just path, emptyScopes @m @NExprLoc)) $ do
@@ -112,19 +126,24 @@ staticImport pann path = do
 --     NSym_ _ var -> S.singleton var
 --     Compose (Ann _ x) -> fold x
 
-reduceExpr :: (MonadIO m, MonadFail m)
+reduceExpr
-           => Maybe FilePath -> NExprLoc -> m NExprLoc
+  :: (MonadIO m, MonadFail m) => Maybe FilePath -> NExprLoc -> m NExprLoc
-reduceExpr mpath expr
+reduceExpr mpath expr =
-    = (`evalStateT` M.empty)
+  (`evalStateT` M.empty)
     . (`runReaderT` (mpath, emptyScopes))
     . runReducer
     $ cata reduce expr
 
-reduce :: forall m.
+reduce
-            (MonadIO m, Scoped NExprLoc m, MonadFail m,
+  :: forall m
-            MonadReader (Maybe FilePath, Scopes m NExprLoc) m,
+   . ( MonadIO m
-            MonadState (HashMap FilePath NExprLoc) m)
+     , Scoped NExprLoc m
-       => NExprLocF (m NExprLoc) -> m NExprLoc
+     , MonadFail m
+     , MonadReader (Maybe FilePath, Scopes m NExprLoc) m
+     , MonadState (HashMap FilePath NExprLoc) m
+     )
+  => NExprLocF (m NExprLoc)
+  -> m NExprLoc
 
 -- | Reduce the variable to its value if defined.
 --   Leave it as it is otherwise.
@@ -182,18 +201,18 @@ reduce base@(NSelect_ _ _ attrs _)
  where
   sId = Fix <$> sequence base
   -- The selection AttrPath is composed of StaticKeys.
-    sAttrPath (StaticKey _:xs) = sAttrPath xs
+  sAttrPath (StaticKey _ : xs) = sAttrPath xs
   sAttrPath []                 = True
   sAttrPath _                  = False
   -- Find appropriate bind in set's binds.
   findBind []       _              = Nothing
-    findBind (x:xs) attrs@(a:|_) = case x of
+  findBind (x : xs) attrs@(a :| _) = case x of
-        n@(NamedVar (a':|_) _ _) | a' == a -> Just n
+    n@(NamedVar (a' :| _) _ _) | a' == a -> Just n
     _ -> findBind xs attrs
   -- Follow the attrpath recursively in sets.
   inspectSet (NSet_ _ binds) attrs = case findBind binds attrs of
     Just (NamedVar _ e _) -> case NE.uncons attrs of
-               (_,Just attrs) -> inspectSet (unFix e) attrs
+      (_, Just attrs) -> inspectSet (unFix e) attrs
       _               -> pure e
     _ -> sId
   inspectSet _ _ = sId
@@ -204,11 +223,10 @@ reduce base@(NSelect_ _ _ attrs _)
 --   if none of the binds inherit the super set.
 reduce e@(NSet_ ann binds) = do
   let usesInherit = flip any binds $ \case
-            Inherit {} -> True
+        Inherit{} -> True
         _         -> False
   if usesInherit
-        then clearScopes @NExprLoc $
+    then clearScopes @NExprLoc $ Fix . NSet_ ann <$> traverse sequence binds
-            Fix . NSet_ ann <$> traverse sequence binds
     else Fix <$> sequence e
 
 -- Encountering a 'rec set' construction eliminates any hope of inlining
@@ -226,9 +244,9 @@ reduce (NWith_ ann scope body) =
 reduce (NLet_ ann binds body) = do
   s <- fmap (M.fromList . catMaybes) $ forM binds $ \case
     NamedVar (StaticKey name :| []) def _pos -> def >>= \case
-            d@(Fix NAbs_ {})      -> pure $ Just (name, d)
+      d@(Fix NAbs_{}     ) -> pure $ Just (name, d)
-            d@(Fix NConstant_ {}) -> pure $ Just (name, d)
+      d@(Fix NConstant_{}) -> pure $ Just (name, d)
-            d@(Fix NStr_ {})      -> pure $ Just (name, d)
+      d@(Fix NStr_{}     ) -> pure $ Just (name, d)
       _                    -> pure Nothing
     _ -> pure Nothing
   body'  <- pushScope s body
@@ -280,8 +298,7 @@ instance Show (f r) => Show (FlaggedF f r) where
 
 type Flagged f = Fix (FlaggedF f)
 
-flagExprLoc :: (MonadIO n, Traversable f)
+flagExprLoc :: (MonadIO n, Traversable f) => Fix f -> n (Flagged f)
-            => Fix f -> n (Flagged f)
 flagExprLoc = cataM $ \x -> do
   flag <- liftIO $ newIORef False
   pure $ Fix $ FlaggedF (flag, x)
@@ -292,21 +309,21 @@ flagExprLoc = cataM $ \x -> do
 pruneTree :: MonadIO n => Options -> Flagged NExprLocF -> n (Maybe NExprLoc)
 pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do
   used <- liftIO $ readIORef b
-    pure $ if used
+  pure $ if used then Fix . Compose <$> traverse prune x else Nothing
-           then Fix . Compose <$> traverse prune x
-           else Nothing
  where
   prune :: NExprF (Maybe NExprLoc) -> Maybe (NExprF NExprLoc)
   prune = \case
     NStr str -> Just $ NStr (pruneString str)
-        NHasAttr (Just aset) attr -> Just $ NHasAttr aset (NE.map pruneKeyName attr)
+    NHasAttr (Just aset) attr ->
+      Just $ NHasAttr aset (NE.map pruneKeyName attr)
     NAbs params (Just body) -> Just $ NAbs (pruneParams params) body
 
     NList l | reduceLists opts -> Just $ NList (catMaybes l)
             | otherwise        -> Just $ NList (map (fromMaybe nNull) l)
     NSet binds | reduceSets opts -> Just $ NSet (mapMaybe sequence binds)
                | otherwise -> Just $ NSet (map (fmap (fromMaybe nNull)) binds)
-        NRecSet binds | reduceSets opts  -> Just $ NRecSet (mapMaybe sequence binds)
+    NRecSet binds
+      | reduceSets opts -> Just $ NRecSet (mapMaybe sequence binds)
       | otherwise       -> Just $ NRecSet (map (fmap (fromMaybe nNull)) binds)
 
     NLet binds (Just body@(Fix (Compose (Ann _ x)))) ->
@@ -341,8 +358,7 @@ pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do
     NAssert _ (Just (Fix (Compose (Ann _ body)))) -> Just body
     NAssert (Just cond) _ -> Just $ NAssert cond nNull
 
-        NIf Nothing _ _ ->
+    NIf Nothing _ _ -> error "How can an if be used, but its condition not?"
-            error "How can an if be used, but its condition not?"
 
     NIf _ Nothing (Just (Fix (Compose (Ann _ f)))) -> Just f
     NIf _ (Just (Fix (Compose (Ann _ t)))) Nothing -> Just t
@@ -352,15 +368,13 @@ pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do
   pruneString :: NString (Maybe NExprLoc) -> NString NExprLoc
   pruneString (DoubleQuoted xs) =
     DoubleQuoted (mapMaybe pruneAntiquotedText xs)
-    pruneString (Indented n xs)   =
+  pruneString (Indented n xs) = Indented n (mapMaybe pruneAntiquotedText xs)
-        Indented n (mapMaybe pruneAntiquotedText xs)
 
   pruneAntiquotedText
-        :: Antiquoted Text (Maybe NExprLoc)
+    :: Antiquoted Text (Maybe NExprLoc) -> Maybe (Antiquoted Text NExprLoc)
-        -> Maybe (Antiquoted Text NExprLoc)
   pruneAntiquotedText (Plain v)             = Just (Plain v)
   pruneAntiquotedText EscapedNewline        = Just EscapedNewline
-    pruneAntiquotedText (Antiquoted Nothing)  = Nothing
+  pruneAntiquotedText (Antiquoted Nothing ) = Nothing
   pruneAntiquotedText (Antiquoted (Just k)) = Just (Antiquoted k)
 
   pruneAntiquoted
@@ -368,23 +382,22 @@ pruneTree opts = cataM $ \(FlaggedF (b, Compose x)) -> do
     -> Maybe (Antiquoted (NString NExprLoc) NExprLoc)
   pruneAntiquoted (Plain v)             = Just (Plain (pruneString v))
   pruneAntiquoted EscapedNewline        = Just EscapedNewline
-    pruneAntiquoted (Antiquoted Nothing)  = Nothing
+  pruneAntiquoted (Antiquoted Nothing ) = Nothing
   pruneAntiquoted (Antiquoted (Just k)) = Just (Antiquoted k)
 
   pruneKeyName :: NKeyName (Maybe NExprLoc) -> NKeyName NExprLoc
   pruneKeyName (StaticKey n) = StaticKey n
-    pruneKeyName (DynamicKey k)
+  pruneKeyName (DynamicKey k) | Just k' <- pruneAntiquoted k = DynamicKey k'
-        | Just k' <- pruneAntiquoted k = DynamicKey k'
                               | otherwise = StaticKey "<unused?>"
 
   pruneParams :: Params (Maybe NExprLoc) -> Params NExprLoc
   pruneParams (Param n) = Param n
   pruneParams (ParamSet xs b n)
-        | reduceSets opts =
+    | reduceSets opts = ParamSet
-              ParamSet (map (second (maybe (Just nNull) Just
+      (map (second (maybe (Just nNull) Just . fmap (fromMaybe nNull))) xs)
-                                     . fmap (fromMaybe nNull))) xs) b n
+      b
-        | otherwise =
+      n
-              ParamSet (map (second (fmap (fromMaybe nNull))) xs) b n
+    | otherwise = ParamSet (map (second (fmap (fromMaybe nNull))) xs) b n
 
   pruneBinding :: Binding (Maybe NExprLoc) -> Maybe (Binding NExprLoc)
   pruneBinding (NamedVar _ Nothing _) = Nothing
@@ -407,8 +420,7 @@ reducingEvalExpr eval mpath expr = do
   opts :: Options <- asks (view hasLens)
   expr''          <- pruneTree opts expr'
   return (fromMaybe nNull expr'', eres)
-  where
+  where addEvalFlags k (FlaggedF (b, x)) = liftIO (writeIORef b True) *> k x
-    addEvalFlags k (FlaggedF (b, x)) = liftIO (writeIORef b True) *> k x
 
 instance Monad m => Scoped NExprLoc (Reducer m) where
   currentScopes = currentScopesReader

src/Nix/Render.hs

@@ -11,10 +11,10 @@
 
 module Nix.Render where
 
-import           Prelude hiding (readFile)
+import           Prelude                 hiding ( readFile )
 
 import           Control.Monad.Trans
-import           Data.ByteString (ByteString)
+import           Data.ByteString                ( ByteString )
 import qualified Data.ByteString               as BS
 import qualified Data.Set                      as Set
 import qualified Data.Text                     as T
@@ -68,48 +68,59 @@ instance MonadFile IO where
   getSymbolicLinkStatus = S.getSymbolicLinkStatus
 
 posAndMsg :: SourcePos -> Doc a -> ParseError s Void
-posAndMsg (SourcePos _ lineNo _) msg =
+posAndMsg (SourcePos _ lineNo _) msg = FancyError
-    FancyError (unPos lineNo)
+  (unPos lineNo)
   (Set.fromList [ErrorFail (show msg) :: ErrorFancy Void])
 
 renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)
-renderLocation (SrcSpan (SourcePos file begLine begCol)
+renderLocation (SrcSpan (SourcePos file begLine begCol) (SourcePos file' endLine endCol)) msg
-                        (SourcePos file' endLine endCol)) msg
+  | file /= "<string>" && file == file'
-    | file /= "<string>" && file == file' = do
+  = do
     exist <- doesFileExist file
     if exist
       then do
         txt <- sourceContext file begLine begCol endLine endCol msg
-            return $ vsep
+        return
-              [ "In file " <> errorContext file begLine begCol endLine endCol <> ":"
+          $ vsep
+              [ "In file "
+              <> errorContext file begLine begCol endLine endCol
+              <> ":"
               , txt
               ]
       else return msg
 renderLocation (SrcSpan beg end) msg =
-    fail $ "Don't know how to render range from " ++ show beg ++ " to " ++ show end
+  fail
-      ++ " for error: " ++ show msg
+    $  "Don't know how to render range from "
+    ++ show beg
+    ++ " to "
+    ++ show end
+    ++ " for error: "
+    ++ show msg
 
 errorContext :: FilePath -> Pos -> Pos -> Pos -> Pos -> Doc a
 errorContext path bl bc _el _ec =
   pretty path <> ":" <> pretty (unPos bl) <> ":" <> pretty (unPos bc)
 
-sourceContext :: MonadFile m => FilePath -> Pos -> Pos -> Pos -> Pos -> Doc a -> m (Doc a)
+sourceContext
-sourceContext path (unPos -> begLine) (unPos -> _begCol)
+  :: MonadFile m => FilePath -> Pos -> Pos -> Pos -> Pos -> Doc a -> m (Doc a)
-                   (unPos -> endLine) (unPos -> _endCol) msg = do
+sourceContext path (unPos -> begLine) (unPos -> _begCol) (unPos -> endLine) (unPos -> _endCol) msg
+  = do
     let beg' = max 1 (min begLine (begLine - 3))
         end' = max endLine (endLine + 3)
-    ls <- map pretty
+    ls <-
+      map pretty
       .   take (end' - beg')
       .   drop (pred beg')
       .   T.lines
       .   T.decodeUtf8
       <$> readFile path
-    let nums    = map (show . fst) $ zip [beg'..] ls
+    let
+      nums    = map (show . fst) $ zip [beg' ..] ls
       longest = maximum (map length nums)
-        nums'   = flip map nums $ \n ->
+      nums'   = flip map nums $ \n -> replicate (longest - length n) ' ' ++ n
-            replicate (longest - length n) ' ' ++ n
       pad n | read n == begLine = "==> " ++ n
             | otherwise         = "    " ++ n
-        ls' = zipWith (<+>) (map (pretty . pad) nums')
+      ls' = zipWith (<+>)
+                    (map (pretty . pad) nums')
                     (zipWith (<+>) (repeat "| ") ls)
     pure $ vsep $ ls' ++ [msg]

src/Nix/Render/Frame.hs

@@ -41,18 +41,17 @@ renderFrames
      , MonadCitedThunks t f m
      , Typeable v
      )
-  => Frames -> m (Doc ann)
+  => Frames
+  -> m (Doc ann)
 renderFrames []       = pure mempty
-renderFrames (x:xs) = do
+renderFrames (x : xs) = do
   opts :: Options <- asks (view hasLens)
-    frames <-
+  frames          <- if
-        if | verbose opts <= ErrorsOnly ->
+    | verbose opts <= ErrorsOnly -> renderFrame @v @t @f x
-             renderFrame @v @t @f x
     | verbose opts <= Informational -> do
       f <- renderFrame @v @t @f x
       pure $ concatMap go (reverse xs) ++ f
-           | otherwise ->
+    | otherwise -> concat <$> mapM (renderFrame @v @t @f) (reverse (x : xs))
-             concat <$> mapM (renderFrame @v @t @f) (reverse (x:xs))
   pure $ case frames of
     [] -> mempty
     _  -> vsep frames
@@ -60,29 +59,30 @@ renderFrames (x:xs) = do
   go :: NixFrame -> [Doc ann]
   go f = case framePos @v @m f of
     Just pos ->
-            ["While evaluating at "
+      ["While evaluating at " <> pretty (sourcePosPretty pos) <> colon]
-                <> pretty (sourcePosPretty pos)
-                <> colon]
     Nothing -> []
 
-framePos :: forall v (m :: * -> *). (Typeable m, Typeable v)
+framePos
-         => NixFrame -> Maybe SourcePos
+  :: forall v (m :: * -> *)
+   . (Typeable m, Typeable v)
+  => NixFrame
+  -> Maybe SourcePos
 framePos (NixFrame _ f)
   | Just (e :: EvalFrame m v) <- fromException f = case e of
-          EvaluatingExpr _ (Fix (Compose (Ann (SrcSpan beg _) _))) ->
+    EvaluatingExpr _ (Fix (Compose (Ann (SrcSpan beg _) _))) -> Just beg
-              Just beg
     _ -> Nothing
   | otherwise = Nothing
 
 renderFrame
-    :: forall v t f e m ann.
+  :: forall v t f e m ann
-      ( MonadReader e m
+   . ( MonadReader e m
      , Has e Options
      , MonadFile m
      , MonadCitedThunks t f m
      , Typeable v
      )
-    => NixFrame -> m [Doc ann]
+  => NixFrame
+  -> m [Doc ann]
 renderFrame (NixFrame level f)
   | Just (e :: EvalFrame m v) <- fromException f = renderEvalFrame level e
   | Just (e :: ThunkLoop) <- fromException f = renderThunkLoop level e
@@ -96,39 +96,50 @@ renderFrame (NixFrame level f)
 wrapExpr :: NExprF r -> NExpr
 wrapExpr x = Fix (Fix (NSym "<?>") <$ x)
 
-renderEvalFrame :: (MonadReader e m, Has e Options, MonadFile m)
+renderEvalFrame
-                => NixLevel -> EvalFrame m v -> m [Doc ann]
+  :: (MonadReader e m, Has e Options, MonadFile m)
+  => NixLevel
+  -> EvalFrame m v
+  -> m [Doc ann]
 renderEvalFrame level f = do
   opts :: Options <- asks (view hasLens)
   case f of
     EvaluatingExpr scope e@(Fix (Compose (Ann ann _))) -> do
       let scopeInfo | scopes opts = [pretty $ show scope]
                     | otherwise   = []
-            fmap (\x -> scopeInfo ++ [x]) $ renderLocation ann
+      fmap (\x -> scopeInfo ++ [x])
+        $   renderLocation ann
         =<< renderExpr level "While evaluating" "Expression" e
 
-        ForcingExpr _scope e@(Fix (Compose (Ann ann _)))
+    ForcingExpr _scope e@(Fix (Compose (Ann ann _))) | thunks opts ->
-            | thunks opts ->
+      fmap (: [])
-                  fmap (:[]) $ renderLocation ann
+        $   renderLocation ann
-                      =<< renderExpr level "While forcing thunk from"
+        =<< renderExpr level "While forcing thunk from" "Forcing thunk" e
-                                     "Forcing thunk" e
 
     Calling name ann ->
-            fmap (:[]) $ renderLocation ann $
+      fmap (: [])
-                "While calling builtins." <> pretty name
+        $  renderLocation ann
+        $  "While calling builtins."
+        <> pretty name
 
-        SynHole synfo -> sequence $
+    SynHole synfo ->
-            let e@(Fix (Compose (Ann ann _))) = _synHoleInfo_expr synfo
+      sequence
-             in [ renderLocation ann =<<
+        $ let e@(Fix (Compose (Ann ann _))) = _synHoleInfo_expr synfo
-                    renderExpr level "While evaluating" "Syntactic Hole" e
+          in  [ renderLocation ann
+                =<< renderExpr level "While evaluating" "Syntactic Hole" e
               , pure $ pretty $ show (_synHoleInfo_scope synfo)
               ]
 
     ForcingExpr _ _ -> pure []
 
 
-renderExpr :: (MonadReader e m, Has e Options, MonadFile m)
+renderExpr
-           => NixLevel -> String -> String -> NExprLoc -> m (Doc ann)
+  :: (MonadReader e m, Has e Options, MonadFile m)
+  => NixLevel
+  -> String
+  -> String
+  -> NExprLoc
+  -> m (Doc ann)
 renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do
   opts :: Options <- asks (view hasLens)
   let rendered
@@ -138,26 +149,20 @@ renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do
 #else
               pretty (show (stripAnnotation e))
 #endif
-            | verbose opts >= Chatty =
+          | verbose opts >= Chatty = prettyNix (stripAnnotation e)
-              prettyNix (stripAnnotation e)
+          | otherwise = prettyNix (Fix (Fix (NSym "<?>") <$ x))
-            | otherwise =
-              prettyNix (Fix (Fix (NSym "<?>") <$ x))
   pure $ if verbose opts >= Chatty
-           then vsep $
+    then
-               [ pretty (longLabel ++ ":\n>>>>>>>>")
+      vsep
-               , indent 2 rendered
+        $ [pretty (longLabel ++ ":\n>>>>>>>>"), indent 2 rendered, "<<<<<<<<"]
-               , "<<<<<<<<"
-               ]
     else pretty shortLabel <> fillSep [": ", rendered]
 
 renderValueFrame
-    :: ( MonadReader e m
+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
-      , Has e Options
+  => NixLevel
-      , MonadFile m
+  -> ValueFrame t f m
-      , MonadCitedThunks t f m
+  -> m [Doc ann]
-      )
+renderValueFrame level = fmap (: []) . \case
-    => NixLevel -> ValueFrame t f m -> m [Doc ann]
-renderValueFrame level = fmap (:[]) . \case
   ForcingThunk       -> pure "ForcingThunk"
   ConcerningValue _v -> pure "ConcerningValue"
   Comparison     _ _ -> pure "Comparing"
@@ -165,12 +170,8 @@ renderValueFrame level = fmap (:[]) . \case
   Division       _ _ -> pure "Dividing"
   Multiplication _ _ -> pure "Multiplying"
 
-    Coercion x y -> pure $ mconcat
+  Coercion       x y -> pure
-        [ desc
+    $ mconcat [desc, pretty (describeValue x), " to ", pretty (describeValue y)]
-        , pretty (describeValue x)
-        , " to "
-        , pretty (describeValue y)
-        ]
    where
     desc | level <= Error = "Cannot coerce "
          | otherwise      = "While coercing "
@@ -182,49 +183,54 @@ renderValueFrame level = fmap (:[]) . \case
   ExpectationNF _t _v -> pure "ExpectationNF"
   Expectation   t  v  -> do
     v' <- renderValue level "" "" v
-        pure $ "Saw " <> v'
+    pure $ "Saw " <> v' <> " but expected " <> pretty (describeValue t)
-            <> " but expected " <> pretty (describeValue t)
 
 renderValue
-    :: ( MonadReader e m
+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
-      , Has e Options
+  => NixLevel
-      , MonadFile m
+  -> String
-      , MonadCitedThunks t f m
+  -> String
-      )
+  -> NValue t f m
-    => NixLevel -> String -> String -> NValue t f m -> m (Doc ann)
+  -> m (Doc ann)
 renderValue _level _longLabel _shortLabel v = do
   opts :: Options <- asks (view hasLens)
-    if values opts
+  if values opts then prettyNValueProv v else prettyNValue v
-        then prettyNValueProv v
-        else prettyNValue v
 
 renderExecFrame
-    :: ( MonadReader e m
+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
-      , Has e Options
+  => NixLevel
-      , MonadFile m
+  -> ExecFrame t f m
-      , MonadCitedThunks t f m
+  -> m [Doc ann]
-      )
-    => NixLevel -> ExecFrame t f m -> m [Doc ann]
 renderExecFrame level = \case
   Assertion ann v ->
-        fmap (:[]) $ renderLocation ann
+    fmap (: [])
-            =<< ((\d -> fillSep ["Assertion failed:", d])
+      $   renderLocation ann
-                     <$> renderValue level "" "" v)
+      =<< (   (\d -> fillSep ["Assertion failed:", d])
+          <$> renderValue level "" "" v
+          )
 
 renderThunkLoop
   :: (MonadReader e m, Has e Options, MonadFile m, Show (ThunkId m))
-    => NixLevel -> ThunkLoop -> m [Doc ann]
+  => NixLevel
-renderThunkLoop _level = pure . (:[]) . \case
+  -> ThunkLoop
+  -> m [Doc ann]
+renderThunkLoop _level = pure . (: []) . \case
   ThunkLoop n -> pretty $ "Infinite recursion in thunk " ++ n
 
 renderNormalLoop
-    :: ( MonadReader e m
+  :: (MonadReader e m, Has e Options, MonadFile m, MonadCitedThunks t f m)
-      , Has e Options
+  => NixLevel
-      , MonadFile m
+  -> NormalLoop t f m
-      , MonadCitedThunks t f m
+  -> m [Doc ann]
-      )
+renderNormalLoop level = fmap (: []) . \case
-    => NixLevel -> NormalLoop t f m -> m [Doc ann]
-renderNormalLoop level = fmap (:[]) . \case
   NormalLoop v -> do
     v' <- renderValue level "" "" v
     pure $ "Infinite recursion during normalization forcing " <> v'
+
+
+
+
+
+
+
+

src/Nix/Scope.hs

@@ -16,7 +16,7 @@ module Nix.Scope where
 import           Control.Applicative
 import           Control.Monad.Reader
 import qualified Data.HashMap.Lazy             as M
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import           Lens.Family2
 import           Nix.Utils
 
@@ -31,8 +31,7 @@ newScope = Scope
 
 scopeLookup :: Text -> [Scope t] -> Maybe t
 scopeLookup key = foldr go Nothing
-  where
+  where go (Scope m) rest = M.lookup key m <|> rest
-    go (Scope m) rest = M.lookup key m <|> rest
 
 data Scopes m t = Scopes
     { lexicalScopes :: [Scope t]
@@ -41,8 +40,7 @@ data Scopes m t = Scopes
 
 instance Show (Scopes m t) where
   show (Scopes m t) =
-        "Scopes: " ++ show m ++ ", and "
+    "Scopes: " ++ show m ++ ", and " ++ show (length t) ++ " with-scopes"
-            ++ show (length t) ++ " with-scopes"
 
 instance Semigroup (Scopes m t) where
   Scopes ls lw <> Scopes rs rw = Scopes (ls <> rs) (lw <> rw)
@@ -51,7 +49,7 @@ instance Monoid (Scopes m t) where
   mempty  = emptyScopes
   mappend = (<>)
 
-emptyScopes :: forall m t. Scopes m t
+emptyScopes :: forall m t . Scopes m t
 emptyScopes = Scopes [] []
 
 class Scoped t m | m -> t where
@@ -60,10 +58,12 @@ class Scoped t m | m -> t where
   pushScopes :: Scopes m t -> m a -> m a
   lookupVar :: Text -> m (Maybe t)
 
-currentScopesReader :: forall m t e. (MonadReader e m, Has e (Scopes m t)) => m (Scopes m t)
+currentScopesReader
+  :: forall m t e . (MonadReader e m, Has e (Scopes m t)) => m (Scopes m t)
 currentScopesReader = asks (view hasLens)
 
-clearScopesReader :: forall m t e a. (MonadReader e m, Has e (Scopes m t)) => m a -> m a
+clearScopesReader
+  :: forall m t e a . (MonadReader e m, Has e (Scopes m t)) => m a -> m a
 clearScopesReader = local (set hasLens (emptyScopes @m @t))
 
 pushScope :: Scoped t m => AttrSet t -> m a -> m a
@@ -72,22 +72,27 @@ pushScope s = pushScopes (Scopes [Scope s] [])
 pushWeakScope :: (Functor m, Scoped t m) => m (AttrSet t) -> m a -> m a
 pushWeakScope s = pushScopes (Scopes [] [Scope <$> s])
 
-pushScopesReader :: (MonadReader e m, Has e (Scopes m t)) => Scopes m t -> m a -> m a
+pushScopesReader
+  :: (MonadReader e m, Has e (Scopes m t)) => Scopes m t -> m a -> m a
 pushScopesReader s = local (over hasLens (s <>))
 
-lookupVarReader :: forall m t e. (MonadReader e m, Has e (Scopes m t)) => Text -> m (Maybe t)
+lookupVarReader
+  :: forall m t e . (MonadReader e m, Has e (Scopes m t)) => Text -> m (Maybe t)
 lookupVarReader k = do
   mres <- asks (scopeLookup k . lexicalScopes @m . view hasLens)
   case mres of
     Just sym -> return $ Just sym
     Nothing  -> do
       ws <- asks (dynamicScopes . view hasLens)
-            foldr (\x rest -> do
+      foldr
+        (\x rest -> do
           mres' <- M.lookup k . getScope <$> x
           case mres' of
             Just sym -> return $ Just sym
-                              Nothing  -> rest)
+            Nothing  -> rest
-                  (return Nothing) ws
+        )
+        (return Nothing)
+        ws
 
 withScopes :: Scoped t m => Scopes m t -> m a -> m a
 withScopes scope = clearScopes . pushScopes scope

src/Nix/String.hs

@@ -2,8 +2,8 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
-module Nix.String (
+module Nix.String
-    NixString
+  ( NixString
   , principledGetContext
   , principledMakeNixString
   , principledMempty
@@ -29,13 +29,14 @@ module Nix.String (
   , addSingletonStringContext
   , runWithStringContextT
   , runWithStringContext
-) where
+  )
+where
 
 import           Control.Monad.Writer
 import           Data.Functor.Identity
 import qualified Data.HashSet                  as S
 import           Data.Hashable
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
 import           GHC.Generics
 
@@ -73,11 +74,13 @@ principledMempty = NixString "" mempty
 
 -- | Combine two NixStrings using mappend
 principledStringMappend :: NixString -> NixString -> NixString
-principledStringMappend (NixString s1 t1) (NixString s2 t2) = NixString (s1 <> s2) (t1 <> t2)
+principledStringMappend (NixString s1 t1) (NixString s2 t2) =
+  NixString (s1 <> s2) (t1 <> t2)
 
 -- | Combine two NixStrings using mappend
 hackyStringMappend :: NixString -> NixString -> NixString
-hackyStringMappend (NixString s1 t1) (NixString s2 t2) = NixString (s1 <> s2) (t1 <> t2)
+hackyStringMappend (NixString s1 t1) (NixString s2 t2) =
+  NixString (s1 <> s2) (t1 <> t2)
 
 -- | Combine NixStrings with a separator
 principledIntercalateNixString :: NixString -> [NixString] -> NixString
@@ -98,7 +101,8 @@ principledStringMempty = NixString mempty mempty
 
 -- | Combine NixStrings using mconcat
 principledStringMConcat :: [NixString] -> NixString
-principledStringMConcat = foldr principledStringMappend (NixString mempty mempty)
+principledStringMConcat =
+  foldr principledStringMappend (NixString mempty mempty)
 
 --instance Semigroup NixString where
   --NixString s1 t1 <> NixString s2 t2 = NixString (s1 <> s2) (t1 <> t2)
@@ -142,7 +146,8 @@ principledModifyNixContents :: (Text -> Text) -> NixString -> NixString
 principledModifyNixContents f (NixString s c) = NixString (f s) c
 
 -- | Create a NixString using a singleton context
-principledMakeNixStringWithSingletonContext :: Text -> StringContext -> NixString
+principledMakeNixStringWithSingletonContext
+  :: Text -> StringContext -> NixString
 principledMakeNixStringWithSingletonContext s c = NixString s (S.singleton c)
 
 -- | Create a NixString from a Text and context
@@ -156,7 +161,8 @@ newtype WithStringContextT m a = WithStringContextT (WriterT (S.HashSet StringCo
 type WithStringContext = WithStringContextT Identity
 
 -- | Add 'StringContext's into the resulting set.
-addStringContext :: Monad m => S.HashSet StringContext -> WithStringContextT m ()
+addStringContext
+  :: Monad m => S.HashSet StringContext -> WithStringContextT m ()
 addStringContext = WithStringContextT . tell
 
 -- | Add a 'StringContext' into the resulting set.
@@ -169,7 +175,8 @@ extractNixString (NixString s c) = WithStringContextT $ tell c >> return s
 
 -- | Run an action producing a string with a context and put those into a 'NixString'.
 runWithStringContextT :: Monad m => WithStringContextT m Text -> m NixString
-runWithStringContextT (WithStringContextT m) = uncurry NixString <$> runWriterT m
+runWithStringContextT (WithStringContextT m) =
+  uncurry NixString <$> runWriterT m
 
 -- | Run an action producing a string with a context and put those into a 'NixString'.
 runWithStringContext :: WithStringContextT Identity Text -> NixString

src/Nix/Strings.hs

@@ -4,20 +4,23 @@
 -- | Functions for manipulating nix strings.
 module Nix.Strings where
 
-import           Data.List (intercalate, dropWhileEnd, inits)
+import           Data.List                      ( intercalate
-import           Data.Monoid ((<>))
+                                                , dropWhileEnd
-import           Data.Text (Text)
+                                                , inits
+                                                )
+import           Data.Monoid                    ( (<>) )
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as T
-import           Data.Tuple (swap)
+import           Data.Tuple                     ( swap )
 import           Nix.Expr
 
 -- | Merge adjacent 'Plain' values with 'mappend'.
 mergePlain :: [Antiquoted Text r] -> [Antiquoted Text r]
 mergePlain [] = []
-mergePlain (Plain a: EscapedNewline : Plain b: xs) =
+mergePlain (Plain a : EscapedNewline : Plain b : xs) =
   mergePlain (Plain (a <> "\n" <> b) : xs)
-mergePlain (Plain a: Plain b: xs) = mergePlain (Plain (a <> b) : xs)
+mergePlain (Plain a : Plain b : xs) = mergePlain (Plain (a <> b) : xs)
-mergePlain (x:xs) = x : mergePlain xs
+mergePlain (x                 : xs) = x : mergePlain xs
 
 -- | Remove 'Plain' values equal to 'mempty', as they don't have any
 -- informational content.
@@ -42,11 +45,11 @@ runAntiquoted _  _ k (Antiquoted r) = k r
 splitLines :: [Antiquoted Text r] -> [[Antiquoted Text r]]
 splitLines = uncurry (flip (:)) . go where
   go (Plain t : xs) = (Plain l :) <$> foldr f (go xs) ls   where
-    (l : ls) = T.split (=='\n') t
+    (l : ls) = T.split (== '\n') t
     f prefix (finished, current) = ((Plain prefix : current) : finished, [])
   go (Antiquoted a   : xs) = (Antiquoted a :) <$> go xs
   go (EscapedNewline : xs) = (EscapedNewline :) <$> go xs
-  go [] = ([],[])
+  go []                    = ([], [])
 
 -- | Join a stream of strings containing antiquotes again. This is the inverse
 -- of 'splitLines'.
@@ -62,10 +65,18 @@ stripIndent xs =
     . mergePlain
     . map snd
     . dropWhileEnd cleanup
-      . (\ys -> zip (map (\case [] -> Nothing
+    . (\ys -> zip
-                                x -> Just (last x))
+        (map
-                        (inits ys)) ys)
+          (\case
-      . unsplitLines $ ls'
+            [] -> Nothing
+            x  -> Just (last x)
+          )
+          (inits ys)
+        )
+        ys
+      )
+    . unsplitLines
+    $ ls'
  where
   ls        = stripEmptyOpening $ splitLines xs
   ls'       = map (dropSpaces minIndent) ls
@@ -78,11 +89,11 @@ stripIndent xs =
     [Plain t] -> not $ T.null $ T.strip t
     _         -> True
 
-    stripEmptyOpening ([Plain t]:ts) | T.null (T.strip t) = ts
+  stripEmptyOpening ([Plain t] : ts) | T.null (T.strip t) = ts
   stripEmptyOpening ts = ts
 
-    countSpaces (Antiquoted _:_) = 0
+  countSpaces (Antiquoted _   : _) = 0
-    countSpaces (EscapedNewline:_) = 0
+  countSpaces (EscapedNewline : _) = 0
   countSpaces (Plain t        : _) = T.length . T.takeWhile (== ' ') $ t
   countSpaces []                   = 0
 
@@ -91,19 +102,12 @@ stripIndent xs =
   dropSpaces _ _              = error "stripIndent: impossible"
 
   cleanup (Nothing, Plain y) = T.all (== ' ') y
-    cleanup (Just (Plain x), Plain y)
+  cleanup (Just (Plain x), Plain y) | "\n" `T.isSuffixOf` x = T.all (== ' ') y
-        | "\n" `T.isSuffixOf` x = T.all (== ' ') y
   cleanup _                  = False
 
 escapeCodes :: [(Char, Char)]
 escapeCodes =
-  [ ('\n', 'n' )
+  [('\n', 'n'), ('\r', 'r'), ('\t', 't'), ('\\', '\\'), ('$', '$'), ('"', '"')]
-  , ('\r', 'r' )
-  , ('\t', 't' )
-  , ('\\', '\\')
-  , ('$' , '$' )
-  , ('"', '"')
-  ]
 
 fromEscapeCode :: Char -> Maybe Char
 fromEscapeCode = (`lookup` map swap escapeCodes)

src/Nix/TH.hs

@@ -10,11 +10,13 @@ module Nix.TH where
 
 import           Data.Fix
 import           Data.Generics.Aliases
-import           Data.Set (Set, (\\))
+import           Data.Set                       ( Set
+                                                , (\\)
+                                                )
 import qualified Data.Set                      as Set
 import qualified Data.Text                     as Text
-import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.List.NonEmpty             ( NonEmpty(..) )
-import           Data.Maybe (mapMaybe)
+import           Data.Maybe                     ( mapMaybe )
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Quote
 import           Nix.Atoms
@@ -37,40 +39,49 @@ quoteExprPat s = do
 
 freeVars :: NExpr -> Set VarName
 freeVars e = case unFix e of
-  (NConstant _) -> Set.empty
+  (NConstant    _       ) -> Set.empty
-  (NStr string) -> foldMap freeVars string
+  (NStr         string  ) -> foldMap freeVars string
-  (NSym var) -> Set.singleton var
+  (NSym         var     ) -> Set.singleton var
-  (NList list) -> foldMap freeVars list
+  (NList        list    ) -> foldMap freeVars list
   (NSet         bindings) -> foldMap bindFree bindings
   (NRecSet bindings) -> foldMap bindFree bindings \\ foldMap bindDefs bindings
-  (NLiteralPath _) -> Set.empty
+  (NLiteralPath _       ) -> Set.empty
-  (NEnvPath _) -> Set.empty
+  (NEnvPath     _       ) -> Set.empty
-  (NUnary _ expr) -> freeVars expr
+  (NUnary _ expr        ) -> freeVars expr
-  (NBinary _ left right) -> freeVars left `Set.union` freeVars right
+  (NBinary _ left right ) -> freeVars left `Set.union` freeVars right
-  (NSelect expr path orExpr) -> freeVars expr `Set.union` pathFree path `Set.union` maybe Set.empty freeVars orExpr
+  (NSelect expr path orExpr) ->
+    freeVars expr
+      `Set.union` pathFree path
+      `Set.union` maybe Set.empty freeVars orExpr
   (NHasAttr expr            path) -> freeVars expr `Set.union` pathFree path
   (NAbs     (Param varname) expr) -> Set.delete varname (freeVars expr)
   (NAbs (ParamSet set _ varname) expr) ->
     -- Include all free variables from the expression and the default arguments
-    freeVars expr `Set.union` Set.unions (mapMaybe (fmap freeVars . snd) set)
+    freeVars expr
+      `Set.union` Set.unions (mapMaybe (fmap freeVars . snd) set)
     -- But remove the argument name if existing, and all arguments in the parameter set
-    \\ maybe Set.empty Set.singleton varname \\ Set.fromList (map fst set)
+      \\          maybe Set.empty Set.singleton varname
-  (NLet bindings expr) -> freeVars expr `Set.union` foldMap bindFree bindings \\ foldMap bindDefs bindings
+      \\          Set.fromList (map fst set)
-  (NIf cond th el) -> freeVars cond `Set.union` freeVars th `Set.union` freeVars el
+  (NLet bindings expr) ->
+    freeVars expr
+      `Set.union` foldMap bindFree bindings
+      \\          foldMap bindDefs bindings
+  (NIf cond th el) ->
+    freeVars cond `Set.union` freeVars th `Set.union` freeVars el
   -- Evaluation is needed to find out whether x is a "real" free variable in `with y; x`, we just include it
   -- This also makes sense because its value can be overridden by `x: with y; x`
   (NWith   set       expr) -> freeVars set `Set.union` freeVars expr
   (NAssert assertion expr) -> freeVars assertion `Set.union` freeVars expr
-  (NSynHole _) -> Set.empty
+  (NSynHole _            ) -> Set.empty
 
  where
 
   staticKey :: NKeyName r -> Maybe VarName
   staticKey (StaticKey  varname) = Just varname
-    staticKey (DynamicKey _) = Nothing
+  staticKey (DynamicKey _      ) = Nothing
 
   bindDefs :: Binding r -> Set VarName
-    bindDefs (Inherit Nothing _ _) = Set.empty;
+  bindDefs (Inherit  Nothing                   _    _) = Set.empty
   bindDefs (Inherit (Just _) keys _) = Set.fromList $ mapMaybe staticKey keys
   bindDefs (NamedVar (StaticKey  varname :| _) _    _) = Set.singleton varname
   bindDefs (NamedVar (DynamicKey _       :| _) _    _) = Set.empty
@@ -113,7 +124,4 @@ metaPat fvs (Fix (NSym_ _ x)) | x `Set.member` fvs =
 metaPat _ _ = Nothing
 
 nix :: QuasiQuoter
-nix = QuasiQuoter
+nix = QuasiQuoter { quoteExp = quoteExprExp, quotePat = quoteExprPat }
-    { quoteExp = quoteExprExp
-    , quotePat = quoteExprPat
-    }

src/Nix/Thunk.hs

@@ -7,9 +7,9 @@
 
 module Nix.Thunk where
 
-import Control.Exception (Exception)
+import           Control.Exception              ( Exception )
-import Control.Monad.Trans.Class (MonadTrans(..))
+import           Control.Monad.Trans.Class      ( MonadTrans(..) )
-import Data.Typeable (Typeable)
+import           Data.Typeable                  ( Typeable )
 
 class ( Monad m
       , Eq (ThunkId m)

src/Nix/Thunk/Basic.hs

@@ -15,7 +15,7 @@
 
 module Nix.Thunk.Basic (NThunkF(..), Deferred(..), MonadBasicThunk) where
 
-import Control.Exception hiding (catch)
+import           Control.Exception       hiding ( catch )
 import           Control.Monad.Catch
 
 import           Nix.Thunk
@@ -36,7 +36,7 @@ instance (Eq v, Eq (ThunkId m)) => Eq (NThunkF m v) where
   _           == _           = False              -- jww (2019-03-16): not accurate...
 
 instance Show v => Show (NThunkF m v) where
-    show (Value v) = show v
+  show (Value v    ) = show v
   show (Thunk _ _ _) = "<thunk>"
 
 type MonadBasicThunk m = (MonadThunkId m, MonadVar m)
@@ -62,7 +62,7 @@ thunkValue (Value v) = Just v
 thunkValue _         = Nothing
 
 buildThunk :: MonadBasicThunk m => m v -> m (NThunkF m v)
-buildThunk action =do
+buildThunk action = do
   freshThunkId <- freshId
   Thunk freshThunkId <$> newVar False <*> newVar (Deferred action)
 
@@ -71,9 +71,9 @@ queryValue (Value v) _ k = k v
 queryValue _         n _ = n
 
 queryThunk :: MonadVar m => NThunkF m v -> m a -> (v -> m a) -> m a
-queryThunk (Value v) _ k = k v
+queryThunk (Value v           ) _ k = k v
 queryThunk (Thunk _ active ref) n k = do
-    nowActive <- atomicModifyVar active (True,)
+  nowActive <- atomicModifyVar active (True, )
   if nowActive
     then n
     else do
@@ -81,40 +81,37 @@ queryThunk (Thunk _ active ref) n k = do
       res  <- case eres of
         Computed v -> k v
         _          -> n
-            _ <- atomicModifyVar active (False,)
+      _ <- atomicModifyVar active (False, )
       return res
 
 forceThunk
-    :: forall m v a.
+  :: forall m v a
-    ( MonadVar m
+   . (MonadVar m, MonadThrow m, MonadCatch m, Show (ThunkId m))
-    , MonadThrow m
+  => NThunkF m v
-    , MonadCatch m
+  -> (v -> m a)
-    , Show (ThunkId m)
+  -> m a
-    )
+forceThunk (Value v           ) k = k v
-    => NThunkF m v -> (v -> m a) -> m a
-forceThunk (Value v) k = k v
 forceThunk (Thunk n active ref) k = do
   eres <- readVar ref
   case eres of
     Computed v      -> k v
     Deferred action -> do
-            nowActive <- atomicModifyVar active (True,)
+      nowActive <- atomicModifyVar active (True, )
       if nowActive
-                then
+        then throwM $ ThunkLoop $ show n
-                    throwM $ ThunkLoop $ show n
         else do
           traceM $ "Forcing " ++ show n
           v <- catch action $ \(e :: SomeException) -> do
-                        _ <- atomicModifyVar active (False,)
+            _ <- atomicModifyVar active (False, )
             throwM e
-                    _ <- atomicModifyVar active (False,)
+          _ <- atomicModifyVar active (False, )
           writeVar ref (Computed v)
           k v
 
 forceEffects :: MonadVar m => NThunkF m v -> (v -> m r) -> m r
-forceEffects (Value v) k = k v
+forceEffects (Value v           ) k = k v
 forceEffects (Thunk _ active ref) k = do
-    nowActive <- atomicModifyVar active (True,)
+  nowActive <- atomicModifyVar active (True, )
   if nowActive
     then return $ error "Loop detected"
     else do
@@ -124,5 +121,5 @@ forceEffects (Thunk _ active ref) k = do
         Deferred action -> do
           v <- action
           writeVar ref (Computed v)
-                    _ <- atomicModifyVar active (False,)
+          _ <- atomicModifyVar active (False, )
           k v

src/Nix/Thunk/Standard.hs

@@ -19,9 +19,9 @@
 
 module Nix.Thunk.Standard where
 
-import Control.Comonad (Comonad)
+import           Control.Comonad                ( Comonad )
-import Control.Comonad.Env (ComonadEnv)
+import           Control.Comonad.Env            ( ComonadEnv )
-import Control.Monad.Catch hiding (catchJust)
+import           Control.Monad.Catch     hiding ( catchJust )
 import           Control.Monad.Reader
 import           Data.Fix
 import           GHC.Generics
@@ -39,7 +39,9 @@ import Nix.Thunk
 import           Nix.Thunk.Basic
 import           Nix.Utils
 import           Nix.Value
-import Nix.Var (MonadVar, newVar)
+import           Nix.Var                        ( MonadVar
+                                                , newVar
+                                                )
 
 newtype StdCited m a = StdCited
     { _stdCited :: NCited (StdThunk m) (StdCited m) (StdLazy m) a }
@@ -64,12 +66,7 @@ type StdIdT m = FreshIdT Int m
 
 type StdLazy m = Lazy (StdThunk m) (StdCited m) (StdIdT m)
 
-type MonadStdThunk m =
+type MonadStdThunk m = (MonadVar m, MonadCatch m, MonadThrow m, Typeable m)
-    ( MonadVar m
-    , MonadCatch m
-    , MonadThrow m
-    , Typeable m
-    )
 
 instance MonadStdThunk m
   => MonadThunk (StdThunk m) (StdLazy m) (StdValue m) where
@@ -91,43 +88,41 @@ instance MonadStdThunk m
             ps = concatMap (go . frame) frames
 
         fmap (StdThunk . StdCited . NCited ps) . thunk $ mv
-            else
+      else fmap (StdThunk . StdCited . NCited []) . thunk $ mv
-                fmap (StdThunk . StdCited . NCited []) . thunk $ mv
 
   thunkId (StdThunk (StdCited (NCited _ t))) = thunkId t
 
   query (StdThunk (StdCited (NCited _ t))) = query t
   queryM (StdThunk (StdCited (NCited _ t))) = queryM t
 
-    -- The ThunkLoop exception is thrown as an exception with MonadThrow,
+-- The ThunkLoop exception is thrown as an exception with MonadThrow,
-    -- which does not capture the current stack frame information to provide
+-- which does not capture the current stack frame information to provide
-    -- it in a NixException, so we catch and re-throw it here using
+-- it in a NixException, so we catch and re-throw it here using
-    -- 'throwError' from Frames.hs.
+-- 'throwError' from Frames.hs.
-    force (StdThunk (StdCited (NCited ps t))) f =
+  force (StdThunk (StdCited (NCited ps t))) f = catch go
-        catch go (throwError @ThunkLoop)
+                                                      (throwError @ThunkLoop)
    where
     go = case ps of
       [] -> force t f
-            Provenance scope e@(Compose (Ann s _)):_ ->
+      Provenance scope e@(Compose (Ann s _)) : _ ->
           -- r <- liftWith $ \run -> do
           --     withFrame Info (ForcingExpr scope (wrapExprLoc s e))
           --         (run (force t f))
           -- restoreT $ return r
-                withFrame Info (ForcingExpr scope (wrapExprLoc s e))
+        withFrame Info (ForcingExpr scope (wrapExprLoc s e)) (force t f)
-                    (force t f)
 
-    forceEff (StdThunk (StdCited (NCited ps t))) f =
+  forceEff (StdThunk (StdCited (NCited ps t))) f = catch
-        catch go (throwError @ThunkLoop)
+    go
+    (throwError @ThunkLoop)
    where
     go = case ps of
       [] -> forceEff t f
-            Provenance scope e@(Compose (Ann s _)):_ -> do
+      Provenance scope e@(Compose (Ann s _)) : _ -> do
           -- r <- liftWith $ \run -> do
           --     withFrame Info (ForcingExpr scope (wrapExprLoc s e))
           --         (run (forceEff t f))
           -- restoreT $ return r
-                withFrame Info (ForcingExpr scope (wrapExprLoc s e))
+        withFrame Info (ForcingExpr scope (wrapExprLoc s e)) (forceEff t f)
-                    (forceEff t f)
 
   wrapValue = StdThunk . StdCited . NCited [] . wrapValue
   getValue (StdThunk (StdCited (NCited _ v))) = getValue v

src/Nix/Type/Assumption.hs

@@ -1,16 +1,17 @@
-module Nix.Type.Assumption (
+module Nix.Type.Assumption
-  Assumption(..),
+  ( Assumption(..)
-  empty,
+  , empty
-  lookup,
+  , lookup
-  remove,
+  , remove
-  extend,
+  , extend
-  keys,
+  , keys
-  merge,
+  , merge
-  mergeAssumptions,
+  , mergeAssumptions
-  singleton,
+  , singleton
-) where
+  )
+where
 
-import Prelude hiding (lookup)
+import           Prelude                 hiding ( lookup )
 
 import           Nix.Type.Type
 

src/Nix/Type/Env.hs

@@ -1,23 +1,24 @@
-module Nix.Type.Env (
+module Nix.Type.Env
-  Env(..),
+  ( Env(..)
-  empty,
+  , empty
-  lookup,
+  , lookup
-  remove,
+  , remove
-  extend,
+  , extend
-  extends,
+  , extends
-  merge,
+  , merge
-  mergeEnvs,
+  , mergeEnvs
-  singleton,
+  , singleton
-  keys,
+  , keys
-  fromList,
+  , fromList
-  toList,
+  , toList
-) where
+  )
+where
 
-import           Prelude hiding (lookup)
+import           Prelude                 hiding ( lookup )
 
 import           Nix.Type.Type
 
-import           Data.Foldable hiding (toList)
+import           Data.Foldable           hiding ( toList )
 import qualified Data.Map                      as Map
 
 -------------------------------------------------------------------------------
@@ -37,8 +38,7 @@ remove :: Env -> Name -> Env
 remove (TypeEnv env) var = TypeEnv (Map.delete var env)
 
 extends :: Env -> [(Name, [Scheme])] -> Env
-extends env xs =
+extends env xs = env { types = Map.union (Map.fromList xs) (types env) }
-    env { types = Map.union (Map.fromList xs) (types env) }
 
 lookup :: Name -> Env -> Maybe [Scheme]
 lookup key (TypeEnv tys) = Map.lookup key tys

src/Nix/Type/Infer.hs

@@ -17,13 +17,14 @@
 
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
-module Nix.Type.Infer (
+module Nix.Type.Infer
-  Constraint(..),
+  ( Constraint(..)
-  TypeError(..),
+  , TypeError(..)
-  InferError(..),
+  , InferError(..)
-  Subst(..),
+  , Subst(..)
-  inferTop
+  , inferTop
-) where
+  )
+where
 
 import           Control.Applicative
 import           Control.Arrow
@@ -38,15 +39,20 @@ import           Control.Monad.State.Strict
 import           Data.Fix
 import           Data.Foldable
 import qualified Data.HashMap.Lazy             as M
-import           Data.List (delete, find, nub, intersect, (\\))
+import           Data.List                      ( delete
-import           Data.Map (Map)
+                                                , find
+                                                , nub
+                                                , intersect
+                                                , (\\)
+                                                )
+import           Data.Map                       ( Map )
 import qualified Data.Map                      as Map
-import           Data.Maybe (fromJust)
+import           Data.Maybe                     ( fromJust )
 import qualified Data.Set                      as Set
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import           Nix.Atoms
 import           Nix.Convert
-import           Nix.Eval (MonadEval(..))
+import           Nix.Eval                       ( MonadEval(..) )
 import qualified Nix.Eval                      as Eval
 import           Nix.Expr.Types
 import           Nix.Expr.Types.Annotated
@@ -112,16 +118,17 @@ class Substitutable a where
 
 instance Substitutable TVar where
   apply (Subst s) a = tv
-    where t = TVar a
+   where
+    t         = TVar a
     (TVar tv) = Map.findWithDefault t a s
 
 instance Substitutable Type where
-  apply _ (TCon a)           = TCon a
+  apply _         (  TCon a   ) = TCon a
-  apply s (TSet b a)         = TSet b (M.map (apply s) a)
+  apply s         (  TSet b a ) = TSet b (M.map (apply s) a)
-  apply s (TList a)          = TList (map (apply s) a)
+  apply s         (  TList a  ) = TList (map (apply s) a)
-  apply (Subst s) t@(TVar a) = Map.findWithDefault t a s
+  apply (Subst s) t@(TVar  a  ) = Map.findWithDefault t a s
-  apply s (t1 :~> t2)        = apply s t1 :~> apply s t2
+  apply s         (  t1 :~> t2) = apply s t1 :~> apply s t2
-  apply s (TMany ts)         = TMany (map (apply s) ts)
+  apply s         (  TMany ts ) = TMany (map (apply s) ts)
 
 instance Substitutable Scheme where
   apply (Subst s) (Forall as t) = Forall as $ apply s' t
@@ -130,7 +137,8 @@ instance Substitutable Scheme where
 instance Substitutable Constraint where
   apply s (EqConst      t1 t2) = EqConst (apply s t1) (apply s t2)
   apply s (ExpInstConst t  sc) = ExpInstConst (apply s t) (apply s sc)
-   apply s (ImpInstConst t1 ms t2) = ImpInstConst (apply s t1) (apply s ms) (apply s t2)
+  apply s (ImpInstConst t1 ms t2) =
+    ImpInstConst (apply s t1) (apply s ms) (apply s t2)
 
 instance Substitutable a => Substitutable [a] where
   apply = map . apply
@@ -144,11 +152,11 @@ class FreeTypeVars a where
 
 instance FreeTypeVars Type where
   ftv TCon{}      = Set.empty
-  ftv (TVar a)    = Set.singleton a
+  ftv (TVar a   ) = Set.singleton a
-  ftv (TSet _ a)  = Set.unions (map ftv (M.elems a))
+  ftv (TSet _ a ) = Set.unions (map ftv (M.elems a))
-  ftv (TList a)   = Set.unions (map ftv a)
+  ftv (TList a  ) = Set.unions (map ftv a)
   ftv (t1 :~> t2) = ftv t1 `Set.union` ftv t2
-  ftv (TMany ts)  = Set.unions (map ftv ts)
+  ftv (TMany ts ) = Set.unions (map ftv ts)
 
 instance FreeTypeVars TVar where
   ftv = Set.singleton
@@ -168,7 +176,8 @@ class ActiveTypeVars a where
 
 instance ActiveTypeVars Constraint where
   atv (EqConst t1 t2) = ftv t1 `Set.union` ftv t2
-  atv (ImpInstConst t1 ms t2) = ftv t1 `Set.union` (ftv ms `Set.intersection` ftv t2)
+  atv (ImpInstConst t1 ms t2) =
+    ftv t1 `Set.union` (ftv ms `Set.intersection` ftv t2)
   atv (ExpInstConst t s) = ftv t `Set.union` ftv s
 
 instance ActiveTypeVars a => ActiveTypeVars [a] where
@@ -206,28 +215,31 @@ instance Monoid InferError where
 
 -- | Run the inference monad
 runInfer' :: MonadInfer m => InferT s m a -> m (Either InferError a)
-runInfer' = runExceptT
+runInfer' =
+  runExceptT
     . (`evalStateT` initInfer)
     . (`runReaderT` (Set.empty, emptyScopes))
     . getInfer
 
-runInfer :: (forall s. InferT s (FreshIdT Int (ST s)) a) -> Either InferError a
+runInfer :: (forall s . InferT s (FreshIdT Int (ST s)) a) -> Either InferError a
 runInfer m = runST $ do
   i <- newVar (1 :: Int)
   runFreshIdT i (runInfer' m)
 
-inferType :: forall s m. MonadInfer m
+inferType
-          => Env -> NExpr -> InferT s m [(Subst, Type)]
+  :: forall s m . MonadInfer m => Env -> NExpr -> InferT s m [(Subst, Type)]
 inferType env ex = do
   Judgment as cs t <- infer ex
-  let unbounds = Set.fromList (As.keys as) `Set.difference`
+  let unbounds =
-                 Set.fromList (Env.keys env)
+        Set.fromList (As.keys as) `Set.difference` Set.fromList (Env.keys env)
-  unless (Set.null unbounds) $
+  unless (Set.null unbounds) $ typeError $ UnboundVariables
-      typeError $ UnboundVariables (nub (Set.toList unbounds))
+    (nub (Set.toList unbounds))
-  let cs' = [ ExpInstConst t s
+  let cs' =
+        [ ExpInstConst t s
         | (x, ss) <- Env.toList env
         , s       <- ss
-            , t <- As.lookup x as]
+        , t       <- As.lookup x as
+        ]
   inferState <- get
   let eres = (`evalState` inferState) $ runSolver $ do
         subst <- solve (cs ++ cs')
@@ -250,12 +262,12 @@ extendMSet :: Monad m => TVar -> InferT s m a -> InferT s m a
 extendMSet x = InferT . local (first (Set.insert x)) . getInfer
 
 letters :: [String]
-letters = [1..] >>= flip replicateM ['a'..'z']
+letters = [1 ..] >>= flip replicateM ['a' .. 'z']
 
 freshTVar :: MonadState InferState m => m TVar
 freshTVar = do
   s <- get
-    put s{count = count s + 1}
+  put s { count = count s + 1 }
   return $ TV (letters !! count s)
 
 fresh :: MonadState InferState m => m Type
@@ -273,9 +285,12 @@ generalize free t  = Forall as t
 
 unops :: Type -> NUnaryOp -> [Constraint]
 unops u1 = \case
-    NNot -> [ EqConst u1 (typeFun [typeBool, typeBool]) ]
+  NNot -> [EqConst u1 (typeFun [typeBool, typeBool])]
-    NNeg -> [ EqConst u1 (TMany [ typeFun [typeInt,   typeInt]
+  NNeg ->
-                               , typeFun [typeFloat, typeFloat] ]) ]
+    [ EqConst
+        u1
+        (TMany [typeFun [typeInt, typeInt], typeFun [typeFloat, typeFloat]])
+    ]
 
 binops :: Type -> NBinaryOp -> [Constraint]
 binops u1 = \case
@@ -291,45 +306,73 @@ binops u1 = \case
   NLt   -> inequality
   NLte  -> inequality
 
-    NAnd    -> [ EqConst u1 (typeFun [typeBool, typeBool, typeBool]) ]
+  NAnd  -> [EqConst u1 (typeFun [typeBool, typeBool, typeBool])]
-    NOr     -> [ EqConst u1 (typeFun [typeBool, typeBool, typeBool]) ]
+  NOr   -> [EqConst u1 (typeFun [typeBool, typeBool, typeBool])]
-    NImpl   -> [ EqConst u1 (typeFun [typeBool, typeBool, typeBool]) ]
+  NImpl -> [EqConst u1 (typeFun [typeBool, typeBool, typeBool])]
 
-    NConcat -> [ EqConst u1 (TMany [ typeFun [typeList,   typeList,   typeList]
+  NConcat ->
+    [ EqConst
+        u1
+        (TMany
+          [ typeFun [typeList, typeList, typeList]
           , typeFun [typeList, typeNull, typeList]
           , typeFun [typeNull, typeList, typeList]
-                                  ]) ]
+          ]
+        )
+    ]
 
-    NUpdate -> [ EqConst u1 (TMany [ typeFun [typeSet,    typeSet,    typeSet]
+  NUpdate ->
+    [ EqConst
+        u1
+        (TMany
+          [ typeFun [typeSet, typeSet, typeSet]
           , typeFun [typeSet, typeNull, typeSet]
           , typeFun [typeNull, typeSet, typeSet]
-                                  ]) ]
+          ]
+        )
+    ]
 
-    NPlus   -> [ EqConst u1 (TMany [ typeFun [typeInt,    typeInt,    typeInt]
+  NPlus ->
+    [ EqConst
+        u1
+        (TMany
+          [ typeFun [typeInt, typeInt, typeInt]
           , typeFun [typeFloat, typeFloat, typeFloat]
           , typeFun [typeInt, typeFloat, typeFloat]
           , typeFun [typeFloat, typeInt, typeFloat]
           , typeFun [typeString, typeString, typeString]
           , typeFun [typePath, typePath, typePath]
           , typeFun [typeString, typeString, typePath]
-                                  ]) ]
+          ]
+        )
+    ]
   NMinus -> arithmetic
   NMult  -> arithmetic
   NDiv   -> arithmetic
  where
   inequality =
-        [ EqConst u1 (TMany [ typeFun [typeInt,    typeInt,    typeBool]
+    [ EqConst
+        u1
+        (TMany
+          [ typeFun [typeInt, typeInt, typeBool]
           , typeFun [typeFloat, typeFloat, typeBool]
           , typeFun [typeInt, typeFloat, typeBool]
           , typeFun [typeFloat, typeInt, typeBool]
-                            ]) ]
+          ]
+        )
+    ]
 
   arithmetic =
-        [ EqConst u1 (TMany [ typeFun [typeInt,    typeInt,    typeInt]
+    [ EqConst
+        u1
+        (TMany
+          [ typeFun [typeInt, typeInt, typeInt]
           , typeFun [typeFloat, typeFloat, typeFloat]
           , typeFun [typeInt, typeFloat, typeFloat]
           , typeFun [typeFloat, typeInt, typeFloat]
-                            ]) ]
+          ]
+        )
+    ]
 
 liftInfer :: Monad m => m a -> InferT s m a
 liftInfer = InferT . lift . lift . lift
@@ -353,16 +396,13 @@ instance Monad m => MonadThrow (InferT s m) where
 
 instance Monad m => MonadCatch (InferT s m) where
   catch m h = catchError m $ \case
-        EvaluationError e ->
+    EvaluationError e -> maybe
-            maybe (error $ "Exception was not an exception: " ++ show e) h
+      (error $ "Exception was not an exception: " ++ show e)
+      h
       (fromException (toException e))
     err -> error $ "Unexpected error: " ++ show err
 
-type MonadInfer m
+type MonadInfer m = (MonadThunkId m, MonadVar m, MonadFix m)
-    = ( MonadThunkId m
-      , MonadVar m
-      , MonadFix m
-      )
 
 instance MonadInfer m
   => MonadThunk (JThunkT s m) (InferT s m) (Judgment s) where
@@ -372,11 +412,13 @@ instance MonadInfer m
   query (JThunk x) b f = query x b f
   queryM (JThunk x) b f = queryM x b f
 
-    force (JThunk t) f = catch (force t f) $ \(_ :: ThunkLoop) ->
+  force (JThunk t) f = catch (force t f)
-        -- If we have a thunk loop, we just don't know the type.
+    $ \(_ :: ThunkLoop) ->
+-- If we have a thunk loop, we just don't know the type.
                            f =<< Judgment As.empty [] <$> fresh
-    forceEff (JThunk t) f = catch (forceEff t f) $ \(_ :: ThunkLoop) ->
+  forceEff (JThunk t) f = catch (forceEff t f)
-        -- If we have a thunk loop, we just don't know the type.
+    $ \(_ :: ThunkLoop) ->
+-- If we have a thunk loop, we just don't know the type.
                            f =<< Judgment As.empty [] <$> fresh
 
   wrapValue = JThunk . wrapValue
@@ -391,16 +433,13 @@ instance MonadInfer m => MonadEval (Judgment s) (InferT s m) where
     tv <- fresh
     return $ Judgment (As.singleton var tv) [] tv
 
-    -- If we fail to look up an attribute, we just don't know the type.
+-- If we fail to look up an attribute, we just don't know the type.
   attrMissing _ _ = Judgment As.empty [] <$> fresh
 
   evaledSym _ = pure
 
-    evalCurPos =
+  evalCurPos = return $ Judgment As.empty [] $ TSet False $ M.fromList
-        return $ Judgment As.empty [] $ TSet False $ M.fromList
+    [("file", typePath), ("line", typeInt), ("col", typeInt)]
-            [ ("file", typePath)
-            , ("line", typeInt)
-            , ("col",  typeInt) ]
 
   evalConstant c = return $ Judgment As.empty [] (go c)
    where
@@ -421,8 +460,7 @@ instance MonadInfer m => MonadEval (Judgment s) (InferT s m) where
   evalBinary op (Judgment as1 cs1 t1) e2 = do
     Judgment as2 cs2 t2 <- e2
     tv                  <- fresh
-        return $ Judgment
+    return $ Judgment (as1 `As.merge` as2)
-            (as1 `As.merge` as2)
                       (cs1 ++ cs2 ++ binops (t1 :~> t2 :~> tv) op)
                       tv
 
@@ -438,28 +476,24 @@ instance MonadInfer m => MonadEval (Judgment s) (InferT s m) where
 
   evalAssert (Judgment as1 cs1 t1) body = do
     Judgment as2 cs2 t2 <- body
-        return $ Judgment
+    return
-            (as1 `As.merge` as2)
+      $ Judgment (as1 `As.merge` as2) (cs1 ++ cs2 ++ [EqConst t1 typeBool]) t2
-            (cs1 ++ cs2 ++ [EqConst t1 typeBool])
-            t2
 
   evalApp (Judgment as1 cs1 t1) e2 = do
     Judgment as2 cs2 t2 <- e2
     tv                  <- fresh
-        return $ Judgment
+    return $ Judgment (as1 `As.merge` as2)
-            (as1 `As.merge` as2)
                       (cs1 ++ cs2 ++ [EqConst t1 (t2 :~> tv)])
                       tv
 
   evalAbs (Param x) k = do
     a <- freshTVar
     let tv = TVar a
-        ((), Judgment as cs t) <-
+    ((), Judgment as cs t) <- extendMSet
-            extendMSet a (k (pure (Judgment (As.singleton x tv) [] tv))
+      a
-                            (\_ b -> ((),) <$> b))
+      (k (pure (Judgment (As.singleton x tv) [] tv)) (\_ b -> ((), ) <$> b))
-        return $ Judgment
+    return $ Judgment (as `As.remove` x)
-            (as `As.remove` x)
+                      (cs ++ [ EqConst t' tv | t' <- As.lookup x as ])
-            (cs ++ [EqConst t' tv | t' <- As.lookup x as])
                       (tv :~> t)
 
   evalAbs (ParamSet ps variadic _mname) k = do
@@ -467,23 +501,20 @@ instance MonadInfer m => MonadEval (Judgment s) (InferT s m) where
       tv <- fresh
       pure [(name, tv)]
 
-        let (env, tys) = (\f -> foldl' f (As.empty, M.empty) js)
+    let (env, tys) =
-                $ \(as1, t1) (k, t) ->
+          (\f -> foldl' f (As.empty, M.empty) js) $ \(as1, t1) (k, t) ->
             (as1 `As.merge` As.singleton k t, M.insert k t t1)
         arg   = pure $ Judgment env [] (TSet True tys)
-            call  = k arg $ \args b -> (args,) <$> b
+        call  = k arg $ \args b -> (args, ) <$> b
         names = map fst js
 
-        (args, Judgment as cs t) <-
+    (args, Judgment as cs t) <- foldr (\(_, TVar a) -> extendMSet a) call js
-            foldr (\(_, TVar a) -> extendMSet a) call js
 
     ty <- TSet variadic <$> traverse (inferredType <$>) args
 
     return $ Judgment
       (foldl' As.remove as names)
-            (cs ++ [ EqConst t' (tys M.! x)
+      (cs ++ [ EqConst t' (tys M.! x) | x <- names, t' <- As.lookup x as ])
-                   | x  <- names
-                   , t' <- As.lookup x as])
       (ty :~> t)
 
   evalError = throwError . EvaluationError
@@ -513,20 +544,20 @@ instance MonadInfer m
 instance MonadInfer m
   => ToValue (AttrSet (JThunkT s m), AttrSet SourcePos)
             (InferT s m) (Judgment s) where
-    toValue (xs, _) = Judgment
+  toValue (xs, _) =
+    Judgment
       <$> foldrM go As.empty xs
       <*> (concat <$> traverse (`force` (pure . typeConstraints)) xs)
       <*> (TSet True <$> traverse (`force` (pure . inferredType)) xs)
-      where
+    where go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest
-        go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest
 
 instance MonadInfer m => ToValue [JThunkT s m] (InferT s m) (Judgment s) where
-    toValue xs = Judgment
+  toValue xs =
+    Judgment
       <$> foldrM go As.empty xs
       <*> (concat <$> traverse (`force` (pure . typeConstraints)) xs)
       <*> (TList <$> traverse (`force` (pure . inferredType)) xs)
-      where
+    where go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest
-        go x rest = force x $ \x' -> pure $ As.merge (assumptions x') rest
 
 instance MonadInfer m => ToValue Bool (InferT s m) (Judgment s) where
   toValue _ = pure $ Judgment As.empty [] typeBool
@@ -536,7 +567,7 @@ infer = cata Eval.eval
 
 inferTop :: Env -> [(Text, NExpr)] -> Either InferError Env
 inferTop env []                = Right env
-inferTop env ((name, ex):xs) = case inferExpr env ex of
+inferTop env ((name, ex) : xs) = case inferExpr env ex of
   Left  err -> Left err
   Right ty  -> inferTop (extend env (name, ty)) xs
 
@@ -545,20 +576,19 @@ normalize (Forall _ body) = Forall (map snd ord) (normtype body)
  where
   ord = zip (nub $ fv body) (map TV letters)
 
-    fv (TVar a)    = [a]
+  fv (TVar a  ) = [a]
-    fv (a :~> b)   = fv a ++ fv b
+  fv (a :~> b ) = fv a ++ fv b
-    fv (TCon _)    = []
+  fv (TCon _  ) = []
   fv (TSet _ a) = concatMap fv (M.elems a)
-    fv (TList a)   = concatMap fv a
+  fv (TList a ) = concatMap fv a
   fv (TMany ts) = concatMap fv ts
 
-    normtype (a :~> b)  = normtype a :~> normtype b
+  normtype (a :~> b ) = normtype a :~> normtype b
-    normtype (TCon a)   = TCon a
+  normtype (TCon a  ) = TCon a
   normtype (TSet b a) = TSet b (M.map normtype a)
-    normtype (TList a)  = TList (map normtype a)
+  normtype (TList a ) = TList (map normtype a)
   normtype (TMany ts) = TMany (map normtype ts)
-    normtype (TVar a)   =
+  normtype (TVar  a ) = case Prelude.lookup a ord of
-      case Prelude.lookup a ord of
     Just x  -> TVar x
     Nothing -> error "type variable not in signature"
 
@@ -574,15 +604,15 @@ instance MonadTrans Solver where
   lift = Solver . lift . lift
 
 instance Monad m => MonadError TypeError (Solver m) where
-    throwError err = Solver $ lift (modify (err:)) >> mzero
+  throwError err = Solver $ lift (modify (err :)) >> mzero
   catchError _ _ = error "This is never used"
 
 runSolver :: Monad m => Solver m a -> m (Either [TypeError] [a])
 runSolver (Solver s) = do
   res <- runStateT (observeAllT s) []
   pure $ case res of
-        (x:xs, _) -> Right (x:xs)
+    (x : xs, _ ) -> Right (x : xs)
-        (_, es)   -> Left (nub es)
+    (_     , es) -> Left (nub es)
 
 -- | The empty substitution
 emptySubst :: Subst
@@ -595,16 +625,16 @@ Subst s1 `compose` Subst s2 =
 
 unifyMany :: Monad m => [Type] -> [Type] -> Solver m Subst
 unifyMany []         []         = return emptySubst
-unifyMany (t1 : ts1) (t2 : ts2) =
+unifyMany (t1 : ts1) (t2 : ts2) = do
-  do su1 <- unifies t1 t2
+  su1 <- unifies t1 t2
   su2 <- unifyMany (apply su1 ts1) (apply su1 ts2)
   return (su2 `compose` su1)
 unifyMany t1 t2 = throwError $ UnificationMismatch t1 t2
 
 allSameType :: [Type] -> Bool
 allSameType []           = True
-allSameType [_] = True
+allSameType [_         ] = True
-allSameType (x:y:ys) = x == y && allSameType (y:ys)
+allSameType (x : y : ys) = x == y && allSameType (y : ys)
 
 unifies :: Monad m => Type -> Type -> Solver m Subst
 unifies t1 t2 | t1 == t2  = return emptySubst
@@ -612,19 +642,19 @@ unifies (TVar v) t = v `bind` t
 unifies t        (TVar v) = v `bind` t
 unifies (TList xs) (TList ys)
   | allSameType xs && allSameType ys = case (xs, ys) of
-          (x:_, y:_) -> unifies x y
+    (x : _, y : _) -> unifies x y
     _              -> return emptySubst
   | length xs == length ys = unifyMany xs ys
 -- We assume that lists of different lengths containing various types cannot
 -- be unified.
-unifies t1@(TList _) t2@(TList _) = throwError $ UnificationFail t1 t2
+unifies t1@(TList _    ) t2@(TList _    ) = throwError $ UnificationFail t1 t2
-unifies (TSet True _) (TSet True _) = return emptySubst
+unifies (   TSet True _) (   TSet True _) = return emptySubst
 unifies (TSet False b) (TSet True s)
   | M.keys b `intersect` M.keys s == M.keys s = return emptySubst
 unifies (TSet True s) (TSet False b)
   | M.keys b `intersect` M.keys s == M.keys b = return emptySubst
-unifies (TSet False s) (TSet False b)
+unifies (TSet False s) (TSet False b) | null (M.keys b \\ M.keys s) =
-    | null (M.keys b \\ M.keys s) = return emptySubst
+  return emptySubst
 unifies (t1 :~> t2) (t3 :~> t4) = unifyMany [t1, t2] [t3, t4]
 unifies (TMany t1s) t2          = considering t1s >>- unifies ?? t2
 unifies t1          (TMany t2s) = considering t2s >>- unifies t1
@@ -641,9 +671,9 @@ occursCheck a t = a `Set.member` ftv t
 nextSolvable :: [Constraint] -> (Constraint, [Constraint])
 nextSolvable xs = fromJust (find solvable (chooseOne xs))
  where
-    chooseOne xs = [(x, ys) | x <- xs, let ys = delete x xs]
+  chooseOne xs = [ (x, ys) | x <- xs, let ys = delete x xs ]
 
-    solvable (EqConst{}, _)      = True
+  solvable (EqConst{}     , _) = True
   solvable (ExpInstConst{}, _) = True
   solvable (ImpInstConst _t1 ms t2, cs) =
     Set.null ((ftv t2 `Set.difference` ms) `Set.intersection` atv cs)
@@ -655,10 +685,8 @@ solve :: MonadState InferState m => [Constraint] -> Solver m Subst
 solve [] = return emptySubst
 solve cs = solve' (nextSolvable cs)
  where
-    solve' (EqConst t1 t2, cs) =
+  solve' (EqConst t1 t2, cs) = unifies t1 t2
-      unifies t1 t2 >>- \su1 ->
+    >>- \su1 -> solve (apply su1 cs) >>- \su2 -> return (su2 `compose` su1)
-      solve (apply su1 cs) >>- \su2 ->
-          return (su2 `compose` su1)
 
   solve' (ImpInstConst t1 ms t2, cs) =
     solve (ExpInstConst t1 (generalize ms t2) : cs)

src/Nix/Type/Type.hs

@@ -1,7 +1,7 @@
 module Nix.Type.Type where
 
 import qualified Data.HashMap.Lazy             as M
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import           Nix.Utils
 
 newtype TVar = TV String

src/Nix/Utils.hs

@@ -12,28 +12,36 @@
 
 module Nix.Utils (module Nix.Utils, module X) where
 
-import           Control.Arrow ((&&&))
+import           Control.Arrow                  ( (&&&) )
 import           Control.Monad
 import           Control.Monad.Fix
 import qualified Data.Aeson                    as A
 import qualified Data.Aeson.Encoding           as A
 import           Data.Fix
 import           Data.Hashable
-import           Data.HashMap.Lazy (HashMap)
+import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
-import           Data.List (sortOn)
+import           Data.List                      ( sortOn )
-import           Data.Monoid (Endo, (<>))
+import           Data.Monoid                    ( Endo
-import           Data.Text (Text)
+                                                , (<>)
+                                                )
+import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
 import qualified Data.Vector                   as V
 import           Lens.Family2                  as X
-import           Lens.Family2.Stock (_1, _2)
+import           Lens.Family2.Stock             ( _1
+                                                , _2
+                                                )
 import           Lens.Family2.TH
 
 #if ENABLE_TRACING
 import           Debug.Trace as X
 #else
-import           Prelude as X hiding (putStr, putStrLn, print)
+import           Prelude                       as X
+                                         hiding ( putStr
+                                                , putStrLn
+                                                , print
+                                                )
 trace :: String -> a -> a
 trace = const id
 traceM :: Monad m => String -> m ()
@@ -71,7 +79,7 @@ para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
 para f = f . fmap (id &&& para f) . unFix
 
 paraM :: (Traversable f, Monad m) => (f (Fix f, a) -> m a) -> Fix f -> m a
-paraM f = f <=< traverse (\x -> (x,) <$> paraM f x) . unFix
+paraM f = f <=< traverse (\x -> (x, ) <$> paraM f x) . unFix
 
 cataP :: Functor f => (Fix f -> f a -> a) -> Fix f -> a
 cataP f x = f x . fmap (cataP f) . unFix $ x
@@ -79,7 +87,7 @@ cataP f x = f x . fmap (cataP f) . unFix $ x
 cataPM :: (Traversable f, Monad m) => (Fix f -> f a -> m a) -> Fix f -> m a
 cataPM f x = f x <=< traverse (cataPM f) . unFix $ x
 
-transport :: Functor g => (forall x. f x -> g x) -> Fix f -> Fix g
+transport :: Functor g => (forall x . f x -> g x) -> Fix f -> Fix g
 transport f (Fix x) = Fix $ fmap (transport f) (f x)
 
 -- | adi is Abstracting Definitional Interpreters:
@@ -92,8 +100,12 @@ transport f (Fix x) = Fix $ fmap (transport f) (f x)
 adi :: Functor f => (f a -> a) -> ((Fix f -> a) -> Fix f -> a) -> Fix f -> a
 adi f g = g (f . fmap (adi f g) . unFix)
 
-adiM :: (Traversable t, Monad m)
+adiM
-     => (t a -> m a) -> ((Fix t -> m a) -> Fix t -> m a) -> Fix t -> m a
+  :: (Traversable t, Monad m)
+  => (t a -> m a)
+  -> ((Fix t -> m a) -> Fix t -> m a)
+  -> Fix t
+  -> m a
 adiM f g = g ((f <=< traverse (adiM f g)) . unFix)
 
 class Has a b where
@@ -111,7 +123,8 @@ instance Has (a, b) b where
 toEncodingSorted :: A.Value -> A.Encoding
 toEncodingSorted = \case
   A.Object m ->
-        A.pairs . mconcat
+    A.pairs
+      . mconcat
       . fmap (\(k, v) -> A.pair k $ toEncodingSorted v)
       . sortOn fst
       $ M.toList m
@@ -126,14 +139,28 @@ uriAwareSplit :: Text -> [(Text, NixPathEntryType)]
 uriAwareSplit = go where
   go str = case Text.break (== ':') str of
     (e1, e2)
-            | Text.null e2 -> [(e1, PathEntryPath)]
+      | Text.null e2
-            | Text.pack "://" `Text.isPrefixOf` e2 ->
+      -> [(e1, PathEntryPath)]
-                let ((suffix, _):path) = go (Text.drop 3 e2)
+      | Text.pack "://" `Text.isPrefixOf` e2
+      -> let ((suffix, _) : path) = go (Text.drop 3 e2)
          in  (e1 <> Text.pack "://" <> suffix, PathEntryURI) : path
-            | otherwise -> (e1, PathEntryPath) : go (Text.drop 1 e2)
+      | otherwise
+      -> (e1, PathEntryPath) : go (Text.drop 1 e2)
 
-alterF :: (Eq k, Hashable k, Functor f)
+alterF
-       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
+  :: (Eq k, Hashable k, Functor f)
+  => (Maybe v -> f (Maybe v))
+  -> k
+  -> HashMap k v
+  -> f (HashMap k v)
 alterF f k m = f (M.lookup k m) <&> \case
   Nothing -> M.delete k m
   Just v  -> M.insert k v m
+
+
+
+
+
+
+
+

src/Nix/Value.hs

@@ -41,11 +41,11 @@ import           Data.Align
 import           Data.Eq.Deriving
 import           Data.Functor.Classes
 import           Data.Functor.Identity
-import           Data.HashMap.Lazy (HashMap)
+import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
-import           Data.Text (Text)
+import           Data.Text                      ( Text )
 import           Data.These
-import           Data.Typeable (Typeable)
+import           Data.Typeable                  ( Typeable )
 import           GHC.Generics
 import           Lens.Family2
 import           Lens.Family2.Stock
@@ -99,8 +99,11 @@ instance Foldable (NValueF p m) where
     NVClosureF _ _ -> mempty
     NVBuiltinF _ _ -> mempty
 
-bindNValueF :: (Monad m, Monad n)
+bindNValueF
-            => (forall x. n x -> m x) -> (a -> n b) -> NValueF p m a
+  :: (Monad m, Monad n)
+  => (forall x . n x -> m x)
+  -> (a -> n b)
+  -> NValueF p m a
   -> n (NValueF p m b)
 bindNValueF transform f = \case
   NVConstantF a  -> pure $ NVConstantF a
@@ -121,8 +124,9 @@ lmapNValueF f = \case
   NVClosureF p g -> NVClosureF p (g . fmap f)
   NVBuiltinF s g -> NVBuiltinF s (g . fmap f)
 
-liftNValueF :: (MonadTrans u, Monad m)
+liftNValueF
-            => (forall x. u m x -> m x)
+  :: (MonadTrans u, Monad m)
+  => (forall x . u m x -> m x)
   -> NValueF p m a
   -> NValueF p (u m) a
 liftNValueF run = \case
@@ -134,8 +138,9 @@ liftNValueF run = \case
   NVClosureF p g -> NVClosureF p $ lift . g . run
   NVBuiltinF s g -> NVBuiltinF s $ lift . g . run
 
-unliftNValueF :: (MonadTrans u, Monad m)
+unliftNValueF
-              => (forall x. u m x -> m x)
+  :: (MonadTrans u, Monad m)
+  => (forall x . u m x -> m x)
   -> NValueF p (u m) a
   -> NValueF p m a
 unliftNValueF run = \case
@@ -147,8 +152,8 @@ unliftNValueF run = \case
   NVClosureF p g -> NVClosureF p $ run . g . lift
   NVBuiltinF s g -> NVBuiltinF s $ run . g . lift
 
-type MonadDataContext f (m :: * -> *) =
+type MonadDataContext f (m :: * -> *)
-    (Comonad f, Applicative f, Traversable f, Monad m)
+  = (Comonad f, Applicative f, Traversable f, Monad m)
 
 -- | At the time of constructor, the expected arguments to closures are values
 --   that may contain thunks. The type of such thunks are fixed at that time.
@@ -157,13 +162,13 @@ newtype NValue' t f m a = NValue { _nValue :: f (NValueF (NValue t f m) m a) }
 
 instance Show r => Show (NValueF p m r) where
   showsPrec = flip go   where
-      go (NVConstantF atom)  = showsCon1 "NVConstant" atom
+    go (NVConstantF atom  ) = showsCon1 "NVConstant" atom
-      go (NVStrF ns)         = showsCon1 "NVStr"      (hackyStringIgnoreContext ns)
+    go (NVStrF      ns    ) = showsCon1 "NVStr" (hackyStringIgnoreContext ns)
-      go (NVListF     lst)   = showsCon1 "NVList"     lst
+    go (NVListF     lst   ) = showsCon1 "NVList" lst
     go (NVSetF     attrs _) = showsCon1 "NVSet" attrs
     go (NVClosureF p     _) = showsCon1 "NVClosure" p
-      go (NVPathF p)         = showsCon1 "NVPath"     p
+    go (NVPathF p         ) = showsCon1 "NVPath" p
-      go (NVBuiltinF name _) = showsCon1 "NVBuiltin"  name
+    go (NVBuiltinF name _ ) = showsCon1 "NVBuiltin" name
 
     showsCon1 :: Show a => String -> a -> Int -> String -> String
     showsCon1 con a d =
@@ -174,21 +179,26 @@ instance (Comonad f, Show a) => Show (NValue' t f m a) where
 
 type NValue t f m = NValue' t f m t
 
-bindNValue :: (Traversable f, Monad m, Monad n)
+bindNValue
-           => (forall x. n x -> m x) -> (a -> n b) -> NValue' t f m a
+  :: (Traversable f, Monad m, Monad n)
+  => (forall x . n x -> m x)
+  -> (a -> n b)
+  -> NValue' t f m a
   -> n (NValue' t f m b)
 bindNValue transform f (NValue v) =
   NValue <$> traverse (bindNValueF transform f) v
 
-liftNValue :: (MonadTrans u, Monad m, Functor (u m), Functor f)
+liftNValue
-           => (forall x. u m x -> m x)
+  :: (MonadTrans u, Monad m, Functor (u m), Functor f)
+  => (forall x . u m x -> m x)
   -> NValue' t f m a
   -> NValue' t f (u m) a
 liftNValue run (NValue v) =
   NValue (fmap (lmapNValueF (unliftNValue run) . liftNValueF run) v)
 
-unliftNValue :: (MonadTrans u, Monad m, Functor (u m), Functor f)
+unliftNValue
-             => (forall x. u m x -> m x)
+  :: (MonadTrans u, Monad m, Functor (u m), Functor f)
+  => (forall x . u m x -> m x)
   -> NValue' t f (u m) a
   -> NValue' t f m a
 unliftNValue run (NValue v) =
@@ -207,18 +217,21 @@ unliftNValue run (NValue v) =
 type NValueNF t f m = Free (NValue' t f m) t
 
 iterNValue
-    :: forall t f m a r. MonadDataContext f m
+  :: forall t f m a r
+   . MonadDataContext f m
   => (a -> (NValue' t f m a -> r) -> r)
   -> (NValue' t f m r -> r)
-    -> NValue' t f m a -> r
+  -> NValue' t f m a
+  -> r
 iterNValue k f = f . fmap (\a -> k a (iterNValue k f))
 
 iterNValueM
   :: (MonadDataContext f m, Monad n)
-    => (forall x. n x -> m x)
+  => (forall x . n x -> m x)
   -> (a -> (NValue' t f m a -> n r) -> n r)
   -> (NValue' t f m r -> n r)
-    -> NValue' t f m a -> n r
+  -> NValue' t f m a
+  -> n r
 iterNValueM transform k f =
   f <=< bindNValue transform (\a -> k a (iterNValueM transform k f))
 
@@ -226,34 +239,42 @@ iterNValueNF
   :: MonadDataContext f m
   => (t -> r)
   -> (NValue' t f m r -> r)
-    -> NValueNF t f m -> r
+  -> NValueNF t f m
+  -> r
 iterNValueNF k f = iter f . fmap k
 
-sequenceNValueNF :: (Functor n, Traversable f, Monad m, Monad n)
+sequenceNValueNF
-                 => (forall x. n x -> m x) -> Free (NValue' t f m) (n a)
+  :: (Functor n, Traversable f, Monad m, Monad n)
+  => (forall x . n x -> m x)
+  -> Free (NValue' t f m) (n a)
   -> n (Free (NValue' t f m) a)
 sequenceNValueNF transform = go
  where
-    go (Pure a) = Pure <$> a
+  go (Pure a ) = Pure <$> a
   go (Free fa) = Free <$> bindNValue transform go fa
 
 iterNValueNFM
-    :: forall f m n t r. (MonadDataContext f m, Monad n)
+  :: forall f m n t r
-    => (forall x. n x -> m x)
+   . (MonadDataContext f m, Monad n)
+  => (forall x . n x -> m x)
   -> (t -> n r)
   -> (NValue' t f m (n r) -> n r)
-    -> NValueNF t f m -> n r
+  -> NValueNF t f m
+  -> n r
 iterNValueNFM transform k f v =
   iterM f =<< sequenceNValueNF transform (fmap k v)
 
-nValueFromNF :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+nValueFromNF
-             => NValueNF t f m -> NValue t f m
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+  => NValueNF t f m
+  -> NValue t f m
 nValueFromNF = iterNValueNF f (fmap wrapValue)
  where
   f t = query t cyc id
   cyc = nvStr (principledMakeNixStringWithoutContext "<CYCLE>")
 
-nValueToNF :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+nValueToNF
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
   => (t -> (NValue t f m -> NValueNF t f m) -> NValueNF t f m)
   -> NValue t f m
   -> NValueNF t f m
@@ -261,7 +282,7 @@ nValueToNF k = iterNValue k Free
 
 nValueToNFM
   :: (MonadDataContext f m, Monad n)
-    => (forall x. n x -> m x)
+  => (forall x . n x -> m x)
   -> (t -> (NValue t f m -> n (NValueNF t f m)) -> n (NValueNF t f m))
   -> NValue t f m
   -> n (NValueNF t f m)
@@ -329,8 +350,11 @@ nvBuiltinNF :: Applicative f
             => String -> (m (NValue t f m) -> m (NValueNF t f m)) -> NValueNF t f m
 nvBuiltinNF name f = Free (NValue (pure (NVBuiltinF name f)))
 
-checkComparable :: (Framed e m, MonadDataErrorContext t f m)
+checkComparable
-                => NValue t f m -> NValue t f m -> m ()
+  :: (Framed e m, MonadDataErrorContext t f m)
+  => NValue t f m
+  -> NValue t f m
+  -> m ()
 checkComparable x y = case (x, y) of
   (NVConstant (NFloat _), NVConstant (NInt _)) -> pure ()
   (NVConstant (NInt _), NVConstant (NFloat _)) -> pure ()
@@ -340,37 +364,46 @@ checkComparable x y = case (x, y) of
   (NVPath _, NVPath _) -> pure ()
   _ -> throwError $ Comparison x y
 
-thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f)
+thunkEqM :: (MonadThunk t m (NValue t f m), Comonad f) => t -> t -> m Bool
-         => t -> t -> m Bool
 thunkEqM lt rt = force lt $ \lv -> force rt $ \rv ->
   let unsafePtrEq = case (lt, rt) of
-         (thunkId -> lid, thunkId -> rid)
+        (thunkId -> lid, thunkId -> rid) | lid == rid -> return True
-             | lid == rid -> return True
         _ -> valueEqM lv rv
   in  case (lv, rv) of
         (NVClosure _ _, NVClosure _ _) -> unsafePtrEq
-   (NVList _, NVList _) -> unsafePtrEq
+        (NVList _     , NVList _     ) -> unsafePtrEq
-   (NVSet _ _, NVSet _ _) -> unsafePtrEq
+        (NVSet _ _    , NVSet _ _    ) -> unsafePtrEq
         _                              -> valueEqM lv rv
 
-builtin :: forall m f t. (MonadThunk t m (NValue t f m), MonadDataContext f m)
+builtin
-        => String -> (m (NValue t f m) -> m (NValue t f m)) -> m (NValue t f m)
+  :: forall m f t
+   . (MonadThunk t m (NValue t f m), MonadDataContext f m)
+  => String
+  -> (m (NValue t f m) -> m (NValue t f m))
+  -> m (NValue t f m)
 builtin name f = return $ nvBuiltin name $ thunk . f
 
-builtin2 :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+builtin2
-         => String -> (m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m))
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+  => String
+  -> (m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m))
   -> m (NValue t f m)
 builtin2 name f = builtin name (builtin name . f)
 
-builtin3 :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
+builtin3
+  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
   => String
-         -> (m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m) -> m (NValue t f m))
+  -> (  m (NValue t f m)
+     -> m (NValue t f m)
+     -> m (NValue t f m)
+     -> m (NValue t f m)
+     )
   -> m (NValue t f m)
 builtin3 name f =
   builtin name $ \a -> builtin name $ \b -> builtin name $ \c -> f a b c
 
 isClosureNF :: Comonad f => NValueNF t f m -> Bool
-isClosureNF NVClosureNF {} = True
+isClosureNF NVClosureNF{} = True
 isClosureNF _             = False
 
 -- | Checks whether two containers are equal, using the given item equality
@@ -405,35 +438,38 @@ isDerivationM f m = case M.lookup "type" m of
 isDerivation :: Monad m => (t -> Maybe NixString) -> AttrSet t -> Bool
 isDerivation f = runIdentity . isDerivationM (\x -> Identity (f x))
 
-valueFEqM :: Monad n
+valueFEqM
+  :: Monad n
   => (AttrSet a -> AttrSet a -> n Bool)
   -> (a -> a -> n Bool)
   -> NValueF p m a
   -> NValueF p m a
   -> n Bool
 valueFEqM attrsEq eq = curry $ \case
-    (NVConstantF (NFloat x), NVConstantF (NInt y)) -> pure $ x == fromInteger y
+  (NVConstantF (NFloat x), NVConstantF (NInt y)  ) -> pure $ x == fromInteger y
   (NVConstantF (NInt   x), NVConstantF (NFloat y)) -> pure $ fromInteger x == y
-    (NVConstantF lc, NVConstantF rc) -> pure $ lc == rc
+  (NVConstantF lc        , NVConstantF rc        ) -> pure $ lc == rc
   (NVStrF ls, NVStrF rs) ->
-        pure $ principledStringIgnoreContext ls
+    pure $ principledStringIgnoreContext ls == principledStringIgnoreContext rs
-            == principledStringIgnoreContext rs
+  (NVListF ls , NVListF rs ) -> alignEqM eq ls rs
-    (NVListF ls, NVListF rs)   -> alignEqM eq ls rs
   (NVSetF lm _, NVSetF rm _) -> attrsEq lm rm
-    (NVPathF lp, NVPathF rp)   -> pure $ lp == rp
+  (NVPathF lp , NVPathF rp ) -> pure $ lp == rp
   _                          -> pure False
 
-valueFEq :: (AttrSet a -> AttrSet a -> Bool)
+valueFEq
+  :: (AttrSet a -> AttrSet a -> Bool)
   -> (a -> a -> Bool)
   -> NValueF p m a
   -> NValueF p m a
   -> Bool
-valueFEq attrsEq eq x y =
+valueFEq attrsEq eq x y = runIdentity $ valueFEqM
-    runIdentity $ valueFEqM
   (\x' y' -> Identity (attrsEq x' y'))
-        (\x' y' -> Identity (eq x' y')) x y
+  (\x' y' -> Identity (eq x' y'))
+  x
+  y
 
-compareAttrSetsM :: Monad m
+compareAttrSetsM
+  :: Monad m
   => (t -> m (Maybe NixString))
   -> (t -> t -> m Bool)
   -> AttrSet t
@@ -442,42 +478,46 @@ compareAttrSetsM :: Monad m
 compareAttrSetsM f eq lm rm = do
   isDerivationM f lm >>= \case
     True -> isDerivationM f rm >>= \case
-            True | Just lp <- M.lookup "outPath" lm
+      True
-                 , Just rp <- M.lookup "outPath" rm
+        | Just lp <- M.lookup "outPath" lm, Just rp <- M.lookup "outPath" rm -> eq
-                   -> eq lp rp
+          lp
+          rp
       _ -> compareAttrs
     _ -> compareAttrs
-  where
+  where compareAttrs = alignEqM eq lm rm
-    compareAttrs = alignEqM eq lm rm
 
-compareAttrSets :: (t -> Maybe NixString)
+compareAttrSets
+  :: (t -> Maybe NixString)
   -> (t -> t -> Bool)
   -> AttrSet t
   -> AttrSet t
   -> Bool
-compareAttrSets f eq lm rm =
+compareAttrSets f eq lm rm = runIdentity
-    runIdentity $ compareAttrSetsM
+  $ compareAttrSetsM (\t -> Identity (f t)) (\x y -> Identity (eq x y)) lm rm
-        (\t -> Identity (f t))
-        (\x y -> Identity (eq x y)) lm rm
 
-valueEqM :: (MonadThunk t m (NValue t f m), Comonad f)
+valueEqM
-         => NValue t f m -> NValue t f m -> m Bool
+  :: (MonadThunk t m (NValue t f m), Comonad f)
-valueEqM (NValue (extract -> x)) (NValue (extract -> y)) =
+  => NValue t f m
-    valueFEqM (compareAttrSetsM f thunkEqM) thunkEqM x y
+  -> NValue t f m
+  -> m Bool
+valueEqM (NValue (extract -> x)) (NValue (extract -> y)) = valueFEqM
+  (compareAttrSetsM f thunkEqM)
+  thunkEqM
+  x
+  y
  where
   f t = force t $ \case
     NVStr s -> pure $ Just s
     _       -> pure Nothing
 
-valueNFEq :: Comonad f
+valueNFEq :: Comonad f => NValueNF t f m -> NValueNF t f m -> Bool
-          => NValueNF t f m -> NValueNF t f m -> Bool
 valueNFEq (Pure _) (Pure _) = False
 valueNFEq (Pure _) (Free _) = False
 valueNFEq (Free _) (Pure _) = False
 valueNFEq (Free (NValue (extract -> x))) (Free (NValue (extract -> y))) =
   valueFEq (compareAttrSets f valueNFEq) valueNFEq x y
  where
-    f (Pure _) = Nothing
+  f (Pure _        ) = Nothing
   f (Free (NVStr s)) = Just s
   f _                = Nothing
 
@@ -506,11 +546,11 @@ valueType = \case
     NNull    -> TNull
   NVStrF ns | stringHasContext ns -> TString HasContext
             | otherwise           -> TString NoContext
-    NVListF {}    -> TList
+  NVListF{}    -> TList
-    NVSetF {}     -> TSet
+  NVSetF{}     -> TSet
-    NVClosureF {} -> TClosure
+  NVClosureF{} -> TClosure
-    NVPathF {}    -> TPath
+  NVPathF{}    -> TPath
-    NVBuiltinF {} -> TBuiltin
+  NVBuiltinF{} -> TBuiltin
 
 describeValue :: ValueType -> String
 describeValue = \case
@@ -530,15 +570,15 @@ instance Eq1 (NValueF p m) where
   liftEq _  (NVConstantF x) (NVConstantF y) = x == y
   liftEq _  (NVStrF      x) (NVStrF      y) = x == y
   liftEq eq (NVListF     x) (NVListF     y) = liftEq eq x y
-    liftEq eq (NVSetF x _)    (NVSetF y _)    = liftEq eq x y
+  liftEq eq (NVSetF x _   ) (NVSetF y _   ) = liftEq eq x y
-    liftEq _  (NVPathF x)     (NVPathF y)     = x == y
+  liftEq _  (NVPathF x    ) (NVPathF y    ) = x == y
   liftEq _  _               _               = False
 
 instance Comonad f => Show1 (NValue' t f m) where
   liftShowsPrec sp sl p = \case
     NVConstant atom -> showsUnaryWith showsPrec "NVConstantF" p atom
-        NVStr ns         -> showsUnaryWith showsPrec "NVStrF"      p
+    NVStr ns ->
-                                          (hackyStringIgnoreContext ns)
+      showsUnaryWith showsPrec "NVStrF" p (hackyStringIgnoreContext ns)
     NVList lst       -> showsUnaryWith (liftShowsPrec sp sl) "NVListF" p lst
     NVSet attrs _    -> showsUnaryWith (liftShowsPrec sp sl) "NVSetF" p attrs
     NVPath path      -> showsUnaryWith showsPrec "NVPathF" p path
@@ -560,16 +600,18 @@ data ValueFrame t f m
     | Expectation ValueType (NValue t f m)
     deriving (Show, Typeable)
 
-type MonadDataErrorContext t f m =
+type MonadDataErrorContext t f m
-    (Show t, Typeable t, Typeable m, Typeable f, MonadDataContext f m)
+  = (Show t, Typeable t, Typeable m, Typeable f, MonadDataContext f m)
 
 instance MonadDataErrorContext t f m => Exception (ValueFrame t f m)
 
 $(makeTraversals ''NValueF)
 $(makeLenses ''NValue')
 
-key :: (Traversable f, Applicative g)
+key
-    => VarName -> LensLike' g (NValue' t f m a) (Maybe a)
+  :: (Traversable f, Applicative g)
-key k = nValue.traverse._NVSetF._1.hashAt k
+  => VarName
+  -> LensLike' g (NValue' t f m a) (Maybe a)
+key k = nValue . traverse . _NVSetF . _1 . hashAt k
 
 $(deriveEq1 ''NValue')

src/Nix/Var.hs

@@ -22,7 +22,7 @@ type Var m = Ref m
 
 type MonadVar m = MonadAtomicRef m
 
-eqVar :: forall m a. GEq (Ref m) => Ref m a -> Ref m a -> Bool
+eqVar :: forall m a . GEq (Ref m) => Ref m a -> Ref m a -> Bool
 eqVar a b = isJust $ geq a b
 
 newVar :: MonadRef m => a -> m (Ref m a)
@@ -39,11 +39,7 @@ atomicModifyVar = atomicModifyRef
 
 --TODO: Upstream GEq instances
 instance GEq IORef where
-    a `geq` b = if a == unsafeCoerce b
+  a `geq` b = if a == unsafeCoerce b then Just $ unsafeCoerce Refl else Nothing
-                then Just $ unsafeCoerce Refl
-                else Nothing
 
 instance GEq (STRef s) where
-    a `geq` b = if a == unsafeCoerce b
+  a `geq` b = if a == unsafeCoerce b then Just $ unsafeCoerce Refl else Nothing
-                then Just $ unsafeCoerce Refl
-                else Nothing

src/Nix/XML.hs

@@ -15,12 +15,14 @@ import           Nix.String
 import           Nix.Value
 import           Text.XML.Light
 
-toXML :: forall t f m. MonadDataContext f m => NValueNF t f m -> NixString
+toXML :: forall t f m . MonadDataContext f m => NValueNF t f m -> NixString
-toXML = runWithStringContext
+toXML =
+  runWithStringContext
     . fmap pp
     . iterNValueNF (const (pure (mkElem "cycle" "value" ""))) phi
  where
-    pp = ("<?xml version='1.0' encoding='utf-8'?>\n" <>)
+  pp =
+    ("<?xml version='1.0' encoding='utf-8'?>\n" <>)
       . (<> "\n")
       . Text.pack
       . ppElement
@@ -35,18 +37,26 @@ toXML = runWithStringContext
       NNull    -> return $ Element (unqual "null") [] [] Nothing
 
     NVStr  str -> mkElem "string" "value" . Text.unpack <$> extractNixString str
-        NVList l  -> sequence l >>= \els ->
+    NVList l   -> sequence l
-          return $ Element (unqual "list") [] (Elem <$> els) Nothing
+      >>= \els -> return $ Element (unqual "list") [] (Elem <$> els) Nothing
 
-        NVSet s _ -> sequence s >>= \kvs ->
+    NVSet s _ -> sequence s >>= \kvs -> return $ Element
-          return $ Element (unqual "attrs") []
+      (unqual "attrs")
-            (map (\(k, v) ->
+      []
-                      Elem (Element (unqual "attr")
+      (map
+        (\(k, v) -> Elem
+          (Element (unqual "attr")
                    [Attr (unqual "name") (Text.unpack k)]
-                               [Elem v] Nothing))
+                   [Elem v]
-                 (sortBy (comparing fst) $ M.toList kvs)) Nothing
+                   Nothing
+          )
+        )
+        (sortBy (comparing fst) $ M.toList kvs)
+      )
+      Nothing
 
-        NVClosure p _    -> return $ Element (unqual "function") [] (paramsXML p) Nothing
+    NVClosure p _ ->
+      return $ Element (unqual "function") [] (paramsXML p) Nothing
     NVPath fp        -> return $ mkElem "path" "value" fp
     NVBuiltin name _ -> return $ mkElem "function" "name" name
     _                -> error "Pattern synonyms mask coverage"
@@ -55,13 +65,12 @@ mkElem :: String -> String -> String -> Element
 mkElem n a v = Element (unqual n) [Attr (unqual a) v] [] Nothing
 
 paramsXML :: Params r -> [Content]
-paramsXML (Param name) =
+paramsXML (Param name) = [Elem $ mkElem "varpat" "name" (Text.unpack name)]
-    [Elem $ mkElem "varpat" "name" (Text.unpack name)]
 paramsXML (ParamSet s b mname) =
   [Elem $ Element (unqual "attrspat") (battr <> nattr) (paramSetXML s) Nothing]
  where
   battr = [ Attr (unqual "ellipsis") "1" | b ]
-    nattr = maybe [] ((:[]) . Attr (unqual "name") . Text.unpack) mname
+  nattr = maybe [] ((: []) . Attr (unqual "name") . Text.unpack) mname
 
 paramSetXML :: ParamSet r -> [Content]
-paramSetXML = map (\(k,_) -> Elem $ mkElem "attr" "name" (Text.unpack k))
+paramSetXML = map (\(k, _) -> Elem $ mkElem "attr" "name" (Text.unpack k))

tests/NixLanguageTests.hs

@@ -4,16 +4,18 @@
 
 module NixLanguageTests (genTests) where
 
-import           Control.Arrow ((&&&))
+import           Control.Arrow                  ( (&&&) )
 import           Control.Exception
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.ST
-import           Data.List (delete, sort)
+import           Data.List                      ( delete
-import           Data.List.Split (splitOn)
+                                                , sort
-import           Data.Map (Map)
+                                                )
+import           Data.List.Split                ( splitOn )
+import           Data.Map                       ( Map )
 import qualified Data.Map                      as Map
-import           Data.Set (Set)
+import           Data.Set                       ( Set )
 import qualified Data.Set                      as Set
 import qualified Data.Text                     as Text
 import qualified Data.Text.IO                  as Text
@@ -30,7 +32,9 @@ import           Nix.XML
 import qualified Options.Applicative           as Opts
 import           System.Environment
 import           System.FilePath
-import           System.FilePath.Glob (compile, globDir1)
+import           System.FilePath.Glob           ( compile
+                                                , globDir1
+                                                )
 import           Test.Tasty
 import           Test.Tasty.HUnit
 import           TestCommon
@@ -72,7 +76,8 @@ newFailingTests = Set.fromList
 
 genTests :: IO TestTree
 genTests = do
-  testFiles <- sort
+  testFiles <-
+    sort
         -- jww (2018-05-07): Temporarily disable this test until #128 is fixed.
     .   filter ((`Set.notMember` newFailingTests) . takeBaseName)
     .   filter ((/= ".xml") . takeExtension)
@@ -80,22 +85,21 @@ genTests = do
   let testsByName = groupBy (takeFileName . dropExtensions) testFiles
   let testsByType = groupBy testType (Map.toList testsByName)
   let testGroups  = map mkTestGroup (Map.toList testsByType)
-  return $ localOption (mkTimeout 2000000)
+  return $ localOption (mkTimeout 2000000) $ testGroup
-         $ testGroup "Nix (upstream) language tests" testGroups
+    "Nix (upstream) language tests"
+    testGroups
  where
-    testType (fullpath, _files) =
+  testType (fullpath, _files) = take 2 $ splitOn "-" $ takeFileName fullpath
-        take 2 $ splitOn "-" $ takeFileName fullpath
   mkTestGroup (kind, tests) =
     testGroup (unwords kind) $ map (mkTestCase kind) tests
-    mkTestCase kind (basename, files) =
+  mkTestCase kind (basename, files) = testCase (takeFileName basename) $ do
-        testCase (takeFileName basename) $ do
     time <- liftIO getCurrentTime
     let opts = defaultOptions time
     case kind of
       ["parse", "okay"] -> assertParse opts $ the files
       ["parse", "fail"] -> assertParseFail opts $ the files
-                ["eval", "okay"]  -> assertEval opts files
+      ["eval" , "okay"] -> assertEval opts files
-                ["eval", "fail"]  -> assertEvalFail $ the files
+      ["eval" , "fail"] -> assertEvalFail $ the files
       _                 -> error $ "Unexpected: " ++ show kind
 
 assertParse :: Options -> FilePath -> Assertion
@@ -107,13 +111,18 @@ assertParse _opts file = parseNixFileLoc file >>= \case
 assertParseFail :: Options -> FilePath -> Assertion
 assertParseFail opts file = do
   eres <- parseNixFileLoc file
-    catch (case eres of
+  catch
+      (case eres of
         Success expr -> do
           _ <- pure $! runST $ void $ lint opts expr
-                   assertFailure $ "Unexpected success parsing `"
+          assertFailure
-                       ++ file ++ ":\nParsed value: " ++ show expr
+            $  "Unexpected success parsing `"
-               Failure _ -> return ()) $ \(_ :: SomeException) ->
+            ++ file
-        return ()
+            ++ ":\nParsed value: "
+            ++ show expr
+        Failure _ -> return ()
+      )
+    $ \(_ :: SomeException) -> return ()
 
 assertLangOk :: Options -> FilePath -> Assertion
 assertLangOk opts file = do
@@ -123,7 +132,9 @@ assertLangOk opts file = do
 
 assertLangOkXml :: Options -> FilePath -> Assertion
 assertLangOkXml opts file = do
-  actual <- principledStringIgnoreContext . toXML <$> hnixEvalFile opts (file ++ ".nix")
+  actual <- principledStringIgnoreContext . toXML <$> hnixEvalFile
+    opts
+    (file ++ ".nix")
   expected <- Text.readFile $ file ++ ".exp.xml"
   assertEqual "" expected actual
 
@@ -133,8 +144,8 @@ assertEval _opts files = do
   let opts = defaultOptions time
   case delete ".nix" $ sort $ map takeExtensions files of
     []                 -> () <$ hnixEvalFile opts (name ++ ".nix")
-        [".exp"] -> assertLangOk opts name
+    [".exp"         ]  -> assertLangOk opts name
-        [".exp.xml"] -> assertLangOkXml opts name
+    [".exp.xml"     ]  -> assertLangOkXml opts name
     [".exp.disabled"]  -> return ()
     [".exp-disabled"]  -> return ()
     [".exp", ".flags"] -> do
@@ -142,33 +153,46 @@ assertEval _opts files = do
       flags <- Text.readFile (name ++ ".flags")
       let flags' | Text.last flags == '\n' = Text.init flags
                  | otherwise               = flags
-            case Opts.execParserPure Opts.defaultPrefs (nixOptionsInfo time)
+      case
-                     (fixup (map Text.unpack (Text.splitOn " " flags'))) of
+          Opts.execParserPure
-                Opts.Failure err -> errorWithoutStackTrace $
+            Opts.defaultPrefs
-                    "Error parsing flags from " ++ name ++ ".flags: "
+            (nixOptionsInfo time)
+            (fixup (map Text.unpack (Text.splitOn " " flags')))
+        of
+          Opts.Failure err ->
+            errorWithoutStackTrace
+              $  "Error parsing flags from "
+              ++ name
+              ++ ".flags: "
               ++ show err
-                Opts.Success opts' ->
+          Opts.Success opts' -> assertLangOk
-                    assertLangOk
+            (opts'
-                        (opts' { include = include opts' ++
+              { include = include opts'
-                                   [ "nix=../../../../data/nix/corepkgs"
+                            ++ [ "nix=../../../../data/nix/corepkgs"
                                , "lang/dir4"
-                                   , "lang/dir5" ] })
+                               , "lang/dir5"
+                               ]
+              }
+            )
             name
           Opts.CompletionInvoked _ -> error "unused"
     _ -> assertFailure $ "Unknown test type " ++ show files
  where
-    name = "data/nix/tests/lang/"
+  name =
-        ++ the (map (takeFileName . dropExtensions) files)
+    "data/nix/tests/lang/" ++ the (map (takeFileName . dropExtensions) files)
 
-    fixup ("--arg":x:y:rest) = "--arg":(x ++ "=" ++ y):fixup rest
+  fixup ("--arg"    : x : y : rest) = "--arg" : (x ++ "=" ++ y) : fixup rest
-    fixup ("--argstr":x:y:rest) = "--argstr":(x ++ "=" ++ y):fixup rest
+  fixup ("--argstr" : x : y : rest) = "--argstr" : (x ++ "=" ++ y) : fixup rest
-    fixup (x:rest) = x:fixup rest
+  fixup (x                  : rest) = x : fixup rest
   fixup []                          = []
 
 assertEvalFail :: FilePath -> Assertion
 assertEvalFail file = catch ?? (\(_ :: SomeException) -> return ()) $ do
   time       <- liftIO getCurrentTime
   evalResult <- printNix <$> hnixEvalFile (defaultOptions time) file
-  evalResult `seq` assertFailure $
+  evalResult
-      file ++ " should not evaluate.\nThe evaluation result was `"
+    `seq` assertFailure
-           ++ evalResult ++ "`."
+    $     file
+    ++    " should not evaluate.\nThe evaluation result was `"
+    ++    evalResult
+    ++    "`."

tests/PrettyParseTests.hs

@@ -16,7 +16,9 @@ import           Data.Algorithm.DiffOutput
 import           Data.Char
 import           Data.Fix
 import qualified Data.List.NonEmpty            as NE
-import           Data.Text (Text, pack)
+import           Data.Text                      ( Text
+                                                , pack
+                                                )
 import           Data.Text.Prettyprint.Doc
 import           Hedgehog
 import qualified Hedgehog.Gen                  as Gen
@@ -27,7 +29,10 @@ import           Nix.Parser
 import           Nix.Pretty
 import           Test.Tasty
 import           Test.Tasty.Hedgehog
-import           Text.Megaparsec (Pos, SourcePos, mkPos)
+import           Text.Megaparsec                ( Pos
+                                                , SourcePos
+                                                , mkPos
+                                                )
 import qualified Text.Show.Pretty              as PS
 
 asciiString :: MonadGen m => m String
@@ -44,20 +49,18 @@ genSourcePos :: Gen SourcePos
 genSourcePos = SourcePos <$> asciiString <*> genPos <*> genPos
 
 genKeyName :: Gen (NKeyName NExpr)
-genKeyName = Gen.choice [ DynamicKey <$> genAntiquoted genString
+genKeyName =
-                        , StaticKey <$> asciiText ]
+  Gen.choice [DynamicKey <$> genAntiquoted genString, StaticKey <$> asciiText]
 
 genAntiquoted :: Gen a -> Gen (Antiquoted a NExpr)
-genAntiquoted gen = Gen.choice
+genAntiquoted gen =
-  [ Plain <$> gen
+  Gen.choice [Plain <$> gen, pure EscapedNewline, Antiquoted <$> genExpr]
-  , pure EscapedNewline
-  , Antiquoted <$> genExpr
-  ]
 
 genBinding :: Gen (Binding NExpr)
 genBinding = Gen.choice
   [ NamedVar <$> genAttrPath <*> genExpr <*> genSourcePos
-  , Inherit <$> Gen.maybe genExpr
+  , Inherit
+  <$> Gen.maybe genExpr
   <*> Gen.list (Range.linear 0 5) genKeyName
   <*> genSourcePos
   ]
@@ -65,19 +68,19 @@ genBinding = Gen.choice
 genString :: Gen (NString NExpr)
 genString = Gen.choice
   [ DoubleQuoted <$> Gen.list (Range.linear 0 5) (genAntiquoted asciiText)
-  , Indented <$> Gen.int (Range.linear 0 10)
+  , Indented <$> Gen.int (Range.linear 0 10) <*> Gen.list
-             <*> Gen.list (Range.linear 0 5) (genAntiquoted asciiText)
+    (Range.linear 0 5)
+    (genAntiquoted asciiText)
   ]
 
 genAttrPath :: Gen (NAttrPath NExpr)
-genAttrPath = (NE.:|) <$> genKeyName
+genAttrPath = (NE.:|) <$> genKeyName <*> Gen.list (Range.linear 0 4) genKeyName
-                      <*> Gen.list (Range.linear 0 4) genKeyName
 
 genParams :: Gen (Params NExpr)
 genParams = Gen.choice
   [ Param <$> asciiText
-  , ParamSet <$> Gen.list (Range.linear 0 10) ((,) <$> asciiText
+  , ParamSet
-                                                   <*> Gen.maybe genExpr)
+  <$> Gen.list (Range.linear 0 10) ((,) <$> asciiText <*> Gen.maybe genExpr)
   <*> Gen.bool
   <*> Gen.choice [pure Nothing, Just <$> asciiText]
   ]
@@ -87,33 +90,30 @@ genAtom = Gen.choice
   [ NInt <$> Gen.integral (Range.linear 0 1000)
   , NFloat <$> Gen.float (Range.linearFrac 0.0 1000.0)
   , NBool <$> Gen.bool
-  , pure NNull ]
+  , pure NNull
+  ]
 
 -- This is written by hand so we can use `fairList` rather than the normal
 -- list Arbitrary instance which makes the generator terminate. The
 -- distribution is not scientifically chosen.
 genExpr :: Gen NExpr
-genExpr = Gen.sized $ \(Size n) ->
+genExpr = Gen.sized $ \(Size n) -> Fix <$> if n < 2
-  Fix <$>
+  then Gen.choice [genConstant, genStr, genSym, genLiteralPath, genEnvPath]
-      if n < 2
+  else Gen.frequency
-      then Gen.choice
+    [ (1 , genConstant)
-        [genConstant, genStr, genSym, genLiteralPath, genEnvPath ]
+    , (1 , genSym)
-      else
+    , (4 , Gen.resize (Size (n `div` 3)) genIf)
-        Gen.frequency
+    , (10, genRecSet)
-          [ ( 1, genConstant)
+    , (20, genSet)
-          , ( 1, genSym)
+    , (5 , genList)
-          , ( 4, Gen.resize (Size (n `div` 3)) genIf)
+    , (2 , genUnary)
-          , (10, genRecSet )
+    , (2, Gen.resize (Size (n `div` 3)) genBinary)
-          , (20, genSet )
+    , (3, Gen.resize (Size (n `div` 3)) genSelect)
-          , ( 5, genList )
+    , (20, Gen.resize (Size (n `div` 2)) genAbs)
-          , ( 2, genUnary )
+    , (2, Gen.resize (Size (n `div` 2)) genHasAttr)
-          , ( 2, Gen.resize (Size (n `div` 3)) genBinary )
+    , (10, Gen.resize (Size (n `div` 2)) genLet)
-          , ( 3, Gen.resize (Size (n `div` 3)) genSelect )
+    , (10, Gen.resize (Size (n `div` 2)) genWith)
-          , (20, Gen.resize (Size (n `div` 2)) genAbs )
+    , (1, Gen.resize (Size (n `div` 2)) genAssert)
-          , ( 2, Gen.resize (Size (n `div` 2)) genHasAttr )
-          , (10, Gen.resize (Size (n `div` 2)) genLet )
-          , (10, Gen.resize (Size (n `div` 2)) genWith )
-          , ( 1, Gen.resize (Size (n `div` 2)) genAssert)
     ]
  where
   genConstant    = NConstant <$> genAtom
@@ -147,8 +147,10 @@ equivUpToNormalization x y = normalize x == normalize y
 
 normalize :: NExpr -> NExpr
 normalize = cata $ \case
-  NConstant (NInt n)   | n < 0 -> Fix (NUnary NNeg (Fix (NConstant (NInt (negate n)))))
+  NConstant (NInt n) | n < 0 ->
-  NConstant (NFloat n) | n < 0 -> Fix (NUnary NNeg (Fix (NConstant (NFloat (negate n)))))
+    Fix (NUnary NNeg (Fix (NConstant (NInt (negate n)))))
+  NConstant (NFloat n) | n < 0 ->
+    Fix (NUnary NNeg (Fix (NConstant (NFloat (negate n)))))
 
   NSet    binds -> Fix (NSet (map normBinding binds))
   NRecSet binds -> Fix (NRecSet (map normBinding binds))
@@ -163,12 +165,11 @@ normalize = cata $ \case
   normBinding (Inherit  mr   names pos) = Inherit mr (map normKey names) pos
 
   normKey (DynamicKey quoted) = DynamicKey (normAntiquotedString quoted)
-  normKey (StaticKey name) = StaticKey name
+  normKey (StaticKey  name  ) = StaticKey name
 
-  normAntiquotedString :: Antiquoted (NString NExpr) NExpr
+  normAntiquotedString
-                       -> Antiquoted (NString NExpr) NExpr
+    :: Antiquoted (NString NExpr) NExpr -> Antiquoted (NString NExpr) NExpr
-  normAntiquotedString (Plain (DoubleQuoted [EscapedNewline])) =
+  normAntiquotedString (Plain (DoubleQuoted [EscapedNewline])) = EscapedNewline
-      EscapedNewline
   normAntiquotedString (Plain (DoubleQuoted strs)) =
     let strs' = map normAntiquotedText strs
     in  if strs == strs'
@@ -177,7 +178,7 @@ normalize = cata $ \case
   normAntiquotedString r = r
 
   normAntiquotedText :: Antiquoted Text NExpr -> Antiquoted Text NExpr
-  normAntiquotedText (Plain "\n")   = EscapedNewline
+  normAntiquotedText (Plain "\n"  ) = EscapedNewline
   normAntiquotedText (Plain "''\n") = EscapedNewline
   normAntiquotedText r              = r
 
@@ -191,17 +192,17 @@ prop_prettyparse p = do
   case parse (pack prog) of
     Failure s -> do
       footnote $ show $ vsep
-            [ fillSep ["Parse failed:", pretty (show s)]
+        [fillSep ["Parse failed:", pretty (show s)], indent 2 (prettyNix p)]
-            , indent 2 (prettyNix p)
-            ]
       discard
     Success v
       | equivUpToNormalization p v -> success
       | otherwise -> do
         let pp = normalise prog
             pv = normalise (show (prettyNix v))
-          footnote $ show $ vsep $
+        footnote
-              [ "----------------------------------------"
+          $ show
+          $ vsep
+          $ [ "----------------------------------------"
             , vsep ["Expr before:", indent 2 (pretty (PS.ppShow p))]
             , "----------------------------------------"
             , vsep ["Expr after:", indent 2 (pretty (PS.ppShow v))]
@@ -224,7 +225,7 @@ prop_prettyparse p = do
   normalise = unlines . map (reverse . dropWhile isSpace . reverse) . lines
 
   diff :: String -> String -> [Diff [String]]
-    diff s1 s2 = getDiff (map (:[]) (lines s1)) (map (:[]) (lines s2))
+  diff s1 s2 = getDiff (map (: []) (lines s1)) (map (: []) (lines s2))
 
 tests :: TestLimit -> TestTree
 tests n = testProperty "Pretty/Parse Property" $ withTests n $ property $ do

tests/PrettyTests.hs

@@ -34,4 +34,5 @@ tests = $testGroupGenerator
 
 --------------------------------------------------------------------------------
 assertPretty :: NExpr -> String -> Assertion
-assertPretty e s = assertEqual ("When pretty-printing " ++ show e) s . show $ prettyNix e
+assertPretty e s =
+  assertEqual ("When pretty-printing " ++ show e) s . show $ prettyNix e

tests/ReduceExprTests.hs

@@ -9,19 +9,20 @@ import Nix.Atoms
 import           Nix.Expr.Types
 import           Nix.Expr.Types.Annotated
 import           Nix.Parser
-import Nix.Reduce (reduceExpr)
+import           Nix.Reduce                     ( reduceExpr )
 
 
 tests :: TestTree
-tests = testGroup "Expr Reductions"
+tests = testGroup
-    [ testCase "Non nested NSelect on set should be reduced" $ 
+  "Expr Reductions"
-        cmpReduceResult selectBasic selectBasicExpect,
+  [ testCase "Non nested NSelect on set should be reduced"
-      testCase "Nested NSelect on set should be reduced" $ 
+    $ cmpReduceResult selectBasic selectBasicExpect
-        cmpReduceResult selectNested selectNestedExpect,
+  , testCase "Nested NSelect on set should be reduced"
-      testCase "Non nested NSelect with incorrect attrpath shouldn't be reduced" $ 
+    $ cmpReduceResult selectNested selectNestedExpect
-        shouldntReduce selectIncorrectAttrPath,
+  , testCase "Non nested NSelect with incorrect attrpath shouldn't be reduced"
-      testCase "Nested NSelect with incorrect attrpath shouldn't be reduced" $ 
+    $ shouldntReduce selectIncorrectAttrPath
-        shouldntReduce selectNestedIncorrectAttrPath 
+  , testCase "Nested NSelect with incorrect attrpath shouldn't be reduced"
+    $ shouldntReduce selectNestedIncorrectAttrPath
   ]
 
 assertSucc :: Result a -> IO a

tests/TestCommon.hs

@@ -6,7 +6,9 @@ module TestCommon where
 
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
-import Data.Text (Text, unpack)
+import           Data.Text                      ( Text
+                                                , unpack
+                                                )
 import           Data.Time
 import           Nix
 import           Nix.Thunk.Standard
@@ -25,25 +27,29 @@ hnixEvalFile opts file = do
       error $ "Parsing failed for file `" ++ file ++ "`.\n" ++ show err
     Success expr -> do
       setEnv "TEST_VAR" "foo"
-        runStdLazyM opts $
+      runStdLazyM opts
-            catch (evaluateExpression (Just file) nixEvalExprLoc
+        $ catch (evaluateExpression (Just file) nixEvalExprLoc normalForm expr)
-                                      normalForm expr) $ \case
+        $ \case
             NixException frames ->
-                    errorWithoutStackTrace . show
+              errorWithoutStackTrace
+                .   show
                 =<< renderFrames @(StdValue IO) @(StdThunk IO) frames
 
 hnixEvalText :: Options -> Text -> IO (StdValueNF IO)
 hnixEvalText opts src = case parseNixText src of
   Failure err ->
-        error $ "Parsing failed for expressien `"
+    error
-            ++ unpack src ++ "`.\n" ++ show err
+      $  "Parsing failed for expressien `"
+      ++ unpack src
+      ++ "`.\n"
+      ++ show err
   Success expr ->
       -- runStdLazyM opts $ normalForm =<< nixEvalExpr Nothing expr
     runStdLazyM opts $ normalForm =<< nixEvalExpr Nothing expr
 
 nixEvalString :: String -> IO String
 nixEvalString expr = do
-  (fp,h) <- mkstemp "nix-test-eval"
+  (fp, h) <- mkstemp "nix-test-eval"
   hPutStr h expr
   hClose h
   res <- nixEvalFile fp
@@ -56,15 +62,14 @@ nixEvalFile fp = readProcess "nix-instantiate" ["--eval", "--strict", fp] ""
 assertEvalFileMatchesNix :: FilePath -> Assertion
 assertEvalFileMatchesNix fp = do
   time    <- liftIO getCurrentTime
-  hnixVal <- (++"\n") . printNix <$> hnixEvalFile (defaultOptions time) fp
+  hnixVal <- (++ "\n") . printNix <$> hnixEvalFile (defaultOptions time) fp
   nixVal  <- nixEvalFile fp
   assertEqual fp nixVal hnixVal
 
 assertEvalMatchesNix :: Text -> Assertion
 assertEvalMatchesNix expr = do
   time    <- liftIO getCurrentTime
-  hnixVal <- (++"\n") . printNix <$> hnixEvalText (defaultOptions time) expr
+  hnixVal <- (++ "\n") . printNix <$> hnixEvalText (defaultOptions time) expr
   nixVal  <- nixEvalString expr'
   assertEqual expr' nixVal hnixVal
- where
+  where expr' = unpack expr
-  expr' = unpack expr