diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## next + - Output generated cabal file to `stdout` when `-` is given as a command-line + option (see #113) + - Recognize `.chs`, `.y`, `.ly` and `.x` as Haskell modules when inferring + modules for + ## Change in 0.18.0 - Make `executable` a shortcut of `executables: { package-name: ... }` - Add support for `ghcjs-options` and `js-sources` (see #161) diff --git a/hpack.cabal b/hpack.cabal --- a/hpack.cabal +++ b/hpack.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: hpack -version: 0.18.0 +version: 0.18.1 synopsis: An alternative format for Haskell packages description: See README at category: Development @@ -48,6 +48,7 @@ Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell + Hpack.Options Hpack.Render Hpack.Util Paths_hpack @@ -107,6 +108,7 @@ Hpack.FormattingHintsSpec Hpack.GenericsUtilSpec Hpack.HaskellSpec + Hpack.OptionsSpec Hpack.RenderSpec Hpack.RunSpec Hpack.UtilSpec @@ -116,6 +118,7 @@ Hpack.FormattingHints Hpack.GenericsUtil Hpack.Haskell + Hpack.Options Hpack.Render Hpack.Run Hpack.Util diff --git a/src/Hpack.hs b/src/Hpack.hs --- a/src/Hpack.hs +++ b/src/Hpack.hs @@ -8,7 +8,6 @@ , main #ifdef TEST , hpackWithVersion -, parseVerbosity , extractVersion , parseVersion , splitDirectory @@ -34,6 +33,7 @@ import Text.ParserCombinators.ReadP import Paths_hpack (version) +import Hpack.Options import Hpack.Config import Hpack.Run import Hpack.Util @@ -52,30 +52,23 @@ main :: IO () main = do args <- getArgs - case args of - ["--version"] -> putStrLn (programVersion version) - ["--help"] -> printHelp - _ -> case parseVerbosity args of - (verbose, [dir]) -> hpack (Just dir) verbose - (verbose, []) -> hpack Nothing verbose - _ -> do - printHelp - exitFailure + case parseOptions args of + PrintVersion -> putStrLn (programVersion version) + Help -> printHelp + Run options -> case options of + Options _verbose True dir -> hpackStdOut dir + Options verbose False dir -> hpack dir verbose + ParseError -> do + printHelp + exitFailure printHelp :: IO () printHelp = do hPutStrLn stderr $ unlines [ - "Usage: hpack [ --silent ] [ dir ]" + "Usage: hpack [ --silent ] [ dir ] [ - ]" , " hpack --version" ] -parseVerbosity :: [String] -> (Bool, [String]) -parseVerbosity xs = (verbose, ys) - where - silentFlag = "--silent" - verbose = not (silentFlag `elem` xs) - ys = filter (/= silentFlag) xs - safeInit :: [a] -> [a] safeInit [] = [] safeInit xs = init xs @@ -107,13 +100,17 @@ hpackWithVersion :: Version -> Maybe FilePath -> Bool -> IO () hpackWithVersion v p verbose = do r <- hpackWithVersionResult v p - forM_ (resultWarnings r) $ \warning -> hPutStrLn stderr ("WARNING: " ++ warning) + printWarnings (resultWarnings r) when verbose $ putStrLn $ case resultStatus r of Generated -> "generated " ++ resultCabalFile r OutputUnchanged -> resultCabalFile r ++ " is up-to-date" AlreadyGeneratedByNewerHpack -> resultCabalFile r ++ " was generated with a newer version of hpack, please upgrade and try again." +printWarnings :: [String] -> IO () +printWarnings warnings = do + forM_ warnings $ \warning -> hPutStrLn stderr ("WARNING: " ++ warning) + splitDirectory :: Maybe FilePath -> IO (Maybe FilePath, FilePath) splitDirectory Nothing = return (Nothing, packageConfig) splitDirectory (Just p) = do @@ -148,3 +145,10 @@ where splitHeader :: String -> ([String], [String]) splitHeader = fmap (dropWhile null) . span ("--" `isPrefixOf`) . lines + +hpackStdOut :: Maybe FilePath -> IO () +hpackStdOut p = do + (dir, file) <- splitDirectory p + (warnings, _cabalFile, new) <- run dir file + B.putStr $ encodeUtf8 $ T.pack new + printWarnings warnings diff --git a/src/Hpack/Options.hs b/src/Hpack/Options.hs new file mode 100644 --- /dev/null +++ b/src/Hpack/Options.hs @@ -0,0 +1,33 @@ +module Hpack.Options where + +import Prelude () +import Prelude.Compat + +data ParseResult = Help | PrintVersion | Run Options | ParseError + deriving (Eq, Show) + +data Options = Options { + optionsVerbose :: Bool +, optionsToStdout :: Bool +, optionsTarget :: Maybe FilePath +} deriving (Eq, Show) + +parseOptions :: [String] -> ParseResult +parseOptions xs = case xs of + ["--version"] -> PrintVersion + ["--help"] -> Help + _ -> case targets of + Just (target, toStdout) -> Run (Options verbose toStdout target) + Nothing -> ParseError + where + silentFlag = "--silent" + verbose = not (silentFlag `elem` xs) + ys = filter (/= silentFlag) xs + + targets = case ys of + ["-"] -> Just (Nothing, True) + ["-", "-"] -> Nothing + [dir] -> Just (Just dir, False) + [dir, "-"] -> Just (Just dir, True) + [] -> Just (Nothing, False) + _ -> Nothing diff --git a/src/Hpack/Util.hs b/src/Hpack/Util.hs --- a/src/Hpack/Util.hs +++ b/src/Hpack/Util.hs @@ -19,7 +19,6 @@ import Prelude () import Prelude.Compat -import Control.Applicative import Control.Exception import Control.Monad.Compat import Data.Aeson.Types @@ -79,7 +78,15 @@ toModule path = case reverse path of [] -> Nothing x : xs -> do - m <- stripSuffix ".hs" x <|> stripSuffix ".lhs" x <|> stripSuffix ".hsc" x + m <- msum $ map (`stripSuffix` x) [ + ".hs" + , ".lhs" + , ".chs" + , ".hsc" + , ".y" + , ".ly" + , ".x" + ] let name = reverse (m : xs) guard (isModule name) >> return (intercalate "." name) where diff --git a/test/Hpack/OptionsSpec.hs b/test/Hpack/OptionsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Hpack/OptionsSpec.hs @@ -0,0 +1,41 @@ +module Hpack.OptionsSpec (spec) where + +import Helper + +import Prelude () +import Prelude.Compat + +import Hpack.Options + +spec :: Spec +spec = do + describe "parseOptions" $ do + context "with --help" $ do + it "returns Help" $ do + parseOptions ["--help"] `shouldBe` Help + + context "with --version" $ do + it "returns PrintVersion" $ do + parseOptions ["--version"] `shouldBe` PrintVersion + + context "by default" $ do + it "returns Run" $ do + parseOptions [] `shouldBe` Run (Options True False Nothing) + + it "includes target" $ do + parseOptions ["foo"] `shouldBe` Run (Options True False (Just "foo")) + + context "with superfluous arguments" $ do + it "returns ParseError" $ do + parseOptions ["foo", "bar"] `shouldBe` ParseError + + context "with --silent" $ do + it "sets optionsVerbose to False" $ do + parseOptions ["--silent"] `shouldBe` Run (Options False False Nothing) + + context "with -" $ do + it "sets optionsToStdout to True" $ do + parseOptions ["-"] `shouldBe` Run (Options True True Nothing) + + it "rejects - for target" $ do + parseOptions ["-", "-"] `shouldBe` ParseError diff --git a/test/HpackSpec.hs b/test/HpackSpec.hs --- a/test/HpackSpec.hs +++ b/test/HpackSpec.hs @@ -18,14 +18,6 @@ spec :: Spec spec = do - describe "parseVerbosity" $ do - it "returns True by default" $ do - parseVerbosity ["foo"] `shouldBe` (True, ["foo"]) - - context "with --silent" $ do - it "returns False" $ do - parseVerbosity ["--silent"] `shouldBe` (False, []) - describe "extractVersion" $ do it "extracts Hpack version from a cabal file" $ do let cabalFile = ["-- This file has been generated from package.yaml by hpack version 0.10.0."]