{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns      #-}

module Pantry.Tree
  ( unpackTree
  , rawParseGPD
  ) where

import           Distribution.PackageDescription ( GenericPackageDescription )
import           Distribution.PackageDescription.Parsec
import           Distribution.Parsec ( PWarning (..) )
import           Pantry.Storage hiding
                   ( Tree, TreeEntry, findOrGenerateCabalFile )
import           Pantry.Types
import           Path ( Abs, Dir, File, Path, toFilePath )
import           RIO
import qualified RIO.ByteString as B
import           RIO.Directory
                   ( createDirectoryIfMissing, getPermissions
                   , setOwnerExecutable, setPermissions
                   )
import           RIO.FilePath ((</>), takeDirectory)
import qualified RIO.Map as Map
import qualified RIO.Text as T

unpackTree ::
     (HasPantryConfig env, HasLogFunc env)
  => RawPackageLocationImmutable -- for exceptions

  -> Path Abs Dir -- ^ dest dir, will be created if necessary

  -> Tree
  -> RIO env ()
unpackTree :: forall env.
(HasPantryConfig env, HasLogFunc env) =>
RawPackageLocationImmutable -> Path Abs Dir -> Tree -> RIO env ()
unpackTree RawPackageLocationImmutable
rpli (forall b t. Path b t -> FilePath
toFilePath -> FilePath
dir) (TreeMap Map SafeFilePath TreeEntry
m) = do
  forall env a.
(HasPantryConfig env, HasLogFunc env) =>
ReaderT SqlBackend (RIO env) a -> RIO env a
withStorage forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall k a. Map k a -> [(k, a)]
Map.toList Map SafeFilePath TreeEntry
m) forall a b. (a -> b) -> a -> b
$ \(SafeFilePath
sfp, TreeEntry BlobKey
blobKey FileType
ft) -> do
    let dest :: FilePath
dest = FilePath
dir FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (SafeFilePath -> Text
unSafeFilePath SafeFilePath
sfp)
    forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
dest
    Maybe ByteString
mbs <- forall env.
HasLogFunc env =>
BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
loadBlob BlobKey
blobKey
    case Maybe ByteString
mbs of
      Maybe ByteString
Nothing -> do
        -- TODO when we have pantry wire stuff, try downloading

        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ RawPackageLocationImmutable
-> SafeFilePath -> BlobKey -> PantryException
TreeReferencesMissingBlob RawPackageLocationImmutable
rpli SafeFilePath
sfp BlobKey
blobKey
      Just ByteString
bs -> do
        forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
B.writeFile FilePath
dest ByteString
bs
        case FileType
ft of
          FileType
FTNormal -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          FileType
FTExecutable -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
            Permissions
perms <- forall (m :: * -> *). MonadIO m => FilePath -> m Permissions
getPermissions FilePath
dest
            forall (m :: * -> *). MonadIO m => FilePath -> Permissions -> m ()
setPermissions FilePath
dest forall a b. (a -> b) -> a -> b
$ Bool -> Permissions -> Permissions
setOwnerExecutable Bool
True Permissions
perms

-- | A helper function that performs the basic character encoding necessary.

rawParseGPD ::
     MonadThrow m
  => Either RawPackageLocationImmutable (Path Abs File)
  -> ByteString
  -> m ([PWarning], GenericPackageDescription)
rawParseGPD :: forall (m :: * -> *).
MonadThrow m =>
Either RawPackageLocationImmutable (Path Abs File)
-> ByteString -> m ([PWarning], GenericPackageDescription)
rawParseGPD Either RawPackageLocationImmutable (Path Abs File)
loc ByteString
bs =
  case Either (Maybe Version, NonEmpty PError) GenericPackageDescription
eres of
    Left (Maybe Version
mversion, NonEmpty PError
errs) ->
      forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Either RawPackageLocationImmutable (Path Abs File)
-> Maybe Version -> [PError] -> [PWarning] -> PantryException
InvalidCabalFile Either RawPackageLocationImmutable (Path Abs File)
loc Maybe Version
mversion (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PError
errs) [PWarning]
warnings
    Right GenericPackageDescription
gpkg -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PWarning]
warnings, GenericPackageDescription
gpkg)
 where
  ([PWarning]
warnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
eres) = forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
bs