{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
module Hpack (
version
, hpack
, hpackResult
, printResult
, Result(..)
, Status(..)
, defaultOptions
, setProgramName
, setTarget
, setDecode
, getOptions
, Verbose(..)
, Options(..)
, Force(..)
, GenerateHashStrategy(..)
#ifdef TEST
, hpackResultWithVersion
, header
, renderCabalFile
#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 Data.Maybe
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 :: Maybe Version -> String
programVersion Nothing = "hpack"
programVersion (Just v) = "hpack version " ++ Version.showVersion v
header :: FilePath -> Maybe Version -> (Maybe Hash) -> [String]
header p v hash = [
"-- This file has been generated from " ++ takeFileName p ++ " by " ++ programVersion v ++ "."
, "--"
, "-- see: https://github.com/sol/hpack"
] ++ case hash of
Just h -> ["--" , "-- hash: " ++ h, ""]
Nothing -> [""]
data Options = Options {
optionsDecodeOptions :: DecodeOptions
, optionsForce :: Force
, optionsGenerateHashStrategy :: GenerateHashStrategy
, optionsToStdout :: Bool
}
data GenerateHashStrategy = ForceHash | ForceNoHash | PreferHash | PreferNoHash
deriving (Eq, Show)
getOptions :: FilePath -> [String] -> IO (Maybe (Verbose, Options))
getOptions defaultPackageConfig args = do
result <- parseOptions defaultPackageConfig args
case result of
PrintVersion -> do
putStrLn (programVersion $ Just version)
return Nothing
PrintNumericVersion -> do
putStrLn (Version.showVersion version)
return Nothing
Help -> do
printHelp
return Nothing
Run (ParseOptions verbose force hash toStdout file) -> do
let generateHash = case hash of
Just True -> ForceHash
Just False -> ForceNoHash
Nothing -> PreferHash
return $ Just (verbose, Options defaultDecodeOptions {decodeOptionsTarget = file} force generateHash toStdout)
ParseError -> do
printHelp
exitFailure
printHelp :: IO ()
printHelp = do
name <- getProgName
Utf8.hPutStrLn stderr $ unlines [
"Usage: " ++ name ++ " [ --silent ] [ --force | -f ] [ --[no-]hash ] [ 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 PreferHash 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 :: CabalFile -> CabalFile -> Status
mkStatus new@(CabalFile _ mNewVersion mNewHash _) existing@(CabalFile _ mExistingVersion _ _)
| new `hasSameContent` existing = OutputUnchanged
| otherwise = case mExistingVersion of
Nothing -> ExistingCabalFileWasModifiedManually
Just _
| mNewVersion < mExistingVersion -> AlreadyGeneratedByNewerHpack
| isJust mNewHash && hashMismatch existing -> ExistingCabalFileWasModifiedManually
| otherwise -> Generated
hasSameContent :: CabalFile -> CabalFile -> Bool
hasSameContent (CabalFile cabalVersionA _ _ a) (CabalFile cabalVersionB _ _ b) = cabalVersionA == cabalVersionB && a == b
hashMismatch :: CabalFile -> Bool
hashMismatch cabalFile = case cabalFileHash cabalFile of
Nothing -> False
Just hash -> hash /= calculateHash cabalFile
calculateHash :: CabalFile -> Hash
calculateHash (CabalFile cabalVersion _ _ body) = sha256 (unlines $ cabalVersion ++ body)
hpackResult :: Options -> IO Result
hpackResult = hpackResultWithVersion version
hpackResultWithVersion :: Version -> Options -> IO Result
hpackResultWithVersion v (Options options force generateHashStrategy toStdout) = do
DecodeResult pkg (lines -> cabalVersion) cabalFileName warnings <- readPackageConfig options >>= either die return
mExistingCabalFile <- readCabalFile cabalFileName
let
newCabalFile = makeCabalFile generateHashStrategy mExistingCabalFile cabalVersion v pkg
status = case force of
Force -> Generated
NoForce -> maybe Generated (mkStatus newCabalFile) mExistingCabalFile
case status of
Generated -> writeCabalFile options toStdout cabalFileName newCabalFile
_ -> return ()
return Result {
resultWarnings = warnings
, resultCabalFile = cabalFileName
, resultStatus = status
}
writeCabalFile :: DecodeOptions -> Bool -> FilePath -> CabalFile -> IO ()
writeCabalFile options toStdout name cabalFile = do
write . unlines $ renderCabalFile (decodeOptionsTarget options) cabalFile
where
write = if toStdout then Utf8.putStr else Utf8.writeFile name
makeCabalFile :: GenerateHashStrategy -> Maybe CabalFile -> [String] -> Version -> Package -> CabalFile
makeCabalFile strategy mExistingCabalFile cabalVersion v pkg = cabalFile
where
cabalFile = CabalFile cabalVersion (Just v) hash body
hash
| shouldGenerateHash mExistingCabalFile strategy = Just $ calculateHash cabalFile
| otherwise = Nothing
body = lines $ renderPackage (maybe [] cabalFileContents mExistingCabalFile) pkg
shouldGenerateHash :: Maybe CabalFile -> GenerateHashStrategy -> Bool
shouldGenerateHash mExistingCabalFile strategy = case (strategy, mExistingCabalFile) of
(ForceHash, _) -> True
(ForceNoHash, _) -> False
(PreferHash, Nothing) -> True
(PreferNoHash, Nothing) -> False
(_, Just CabalFile {cabalFileHash = Nothing}) -> False
(_, Just CabalFile {cabalFileHash = Just _}) -> True
renderCabalFile :: FilePath -> CabalFile -> [String]
renderCabalFile file (CabalFile cabalVersion hpackVersion hash body) = cabalVersion ++ header file hpackVersion hash ++ body