{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
module Hpack (
version
, hpack
, hpackResult
, printResult
, Result(..)
, Status(..)
, defaultOptions
, setProgramName
, setTarget
, setDecode
, getOptions
, Verbose(..)
, Options(..)
, Force(..)
#ifdef TEST
, hpackResultWithVersion
, header
#endif
) where
import Control.Monad
import Data.Version (Version)
import qualified Data.Version as Version
import System.FilePath
import System.Environment
import System.Exit
import System.IO (stderr)
import Data.Aeson (Value)
import Paths_hpack (version)
import Hpack.Options
import Hpack.Config
import Hpack.Render
import Hpack.Util
import Hpack.Utf8 as Utf8
import Hpack.CabalFile
programVersion :: Version -> String
programVersion v = "hpack version " ++ Version.showVersion v
header :: FilePath -> Version -> Hash -> String
header p v hash = unlines [
"-- This file has been generated from " ++ takeFileName p ++ " by " ++ programVersion v ++ "."
, "--"
, "-- see: https://github.com/sol/hpack"
, "--"
, "-- hash: " ++ hash
, ""
]
data Options = Options {
optionsDecodeOptions :: DecodeOptions
, optionsForce :: Force
, optionsToStdout :: Bool
}
getOptions :: FilePath -> [String] -> IO (Maybe (Verbose, Options))
getOptions defaultPackageConfig args = do
result <- parseOptions defaultPackageConfig args
case result of
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
ParseOptions verbose force toStdout file -> do
return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} force toStdout)
ParseError -> do
printHelp
exitFailure
printHelp :: IO ()
printHelp = do
name <- getProgName
Utf8.hPutStrLn stderr $ unlines [
"Usage: " ++ name ++ " [ --silent ] [ --force | -f ] [ PATH ] [ - ]"
, " " ++ name ++ " --version"
, " " ++ name ++ " --numeric-version"
, " " ++ name ++ " --help"
]
hpack :: Verbose -> Options -> IO ()
hpack verbose options = hpackResult options >>= printResult verbose
defaultOptions :: Options
defaultOptions = Options defaultDecodeOptions NoForce False
setTarget :: FilePath -> Options -> Options
setTarget target options@Options{..} =
options {optionsDecodeOptions = optionsDecodeOptions {decodeOptionsTarget = target}}
setProgramName :: ProgramName -> Options -> Options
setProgramName name options@Options{..} =
options {optionsDecodeOptions = optionsDecodeOptions {decodeOptionsProgramName = name}}
setDecode :: (FilePath -> IO (Either String ([String], Value))) -> Options -> Options
setDecode decode options@Options{..} =
options {optionsDecodeOptions = optionsDecodeOptions {decodeOptionsDecode = decode}}
data Result = Result {
resultWarnings :: [String]
, resultCabalFile :: String
, resultStatus :: Status
} deriving (Eq, Show)
data Status =
Generated
| ExistingCabalFileWasModifiedManually
| AlreadyGeneratedByNewerHpack
| OutputUnchanged
deriving (Eq, Show)
printResult :: Verbose -> Result -> IO ()
printResult verbose r = do
printWarnings (resultWarnings r)
when (verbose == 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."
ExistingCabalFileWasModifiedManually -> resultCabalFile r ++ " was modified manually, please use --force to overwrite."
case resultStatus r of
Generated -> return ()
OutputUnchanged -> return ()
AlreadyGeneratedByNewerHpack -> exitFailure
ExistingCabalFileWasModifiedManually -> exitFailure
printWarnings :: [String] -> IO ()
printWarnings = mapM_ $ Utf8.hPutStrLn stderr . ("WARNING: " ++)
mkStatus :: [String] -> Version -> CabalFile -> Status
mkStatus new v (CabalFile mOldVersion mHash old) = case (mOldVersion, mHash) of
(Nothing, _) -> ExistingCabalFileWasModifiedManually
(Just oldVersion, _) | oldVersion < makeVersion [0, 20, 0] -> Generated
(_, Nothing) -> ExistingCabalFileWasModifiedManually
(Just oldVersion, Just hash)
| old == new -> OutputUnchanged
| v < oldVersion -> AlreadyGeneratedByNewerHpack
| sha256 (unlines old) /= hash -> ExistingCabalFileWasModifiedManually
| otherwise -> Generated
hpackResult :: Options -> IO Result
hpackResult = hpackResultWithVersion version
hpackResultWithVersion :: Version -> Options -> IO Result
hpackResultWithVersion v (Options options force toStdout) = do
DecodeResult pkg cabalVersion cabalFile warnings <- readPackageConfig options >>= either die return
oldCabalFile <- readCabalFile cabalFile
let
body = renderPackage (maybe [] cabalFileContents oldCabalFile) pkg
withoutHeader = cabalVersion ++ body
let
status = case force of
Force -> Generated
NoForce -> maybe Generated (mkStatus (lines withoutHeader) v) oldCabalFile
case status of
Generated -> do
let hash = sha256 withoutHeader
out = cabalVersion ++ header (decodeOptionsTarget options) v hash ++ body
if toStdout
then Utf8.putStr out
else Utf8.writeFile cabalFile out
_ -> return ()
return Result {
resultWarnings = warnings
, resultCabalFile = cabalFile
, resultStatus = status
}