{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# 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(..)
, 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 :: Maybe Version -> String
programVersion Maybe Version
Nothing = String
"hpack"
programVersion (Just Version
v) = String
"hpack version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
Version.showVersion Version
v

header :: FilePath -> Maybe Version -> (Maybe Hash) -> [String]
header :: String -> Maybe Version -> Maybe String -> [String]
header String
p Maybe Version
v Maybe String
hash = [
    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]
++ Maybe Version -> String
programVersion Maybe Version
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
  , String
"--"
  , String
"-- see: https://github.com/sol/hpack"
  ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ case Maybe String
hash of
    Just String
h -> [String
"--" , String
"-- hash: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h, String
""]
    Maybe String
Nothing -> [String
""]

data Options = Options {
  Options -> DecodeOptions
optionsDecodeOptions :: DecodeOptions
, Options -> Force
optionsForce :: Force
, Options -> GenerateHashStrategy
optionsGenerateHashStrategy :: GenerateHashStrategy
, Options -> Bool
optionsToStdout :: Bool
}

data GenerateHashStrategy = ForceHash | ForceNoHash | PreferHash | PreferNoHash
  deriving (GenerateHashStrategy -> GenerateHashStrategy -> Bool
(GenerateHashStrategy -> GenerateHashStrategy -> Bool)
-> (GenerateHashStrategy -> GenerateHashStrategy -> Bool)
-> Eq GenerateHashStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenerateHashStrategy -> GenerateHashStrategy -> Bool
$c/= :: GenerateHashStrategy -> GenerateHashStrategy -> Bool
== :: GenerateHashStrategy -> GenerateHashStrategy -> Bool
$c== :: GenerateHashStrategy -> GenerateHashStrategy -> Bool
Eq, Int -> GenerateHashStrategy -> String -> String
[GenerateHashStrategy] -> String -> String
GenerateHashStrategy -> String
(Int -> GenerateHashStrategy -> String -> String)
-> (GenerateHashStrategy -> String)
-> ([GenerateHashStrategy] -> String -> String)
-> Show GenerateHashStrategy
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GenerateHashStrategy] -> String -> String
$cshowList :: [GenerateHashStrategy] -> String -> String
show :: GenerateHashStrategy -> String
$cshow :: GenerateHashStrategy -> String
showsPrec :: Int -> GenerateHashStrategy -> String -> String
$cshowsPrec :: Int -> GenerateHashStrategy -> String -> String
Show)

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 (Maybe Version -> String
programVersion (Maybe Version -> String) -> Maybe Version -> String
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just 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 Verbose
verbose Force
force Maybe Bool
hash Bool
toStdout String
file) -> do
      let generateHash :: GenerateHashStrategy
generateHash = case Maybe Bool
hash of
            Just Bool
True -> GenerateHashStrategy
ForceHash
            Just Bool
False -> GenerateHashStrategy
ForceNoHash
            Maybe Bool
Nothing -> GenerateHashStrategy
PreferNoHash
      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 -> GenerateHashStrategy -> Bool -> Options
Options DecodeOptions
defaultDecodeOptions {decodeOptionsTarget :: String
decodeOptionsTarget = String
file} Force
force GenerateHashStrategy
generateHash 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 ] [ --[no-]hash ] [ 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 -> GenerateHashStrategy -> Bool -> Options
Options DecodeOptions
defaultDecodeOptions Force
NoForce GenerateHashStrategy
PreferNoHash Bool
False

setTarget :: FilePath -> Options -> Options
setTarget :: String -> Options -> Options
setTarget String
target options :: Options
options@Options{Bool
Force
DecodeOptions
GenerateHashStrategy
optionsToStdout :: Bool
optionsGenerateHashStrategy :: GenerateHashStrategy
optionsForce :: Force
optionsDecodeOptions :: DecodeOptions
optionsToStdout :: Options -> Bool
optionsGenerateHashStrategy :: Options -> GenerateHashStrategy
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
GenerateHashStrategy
optionsToStdout :: Bool
optionsGenerateHashStrategy :: GenerateHashStrategy
optionsForce :: Force
optionsDecodeOptions :: DecodeOptions
optionsToStdout :: Options -> Bool
optionsGenerateHashStrategy :: Options -> GenerateHashStrategy
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
GenerateHashStrategy
optionsToStdout :: Bool
optionsGenerateHashStrategy :: GenerateHashStrategy
optionsForce :: Force
optionsDecodeOptions :: DecodeOptions
optionsToStdout :: Options -> Bool
optionsGenerateHashStrategy :: Options -> GenerateHashStrategy
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 :: CabalFile -> CabalFile -> Status
mkStatus :: CabalFile -> CabalFile -> Status
mkStatus new :: CabalFile
new@(CabalFile [String]
_ Maybe Version
mNewVersion Maybe String
mNewHash [String]
_) existing :: CabalFile
existing@(CabalFile [String]
_ Maybe Version
mExistingVersion Maybe String
_ [String]
_)
  | CabalFile
new CabalFile -> CabalFile -> Bool
`hasSameContent` CabalFile
existing = Status
OutputUnchanged
  | Bool
otherwise = case Maybe Version
mExistingVersion of
      Maybe Version
Nothing -> Status
ExistingCabalFileWasModifiedManually
      Just Version
_
        | Maybe Version
mNewVersion Maybe Version -> Maybe Version -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe Version
mExistingVersion -> Status
AlreadyGeneratedByNewerHpack
        | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mNewHash Bool -> Bool -> Bool
&& CabalFile -> Bool
hashMismatch CabalFile
existing -> Status
ExistingCabalFileWasModifiedManually
        | Bool
otherwise -> Status
Generated

hasSameContent :: CabalFile -> CabalFile -> Bool
hasSameContent :: CabalFile -> CabalFile -> Bool
hasSameContent (CabalFile [String]
cabalVersionA Maybe Version
_ Maybe String
_ [String]
a) (CabalFile [String]
cabalVersionB Maybe Version
_ Maybe String
_ [String]
b) = [String]
cabalVersionA [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
cabalVersionB Bool -> Bool -> Bool
&& [String]
a [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
b

hashMismatch :: CabalFile -> Bool
hashMismatch :: CabalFile -> Bool
hashMismatch CabalFile
cabalFile = case CabalFile -> Maybe String
cabalFileHash CabalFile
cabalFile of
  Maybe String
Nothing -> Bool
False
  Just String
hash -> String
hash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= CabalFile -> String
calculateHash CabalFile
cabalFile

calculateHash :: CabalFile -> Hash
calculateHash :: CabalFile -> String
calculateHash (CabalFile [String]
cabalVersion Maybe Version
_ Maybe String
_ [String]
body) = String -> String
sha256 ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
cabalVersion [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body)

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 GenerateHashStrategy
generateHashStrategy Bool
toStdout) = do
  DecodeResult Package
pkg (String -> [String]
lines -> [String]
cabalVersion) String
cabalFileName [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
mExistingCabalFile <- String -> IO (Maybe CabalFile)
readCabalFile String
cabalFileName
  let
    newCabalFile :: CabalFile
newCabalFile = GenerateHashStrategy
-> Maybe CabalFile -> [String] -> Version -> Package -> CabalFile
makeCabalFile GenerateHashStrategy
generateHashStrategy Maybe CabalFile
mExistingCabalFile [String]
cabalVersion Version
v Package
pkg

    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 (CabalFile -> CabalFile -> Status
mkStatus CabalFile
newCabalFile) Maybe CabalFile
mExistingCabalFile

  case Status
status of
    Status
Generated -> DecodeOptions -> Bool -> String -> CabalFile -> IO ()
writeCabalFile DecodeOptions
options Bool
toStdout String
cabalFileName CabalFile
newCabalFile
    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
cabalFileName
  , resultStatus :: Status
resultStatus = Status
status
  }

writeCabalFile :: DecodeOptions -> Bool -> FilePath -> CabalFile -> IO ()
writeCabalFile :: DecodeOptions -> Bool -> String -> CabalFile -> IO ()
writeCabalFile DecodeOptions
options Bool
toStdout String
name CabalFile
cabalFile = do
  String -> IO ()
write (String -> IO ()) -> ([String] -> String) -> [String] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CabalFile -> [String]
renderCabalFile (DecodeOptions -> String
decodeOptionsTarget DecodeOptions
options) CabalFile
cabalFile
  where
    write :: String -> IO ()
write = if Bool
toStdout then String -> IO ()
Utf8.putStr else String -> String -> IO ()
Utf8.writeFile String
name

makeCabalFile :: GenerateHashStrategy -> Maybe CabalFile -> [String] -> Version -> Package -> CabalFile
makeCabalFile :: GenerateHashStrategy
-> Maybe CabalFile -> [String] -> Version -> Package -> CabalFile
makeCabalFile GenerateHashStrategy
strategy Maybe CabalFile
mExistingCabalFile [String]
cabalVersion Version
v Package
pkg = CabalFile
cabalFile
  where
    cabalFile :: CabalFile
cabalFile = [String] -> Maybe Version -> Maybe String -> [String] -> CabalFile
CabalFile [String]
cabalVersion (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v) Maybe String
hash [String]
body

    hash :: Maybe String
hash
      | Maybe CabalFile -> GenerateHashStrategy -> Bool
shouldGenerateHash Maybe CabalFile
mExistingCabalFile GenerateHashStrategy
strategy = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ CabalFile -> String
calculateHash CabalFile
cabalFile
      | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing

    body :: [String]
body = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [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
mExistingCabalFile) Package
pkg

shouldGenerateHash :: Maybe CabalFile -> GenerateHashStrategy -> Bool
shouldGenerateHash :: Maybe CabalFile -> GenerateHashStrategy -> Bool
shouldGenerateHash Maybe CabalFile
mExistingCabalFile GenerateHashStrategy
strategy = case (GenerateHashStrategy
strategy, Maybe CabalFile
mExistingCabalFile) of
  (GenerateHashStrategy
ForceHash, Maybe CabalFile
_) -> Bool
True
  (GenerateHashStrategy
ForceNoHash, Maybe CabalFile
_) -> Bool
False
  (GenerateHashStrategy
PreferHash, Maybe CabalFile
Nothing) -> Bool
True
  (GenerateHashStrategy
PreferNoHash, Maybe CabalFile
Nothing) -> Bool
False
  (GenerateHashStrategy
_, Just CabalFile {cabalFileHash :: CabalFile -> Maybe String
cabalFileHash = Maybe String
Nothing}) -> Bool
False
  (GenerateHashStrategy
_, Just CabalFile {cabalFileHash :: CabalFile -> Maybe String
cabalFileHash = Just String
_}) -> Bool
True

renderCabalFile :: FilePath -> CabalFile -> [String]
renderCabalFile :: String -> CabalFile -> [String]
renderCabalFile String
file (CabalFile [String]
cabalVersion Maybe Version
hpackVersion Maybe String
hash [String]
body) = [String]
cabalVersion [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> Maybe Version -> Maybe String -> [String]
header String
file Maybe Version
hpackVersion Maybe String
hash [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
body