{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
module 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
, 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
header :: String -> Version -> String -> String
header 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
    }