{-# 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)