-- |
-- Module    : Aura.Pkgbuild.Records
-- Copyright : (c) Colin Woodbury, 2012 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Handle the storing of PKGBUILDs.

module Aura.Pkgbuild.Records
  ( hasPkgbuildStored
  , storePkgbuilds
  , pkgbuildPath
  ) where

import           Aura.Types
import           RIO
import           RIO.Directory
import           RIO.FilePath
import qualified RIO.Text as T

---

-- | The default location: \/var\/cache\/aura\/pkgbuilds\/
pkgbuildCache :: FilePath
pkgbuildCache :: FilePath
pkgbuildCache = FilePath
"/var/cache/aura/pkgbuilds/"

-- | The expected path to a stored PKGBUILD, given some package name.
pkgbuildPath :: PkgName -> FilePath
pkgbuildPath :: PkgName -> FilePath
pkgbuildPath (PkgName Text
p) = FilePath
pkgbuildCache FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack Text
p FilePath -> FilePath -> FilePath
<.> FilePath
"pb"

-- | Does a given package has a PKGBUILD stored?
-- This is `True` when a package has been built successfully once before.
hasPkgbuildStored :: PkgName -> IO Bool
hasPkgbuildStored :: PkgName -> IO Bool
hasPkgbuildStored = FilePath -> IO Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesFileExist (FilePath -> IO Bool)
-> (PkgName -> FilePath) -> PkgName -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgName -> FilePath
pkgbuildPath

-- | Write the PKGBUILDs of some `Buildable`s to disk.
storePkgbuilds :: NonEmpty Buildable -> IO ()
storePkgbuilds :: NonEmpty Buildable -> IO ()
storePkgbuilds NonEmpty Buildable
bs = do
  Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True FilePath
pkgbuildCache
  (Buildable -> IO ()) -> NonEmpty Buildable -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\Buildable
p -> PkgName -> Pkgbuild -> IO ()
writePkgbuild (Buildable -> PkgName
bName Buildable
p) (Buildable -> Pkgbuild
bPkgbuild Buildable
p)) NonEmpty Buildable
bs

writePkgbuild :: PkgName -> Pkgbuild -> IO ()
writePkgbuild :: PkgName -> Pkgbuild -> IO ()
writePkgbuild PkgName
pn (Pkgbuild ByteString
pb) = FilePath -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBinary (PkgName -> FilePath
pkgbuildPath PkgName
pn) ByteString
pb