From 05199f1a4ba7133a6dd604a3706d3cf904136e0f Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Wed, 13 Nov 2024 14:25:58 +0100 Subject: [PATCH] fix: Autoformat with ormolu --- Setup.hs | 1 + src/Nixon/Command/Find.hs | 2 +- src/Nixon/Command/Placeholder.hs | 2 +- src/Nixon/Config.hs | 11 ++++++----- src/Nixon/Evaluator.hs | 32 +++++++++++++++---------------- src/Nixon/Logging.hs | 12 ++++++------ src/Nixon/Prelude.hs | 7 +++++-- src/Nixon/Process.hs | 29 ++++++++++++++-------------- src/Nixon/Types.hs | 6 +++--- src/Nixon/Wrappers/Direnv.hs | 5 +++-- src/Nixon/Wrappers/Nix.hs | 19 ++++++++++-------- test/Main.hs | 6 +++--- test/Test/Nixon/Format/Columns.hs | 2 +- test/Test/Nixon/Logging.hs | 6 +++--- test/Test/Nixon/Process.hs | 4 ++-- 15 files changed, 77 insertions(+), 67 deletions(-) diff --git a/Setup.hs b/Setup.hs index 9a994af..e8ef27d 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/src/Nixon/Command/Find.hs b/src/Nixon/Command/Find.hs index 0b6537d..eff4dea 100644 --- a/src/Nixon/Command/Find.hs +++ b/src/Nixon/Command/Find.hs @@ -17,7 +17,7 @@ import Nixon.Backend (Backend) import qualified Nixon.Backend as Backend import qualified Nixon.Backend.Fzf as Fzf import qualified Nixon.Backend.Rofi as Rofi -import Nixon.Command (Command (cmdName, cmdSource, cmdLocation)) +import Nixon.Command (Command (cmdLocation, cmdName, cmdSource)) import qualified Nixon.Command as Cmd import qualified Nixon.Config as Config import Nixon.Config.Options (RunOpts) diff --git a/src/Nixon/Command/Placeholder.hs b/src/Nixon/Command/Placeholder.hs index f90c00b..463506c 100644 --- a/src/Nixon/Command/Placeholder.hs +++ b/src/Nixon/Command/Placeholder.hs @@ -1,7 +1,7 @@ module Nixon.Command.Placeholder ( Placeholder (..), PlaceholderFormat (..), - PlaceholderType (..) + PlaceholderType (..), ) where diff --git a/src/Nixon/Config.hs b/src/Nixon/Config.hs index cc203c6..dc0368b 100644 --- a/src/Nixon/Config.hs +++ b/src/Nixon/Config.hs @@ -17,7 +17,7 @@ import Nixon.Prelude import Nixon.Utils (find_dominating_file, fromPath) import System.IO.Error (isDoesNotExistError, tryIOError) -findLocalConfig :: MonadIO m => FilePath -> m (Maybe Config) +findLocalConfig :: (MonadIO m) => FilePath -> m (Maybe Config) findLocalConfig path = runMaybeT $ do local_config <- MaybeT $ firstOf (find_dominating_file path) ["nixon.md", ".nixon.md"] res <- readConfig local_config @@ -28,13 +28,14 @@ findLocalConfig path = runMaybeT $ do -- | Get the first non-Nothing value from an applicative operation applied to a -- list of inputs. -firstOf :: Applicative f => (a -> f (Maybe b)) -> [a] -> f (Maybe b) +firstOf :: (Applicative f) => (a -> f (Maybe b)) -> [a] -> f (Maybe b) firstOf f xs = getFirst . mconcat . map First <$> traverse f xs -readConfig :: MonadIO m => FilePath -> m (Either ConfigError Config) +readConfig :: (MonadIO m) => FilePath -> m (Either ConfigError Config) readConfig path = do - liftIO $ - tryIOError (T.readFile $ fromPath path) >>= \case + liftIO + $ tryIOError (T.readFile $ fromPath path) + >>= \case Left err | isDoesNotExistError err -> pure (Left NoSuchFile) | otherwise -> ioError err diff --git a/src/Nixon/Evaluator.hs b/src/Nixon/Evaluator.hs index 7434f1e..d115aaa 100644 --- a/src/Nixon/Evaluator.hs +++ b/src/Nixon/Evaluator.hs @@ -48,19 +48,19 @@ import Turtle (), ) -getCacheDir :: MonadIO m => m FilePath +getCacheDir :: (MonadIO m) => m FilePath getCacheDir = liftIO $ fromText . T.pack <$> getXdgDirectory XdgCache "nixon" -writeCommand :: MonadIO m => Command -> m FilePath +writeCommand :: (MonadIO m) => Command -> m FilePath writeCommand cmd = do let content = cmdSource cmd sha1 = digestToHexByteString (hash (encodeUtf8 content) :: Digest SHA1) basename = - fromText $ - decodeUtf8 sha1 - <> "-" - <> cmdName cmd - <> extension (cmdLang cmd) + fromText + $ decodeUtf8 sha1 + <> "-" + <> cmdName cmd + <> extension (cmdLang cmd) path <- liftIO $ do cacheDir <- getCacheDir @@ -71,7 +71,7 @@ writeCommand cmd = do pure path -- | Clean up all cache files in $XDG_CACHE_DIR/nixon -garbageCollect :: MonadIO m => Bool -> m [Text] +garbageCollect :: (MonadIO m) => Bool -> m [Text] garbageCollect dryRun = shell_to_list $ do files <- ls =<< getCacheDir if dryRun @@ -84,10 +84,10 @@ garbageCollect dryRun = shell_to_list $ do maybeWrapCmd :: Cwd -> NonEmpty Text -> Nixon (NonEmpty Text) maybeWrapCmd Nothing cmd = pure cmd maybeWrapCmd (Just path) cmd = - fmap (fromMaybe cmd) $ - runMaybeT $ - MaybeT (direnv_cmd cmd path) - <|> MaybeT (nix_cmd cmd path) + fmap (fromMaybe cmd) + $ runMaybeT + $ MaybeT (direnv_cmd cmd path) + <|> MaybeT (nix_cmd cmd path) -- | Provide an evaluator for a command, possibly in a direnv/nix environment getEvaluator :: RunArgs input m a -> Command -> [Text] -> Cwd -> Env -> Maybe (Shell input) -> Nixon (m a) @@ -139,8 +139,8 @@ evaluate cmd args path env' stdin = do ] cmd' = cmd {cmdSource = cmdSource cmd <> end} term <- - fmap (fromMaybe "x-terminal-emulator") $ - runMaybeT $ - MaybeT (Config.terminal . T.config <$> ask) - <|> MaybeT (need "TERMINAL") + fmap (fromMaybe "x-terminal-emulator") + $ runMaybeT + $ MaybeT (Config.terminal . T.config <$> ask) + <|> MaybeT (need "TERMINAL") withEvaluator (Proc.spawn . ((term :| ["-e"]) <>)) cmd' args path env' stdin diff --git a/src/Nixon/Logging.hs b/src/Nixon/Logging.hs index 71c8201..4be7a74 100644 --- a/src/Nixon/Logging.hs +++ b/src/Nixon/Logging.hs @@ -16,7 +16,7 @@ import Nixon.Utils (printErr) data LogLevel = LogDebug | LogInfo | LogWarning | LogError deriving (Eq, Ord, Show, Bounded, Enum) -class Monad m => HasLogging m where +class (Monad m) => HasLogging m where loglevel :: m LogLevel logout :: Text -> m () @@ -24,19 +24,19 @@ instance HasLogging IO where loglevel = return LogInfo logout = printErr -log :: HasLogging m => LogLevel -> Text -> m () +log :: (HasLogging m) => LogLevel -> Text -> m () log level msg = do should_log <- (level >=) <$> loglevel when should_log $ logout msg -log_debug :: HasLogging m => Text -> m () +log_debug :: (HasLogging m) => Text -> m () log_debug = log LogDebug -log_info :: HasLogging m => Text -> m () +log_info :: (HasLogging m) => Text -> m () log_info = log LogInfo -log_warn :: HasLogging m => Text -> m () +log_warn :: (HasLogging m) => Text -> m () log_warn = log LogWarning -log_error :: HasLogging m => Text -> m () +log_error :: (HasLogging m) => Text -> m () log_error = log LogError diff --git a/src/Nixon/Prelude.hs b/src/Nixon/Prelude.hs index 4f44212..9d6c867 100644 --- a/src/Nixon/Prelude.hs +++ b/src/Nixon/Prelude.hs @@ -2,19 +2,22 @@ module Nixon.Prelude ( -- * "Prelude" module Prelude, + -- * "Applicatives" module Applicative, + -- * "Monads" module Monads, + -- * "Text" module Text, - FilePath + FilePath, ) where -import Prelude hiding (FilePath, fail, log) import Control.Applicative as Applicative (Alternative ((<|>))) import Control.Monad as Monads ((<=<), (>=>)) import Control.Monad.IO.Class as Monads (MonadIO (..), liftIO) import Data.Text as Text (Text) import Turtle (FilePath) +import Prelude hiding (FilePath, fail, log) diff --git a/src/Nixon/Process.hs b/src/Nixon/Process.hs index 5e8976e..77c2050 100644 --- a/src/Nixon/Process.hs +++ b/src/Nixon/Process.hs @@ -52,16 +52,16 @@ instance HasStdin BS.ByteString where flag :: a -> Bool -> Maybe [a] flag key value = if value then Just [key] else Nothing -arg :: Applicative f => a -> a -> f [a] +arg :: (Applicative f) => a -> a -> f [a] arg key = pure . ([key] <>) . pure -arg_fmt :: Applicative f => b -> (a -> b) -> a -> f [b] +arg_fmt :: (Applicative f) => b -> (a -> b) -> a -> f [b] arg_fmt key f' = pure . ([key] <>) . pure . f' build_args :: [Maybe [a]] -> [a] build_args = concat . catMaybes -build_cmd :: MonadIO m => NonEmpty Text -> Cwd -> Env -> m CreateProcess +build_cmd :: (MonadIO m) => NonEmpty Text -> Cwd -> Env -> m CreateProcess build_cmd cmd cwd' env' = do currentEnv <- liftIO getEnvironment let (cmd' :| args) = fmap T.unpack cmd @@ -84,7 +84,7 @@ type RunArgs b m a = m a -- | Run a command and wait for it to finish -run :: MonadIO m => RunArgs Line m () +run :: (MonadIO m) => RunArgs Line m () run cmd cwd' env' stdin = sh $ do cmd' <- build_cmd cmd cwd' env' case stdin of @@ -94,7 +94,7 @@ run cmd cwd' env' stdin = sh $ do type Runner m a = CreateProcess -> Shell a -> m a -- | Run a process and return the output -run_with_output :: HasStdin a => (MonadIO m, Alternative m) => Runner m a -> RunArgs a m a +run_with_output :: (HasStdin a) => (MonadIO m, Alternative m) => Runner m a -> RunArgs a m a run_with_output stream' cmd cwd' env' stdin = do cmd' <- build_cmd cmd cwd' env' case stdin of @@ -102,18 +102,19 @@ run_with_output stream' cmd cwd' env' stdin = do Just stdin' -> stream' cmd' {std_in = CreatePipe} stdin' -- | Spawn/fork off a command in the background -spawn :: MonadIO m => RunArgs Line m () -spawn cmd cwd' env' stdin = liftIO $ - void $ - forkProcess $ do - _ <- createSession - run cmd cwd' env' stdin - -class Monad m => HasProc m where +spawn :: (MonadIO m) => RunArgs Line m () +spawn cmd cwd' env' stdin = liftIO + $ void + $ forkProcess + $ do + _ <- createSession + run cmd cwd' env' stdin + +class (Monad m) => HasProc m where proc' :: Text -> [Text] -> Shell Line -> m (ExitCode, Text) instance HasProc IO where proc' = procStrict -instance MonadIO m => HasProc (ReaderT a m) where +instance (MonadIO m) => HasProc (ReaderT a m) where proc' cmd args input = liftIO $ proc' cmd args input diff --git a/src/Nixon/Types.hs b/src/Nixon/Types.hs index e4167d3..33dcf84 100644 --- a/src/Nixon/Types.hs +++ b/src/Nixon/Types.hs @@ -34,13 +34,13 @@ data NixonError instance Exception NixonError -get_backend :: MonadIO m => Maybe BackendType -> m BackendType +get_backend :: (MonadIO m) => Maybe BackendType -> m BackendType get_backend backend = do def_backend <- liftIO $ bool Rofi Fzf <$> IO.hIsTerminalDevice IO.stdin pure $ fromMaybe def_backend backend -- | Merge the mess of CLI args, config file + user overrides (custom build) -build_env :: MonadIO m => Config -> m Env +build_env :: (MonadIO m) => Config -> m Env build_env config = do backend <- get_backend (Config.backend config) pure Env {backend, config = config} @@ -51,7 +51,7 @@ instance HasLogging Nixon where loglevel = fromMaybe Logging.LogWarning . Config.loglevel . config <$> ask logout = printErr -runNixon :: MonadIO m => Config -> ReaderT Env m a -> m a +runNixon :: (MonadIO m) => Config -> ReaderT Env m a -> m a runNixon config action = do env <- liftIO (build_env config) runReaderT action env diff --git a/src/Nixon/Wrappers/Direnv.hs b/src/Nixon/Wrappers/Direnv.hs index 7489674..7964cb1 100644 --- a/src/Nixon/Wrappers/Direnv.hs +++ b/src/Nixon/Wrappers/Direnv.hs @@ -23,8 +23,9 @@ direnv_cmd :: NonEmpty Text -> FilePath -> Nixon (Maybe (NonEmpty Text)) direnv_cmd cmd path' = ask >>= wrapCmd . use_direnv . config where wrapCmd = \case - Just True -> liftIO $ - runMaybeT $ do + Just True -> liftIO + $ runMaybeT + $ do direnv_active <- maybe False find_path <$> need "DIRENV_DIR" if direnv_active then pure cmd diff --git a/src/Nixon/Wrappers/Nix.hs b/src/Nixon/Wrappers/Nix.hs index 46d95cd..2818c68 100644 --- a/src/Nixon/Wrappers/Nix.hs +++ b/src/Nixon/Wrappers/Nix.hs @@ -17,11 +17,13 @@ import Nixon.Process (Env, RunArgs, arg, build_args, run, spawn) import Nixon.Types (Config (use_nix), Nixon, ask, config) import Nixon.Utils (find_dominating_file, quote) import Turtle - ( format, + ( Line, + Shell, + format, fp, parent, testpath, - (), Shell, Line, + (), ) -- | Nix project files, in prioritized order @@ -32,20 +34,20 @@ nix_files = ] -- | Return the path to a project's Nix file, if there is one -find_nix_file :: MonadIO m => FilePath -> m (Maybe FilePath) +find_nix_file :: (MonadIO m) => FilePath -> m (Maybe FilePath) find_nix_file dir = listToMaybe <$> filter_path nix_files where filter_path = filterM (testpath . (dir )) -- | Evaluate a command in a nix-shell -nix_shell :: MonadIO m => FilePath -> Maybe Text -> Env -> Maybe (Shell Line) -> m () +nix_shell :: (MonadIO m) => FilePath -> Maybe Text -> Env -> Maybe (Shell Line) -> m () nix_shell = nix_run run -- | Fork and evaluate a command in a nix-shell -nix_shell_spawn :: MonadIO m => FilePath -> Maybe Text -> Env -> Maybe (Shell Line) -> m () +nix_shell_spawn :: (MonadIO m) => FilePath -> Maybe Text -> Env -> Maybe (Shell Line) -> m () nix_shell_spawn = nix_run spawn -nix_run :: MonadIO m => RunArgs input m a -> FilePath -> Maybe Text -> Env -> Maybe (Shell input) -> m a +nix_run :: (MonadIO m) => RunArgs input m a -> FilePath -> Maybe Text -> Env -> Maybe (Shell input) -> m a nix_run run' nix_file cmd env' stdin = let nix_file' = format fp nix_file cmd' = @@ -60,8 +62,9 @@ nix_cmd :: NonEmpty Text -> FilePath -> Nixon (Maybe (NonEmpty Text)) nix_cmd cmd path' = ask >>= wrapCmd . use_nix . config where wrapCmd = \case - Just True -> liftIO $ - runMaybeT $ do + Just True -> liftIO + $ runMaybeT + $ do nix_file <- MaybeT (find_dominating_file path' "shell.nix") <|> MaybeT (find_dominating_file path' "default.nix") diff --git a/test/Main.hs b/test/Main.hs index 14cffbe..8c1e898 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -9,11 +9,11 @@ import Test.Hspec import Test.Nixon.Backend.Fzf (fzfTests) import Test.Nixon.Command.Find (findTests) import Test.Nixon.Config.Markdown +import Test.Nixon.Format.Columns (column_tests) import Test.Nixon.Logging import Test.Nixon.Process (process) import Test.QuickCheck import Test.QuickCheck.Instances.Text () -import Test.Nixon.Format.Columns (column_tests) empty :: (Monad m) => a -> m (Selection Text) empty = const (pure EmptySelection) @@ -39,8 +39,8 @@ main :: IO () main = hspec $ do describe "Backend.Fzf" fzfTests - describe "Command" $ - describe "Find" findTests + describe "Command" + $ describe "Find" findTests describe "Config" $ do describe "Markdown" markdown_tests diff --git a/test/Test/Nixon/Format/Columns.hs b/test/Test/Nixon/Format/Columns.hs index 720dc24..a8cd560 100644 --- a/test/Test/Nixon/Format/Columns.hs +++ b/test/Test/Nixon/Format/Columns.hs @@ -12,7 +12,7 @@ column_tests = do it "parses columns (titles only)" $ do let input = ["NAME UUID TYPE DEVICE"] - parseColumns False input `shouldBe` [["NAME","UUID","TYPE","DEVICE"]] + parseColumns False input `shouldBe` [["NAME", "UUID", "TYPE", "DEVICE"]] parseColumns True input `shouldBe` [] it "parses columns" $ do diff --git a/test/Test/Nixon/Logging.hs b/test/Test/Nixon/Logging.hs index 644fe35..1175a23 100644 --- a/test/Test/Nixon/Logging.hs +++ b/test/Test/Nixon/Logging.hs @@ -24,10 +24,10 @@ logging = do test log_fn min_lvl = forAll genInput $ \(lvl, txt) -> let expected = [txt | lvl <= min_lvl] - in runLogger lvl (log_fn txt) == expected + in runLogger lvl (log_fn txt) == expected describe "filters log messages" $ do it "log_debug" $ test log_debug LogDebug - it "log_info" $ test log_info LogInfo - it "log_warn" $ test log_warn LogWarning + it "log_info" $ test log_info LogInfo + it "log_warn" $ test log_warn LogWarning it "log_error" $ test log_error LogError diff --git a/test/Test/Nixon/Process.hs b/test/Test/Nixon/Process.hs index d0dbde1..1ead72b 100644 --- a/test/Test/Nixon/Process.hs +++ b/test/Test/Nixon/Process.hs @@ -12,10 +12,10 @@ process :: SpecWith () process = do it "can simulate success" $ do result <- runProc (ExitSuccess, "output") $ do - proc' "command" ["arg1", "arg2"] mempty + proc' "command" ["arg1", "arg2"] mempty result `shouldBe` (ExitSuccess, "output") it "can simulate failure" $ do result <- runProc (ExitFailure 1, "output") $ do - proc' "command" ["arg1", "arg2"] mempty + proc' "command" ["arg1", "arg2"] mempty result `shouldBe` (ExitFailure 1, "output")