{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}

module Pantry.HPack
    (
     hpack
    , hpackVersion
    ) where

import RIO
import RIO.Process
import Pantry.Types
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Hpack
import qualified Hpack.Config as Hpack
import Data.Char (isSpace, isDigit)
import Path (Path, Abs, toFilePath, Dir, (</>), filename, parseRelFile)
import Path.IO (doesFileExist)


hpackVersion
  :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => RIO env Version
hpackVersion :: forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
RIO env Version
hpackVersion = do
  HpackExecutable
he <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> HpackExecutable
pcHpackExecutable
  case HpackExecutable
he of
    HpackExecutable
HpackBundled -> do
                 let String
bundledHpackVersion :: String = VERSION_hpack
                 forall (m :: * -> *). MonadThrow m => String -> m Version
parseVersionThrowing String
bundledHpackVersion
    HpackCommand String
command -> do
                 String
version <- ByteString -> String
BL.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
 MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
command [String
"--version"] forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
readProcessStdout_
                 let version' :: String
version' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) String
version
                     version'' :: String
version'' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
version'
                 forall (m :: * -> *). MonadThrow m => String -> m Version
parseVersionThrowing String
version''

-- | Generate .cabal file from package.yaml, if necessary.

hpack
  :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => Path Abs Dir
  -> RIO env ()
hpack :: forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Path Abs Dir -> RIO env ()
hpack Path Abs Dir
pkgDir = do
    Path Rel File
packageConfigRelFile <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
Hpack.packageConfig
    let hpackFile :: Path Abs File
hpackFile = Path Abs Dir
pkgDir forall b t. Path b Dir -> Path Rel t -> Path b t
Path.</> Path Rel File
packageConfigRelFile
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
hpackFile) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Running hpack on " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall b t. Path b t -> String
toFilePath Path Abs File
hpackFile)

        HpackExecutable
he <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to PantryConfig -> HpackExecutable
pcHpackExecutable
        case HpackExecutable
he of
            HpackExecutable
HpackBundled -> do
                Result
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Options -> IO Result
Hpack.hpackResult forall a b. (a -> b) -> a -> b
$ ProgramName -> Options -> Options
Hpack.setProgramName ProgramName
"stack" forall a b. (a -> b) -> a -> b
$ String -> Options -> Options
Hpack.setTarget (forall b t. Path b t -> String
toFilePath Path Abs File
hpackFile) Options
Hpack.defaultOptions
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Result -> [String]
Hpack.resultWarnings Result
r) (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString)
                let cabalFile :: Utf8Builder
cabalFile = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> String
Hpack.resultCabalFile forall a b. (a -> b) -> a -> b
$ Result
r
                case Result -> Status
Hpack.resultStatus Result
r of
                    Status
Hpack.Generated -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"hpack generated a modified version of " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
cabalFile
                    Status
Hpack.OutputUnchanged -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Utf8Builder
"hpack output unchanged in " forall a. Semigroup a => a -> a -> a
<> Utf8Builder
cabalFile
                    Status
Hpack.AlreadyGeneratedByNewerHpack -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
                        Utf8Builder
cabalFile forall a. Semigroup a => a -> a -> a
<>
                        Utf8Builder
" was generated with a newer version of hpack,\n" forall a. Semigroup a => a -> a -> a
<>
                        Utf8Builder
"please upgrade and try again."
                    Status
Hpack.ExistingCabalFileWasModifiedManually -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
                        Utf8Builder
cabalFile forall a. Semigroup a => a -> a -> a
<>
                        Utf8Builder
" was modified manually. Ignoring " forall a. Semigroup a => a -> a -> a
<>
                        forall a. IsString a => String -> a
fromString (forall b t. Path b t -> String
toFilePath Path Abs File
hpackFile) forall a. Semigroup a => a -> a -> a
<>
                        Utf8Builder
" in favor of the cabal file.\nIf you want to use the " forall a. Semigroup a => a -> a -> a
<>
                        forall a. IsString a => String -> a
fromString (forall b t. Path b t -> String
toFilePath (forall b. Path b File -> Path Rel File
filename Path Abs File
hpackFile)) forall a. Semigroup a => a -> a -> a
<>
                        Utf8Builder
" file instead of the cabal file,\n" forall a. Semigroup a => a -> a -> a
<>
                        Utf8Builder
"then please delete the cabal file."
            HpackCommand String
command ->
                forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m a -> m a
withWorkingDir (forall b t. Path b t -> String
toFilePath Path Abs Dir
pkgDir) forall a b. (a -> b) -> a -> b
$
                forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
 MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
command [] forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_