publish-2.1.3: src/Utilities.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Utilities
  ( ensureDirectory,
    execProcess,
    ifNewer,
    isNewer,
  )
where

import Chrono.Compat (convertToUTC)
import Control.Monad (when)
import Core.Program
import Core.System
import Core.Text
import qualified Data.List as List (intercalate)
import System.Directory
  ( createDirectoryIfMissing,
    doesDirectoryExist,
    doesFileExist,
    getModificationTime,
  )
import System.Exit (ExitCode (..))
import System.FilePath.Posix (takeDirectory)
import System.Process.Typed (closed, proc, readProcess, setStdin)

{-
Some source files live in subdirectories. Replicate that directory
structure in the temporary build space
-}
ensureDirectory :: FilePath -> Program t ()
ensureDirectory target =
  let subdir = takeDirectory target
   in liftIO $ do
        probe <- doesDirectoryExist subdir
        when (not probe) $ do
          createDirectoryIfMissing True subdir

{-
Thin wrapper around **typed-process**'s `readProcess` so that the command
to be executed can be logged. Bit of an annoyance that the command and the
arguments have to be specified to `proc` separately, but that's _execvp(3)_
for you.

TODO this could potentially move to the **unbeliever** library
-}
execProcess :: [String] -> Program t (ExitCode, Rope, Rope)
execProcess [] = error "No command provided"
execProcess (cmd : args) =
  let task = proc cmd args
      task' = setStdin closed task
      command = List.intercalate " " (cmd : args)
   in do
        debugS "command" command

        (exit, out, err) <- liftIO $ do
          readProcess task'

        return (exit, intoRope out, intoRope err)

-- |
-- If the source file is newer than the target file, then run an action. For
-- example, if you want to install a file but only do so if the file has been
-- rebuilt, then you could do this:
--
-- @
-- copyFileIfNewer :: 'FilePath' -> 'FilePath' -> 'Program' τ ()
-- copyFileIfNewer source target = do
--     'ifNewer' source target $ do
--         'liftIO' ('copyFileWithMetadata' source target)
-- @
--
-- This is basically a build system in a box, although the usual caveats
-- about the brittleness of timestamps apply.
--
-- TODO this could potentially move to the **unbeliever** library
ifNewer :: FilePath -> FilePath -> Program t () -> Program t ()
ifNewer source target program = do
  changed <- isNewer source target
  when changed $ do
    program

isNewer :: FilePath -> FilePath -> Program t Bool
isNewer source target = liftIO $ do
  time1 <- getModificationTime source
  time2 <- doesFileExist target >>= \case
    True -> getModificationTime target
    False -> return (convertToUTC 0) -- the epoch
  return (time1 > time2)