module Hix.Managed.Handlers.StateFile.Prod where

import qualified Data.Text.IO as Text
import Path (Abs, File, Path, parent, toFilePath, (</>), Dir)
import Path.IO (createDirIfMissing, doesDirExist, doesFileExist)
import System.Posix (fileMode, getFileStatus, ownerWriteMode, setFileMode, unionFileModes)

import Hix.Data.NixExpr (Expr)
import qualified Hix.Managed.Data.StateFileConfig
import Hix.Managed.Data.StateFileConfig (StateFileConfig)
import Hix.Managed.Handlers.StateFile (StateFileHandlers (..))
import Hix.Managed.Path (rootOrCwd)
import Hix.Monad (M, tryIOM)
import Hix.NixExpr (renderRootExpr)

setDepsFileWritable ::
  Path Abs File ->
  M ()
setDepsFileWritable :: Path Abs File -> M ()
setDepsFileWritable Path Abs File
file =
  IO () -> M ()
forall a. IO a -> M a
tryIOM do
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs Dir -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
dir) do
      IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Path Abs File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
file) do
        FileStatus
fileCur <- FilePath -> IO FileStatus
getFileStatus FilePath
fileFp
        FilePath -> FileMode -> IO ()
setWrite FilePath
fileFp (FileStatus -> FileMode
fileMode FileStatus
fileCur)
  where
    setWrite :: FilePath -> FileMode -> IO ()
setWrite FilePath
path FileMode
cur = FilePath -> FileMode -> IO ()
setFileMode FilePath
path (FileMode -> FileMode -> FileMode
unionFileModes FileMode
cur FileMode
ownerWriteMode)
    fileFp :: FilePath
fileFp = Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
file
    dir :: Path Abs Dir
dir = Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
file

initFile ::
  StateFileConfig ->
  Maybe (Path Abs Dir) ->
  M (Path Abs File)
initFile :: StateFileConfig -> Maybe (Path Abs Dir) -> M (Path Abs File)
initFile StateFileConfig
conf Maybe (Path Abs Dir)
tmpRoot = do
  Path Abs Dir
root <- M (Path Abs Dir)
-> (Path Abs Dir -> M (Path Abs Dir))
-> Maybe (Path Abs Dir)
-> M (Path Abs Dir)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Path Abs Dir) -> M (Path Abs Dir)
rootOrCwd StateFileConfig
conf.projectRoot) Path Abs Dir -> M (Path Abs Dir)
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs Dir)
tmpRoot
  let depsFile :: Path Abs File
depsFile = Path Abs Dir
root Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> StateFileConfig
conf.file
  Bool -> Path Abs Dir -> M ()
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
False (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
depsFile)
  Path Abs File -> M ()
setDepsFileWritable Path Abs File
depsFile
  pure Path Abs File
depsFile

writeFile ::
  StateFileConfig ->
  Maybe (Path Abs Dir) ->
  Expr ->
  M ()
writeFile :: StateFileConfig -> Maybe (Path Abs Dir) -> Expr -> M ()
writeFile StateFileConfig
conf Maybe (Path Abs Dir)
tmpRoot Expr
nixExpr = do
  Path Abs File
path <- StateFileConfig -> Maybe (Path Abs Dir) -> M (Path Abs File)
initFile StateFileConfig
conf Maybe (Path Abs Dir)
tmpRoot
  IO () -> M ()
forall a. IO a -> M a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> Text -> IO ()
Text.writeFile (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
path) (Expr -> Text
renderRootExpr Expr
nixExpr))

handlersProd ::
  StateFileConfig ->
  StateFileHandlers
handlersProd :: StateFileConfig -> StateFileHandlers
handlersProd StateFileConfig
conf =
  StateFileHandlers {writeFile :: Maybe (Path Abs Dir) -> Expr -> M ()
writeFile = StateFileConfig -> Maybe (Path Abs Dir) -> Expr -> M ()
writeFile StateFileConfig
conf}