document-build-0.1.0.0: src/Document/Build/File.hs

{-# OPTIONS_GHC -Wall #-}

-- | Commands that find, copy, read, write and archive files.
module Document.Build.File (
  -- * Finding
  whenFileExists,
  filesIn,
  filesWithExtension,

  -- * Copying
  copyTo,
  copyDirectoryTo,

  -- * Text
  readUtf8,
  writeUtf8,

  -- * Archives
  tarGz,
) where

import Control.Lens (view, _Wrapped)
import Control.Monad.Trans.Class (lift)
import Data.Bool (bool)
import qualified Data.ByteString as ByteString
import Data.Functor (($>))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Document.Build.Build (Build, Command, createParentDirectory, expectOutput, failBuild, io, processWith, requireDirectory, requireInput)
import Document.Build.Error (BuildError (..), CommandLine (..), ReviewBuildError)
import System.Directory (copyFileWithMetadata, doesDirectoryExist, doesFileExist, makeAbsolute)
import System.FilePath (makeRelative, (</>))
import System.FilePather.Combinators (directoryFiles, hasExtension)
import System.FilePather.FilePather (FilePather (..))
import System.Process (cwd)

{- | A value if a file exists, and 'mempty' otherwise, such as options for a
template that a project may have:

@
whenFileExists "etc/template.html" ["--template", "etc/template.html"]
@

@since 0.1.0.0
-}
whenFileExists :: (Monoid a) => FilePath -> a -> Build e a
whenFileExists p a =
  bool mempty a <$> io (doesFileExist p)

{- | The files in a directory and its subdirectories, in sorted order, or none
if the directory does not exist.

@since 0.1.0.0
-}
filesIn :: FilePath -> Build e [FilePath]
filesIn d =
  io (doesDirectoryExist d)
    >>= bool (pure []) (view _Wrapped directoryFiles d)

{- | The files with one of the extensions in a directory and its
subdirectories, in sorted order, or none if the directory does not exist.

@since 0.1.0.0
-}
filesWithExtension :: [String] -> FilePath -> Build e [FilePath]
filesWithExtension exts =
  fmap (filter (hasExtension exts)) . filesIn

{- | Copy the file being operated on to a file path, creating its directory if
needed, and return the file path.

@since 0.1.0.0
-}
copyTo :: (ReviewBuildError e) => FilePath -> Command e FilePath
copyTo o =
  do
    i <- requireInput
    lift (createParentDirectory o *> io (copyFileWithMetadata i o))
    pure o

{- | Copy every file in the directory being operated on, and its
subdirectories, to the same relative path in another directory, and return
the copied file paths. This is like @rsync -a src/ dst@.

Fails with 'InputFileMissing' if the directory does not exist.

@since 0.1.0.0
-}
copyDirectoryTo :: (ReviewBuildError e) => FilePath -> Command e [FilePath]
copyDirectoryTo o =
  do
    d <- requireDirectory
    fs <- directoryFiles
    lift (traverse (\f -> let t = o </> makeRelative d f in ((createParentDirectory t *> io (copyFileWithMetadata f t)) $> t)) fs)

{- | Read a file as UTF-8 text. Fails with 'InputFileMissing' if it does not
exist, and 'FileNotUtf8' if it is not valid UTF-8.

@since 0.1.0.0
-}
readUtf8 :: (ReviewBuildError e) => FilePath -> Build e Text
readUtf8 p =
  do
    _ <- view _Wrapped requireInput p
    b <- io (ByteString.readFile p)
    either (const (failBuild (FileNotUtf8 p))) pure (decodeUtf8' b)

{- | Write text to a file as UTF-8, creating its directory if needed, and
return the file path.

@since 0.1.0.0
-}
writeUtf8 :: FilePath -> Text -> Build e FilePath
writeUtf8 p t =
  (createParentDirectory p *> io (ByteString.writeFile p (encodeUtf8 t))) $> p

{- | Create a gzipped tar archive of files in the directory being operated
on, and return the file path of the archive. The files are given relative to
the directory, and are stored in the archive with those paths. An empty list
of files creates an empty archive.

@since 0.1.0.0
-}
tarGz :: (ReviewBuildError e) => [FilePath] -> FilePath -> Command e FilePath
tarGz fs o =
  FilePather $ \d ->
    do
      createParentDirectory o
      o' <- io (makeAbsolute o)
      let c = CommandLine "tar" ["-czf", o', "--null", "--files-from=-"]
      _ <- processWith (\p -> p{cwd = Just d}) (concatMap (<> "\NUL") fs) c
      expectOutput c o