Merge #849: Treewide: Basic polymorphic refactoring

* Derivation: m clean-up
* Eval: m improve readability
* upd remainding (map -> fmap)
* upd remaining ((++) -> (<>))
* (Just -> pure)
* (return -> pure)
* ((>>) -> (*>))
* ([] -> mempty)
* (Nothing -> mempty)

Author: Anton-Latukha

main/Main.hs

@@ -51,24 +51,24 @@ main = do
   runWithBasicEffectsIO opts $ case readFrom opts of
     Just path -> do
       let file = addExtension (dropExtension path) "nixc"
-      process opts (Just file) =<< liftIO (readCache path)
+      process opts (pure file) =<< liftIO (readCache path)
     Nothing -> case expression opts of
-      Just s  -> handleResult opts Nothing (parseNixTextLoc s)
+      Just s  -> handleResult opts mempty (parseNixTextLoc s)
       Nothing -> case fromFile opts of
         Just "-" -> mapM_ (processFile opts) . lines =<< liftIO getContents
         Just path ->
           mapM_ (processFile opts) . lines =<< liftIO (readFile path)
         Nothing -> case filePaths opts of
-          [] -> withNixContext Nothing Repl.main
+          [] -> withNixContext mempty Repl.main
           ["-"] ->
-            handleResult opts Nothing
+            handleResult opts mempty
               .   parseNixTextLoc
               =<< liftIO Text.getContents
           paths -> mapM_ (processFile opts) paths
  where
   processFile opts path = do
     eres <- parseNixFileLoc path
-    handleResult opts (Just path) eres
+    handleResult opts (pure path) eres
 
   handleResult opts mpath = \case
     Failure err ->
@@ -77,14 +77,14 @@ main = do
           else errorWithoutStackTrace
         )
         $  "Parse failed: "
-        ++ show err
+        <> 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 -> errorWithoutStackTrace $ "Type error: " ++ PS.ppShow err
-          Right ty  -> liftIO $ putStrLn $ "Type of expression: " ++ PS.ppShow
+          Left  err -> errorWithoutStackTrace $ "Type error: " <> PS.ppShow err
+          Right ty  -> liftIO $ putStrLn $ "Type of expression: " <> PS.ppShow
             (fromJust (Map.lookup "it" (Env.types ty)))
 
           -- liftIO $ putStrLn $ runST $
@@ -102,8 +102,8 @@ main = do
         if evaluate opts
           then do
             val <- Nix.nixEvalExprLoc mpath expr
-            withNixContext Nothing (Repl.main' $ Just val)
-          else withNixContext Nothing Repl.main
+            withNixContext mempty (Repl.main' $ pure val)
+          else withNixContext mempty Repl.main
 
   process opts mpath expr
     | evaluate opts
@@ -165,9 +165,9 @@ main = do
        where
         go prefix s = do
           xs <- forM (sortOn fst (M.toList s)) $ \(k, nv) -> case nv of
-            Free v -> pure (k, Just (Free v))
+            Free v -> pure (k, pure (Free v))
             Pure (StdThunk (extract -> Thunk _ _ ref)) -> do
-              let path         = prefix ++ Text.unpack k
+              let path         = prefix <> Text.unpack k
                   (_, descend) = filterEntry path k
               val <- readVar @(StandardT (StdIdT IO)) ref
               case val of
@@ -176,14 +176,14 @@ main = do
                   | otherwise -> pure (k, Nothing)
 
           forM_ xs $ \(k, mv) -> do
-            let path              = prefix ++ Text.unpack k
+            let path              = prefix <> Text.unpack k
                 (report, descend) = filterEntry path k
             when report $ do
               liftIO $ putStrLn path
               when descend $ case mv of
                 Nothing -> pure ()
                 Just v  -> case v of
-                  NVSet s' _ -> go (path ++ ".") s'
+                  NVSet s' _ -> go (path <> ".") s'
                   _          -> pure ()
          where
           filterEntry path k = case (path, k) of
@@ -204,12 +204,12 @@ main = do
             _                              -> (True, True)
 
           forceEntry k v =
-            catch (Just <$> demand v pure) $ \(NixException frames) -> do
+            catch (pure <$> demand v pure) $ \(NixException frames) -> do
               liftIO
                 .   putStrLn
-                .   ("Exception forcing " ++)
-                .   (k ++)
-                .   (": " ++)
+                .   ("Exception forcing " <>)
+                .   (k <>)
+                .   (": " <>)
                 .   show
                 =<< renderFrames @(StdValue (StandardT (StdIdT IO)))
                       @(StdThunk (StandardT (StdIdT IO)))
@@ -228,7 +228,7 @@ main = do
     -> m (NValue t f m)
   handleReduced path (expr', eres) = do
     liftIO $ do
-      putStrLn $ "Wrote winnowed expression tree to " ++ path
+      putStrLn $ "Wrote winnowed expression tree to " <> path
       writeFile path $ show $ prettyNix (stripAnnotation expr')
     case eres of
       Left  err -> throwM err

main/Repl.hs

@@ -76,10 +76,10 @@ main' iniVal = initState iniVal >>= \s -> flip evalStateT s
         banner
         cmd
         options
-        (Just commandPrefix)
-        (Just "paste")
+        (pure commandPrefix)
+        (pure "paste")
         completion
-        (rcFile >> greeter)
+        (rcFile *> greeter)
         finalizer
  where
   commandPrefix = ':'
@@ -119,7 +119,7 @@ main' iniVal = initState iniVal >>= \s -> flip evalStateT s
              -> System.Console.Repline.Options m
              -> String
              -> m ()
-  optMatcher s [] _ = liftIO $ putStrLn $ "No such command :" ++ s
+  optMatcher s [] _ = liftIO $ putStrLn $ "No such command :" <> s
   optMatcher s ((x, m) : xs) args
     | s `Data.List.isPrefixOf` x = m args
     | otherwise = optMatcher s xs args
@@ -166,7 +166,7 @@ initState mIni = do
   where
     evalText :: (MonadNix e t f m) => Text -> m (NValue t f m)
     evalText expr = case parseNixTextLoc expr of
-      Failure e -> error $ "Impossible happened: Unable to parse expression - '" ++ Data.Text.unpack expr ++ "' error was " ++ show e
+      Failure e -> error $ "Impossible happened: Unable to parse expression - '" <> Data.Text.unpack expr <> "' error was " <> show e
       Success e -> do evalExprLoc e
 
 type Repl e t f m = HaskelineT (StateT (IState t f m) m)
@@ -212,14 +212,14 @@ exec update source = do
           -- Update the interpreter state
           when (update && isBinding) $ do
             -- Set `replIt` to last entered expression
-            put st { replIt = Just expr }
+            put st { replIt = pure expr }
 
             -- If the result value is a set, update our context with it
             case val of
               NVSet xs _ -> put st { replCtx = Data.HashMap.Lazy.union xs (replCtx st) }
               _          -> pure ()
 
-          pure $ Just val
+          pure $ pure val
   where
     -- If parsing fails, turn the input into singleton attribute set
     -- and try again.
@@ -292,7 +292,7 @@ typeof
 typeof args = do
   st <- get
   mVal <- case Data.HashMap.Lazy.lookup line (replCtx st) of
-    Just val -> pure $ Just val
+    Just val -> pure $ pure val
     Nothing  -> do
       exec False line
 
@@ -329,7 +329,7 @@ completion
   :: (MonadNix e t f m, MonadIO m)
   => CompleterStyle (StateT (IState t f m) m)
 completion = System.Console.Repline.Prefix
-  (completeWordWithPrev (Just '\\') separators completeFunc)
+  (completeWordWithPrev (pure '\\') separators completeFunc)
   defaultMatcher
   where
     separators :: String
@@ -360,7 +360,7 @@ completeFunc reversedPrev word
   = do
     s <- get
     case Data.HashMap.Lazy.lookup var (replCtx s) of
-      Nothing -> pure []
+      Nothing -> pure mempty
       Just binding -> do
         candidates <- lift $ algebraicComplete subFields binding
         pure $ notFinished <$> listCompletion (Data.Text.unpack . (var <>) <$> candidates)
@@ -396,14 +396,14 @@ completeFunc reversedPrev word
               [_] -> pure $ keys m
               f:fs ->
                 case Data.HashMap.Lazy.lookup f m of
-                  Nothing -> pure []
+                  Nothing -> pure mempty
                   Just e ->
                     demand e
                       (\e' -> (fmap . fmap) (("." <> f) <>) $ algebraicComplete fs e')
 
       in case val of
         NVSet xs _ -> withMap xs
-        _          -> pure []
+        _          -> pure mempty
 
 -- HelpOption inspired by Dhall Repl
 -- with `Doc` instead of String for syntax and doc

src/Nix.hs

@@ -107,7 +107,7 @@ evaluateExpression
   -> m a
 evaluateExpression mpath evaluator handler expr = do
   opts :: Options <- asks (view hasLens)
-  args <- traverse (traverse eval') $ fmap (second parseArg) (arg opts) ++ fmap
+  args <- traverse (traverse eval') $ fmap (second parseArg) (arg opts) <> fmap
     (second mkStr)
     (argstr opts)
   evaluator mpath expr >>= \f -> demand f $ \f' ->
@@ -144,22 +144,22 @@ processResult h val = do
     _ ->
       errorWithoutStackTrace
         $  "Expected a list for selector '"
-        ++ show n
-        ++ "', but got: "
-        ++ show v
+        <> show n
+        <> "', but got: "
+        <> show v
   go (k : ks) v = demand v $ \case
     NVSet xs _ -> case M.lookup k xs of
       Nothing ->
         errorWithoutStackTrace
           $  "Set does not contain key '"
-          ++ Text.unpack k
-          ++ "'"
+          <> Text.unpack k
+          <> "'"
       Just v' -> case ks of
         [] -> h v'
         _  -> go ks v'
     _ ->
       errorWithoutStackTrace
         $  "Expected a set for selector '"
-        ++ Text.unpack k
-        ++ "', but got: "
-        ++ show v
+        <> Text.unpack k
+        <> "', but got: "
+        <> show v

src/Nix/Builtins.hs

@@ -316,27 +316,27 @@ foldNixPath
 foldNixPath f z = do
   mres <- lookupVar "__includes"
   dirs <- case mres of
-    Nothing -> pure []
+    Nothing -> pure mempty
     Just v  -> demand v $ fromValue . Deeper
   mPath <- getEnvVar "NIX_PATH"
   mDataDir <- getEnvVar "NIX_DATA_DIR"
   dataDir <- maybe getDataDir pure mDataDir
   foldrM go z
     $  fmap (fromInclude . stringIgnoreContext) dirs
     <> case mPath of
-         Nothing  -> []
+         Nothing  -> mempty
          Just str -> uriAwareSplit (Text.pack str)
     <> [ fromInclude $ Text.pack $ "nix=" <> dataDir <> "/nix/corepkgs" ]
  where
   fromInclude x | "://" `Text.isInfixOf` x = (x, PathEntryURI)
                 | otherwise                = (x, PathEntryPath)
   go (x, ty) rest = case Text.splitOn "=" x of
-    [p] -> f (Text.unpack p) Nothing ty rest
-    [n, p] -> f (Text.unpack p) (Just (Text.unpack n)) ty rest
+    [p] -> f (Text.unpack p) mempty ty rest
+    [n, p] -> f (Text.unpack p) (pure (Text.unpack n)) ty rest
     _ -> throwError $ ErrorCall $ "Unexpected entry in NIX_PATH: " <> show x
 
 nixPath :: MonadNix e t f m => m (NValue t f m)
-nixPath = fmap nvList $ flip foldNixPath [] $ \p mn ty rest ->
+nixPath = fmap nvList $ flip foldNixPath mempty $ \p mn ty rest ->
   pure
     $ flip nvSet mempty ( M.fromList
         [ case ty of
@@ -512,7 +512,7 @@ versionComponentSeparators = ".-"
 
 splitVersion :: Text -> [VersionComponent]
 splitVersion s = case Text.uncons s of
-  Nothing -> []
+  Nothing -> mempty
   Just (h, t)
     | h `elem` versionComponentSeparators
     -> splitVersion t
@@ -575,7 +575,7 @@ splitDrvName s =
     breakAfterFirstItem :: (a -> Bool) -> [a] -> ([a], [a])
     breakAfterFirstItem f = \case
       h : t -> let (a, b) = break f t in (h : a, b)
-      []    -> ([], [])
+      []    -> (mempty, mempty)
     (namePieces, versionPieces) =
       breakAfterFirstItem isFirstVersionPiece pieces
   in
@@ -825,7 +825,7 @@ elem_ x = toValue <=< anyM (valueEqM x) <=< fromValue
 elemAt :: [a] -> Int -> Maybe a
 elemAt ls i = case drop i ls of
   []    -> Nothing
-  a : _ -> Just a
+  a : _ -> pure a
 
 elemAt_
   :: MonadNix e t f m
@@ -910,7 +910,7 @@ genericClosure = fromValue @(AttrSet (NValue t f m)) >=> \s ->
     -> [NValue t f m]
     -> Set (WValue t f m)
     -> m (Set (WValue t f m), [NValue t f m])
-  go _  []       ks = pure (ks, [])
+  go _  []       ks = pure (ks, mempty)
   go op (t : ts) ks = demand t $ \v -> fromValue @(AttrSet (NValue t f m)) v >>= \s -> do
     k <- attrsetGet "key" s
     demand k $ \k' -> do
@@ -1108,7 +1108,7 @@ scopedImport asetArg pathArg = fromValue @(AttrSet (NValue t f m)) asetArg >>= \
         traceM $ "Current file being evaluated is: " <> show p'
         pure $ takeDirectory p' </> path
     clearScopes @(NValue t f m)
-      $ withNixContext (Just path')
+      $ withNixContext (pure path')
       $ pushScope s
       $ importPath @t @f @m path'
 
@@ -1480,7 +1480,7 @@ appendContext x y = demand x $ \x' -> demand y $ \y' -> case (x', y') of
         allOutputs <- maybe (pure False) (demand ?? fromValue)
           $ M.lookup "allOutputs" attrs
         outputs <- case M.lookup "outputs" attrs of
-          Nothing -> pure []
+          Nothing -> pure mempty
           Just os -> demand os $ \case
             NVList vs ->
               forM vs $ fmap stringIgnoreContext . fromValue

src/Nix/Cache.hs

@@ -24,13 +24,13 @@ readCache path = do
     eres <- C.unsafeReadCompact path
     case eres of
         Left err -> error $ "Error reading cache file: " <> err
-        Right expr -> return $ C.getCompact expr
+        Right expr -> pure $ C.getCompact expr
 #else
 #ifdef MIN_VERSION_serialise
   eres <- S.deserialiseOrFail <$> BS.readFile path
   case eres of
     Left  err  -> error $ "Error reading cache file: " <> show err
-    Right expr -> return expr
+    Right expr -> pure expr
 #else
     error "readCache not implemented for this platform"
 #endif

src/Nix/Cited.hs

@@ -38,7 +38,7 @@ data NCited m v a = NCited
     deriving (Generic, Typeable, Functor, Foldable, Traversable, Show)
 
 instance Applicative (NCited m v) where
-  pure = NCited []
+  pure = NCited mempty
   NCited xs f <*> NCited ys x = NCited (xs <> ys) (f x)
 
 instance Comonad (NCited m v) where

src/Nix/Cited/Basic.hs

@@ -66,11 +66,11 @@ instance ( Has e Options
                              (Fix (Compose (Ann s e))))) =
                 let e' = Compose (Ann s (Nothing <$ e))
                 in [Provenance scope e']
-            go _ = []
+            go _ = mempty
             ps = concatMap (go . frame) frames
 
         fmap (Cited . NCited ps) . thunk $ mv
-      else fmap (Cited . NCited []) . thunk $ mv
+      else fmap (Cited . NCited mempty) . thunk $ mv
 
   thunkId (Cited (NCited _ t)) = thunkId @_ @m t
 

src/Nix/Context.hs

@@ -32,4 +32,4 @@ instance Has (Context m t) Options where
   hasLens f a = (\x -> a { options = x }) <$> f (options a)
 
 newContext :: Options -> Context m t
-newContext = Context emptyScopes nullSpan []
+newContext = Context emptyScopes nullSpan mempty