{-# 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 :: Version -> String
programVersion Version
v = String
"hpack version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
Version.showVersion Version
v
header :: FilePath -> Version -> Hash -> String
String
p Version
v String
hash = [String] -> String
unlines [
String
"-- This file has been generated from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
takeFileName String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
programVersion Version
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
, String
"--"
, String
"-- see: https://github.com/sol/hpack"
, String
"--"
, String
"-- hash: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hash
, String
""
]
data Options = Options {
Options -> DecodeOptions
optionsDecodeOptions :: DecodeOptions
, Options -> Force
optionsForce :: Force
, Options -> Bool
optionsToStdout :: Bool
}
getOptions :: FilePath -> [String] -> IO (Maybe (Verbose, Options))
getOptions :: String -> [String] -> IO (Maybe (Verbose, Options))
getOptions String
defaultPackageConfig [String]
args = do
ParseResult
result <- String -> [String] -> IO ParseResult
parseOptions String
defaultPackageConfig [String]
args
case ParseResult
result of
ParseResult
PrintVersion -> do
String -> IO ()
putStrLn (Version -> String
programVersion Version
version)
Maybe (Verbose, Options) -> IO (Maybe (Verbose, Options))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Verbose, Options)
forall a. Maybe a
Nothing
ParseResult
PrintNumericVersion -> do
String -> IO ()
putStrLn (Version -> String
Version.showVersion Version
version)
Maybe (Verbose, Options) -> IO (Maybe (Verbose, Options))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Verbose, Options)
forall a. Maybe a
Nothing
ParseResult
Help -> do
IO ()
printHelp
Maybe (Verbose, Options) -> IO (Maybe (Verbose, Options))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Verbose, Options)
forall a. Maybe a
Nothing
Run ParseOptions
options -> case ParseOptions
options of
ParseOptions Verbose
verbose Force
force Bool
toStdout String
file -> do
Maybe (Verbose, Options) -> IO (Maybe (Verbose, Options))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Verbose, Options) -> IO (Maybe (Verbose, Options)))
-> Maybe (Verbose, Options) -> IO (Maybe (Verbose, Options))
forall a b. (a -> b) -> a -> b
$ (Verbose, Options) -> Maybe (Verbose, Options)
forall a. a -> Maybe a
Just (Verbose
verbose, DecodeOptions -> Force -> Bool -> Options
Options DecodeOptions
defaultDecodeOptions {decodeOptionsTarget :: String
decodeOptionsTarget = String
file} Force
force Bool
toStdout)
ParseResult
ParseError -> do
IO ()
printHelp
IO (Maybe (Verbose, Options))
forall a. IO a
exitFailure
printHelp :: IO ()
printHelp :: IO ()
printHelp = do
String
name <- IO String
getProgName
Handle -> String -> IO ()
Utf8.hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
String
"Usage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [ --silent ] [ --force | -f ] [ PATH ] [ - ]"
, String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --version"
, String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --numeric-version"
, String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --help"
]
hpack :: Verbose -> Options -> IO ()
hpack :: Verbose -> Options -> IO ()
hpack Verbose
verbose Options
options = Options -> IO Result
hpackResult Options
options IO Result -> (Result -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbose -> Result -> IO ()
printResult Verbose
verbose
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = DecodeOptions -> Force -> Bool -> Options
Options DecodeOptions
defaultDecodeOptions Force
NoForce Bool
False
setTarget :: FilePath -> Options -> Options
setTarget :: String -> Options -> Options
setTarget String
target options :: Options
options@Options{Bool
Force
DecodeOptions
optionsToStdout :: Bool
optionsForce :: Force
optionsDecodeOptions :: DecodeOptions
optionsToStdout :: Options -> Bool
optionsForce :: Options -> Force
optionsDecodeOptions :: Options -> DecodeOptions
..} =
Options
options {optionsDecodeOptions :: DecodeOptions
optionsDecodeOptions = DecodeOptions
optionsDecodeOptions {decodeOptionsTarget :: String
decodeOptionsTarget = String
target}}
setProgramName :: ProgramName -> Options -> Options
setProgramName :: ProgramName -> Options -> Options
setProgramName ProgramName
name options :: Options
options@Options{Bool
Force
DecodeOptions
optionsToStdout :: Bool
optionsForce :: Force
optionsDecodeOptions :: DecodeOptions
optionsToStdout :: Options -> Bool
optionsForce :: Options -> Force
optionsDecodeOptions :: Options -> DecodeOptions
..} =
Options
options {optionsDecodeOptions :: DecodeOptions
optionsDecodeOptions = DecodeOptions
optionsDecodeOptions {decodeOptionsProgramName :: ProgramName
decodeOptionsProgramName = ProgramName
name}}
setDecode :: (FilePath -> IO (Either String ([String], Value))) -> Options -> Options
setDecode :: (String -> IO (Either String ([String], Value)))
-> Options -> Options
setDecode String -> IO (Either String ([String], Value))
decode options :: Options
options@Options{Bool
Force
DecodeOptions
optionsToStdout :: Bool
optionsForce :: Force
optionsDecodeOptions :: DecodeOptions
optionsToStdout :: Options -> Bool
optionsForce :: Options -> Force
optionsDecodeOptions :: Options -> DecodeOptions
..} =
Options
options {optionsDecodeOptions :: DecodeOptions
optionsDecodeOptions = DecodeOptions
optionsDecodeOptions {decodeOptionsDecode :: String -> IO (Either String ([String], Value))
decodeOptionsDecode = String -> IO (Either String ([String], Value))
decode}}
data Result = Result {
Result -> [String]
resultWarnings :: [String]
, Result -> String
resultCabalFile :: String
, Result -> Status
resultStatus :: Status
} deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> String -> String
[Result] -> String -> String
Result -> String
(Int -> Result -> String -> String)
-> (Result -> String)
-> ([Result] -> String -> String)
-> Show Result
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Result] -> String -> String
$cshowList :: [Result] -> String -> String
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> String -> String
$cshowsPrec :: Int -> Result -> String -> String
Show)
data Status =
Generated
| ExistingCabalFileWasModifiedManually
| AlreadyGeneratedByNewerHpack
| OutputUnchanged
deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> String -> String
[Status] -> String -> String
Status -> String
(Int -> Status -> String -> String)
-> (Status -> String)
-> ([Status] -> String -> String)
-> Show Status
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Status] -> String -> String
$cshowList :: [Status] -> String -> String
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> String -> String
$cshowsPrec :: Int -> Status -> String -> String
Show)
printResult :: Verbose -> Result -> IO ()
printResult :: Verbose -> Result -> IO ()
printResult Verbose
verbose Result
r = do
[String] -> IO ()
printWarnings (Result -> [String]
resultWarnings Result
r)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbose
verbose Verbose -> Verbose -> Bool
forall a. Eq a => a -> a -> Bool
== Verbose
Verbose) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
case Result -> Status
resultStatus Result
r of
Status
Generated -> String
"generated " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Result -> String
resultCabalFile Result
r
Status
OutputUnchanged -> Result -> String
resultCabalFile Result
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is up-to-date"
Status
AlreadyGeneratedByNewerHpack -> Result -> String
resultCabalFile Result
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" was generated with a newer version of hpack, please upgrade and try again."
Status
ExistingCabalFileWasModifiedManually -> Result -> String
resultCabalFile Result
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" was modified manually, please use --force to overwrite."
case Result -> Status
resultStatus Result
r of
Status
Generated -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Status
OutputUnchanged -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Status
AlreadyGeneratedByNewerHpack -> IO ()
forall a. IO a
exitFailure
Status
ExistingCabalFileWasModifiedManually -> IO ()
forall a. IO a
exitFailure
printWarnings :: [String] -> IO ()
printWarnings :: [String] -> IO ()
printWarnings = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> IO ()) -> [String] -> IO ())
-> (String -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
Utf8.hPutStrLn Handle
stderr (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"WARNING: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)
mkStatus :: [String] -> Version -> CabalFile -> Status
mkStatus :: [String] -> Version -> CabalFile -> Status
mkStatus [String]
new Version
v (CabalFile Maybe Version
mOldVersion Maybe String
mHash [String]
old) = case (Maybe Version
mOldVersion, Maybe String
mHash) of
(Maybe Version
Nothing, Maybe String
_) -> Status
ExistingCabalFileWasModifiedManually
(Just Version
oldVersion, Maybe String
_) | Version
oldVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
makeVersion [Int
0, Int
20, Int
0] -> Status
Generated
(Maybe Version
_, Maybe String
Nothing) -> Status
ExistingCabalFileWasModifiedManually
(Just Version
oldVersion, Just String
hash)
| [String]
old [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
new -> Status
OutputUnchanged
| Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
oldVersion -> Status
AlreadyGeneratedByNewerHpack
| String -> String
sha256 ([String] -> String
unlines [String]
old) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
hash -> Status
ExistingCabalFileWasModifiedManually
| Bool
otherwise -> Status
Generated
hpackResult :: Options -> IO Result
hpackResult :: Options -> IO Result
hpackResult = Version -> Options -> IO Result
hpackResultWithVersion Version
version
hpackResultWithVersion :: Version -> Options -> IO Result
hpackResultWithVersion :: Version -> Options -> IO Result
hpackResultWithVersion Version
v (Options DecodeOptions
options Force
force Bool
toStdout) = do
DecodeResult Package
pkg String
cabalVersion String
cabalFile [String]
warnings <- DecodeOptions -> IO (Either String DecodeResult)
readPackageConfig DecodeOptions
options IO (Either String DecodeResult)
-> (Either String DecodeResult -> IO DecodeResult)
-> IO DecodeResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO DecodeResult)
-> (DecodeResult -> IO DecodeResult)
-> Either String DecodeResult
-> IO DecodeResult
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO DecodeResult
forall a. String -> IO a
die DecodeResult -> IO DecodeResult
forall (m :: * -> *) a. Monad m => a -> m a
return
Maybe CabalFile
oldCabalFile <- String -> IO (Maybe CabalFile)
readCabalFile String
cabalFile
let
body :: String
body = [String] -> Package -> String
renderPackage ([String] -> (CabalFile -> [String]) -> Maybe CabalFile -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CabalFile -> [String]
cabalFileContents Maybe CabalFile
oldCabalFile) Package
pkg
withoutHeader :: String
withoutHeader = String
cabalVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body
let
status :: Status
status = case Force
force of
Force
Force -> Status
Generated
Force
NoForce -> Status -> (CabalFile -> Status) -> Maybe CabalFile -> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Status
Generated ([String] -> Version -> CabalFile -> Status
mkStatus (String -> [String]
lines String
withoutHeader) Version
v) Maybe CabalFile
oldCabalFile
case Status
status of
Status
Generated -> do
let hash :: String
hash = String -> String
sha256 String
withoutHeader
out :: String
out = String
cabalVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Version -> String -> String
header (DecodeOptions -> String
decodeOptionsTarget DecodeOptions
options) Version
v String
hash String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
body
if Bool
toStdout
then String -> IO ()
Utf8.putStr String
out
else String -> String -> IO ()
Utf8.writeFile String
cabalFile String
out
Status
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result :: [String] -> String -> Status -> Result
Result {
resultWarnings :: [String]
resultWarnings = [String]
warnings
, resultCabalFile :: String
resultCabalFile = String
cabalFile
, resultStatus :: Status
resultStatus = Status
status
}