cabal-gild 1.5.0.3 → 1.6.0.0
raw patch · 7 files changed
+150/−18 lines, 7 files
Files
- cabal-gild.cabal +4/−1
- source/library/CabalGild/Unstable/Class/MonadHandle.hs +9/−0
- source/library/CabalGild/Unstable/Exception/MoreThanOneCabalFileFound.hs +18/−0
- source/library/CabalGild/Unstable/Exception/NoCabalFileFound.hs +18/−0
- source/library/CabalGild/Unstable/Main.hs +3/−1
- source/library/CabalGild/Unstable/Type/Context.hs +24/−4
- source/test-suite/Main.hs +74/−12
cabal-gild.cabal view
@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 1.5.0.3+version: 1.6.0.0 source-repository head type: git@@ -75,6 +75,7 @@ CabalGild.Unstable.Action.ReflowText CabalGild.Unstable.Action.Render CabalGild.Unstable.Action.StripBlanks+ CabalGild.Unstable.Class.MonadHandle CabalGild.Unstable.Class.MonadLog CabalGild.Unstable.Class.MonadRead CabalGild.Unstable.Class.MonadWalk@@ -84,6 +85,8 @@ CabalGild.Unstable.Exception.InvalidLeniency CabalGild.Unstable.Exception.InvalidMode CabalGild.Unstable.Exception.InvalidOption+ CabalGild.Unstable.Exception.MoreThanOneCabalFileFound+ CabalGild.Unstable.Exception.NoCabalFileFound CabalGild.Unstable.Exception.ParseError CabalGild.Unstable.Exception.SpecifiedOutputWithCheckMode CabalGild.Unstable.Exception.SpecifiedStdinWithFileInput
+ source/library/CabalGild/Unstable/Class/MonadHandle.hs view
@@ -0,0 +1,9 @@+module CabalGild.Unstable.Class.MonadHandle where++import qualified System.IO as IO++class MonadHandle m where+ isTerminalDevice :: IO.Handle -> m Bool++instance MonadHandle IO where+ isTerminalDevice = IO.hIsTerminalDevice
+ source/library/CabalGild/Unstable/Exception/MoreThanOneCabalFileFound.hs view
@@ -0,0 +1,18 @@+module CabalGild.Unstable.Exception.MoreThanOneCabalFileFound where++import qualified CabalGild.Unstable.Type.Flag as Flag+import qualified Control.Monad.Catch as Exception++-- | This exception is thrown when no input or output file has been specified,+-- stdin is a terminal device, and there are multiple Cabal files in the+-- current directory.+data MoreThanOneCabalFileFound+ = MoreThanOneCabalFileFound+ deriving (Eq, Show)++instance Exception.Exception MoreThanOneCabalFileFound where+ displayException =+ const $+ "More than one package description found in the current directory. Use the --"+ <> Flag.ioOption+ <> " option to specify a *.cabal file."
+ source/library/CabalGild/Unstable/Exception/NoCabalFileFound.hs view
@@ -0,0 +1,18 @@+module CabalGild.Unstable.Exception.NoCabalFileFound where++import qualified CabalGild.Unstable.Type.Flag as Flag+import qualified Control.Monad.Catch as Exception++-- | This exception is thrown when no input or output file has been specified,+-- stdin is a terminal device, and there are no Cabal files in the current+-- directory.+data NoCabalFileFound+ = NoCabalFileFound+ deriving (Eq, Show)++instance Exception.Exception NoCabalFileFound where+ displayException =+ const $+ "No package descriptions found in the current directory. Use the --"+ <> Flag.ioOption+ <> " option to specify a *.cabal file."
source/library/CabalGild/Unstable/Main.hs view
@@ -9,6 +9,7 @@ import qualified CabalGild.Unstable.Action.ReflowText as ReflowText import qualified CabalGild.Unstable.Action.Render as Render import qualified CabalGild.Unstable.Action.StripBlanks as StripBlanks+import qualified CabalGild.Unstable.Class.MonadHandle as MonadHandle import qualified CabalGild.Unstable.Class.MonadLog as MonadLog import qualified CabalGild.Unstable.Class.MonadRead as MonadRead import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk@@ -54,7 +55,8 @@ -- constraints so that it can be run in pure code if so desired. But most often -- this will be run in 'IO'. mainWith ::- ( MonadLog.MonadLog m,+ ( MonadHandle.MonadHandle m,+ MonadLog.MonadLog m, MonadRead.MonadRead m, Exception.MonadThrow m, MonadWalk.MonadWalk m,
source/library/CabalGild/Unstable/Type/Context.hs view
@@ -1,6 +1,10 @@ module CabalGild.Unstable.Type.Context where +import qualified CabalGild.Unstable.Class.MonadHandle as MonadHandle import qualified CabalGild.Unstable.Class.MonadLog as MonadLog+import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk+import qualified CabalGild.Unstable.Exception.MoreThanOneCabalFileFound as MoreThanOneCabalFileFound+import qualified CabalGild.Unstable.Exception.NoCabalFileFound as NoCabalFileFound import qualified CabalGild.Unstable.Exception.SpecifiedOutputWithCheckMode as SpecifiedOutputWithCheckMode import qualified CabalGild.Unstable.Exception.SpecifiedStdinWithFileInput as SpecifiedStdinWithFileInput import qualified CabalGild.Unstable.Type.Config as Config@@ -19,6 +23,7 @@ import qualified Paths_cabal_gild as This import qualified System.Console.GetOpt as GetOpt import qualified System.Exit as Exit+import qualified System.IO as IO -- | Represents the context necessary to run the program. This is essentially a -- simplified 'Config.Config'.@@ -35,7 +40,11 @@ -- requested, then this will throw an 'Exit.ExitSuccess'. Otherwise this makes -- sure the config is valid before returning the context. fromConfig ::- (MonadLog.MonadLog m, Exception.MonadThrow m) =>+ ( MonadHandle.MonadHandle m,+ MonadLog.MonadLog m,+ Exception.MonadThrow m,+ MonadWalk.MonadWalk m+ ) => Config.Config -> m Context fromConfig config = do@@ -67,15 +76,26 @@ Exception.throwM SpecifiedOutputWithCheckMode.SpecifiedOutputWithCheckMode _ -> pure () - let theInput = Maybe.fromMaybe Input.Stdin . Optional.toMaybe $ Config.input config- filePath = case theInput of+ let preInput = Maybe.fromMaybe Input.Stdin . Optional.toMaybe $ Config.input config+ filePath = case preInput of Input.Stdin -> "." Input.File f -> f+ preOutput = Maybe.fromMaybe Output.Stdout . Optional.toMaybe $ Config.output config+ (theInput, theOutput) <- do+ isTerm <- MonadHandle.isTerminalDevice IO.stdin+ if preInput == Input.Stdin && preOutput == Output.Stdout && isTerm+ then do+ cabalFiles <- MonadWalk.walk "." ["*.cabal"] []+ case cabalFiles of+ [fp] -> pure (Input.File fp, Output.File fp)+ [] -> Exception.throwM NoCabalFileFound.NoCabalFileFound+ _ -> Exception.throwM MoreThanOneCabalFileFound.MoreThanOneCabalFileFound+ else pure (preInput, preOutput) pure Context { crlf = Maybe.fromMaybe Leniency.Lenient . Optional.toMaybe $ Config.crlf config, input = theInput, mode = Maybe.fromMaybe Mode.Format . Optional.toMaybe $ Config.mode config,- output = Maybe.fromMaybe Output.Stdout . Optional.toMaybe $ Config.output config,+ output = theOutput, stdin = Maybe.fromMaybe filePath . Optional.toMaybe $ Config.stdin config }
source/test-suite/Main.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} +import qualified CabalGild.Unstable.Class.MonadHandle as MonadHandle import qualified CabalGild.Unstable.Class.MonadLog as MonadLog import qualified CabalGild.Unstable.Class.MonadRead as MonadRead import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk@@ -7,6 +8,8 @@ import qualified CabalGild.Unstable.Exception.CheckFailure as CheckFailure import qualified CabalGild.Unstable.Exception.DuplicateOption as DuplicateOption import qualified CabalGild.Unstable.Exception.InvalidOption as InvalidOption+import qualified CabalGild.Unstable.Exception.MoreThanOneCabalFileFound as MoreThanOneCabalFileFound+import qualified CabalGild.Unstable.Exception.NoCabalFileFound as NoCabalFileFound import qualified CabalGild.Unstable.Exception.SpecifiedOutputWithCheckMode as SpecifiedOutputWithCheckMode import qualified CabalGild.Unstable.Exception.SpecifiedStdinWithFileInput as SpecifiedStdinWithFileInput import qualified CabalGild.Unstable.Exception.UnexpectedArgument as UnexpectedArgument@@ -35,13 +38,13 @@ main :: IO () main = Hspec.hspec . Hspec.parallel . Hspec.describe "cabal-gild" $ do Hspec.it "shows the help" $ do- let (a, s, w) = runGild ["--help"] [] (".", [])+ let (a, s, w) = runGild ["--help"] [] (".", []) False a `shouldBeFailure` Exit.ExitSuccess w `Hspec.shouldNotBe` [] s `Hspec.shouldBe` Map.empty Hspec.it "shows the version" $ do- let (a, s, w) = runGild ["--version"] [] (".", [])+ let (a, s, w) = runGild ["--version"] [] (".", []) False a `shouldBeFailure` Exit.ExitSuccess w `Hspec.shouldNotBe` [] s `Hspec.shouldBe` Map.empty@@ -68,6 +71,7 @@ ["--crlf=strict", "--crlf=strict"] [(Input.Stdin, String.toUtf8 "")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton Output.Stdout (String.toUtf8 "")@@ -102,6 +106,7 @@ ["--input", "input.cabal"] [(Input.File "input.cabal", String.toUtf8 "")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton Output.Stdout (String.toUtf8 "")@@ -112,6 +117,7 @@ ["--output", "output.cabal"] [(Input.Stdin, String.toUtf8 "")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton (Output.File "output.cabal") (String.toUtf8 "")@@ -122,6 +128,7 @@ ["--mode", "check"] [(Input.Stdin, String.toUtf8 "pass: yes\n")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -132,6 +139,7 @@ ["--mode", "check"] [(Input.Stdin, String.toUtf8 "pass: no")] (".", [])+ False a `shouldBeFailure` CheckFailure.CheckFailure w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -142,6 +150,7 @@ ["--mode", "check"] [(Input.Stdin, String.toUtf8 "pass: yes\r\n")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -152,6 +161,7 @@ ["--crlf", "strict", "--mode", "check"] [(Input.Stdin, String.toUtf8 "pass: no\r\n")] (".", [])+ False a `shouldBeFailure` CheckFailure.CheckFailure w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -162,6 +172,7 @@ ["--input", "f", "--stdin", "g"] [] (".", [])+ False a `shouldBeFailure` SpecifiedStdinWithFileInput.SpecifiedStdinWithFileInput w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -172,6 +183,7 @@ ["--mode", "check", "--output", "-"] [] (".", [])+ False a `shouldBeFailure` SpecifiedOutputWithCheckMode.SpecifiedOutputWithCheckMode w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -182,6 +194,7 @@ ["--io", "io.cabal"] [(Input.File "io.cabal", String.toUtf8 "")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -192,6 +205,7 @@ ["--input", "p.cabal"] [(Input.File "p.cabal", String.toUtf8 "")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton Output.Stdout (String.toUtf8 "")@@ -202,6 +216,7 @@ ["--input", "p.cabal", "--output", "q.cabal"] [(Input.File "p.cabal", String.toUtf8 "")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton (Output.File "q.cabal") (String.toUtf8 "")@@ -212,6 +227,7 @@ ["--output", "q.cabal"] [(Input.Stdin, String.toUtf8 "")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton (Output.File "q.cabal") (String.toUtf8 "")@@ -222,6 +238,7 @@ ["--io", "io.cabal"] [(Input.File "io.cabal", String.toUtf8 "f:a")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton (Output.File "io.cabal") (String.toUtf8 "f: a\n")@@ -232,6 +249,7 @@ ["--io", "p.cabal"] [(Input.File "p.cabal", String.toUtf8 "s\r\n")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -242,6 +260,7 @@ ["--crlf", "strict", "--io", "p.cabal"] [(Input.File "p.cabal", String.toUtf8 "s\r\n")] (".", [])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton (Output.File "p.cabal") (String.toUtf8 "s\n")@@ -252,6 +271,7 @@ ["--stdin", "d/p.cabal"] [(Input.Stdin, String.toUtf8 "library\n -- cabal-gild: discover\n exposed-modules:")] ("d", [["M.hs"]])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton Output.Stdout (String.toUtf8 "library\n -- cabal-gild: discover\n exposed-modules: M\n")@@ -1300,6 +1320,7 @@ ["--input", FilePath.combine d "io.cabal"] [(Input.File $ FilePath.combine d "io.cabal", String.toUtf8 "library\n -- cabal-gild: discover src --exclude src/N.hs\n exposed-modules:")] (d, [["src", "M.hs"], ["src", "N.hs"]])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton Output.Stdout (String.toUtf8 "library\n -- cabal-gild: discover src --exclude src/N.hs\n exposed-modules: M\n")@@ -1322,6 +1343,7 @@ [] [(Input.Stdin, String.toUtf8 "-- cabal-gild: discover --unknown\nsignatures:")] (".", [])+ False a `shouldBeFailure` UnknownOption.UnknownOption "--unknown" w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -1332,6 +1354,7 @@ [] [(Input.Stdin, String.toUtf8 "-- cabal-gild: discover --exclude\nsignatures:")] (".", [])+ False a `shouldBeFailure` InvalidOption.InvalidOption "option `--exclude' requires an argument PATTERN" w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -1495,6 +1518,7 @@ ["--input", FilePath.combine d "io.cabal"] [(Input.File $ FilePath.combine d "io.cabal", String.toUtf8 "library\n -- cabal-gild: discover src --include src/M.hs\n exposed-modules:")] (d, [["src", "M.hs"], ["src", "N.hs"]])+ False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.singleton Output.Stdout (String.toUtf8 "library\n -- cabal-gild: discover src --include src/M.hs\n exposed-modules: M\n")@@ -1698,6 +1722,31 @@ " N.M2" ] + Hspec.it "successfully determine that stdin is terminal and find/format the cabal file" $ do+ let filePath = "stdin-is-terminal.cabal"+ fileData = "FOO : bar"+ (a, s, w) =+ runGild+ []+ [(Input.File "stdin-is-terminal.cabal", String.toUtf8 fileData)]+ (".", [[filePath]])+ True+ a `Hspec.shouldSatisfy` Either.isRight+ w `Hspec.shouldBe` []+ s `Hspec.shouldBe` Map.singleton (Output.File filePath) (String.toUtf8 "foo: bar\n")++ Hspec.it "fails if no cabal file is found" $ do+ let (a, s, w) = runGild [] [] (".", []) True+ a `shouldBeFailure` NoCabalFileFound.NoCabalFileFound+ w `Hspec.shouldBe` []+ s `Hspec.shouldBe` Map.empty++ Hspec.it "fails if more than one cabal file is found" $ do+ let (a, s, w) = runGild [] [] (".", [["0.cabal"], ["1.cabal"]]) True+ a `shouldBeFailure` MoreThanOneCabalFileFound.MoreThanOneCabalFileFound+ w `Hspec.shouldBe` []+ s `Hspec.shouldBe` Map.empty+ withTemporaryDirectory :: IO () -> IO () withTemporaryDirectory = Temp.withSystemTempDirectory "cabal-gild"@@ -1723,7 +1772,7 @@ ByteString.ByteString -> Hspec.Expectation expectStable files input = do- let (a, s, w) = runGild [] [(Input.Stdin, input)] files+ let (a, s, w) = runGild [] [(Input.Stdin, input)] files False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] output <- case Map.toList s of@@ -1738,7 +1787,7 @@ String -> Hspec.Expectation expectDiscover files input expected = do- let (a, s, w) = runGild [] [(Input.Stdin, String.toUtf8 input)] files+ let (a, s, w) = runGild [] [(Input.Stdin, String.toUtf8 input)] files False a `Hspec.shouldSatisfy` Either.isRight w `Hspec.shouldBe` [] actual <- case Map.toList s of@@ -1751,20 +1800,25 @@ [String] -> [(Input.Input, ByteString.ByteString)] -> (String, [[String]]) ->+ Bool -> (Either E (), S, W)-runGild arguments inputs files =+runGild arguments inputs files tty = runTest (Gild.mainWith arguments)- ( Map.fromList inputs,- fmap FilePath.joinPath <$> uncurry Map.singleton files+ ( ( Map.fromList inputs,+ fmap FilePath.joinPath <$> uncurry Map.singleton files+ ),+ tty ) Map.empty expectException :: (Stack.HasCallStack, Eq e, Exception.Exception e) =>- [String] -> e -> Hspec.Expectation+ [String] ->+ e ->+ Hspec.Expectation expectException flags exception = do- let (a, s, w) = runGild flags [] (".", [])+ let (a, s, w) = runGild flags [] (".", []) False a `shouldBeFailure` exception w `Hspec.shouldBe` [] s `Hspec.shouldBe` Map.empty@@ -1776,7 +1830,12 @@ type E = Exception.SomeException -type R = (Map.Map Input.Input ByteString.ByteString, Map.Map FilePath [FilePath])+type R =+ ( ( Map.Map Input.Input ByteString.ByteString, -- For 'MonadRead'.+ Map.Map FilePath [FilePath] -- For 'MonadWalk'.+ ),+ Bool -- For 'MonadHandle'.+ ) type S = Map.Map Output.Output ByteString.ByteString @@ -1792,7 +1851,7 @@ instance (Monad m) => MonadRead.MonadRead (TestT m) where read k = do- m <- TestT . Trans.lift . RWST.asks $ Map.lookup k . fst+ m <- TestT . Trans.lift . RWST.asks $ Map.lookup k . fst . fst case m of Nothing -> Exception.throwM . userError $ "read " <> show k Just x -> pure x@@ -1802,7 +1861,7 @@ instance (Monad m) => MonadWalk.MonadWalk (TestT m) where walk d i x = do- result <- TestT . Trans.lift . RWST.asks $ Map.lookup d . snd+ result <- TestT . Trans.lift . RWST.asks $ Map.lookup d . snd . fst case result of Nothing -> Exception.throwM . userError $ "walk " <> show d Just fs ->@@ -1813,3 +1872,6 @@ instance (Monad m) => MonadWrite.MonadWrite (TestT m) where write k = TestT . Trans.lift . RWST.modify . Map.insert k++instance (Monad m) => MonadHandle.MonadHandle (TestT m) where+ isTerminalDevice = const . TestT . Trans.lift $ RWST.asks snd