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

    module Pantry.HPack
      ( hpack
      , hpackVersion
      ) where

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

    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 <- Getting HpackExecutable env HpackExecutable
    -> RIO env HpackExecutable
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting HpackExecutable env HpackExecutable
     -> RIO env HpackExecutable)
    -> Getting HpackExecutable env HpackExecutable
    -> RIO env HpackExecutable
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig -> Const HpackExecutable PantryConfig)
    -> env -> Const HpackExecutable env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' env PantryConfig
    pantryConfigL((PantryConfig -> Const HpackExecutable PantryConfig)
     -> env -> Const HpackExecutable env)
    -> ((HpackExecutable -> Const HpackExecutable HpackExecutable)
        -> PantryConfig -> Const HpackExecutable PantryConfig)
    -> Getting HpackExecutable env HpackExecutable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig -> HpackExecutable)
    -> SimpleGetter PantryConfig HpackExecutable
    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
          String -> RIO env Version
    forall (m :: * -> *). MonadThrow m => String -> m Version
    parseVersionThrowing String
    bundledHpackVersion
        HpackCommand String
    command -> do
          String
    version <- ByteString -> String
    BL.unpack (ByteString -> String) -> RIO env ByteString -> RIO env String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String
    -> [String]
    -> (ProcessConfig () () () -> RIO env ByteString)
    -> RIO env ByteString
    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"] ProcessConfig () () () -> RIO env ByteString
    forall (m :: * -> *) stdin stdoutIgnored stderr.
    MonadIO m =>
    ProcessConfig stdin stdoutIgnored stderr -> m ByteString
    readProcessStdout_
          let version' :: String
    version' = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isDigit) String
    version
              version'' :: String
    version'' = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace) String
    version'
          String -> RIO env 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 <- String -> RIO env (Path Rel File)
    forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
    parseRelFile String
    Hpack.packageConfig
      let hpackFile :: Path Abs File
    hpackFile = Path Abs Dir
    pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
    forall b t. Path b Dir -> Path Rel t -> Path b t
    Path.</> Path Rel File
    packageConfigRelFile
      RIO env Bool -> RIO env () -> RIO env ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (Path Abs File -> RIO env Bool
    forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
    doesFileExist Path Abs File
    hpackFile) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ do
        Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ Utf8Builder
    "Running hpack on " Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    hpackFile)
        HpackExecutable
    he <- Getting HpackExecutable env HpackExecutable
    -> RIO env HpackExecutable
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view (Getting HpackExecutable env HpackExecutable
     -> RIO env HpackExecutable)
    -> Getting HpackExecutable env HpackExecutable
    -> RIO env HpackExecutable
    forall a b. (a -> b) -> a -> b
    $ (PantryConfig -> Const HpackExecutable PantryConfig)
    -> env -> Const HpackExecutable env
    forall env. HasPantryConfig env => Lens' env PantryConfig
    Lens' env PantryConfig
    pantryConfigL((PantryConfig -> Const HpackExecutable PantryConfig)
     -> env -> Const HpackExecutable env)
    -> ((HpackExecutable -> Const HpackExecutable HpackExecutable)
        -> PantryConfig -> Const HpackExecutable PantryConfig)
    -> Getting HpackExecutable env HpackExecutable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(PantryConfig -> HpackExecutable)
    -> SimpleGetter PantryConfig HpackExecutable
    forall s a. (s -> a) -> SimpleGetter s a
    to PantryConfig -> HpackExecutable
    pcHpackExecutable
        case HpackExecutable
    he of
          HpackExecutable
    HpackBundled -> do
            Result
    r <- IO Result -> RIO env Result
    forall a. IO a -> RIO env a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> RIO env Result) -> IO Result -> RIO env Result
    forall a b. (a -> b) -> a -> b
    $ Options -> IO Result
    Hpack.hpackResult (Options -> IO Result) -> Options -> IO Result
    forall a b. (a -> b) -> a -> b
    $ ProgramName -> Options -> Options
    Hpack.setProgramName ProgramName
    "stack" (Options -> Options) -> Options -> Options
    forall a b. (a -> b) -> a -> b
    $
              String -> Options -> Options
    Hpack.setTarget (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    hpackFile) Options
    Hpack.defaultOptions
            [String] -> (String -> RIO env ()) -> RIO env ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Result -> [String]
    Hpack.resultWarnings Result
    r) (Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ())
    -> (String -> Utf8Builder) -> String -> RIO env ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString)
            let cabalFile :: Utf8Builder
    cabalFile = String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (String -> Utf8Builder)
    -> (Result -> String) -> Result -> Utf8Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> String
    Hpack.resultCabalFile (Result -> Utf8Builder) -> Result -> Utf8Builder
    forall a b. (a -> b) -> a -> b
    $ Result
    r
            case Result -> Status
    Hpack.resultStatus Result
    r of
              Status
    Hpack.Generated -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                   Utf8Builder
    "hpack generated a modified version of "
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    cabalFile
              Status
    Hpack.OutputUnchanged -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                   Utf8Builder
    "hpack output unchanged in "
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    cabalFile
              Status
    Hpack.AlreadyGeneratedByNewerHpack -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                   Utf8Builder
    cabalFile
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " was generated with a newer version of hpack. Ignoring "
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    hpackFile)
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " in favor of the Cabal file.\n"
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "Either please upgrade and try again or, if you want to use the "
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Rel File -> String
    forall b t. Path b t -> String
    toFilePath (Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename Path Abs File
    hpackFile))
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " file instead of the Cabal file,\n"
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "then please delete the Cabal file."
              Status
    Hpack.ExistingCabalFileWasModifiedManually -> Utf8Builder -> RIO env ()
    forall (m :: * -> *) env.
    (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
    Utf8Builder -> m ()
    logWarn (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
                   Utf8Builder
    cabalFile
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " was modified manually. Ignoring "
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Abs File -> String
    forall b t. Path b t -> String
    toFilePath Path Abs File
    hpackFile)
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " in favor of the Cabal file.\n"
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "If you want to use the "
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> String -> Utf8Builder
    forall a. IsString a => String -> a
    fromString (Path Rel File -> String
    forall b t. Path b t -> String
    toFilePath (Path Abs File -> Path Rel File
    forall b. Path b File -> Path Rel File
    filename Path Abs File
    hpackFile))
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    " file instead of the Cabal file,\n"
                Utf8Builder -> Utf8Builder -> Utf8Builder
    forall a. Semigroup a => a -> a -> a
    <> Utf8Builder
    "then please delete the Cabal file."
          HpackCommand String
    command ->
            String -> RIO env () -> RIO env ()
    forall env (m :: * -> *) a.
    (HasProcessContext env, MonadReader env m, MonadIO m) =>
    String -> m a -> m a
    withWorkingDir (Path Abs Dir -> String
    forall b t. Path b t -> String
    toFilePath Path Abs Dir
    pkgDir) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $
            String
    -> [String] -> (ProcessConfig () () () -> RIO env ()) -> RIO env ()
    forall env (m :: * -> *) a.
    (HasProcessContext env, HasLogFunc env, MonadReader env m,
     MonadIO m, HasCallStack) =>
    String -> [String] -> (ProcessConfig () () () -> m a) -> m a
    proc String
    command [] ProcessConfig () () () -> RIO env ()
    forall (m :: * -> *) stdin stdout stderr.
    MonadIO m =>
    ProcessConfig stdin stdout stderr -> m ()
    runProcess_