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

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

module Files (FsException (..), ensuredFile, allPathsIn, overwrite) where

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

data FsException
  = FileDoesNotExist {FsException -> FilePath
_file :: FilePath}
  | DirectoryDoesNotExist {FsException -> FilePath
_dir :: FilePath}
  | PathIsDirectory {FsException -> FilePath
_path :: FilePath}
  deriving (Show FsException
Typeable FsException
(Typeable FsException, Show FsException) =>
(FsException -> SomeException)
-> (SomeException -> Maybe FsException)
-> (FsException -> FilePath)
-> Exception FsException
SomeException -> Maybe FsException
FsException -> FilePath
FsException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> FilePath) -> Exception e
$ctoException :: FsException -> SomeException
toException :: FsException -> SomeException
$cfromException :: SomeException -> Maybe FsException
fromException :: SomeException -> Maybe FsException
$cdisplayException :: FsException -> FilePath
displayException :: FsException -> FilePath
Exception)

instance Show FsException where
  show :: FsException -> FilePath
show FileDoesNotExist{FilePath
_file :: FsException -> FilePath
_file :: FilePath
..} = FilePath -> ShowS
forall r. PrintfType r => FilePath -> r
printf FilePath
"File '%s' does not exist" FilePath
_file
  show DirectoryDoesNotExist{FilePath
_dir :: FsException -> FilePath
_dir :: FilePath
..} = FilePath -> ShowS
forall r. PrintfType r => FilePath -> r
printf FilePath
"Directory '%s' does not exist" FilePath
_dir
  show PathIsDirectory{FilePath
_path :: FsException -> FilePath
_path :: FilePath
..} = FilePath -> ShowS
forall r. PrintfType r => FilePath -> r
printf FilePath
"'%s' is a directory, while a file is expected" FilePath
_path

ensuredFile :: FilePath -> IO FilePath
ensuredFile :: FilePath -> IO FilePath
ensuredFile FilePath
pth = do
  Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
pth
  if Bool
isDir
    then FsException -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO (FilePath -> FsException
PathIsDirectory FilePath
pth)
    else do
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
pth
      if Bool
exists then FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
pth else FsException -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO (FilePath -> FsException
FileDoesNotExist FilePath
pth)

overwrite :: FilePath -> String -> IO ()
overwrite :: FilePath -> FilePath -> IO ()
overwrite FilePath
path FilePath
content = do
  Bool
link <- FilePath -> IO Bool
pathIsSymbolicLink FilePath
path IO Bool -> (IOException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  FilePath
file <- if Bool
link then FilePath -> IO FilePath
canonicalizePath FilePath
path else FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
path
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory FilePath
file)
  (FilePath
temp, Handle
handle) <- FilePath -> FilePath -> IO (FilePath, Handle)
openTempFileWithDefaultPermissions (ShowS
takeDirectory FilePath
file) (ShowS
takeFileName FilePath
file)
  FilePath -> FilePath -> Handle -> IO ()
replace FilePath
file FilePath
temp Handle
handle IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` (Handle -> IO ()
hClose Handle
handle IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
removeFile FilePath
temp)
  where
    replace :: FilePath -> FilePath -> Handle -> IO ()
    replace :: FilePath -> FilePath -> Handle -> IO ()
replace FilePath
file FilePath
temp Handle
handle = do
      Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
utf8
      Handle -> FilePath -> IO ()
hPutStr Handle
handle FilePath
content
      Handle -> IO ()
hClose Handle
handle
      Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
file
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (FilePath -> FilePath -> IO ()
copyPermissions FilePath
file FilePath
temp)
      FilePath -> FilePath -> IO ()
renameFile FilePath
temp FilePath
file

allPathsIn :: FilePath -> IO [FilePath]
allPathsIn :: FilePath -> IO [FilePath]
allPathsIn FilePath
dir = do
  Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
  [FilePath]
names <- if Bool
exists then FilePath -> IO [FilePath]
listDirectory FilePath
dir else FsException -> IO [FilePath]
forall e a. Exception e => e -> IO a
throwIO (FilePath -> FsException
DirectoryDoesNotExist FilePath
dir)
  let nested :: [FilePath]
nested = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> ShowS
</>) [FilePath]
names
  [[FilePath]]
paths <-
    [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
      [FilePath]
nested
      ( \FilePath
path -> do
          Bool
isLink <- FilePath -> IO Bool
pathIsSymbolicLink FilePath
path
          Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
          if Bool
isLink
            then [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
            else
              if Bool
isDir
                then FilePath -> IO [FilePath]
allPathsIn FilePath
path
                else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
      )
  [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
paths)