packages feed

phino-0.0.134: src/Files.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

-- This module accesses the filesystem: it ensures a file exists,
-- collects every file path under a directory and replaces a file atomically.
module Files (FsException (..), ensuredFile, allPathsIn, overwrite) where

import Control.Exception (Exception, onException, throwIO)
import Control.Monad (forM, when)
import System.Directory (copyPermissions, doesDirectoryExist, doesFileExist, listDirectory, removeFile, renameFile)
import System.FilePath (takeDirectory, takeFileName, (</>))
import System.IO (Handle, hClose, hPutStr, hSetEncoding, openTempFileWithDefaultPermissions, utf8)
import Text.Printf (printf)

data FsException
  = FileDoesNotExist {_file :: FilePath}
  | DirectoryDoesNotExist {_dir :: FilePath}
  deriving (Exception)

instance Show FsException where
  show FileDoesNotExist{..} = printf "File '%s' does not exist" _file
  show DirectoryDoesNotExist{..} = printf "Directory '%s' does not exist" _dir

ensuredFile :: FilePath -> IO FilePath
ensuredFile pth = do
  exists <- doesFileExist pth
  if exists then pure pth else throwIO (FileDoesNotExist pth)

overwrite :: FilePath -> String -> IO ()
overwrite file content = do
  (temp, handle) <- openTempFileWithDefaultPermissions (takeDirectory file) (takeFileName file)
  replace temp handle `onException` (hClose handle >> removeFile temp)
  where
    replace :: FilePath -> Handle -> IO ()
    replace temp handle = do
      hSetEncoding handle utf8
      hPutStr handle content
      hClose handle
      exists <- doesFileExist file
      when exists (copyPermissions file temp)
      renameFile temp file

-- Recursively collect all file paths in provided directory
allPathsIn :: FilePath -> IO [FilePath]
allPathsIn dir = do
  exists <- doesDirectoryExist dir
  names <- if exists then listDirectory dir else throwIO (DirectoryDoesNotExist dir)
  let nested = map (dir </>) names
  paths <-
    forM
      nested
      ( \path -> do
          isDir <- doesDirectoryExist path
          if isDir
            then allPathsIn path
            else return [path]
      )
  return (concat paths)