Expose more flexible API from "Hpack" module

driver/Main.hs

@@ -1,6 +1,9 @@
 module Main (main) where
 
+import           System.Environment
+
 import qualified Hpack
+import qualified Hpack.Config as Hpack
 
 main :: IO ()
-main = Hpack.main
+main = getArgs >>= Hpack.getOptions Hpack.packageConfig >>= mapM_ (uncurry Hpack.hpack)

hpack.cabal

@@ -2,10 +2,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 915b06f21c258063ad56ca291cf410f98c11e9a0b4e56022aca70ca2d3f16288
+-- hash: 6affba6bd6791822c191936fdc6314baff1c094aaaebbdd3bf1020f907131a8e
 
 name:           hpack
-version:        0.25.0
+version:        0.26.0
 synopsis:       An alternative format for Haskell packages
 description:    See README at <https://github.com/sol/hpack#readme>
 category:       Development

package.yaml

@@ -1,5 +1,5 @@
 name: hpack
-version: 0.25.0
+version: 0.26.0
 synopsis: An alternative format for Haskell packages
 description: See README at <https://github.com/sol/hpack#readme>
 maintainer: Simon Hengel <sol@typeful.net>

src/Hpack.hs

@@ -1,18 +1,40 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 module Hpack (
-  hpack
+-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
+-- other tools.  It is not meant for general use by end users.  The following
+-- caveats apply:
+--
+-- * The API is undocumented, consult the source instead.
+--
+-- * The exposed types and functions primarily serve Hpack's own needs, not
+-- that of a public API.  Breaking changes can happen as Hpack evolves.
+--
+-- As an Hpack user you either want to use the @hpack@ executable or a build
+-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).
+
+-- * Version
+  version
+
+-- * Running Hpack
+, hpack
 , hpackResult
+, printResult
 , Result(..)
 , Status(..)
+
+-- * Options
+, defaultOptions
+, setTarget
+, setDecode
+, getOptions
 , Verbose(..)
+, Options(..)
 , Force(..)
-, version
-, main
-, mainWith
+
 #ifdef TEST
+, hpackResultWithVersion
 , header
-, hpackWithVersionResult
 #endif
 ) where
 
@@ -32,7 +54,6 @@ import           Hpack.Render
 import           Hpack.Util
 import           Hpack.Utf8 as Utf8
 import           Hpack.CabalFile
-import           Hpack.Yaml
 
 programVersion :: Version -> String
 programVersion v = "hpack version " ++ Version.showVersion v
@@ -47,19 +68,28 @@ header p v hash = unlines [
   , ""
   ]
 
-main :: IO ()
-main = mainWith packageConfig decodeYaml
+data Options = Options {
+  optionsDecodeOptions :: DecodeOptions
+, optionsForce :: Force
+, optionsToStdout :: Bool
+}
 
-mainWith :: FilePath -> (FilePath -> IO (Either String Value)) -> IO ()
-mainWith configFile decode = do
-  result <- getArgs >>= parseOptions configFile
+getOptions :: FilePath -> [String] -> IO (Maybe (Verbose, Options))
+getOptions defaultPackageConfig args = do
+  result <- parseOptions defaultPackageConfig args
   case result of
-    PrintVersion -> putStrLn (programVersion version)
-    PrintNumericVersion -> putStrLn (Version.showVersion version)
-    Help -> printHelp
+    PrintVersion -> do
+      putStrLn (programVersion version)
+      return Nothing
+    PrintNumericVersion -> do
+      putStrLn (Version.showVersion version)
+      return Nothing
+    Help -> do
+      printHelp
+      return Nothing
     Run options -> case options of
-      Options _verbose _force True file -> hpackStdOut (DecodeOptions file Nothing decode)
-      Options verbose force False file -> hpack (DecodeOptions file Nothing decode) verbose force
+      ParseOptions verbose force toStdout file -> do
+        return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} force toStdout)
     ParseError -> do
       printHelp
       exitFailure
@@ -73,11 +103,19 @@ printHelp = do
     , "       " ++ name ++ " --help"
     ]
 
-hpack :: DecodeOptions -> Verbose -> Force -> IO ()
-hpack = hpackWithVersion version
+hpack :: Verbose -> Options -> IO ()
+hpack verbose options = hpackResult options >>= printResult verbose
 
-hpackResult :: DecodeOptions -> Force -> IO Result
-hpackResult = hpackWithVersionResult version
+defaultOptions :: Options
+defaultOptions = Options defaultDecodeOptions NoForce False
+
+setTarget :: FilePath -> Options -> Options
+setTarget target options@Options{..} =
+  options {optionsDecodeOptions = optionsDecodeOptions {decodeOptionsTarget = target}}
+
+setDecode :: (FilePath -> IO (Either String Value)) -> Options -> Options
+setDecode decode options@Options{..} =
+  options {optionsDecodeOptions = optionsDecodeOptions {decodeOptionsDecode = decode}}
 
 data Result = Result {
   resultWarnings :: [String]
@@ -92,9 +130,8 @@ data Status =
   | OutputUnchanged
   deriving (Eq, Show)
 
-hpackWithVersion :: Version -> DecodeOptions -> Verbose -> Force -> IO ()
-hpackWithVersion v options verbose force = do
-    r <- hpackWithVersionResult v options force
+printResult :: Verbose -> Result -> IO ()
+printResult verbose r = do
   printWarnings (resultWarnings r)
   when (verbose == Verbose) $ putStrLn $
     case resultStatus r of
@@ -104,8 +141,7 @@ hpackWithVersion v options verbose force = do
       ExistingCabalFileWasModifiedManually -> resultCabalFile r ++ " was modified manually, please use --force to overwrite."
 
 printWarnings :: [String] -> IO ()
-printWarnings warnings = do
-  forM_ warnings $ \warning -> Utf8.hPutStrLn stderr ("WARNING: " ++ warning)
+printWarnings = mapM_ $ Utf8.hPutStrLn stderr . ("WARNING: " ++)
 
 mkStatus :: [String] -> Version -> CabalFile -> Status
 mkStatus new v (CabalFile mOldVersion mHash old) = case (mOldVersion, mHash) of
@@ -118,8 +154,11 @@ mkStatus new v (CabalFile mOldVersion mHash old) = case (mOldVersion, mHash) of
     | old == new -> OutputUnchanged
     | otherwise -> Generated
 
-hpackWithVersionResult :: Version -> DecodeOptions -> Force -> IO Result
-hpackWithVersionResult v options force = do
+hpackResult :: Options -> IO Result
+hpackResult = hpackResultWithVersion version
+
+hpackResultWithVersion :: Version -> Options -> IO Result
+hpackResultWithVersion v (Options options force toStdout) = do
   DecodeResult pkg cabalFile warnings <- readPackageConfig options >>= either die return
   oldCabalFile <- readCabalFile cabalFile
   let new = renderPackage (maybe [] cabalFileContents oldCabalFile) pkg
@@ -130,16 +169,12 @@ hpackWithVersionResult v options force = do
   case status of
     Generated -> do
       let hash = sha256 new
-      Utf8.writeFile cabalFile (header (decodeOptionsTarget options) v hash ++ new)
+      if toStdout
+        then Utf8.putStr new
+        else Utf8.writeFile cabalFile (header (decodeOptionsTarget options) v hash ++ new)
     _ -> return ()
   return Result {
       resultWarnings = warnings
     , resultCabalFile = cabalFile
     , resultStatus = status
     }
-
-hpackStdOut :: DecodeOptions -> IO ()
-hpackStdOut options = do
-  DecodeResult pkg _cabalFile warnings <- readPackageConfig options >>= either die return
-  Utf8.putStr (renderPackage [] pkg)
-  printWarnings warnings

src/Hpack/Config.hs

@@ -13,6 +13,18 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
 module Hpack.Config (
+-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
+-- other tools.  It is not meant for general use by end users.  The following
+-- caveats apply:
+--
+-- * The API is undocumented, consult the source instead.
+--
+-- * The exposed types and functions primarily serve Hpack's own needs, not
+-- that of a public API.  Breaking changes can happen as Hpack evolves.
+--
+-- As an Hpack user you either want to use the @hpack@ executable or a build
+-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).
+
   DecodeOptions(..)
 , defaultDecodeOptions
 , packageConfig

src/Hpack/Options.hs

@@ -4,7 +4,7 @@ module Hpack.Options where
 import           System.FilePath
 import           System.Directory
 
-data ParseResult = Help | PrintVersion | PrintNumericVersion | Run Options | ParseError
+data ParseResult = Help | PrintVersion | PrintNumericVersion | Run ParseOptions | ParseError
   deriving (Eq, Show)
 
 data Verbose = Verbose | NoVerbose
@@ -13,11 +13,11 @@ data Verbose = Verbose | NoVerbose
 data Force = Force | NoForce
   deriving (Eq, Show)
 
-data Options = Options {
-  optionsVerbose :: Verbose
-, optionsForce :: Force
-, optionsToStdout :: Bool
-, optionsTarget :: FilePath
+data ParseOptions = ParseOptions {
+  parseOptionsVerbose :: Verbose
+, parseOptionsForce :: Force
+, parseOptionsToStdout :: Bool
+, parseOptionsTarget :: FilePath
 } deriving (Eq, Show)
 
 parseOptions :: FilePath -> [String] -> IO ParseResult
@@ -25,13 +25,14 @@ parseOptions defaultTarget = \ case
   ["--version"] -> return PrintVersion
   ["--numeric-version"] -> return PrintNumericVersion
   ["--help"] -> return Help
-  args -> parseRunOptions defaultTarget args
-
-parseRunOptions :: FilePath -> [String] -> IO ParseResult
-parseRunOptions defaultTarget xs = case targets of
+  args -> case targets of
     Right (target, toStdout) -> do
       file <- expandTarget defaultTarget target
-    return $ Run (Options verbose force toStdout file)
+      let
+        options
+          | toStdout = ParseOptions NoVerbose Force toStdout file
+          | otherwise = ParseOptions verbose force toStdout file
+      return (Run options)
     Left err -> return err
     where
       silentFlag = "--silent"
@@ -39,9 +40,9 @@ parseRunOptions defaultTarget xs = case targets of
 
       flags = silentFlag : forceFlags
 
-    verbose = if silentFlag `elem` xs then NoVerbose else Verbose
-    force = if any (`elem` xs) forceFlags then Force else NoForce
-    ys = filter (`notElem` flags) xs
+      verbose = if silentFlag `elem` args then NoVerbose else Verbose
+      force = if any (`elem` args) forceFlags then Force else NoForce
+      ys = filter (`notElem` flags) args
 
       targets :: Either ParseResult (Maybe FilePath, Bool)
       targets = case ys of

src/Hpack/Render.hs

@@ -5,6 +5,18 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE CPP #-}
 module Hpack.Render (
+-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
+-- other tools.  It is not meant for general use by end users.  The following
+-- caveats apply:
+--
+-- * The API is undocumented, consult the source instead.
+--
+-- * The exposed types and functions primarily serve Hpack's own needs, not
+-- that of a public API.  Breaking changes can happen as Hpack evolves.
+--
+-- As an Hpack user you either want to use the @hpack@ executable or a build
+-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).
+
   renderPackage
 , renderPackageWith
 , defaultRenderSettings

src/Hpack/Yaml.hs

@@ -1,5 +1,19 @@
 {-# LANGUAGE RecordWildCards #-}
-module Hpack.Yaml where
+module Hpack.Yaml (
+-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
+-- other tools.  It is not meant for general use by end users.  The following
+-- caveats apply:
+--
+-- * The API is undocumented, consult the source instead.
+--
+-- * The exposed types and functions primarily serve Hpack's own needs, not
+-- that of a public API.  Breaking changes can happen as Hpack evolves.
+--
+-- As an Hpack user you either want to use the @hpack@ executable or a build
+-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).
+
+  decodeYaml
+) where
 
 import           Data.Yaml hiding (decodeFile, decodeFileEither)
 import           Data.Yaml.Include

test/Hpack/OptionsSpec.hs

@@ -18,10 +18,10 @@ spec = do
 
     context "by default" $ do
       it "returns Run" $ do
-        parseOptions defaultTarget [] `shouldReturn` Run (Options Verbose NoForce False defaultTarget)
+        parseOptions defaultTarget [] `shouldReturn` Run (ParseOptions Verbose NoForce False defaultTarget)
 
       it "includes target" $ do
-        parseOptions defaultTarget ["foo.yaml"] `shouldReturn` Run (Options Verbose NoForce False "foo.yaml")
+        parseOptions defaultTarget ["foo.yaml"] `shouldReturn` Run (ParseOptions Verbose NoForce False "foo.yaml")
 
       context "with superfluous arguments" $ do
         it "returns ParseError" $ do
@@ -29,19 +29,19 @@ spec = do
 
       context "with --silent" $ do
         it "sets optionsVerbose to NoVerbose" $ do
-          parseOptions defaultTarget ["--silent"] `shouldReturn` Run (Options NoVerbose NoForce False defaultTarget)
+          parseOptions defaultTarget ["--silent"] `shouldReturn` Run (ParseOptions NoVerbose NoForce False defaultTarget)
 
       context "with --force" $ do
         it "sets optionsForce to Force" $ do
-          parseOptions defaultTarget ["--force"] `shouldReturn` Run (Options Verbose Force False defaultTarget)
+          parseOptions defaultTarget ["--force"] `shouldReturn` Run (ParseOptions Verbose Force False defaultTarget)
 
       context "with -f" $ do
         it "sets optionsForce to Force" $ do
-          parseOptions defaultTarget ["-f"] `shouldReturn` Run (Options Verbose Force False defaultTarget)
+          parseOptions defaultTarget ["-f"] `shouldReturn` Run (ParseOptions Verbose Force False defaultTarget)
 
       context "with -" $ do
-        it "sets optionsToStdout to True" $ do
-          parseOptions defaultTarget ["-"] `shouldReturn` Run (Options Verbose NoForce True defaultTarget)
+        it "sets optionsToStdout to True, implies Force and NoVerbose" $ do
+          parseOptions defaultTarget ["-"] `shouldReturn` Run (ParseOptions NoVerbose Force True defaultTarget)
 
         it "rejects - for target" $ do
           parseOptions defaultTarget ["-", "-"] `shouldReturn` ParseError

test/HpackSpec.hs

@@ -16,14 +16,14 @@ readFile name = Prelude.readFile name >>= (return $!!)
 
 spec :: Spec
 spec = do
-  describe "hpackWithVersionResult" $ do
+  describe "hpackResult" $ do
     context "with existing cabal file" $ around_ inTempDirectory $ before_ (writeFile packageConfig "name: foo") $ do
       let
         file = "foo.cabal"
 
-        hpackWithVersion v = hpackWithVersionResult v defaultDecodeOptions NoForce
-        hpack = hpackWithVersionResult version defaultDecodeOptions NoForce
-        hpackForce = hpackWithVersionResult version defaultDecodeOptions Force
+        hpackWithVersion v = hpackResultWithVersion v defaultOptions
+        hpack = hpackResult defaultOptions
+        hpackForce = hpackResult defaultOptions {optionsForce = Force}
 
         generated = Result [] file Generated
         modifiedManually = Result [] file ExistingCabalFileWasModifiedManually