{-# LANGUAGE TupleSections #-} module HaskellWorks.CabalCache.Metadata where import Control.Lens ((<&>)) import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO, liftIO) import HaskellWorks.CabalCache.Core (PackageInfo (..)) import HaskellWorks.CabalCache.IO.Tar (TarGroup (..)) import System.FilePath (takeFileName, (</>)) import qualified Data.ByteString.Lazy as LBS import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified System.Directory as IO metaDir :: String metaDir :: String metaDir = String "_CC_METADATA" createMetadata :: MonadIO m => FilePath -> PackageInfo -> [(T.Text, LBS.ByteString)] -> m TarGroup createMetadata :: String -> PackageInfo -> [(Text, ByteString)] -> m TarGroup createMetadata String storePath PackageInfo pkg [(Text, ByteString)] values = IO TarGroup -> m TarGroup forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO TarGroup -> m TarGroup) -> IO TarGroup -> m TarGroup forall a b. (a -> b) -> a -> b $ do let pkgMetaPath :: String pkgMetaPath = String storePath String -> String -> String </> PackageInfo -> String packageDir PackageInfo pkg String -> String -> String </> String metaDir Bool -> String -> IO () IO.createDirectoryIfMissing Bool True String pkgMetaPath [(Text, ByteString)] -> ((Text, ByteString) -> IO ()) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [(Text, ByteString)] values (((Text, ByteString) -> IO ()) -> IO ()) -> ((Text, ByteString) -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \(Text k, ByteString v) -> String -> ByteString -> IO () LBS.writeFile (String pkgMetaPath String -> String -> String </> Text -> String T.unpack Text k) ByteString v TarGroup -> IO TarGroup forall (f :: * -> *) a. Applicative f => a -> f a pure (TarGroup -> IO TarGroup) -> TarGroup -> IO TarGroup forall a b. (a -> b) -> a -> b $ String -> [String] -> TarGroup TarGroup String storePath [PackageInfo -> String packageDir PackageInfo pkg String -> String -> String </> String metaDir] loadMetadata :: MonadIO m => FilePath -> m (Map.Map T.Text LBS.ByteString) loadMetadata :: String -> m (Map Text ByteString) loadMetadata String pkgStorePath = IO (Map Text ByteString) -> m (Map Text ByteString) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Map Text ByteString) -> m (Map Text ByteString)) -> IO (Map Text ByteString) -> m (Map Text ByteString) forall a b. (a -> b) -> a -> b $ do let pkgMetaPath :: String pkgMetaPath = String pkgStorePath String -> String -> String </> String metaDir Bool exists <- String -> IO Bool IO.doesDirectoryExist String pkgMetaPath if Bool -> Bool not Bool exists then Map Text ByteString -> IO (Map Text ByteString) forall (f :: * -> *) a. Applicative f => a -> f a pure Map Text ByteString forall k a. Map k a Map.empty else String -> IO [String] IO.listDirectory String pkgMetaPath IO [String] -> ([String] -> [String]) -> IO [String] forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (String -> String) -> [String] -> [String] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (String pkgMetaPath String -> String -> String </>) IO [String] -> ([String] -> IO [(Text, ByteString)]) -> IO [(Text, ByteString)] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (String -> IO (Text, ByteString)) -> [String] -> IO [(Text, ByteString)] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (\String mfile -> (String -> Text T.pack (String -> String takeFileName String mfile),) (ByteString -> (Text, ByteString)) -> IO ByteString -> IO (Text, ByteString) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> String -> IO ByteString LBS.readFile String mfile) IO [(Text, ByteString)] -> ([(Text, ByteString)] -> Map Text ByteString) -> IO (Map Text ByteString) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> [(Text, ByteString)] -> Map Text ByteString forall k a. Ord k => [(k, a)] -> Map k a Map.fromList deleteMetadata :: MonadIO m => FilePath -> m () deleteMetadata :: String -> m () deleteMetadata String pkgStorePath = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ String -> IO () IO.removeDirectoryRecursive (String pkgStorePath String -> String -> String </> String metaDir)