{-# OPTIONS_GHC -Wunused-imports #-}

module Agda.Utils.IO.Directory
  ( copyDirContent
  , copyIfChanged
  , findWithInfo
  )
where

import Control.Monad
import Control.Monad.Writer ( WriterT, execWriterT, tell )
import Control.Monad.Trans  ( lift )

import Data.ByteString      as BS
import Data.Monoid          ( Endo(Endo, appEndo) )

import System.Directory
import System.FilePath
import System.FilePath.Find qualified as Find


-- | Search a directory recursively, with recursion controlled by a
--   'RecursionPredicate'.  Lazily return a unsorted list of all files
--   matching the given 'FilterPredicate'.  Any errors that occur are
--   ignored, with warnings printed to 'stderr'.
findWithInfo
  :: Find.RecursionPredicate  -- ^ Control recursion into subdirectories.
  -> Find.FilterPredicate     -- ^ Decide whether a file appears in the result.
  -> FilePath                 -- ^ Directory to start searching.
  -> IO [Find.FileInfo]       -- ^ Files that matched the 'FilterPredicate'.
findWithInfo :: RecursionPredicate -> RecursionPredicate -> [Char] -> IO [FileInfo]
findWithInfo RecursionPredicate
recurse RecursionPredicate
filt [Char]
dir = RecursionPredicate
-> ([FileInfo] -> FileInfo -> [FileInfo])
-> [FileInfo]
-> [Char]
-> IO [FileInfo]
forall a.
RecursionPredicate -> (a -> FileInfo -> a) -> a -> [Char] -> IO a
Find.fold RecursionPredicate
recurse [FileInfo] -> FileInfo -> [FileInfo]
act [] [Char]
dir
  where
  -- Add file to list front when it matches the filter
  act :: [Find.FileInfo] -> Find.FileInfo -> [Find.FileInfo]
  act :: [FileInfo] -> FileInfo -> [FileInfo]
act [FileInfo]
fs FileInfo
f = if RecursionPredicate -> FileInfo -> Bool
forall a. FindClause a -> FileInfo -> a
Find.evalClause RecursionPredicate
filt FileInfo
f then FileInfo
f FileInfo -> [FileInfo] -> [FileInfo]
forall a. a -> [a] -> [a]
: [FileInfo]
fs else [FileInfo]
fs


-- | @copyDirContent src dest@ recursively copies directory @src@ onto @dest@.
--
--   First, a to-do list of copy actions is created.
--   Then, the to-do list is carried out.
--
--   This avoids copying files we have just created again, which can happen
--   if @src@ and @dest@ are not disjoint.
--   (See issue #2705.)
--
copyDirContent :: FilePath -> FilePath -> IO ()
copyDirContent :: [Char] -> [Char] -> IO ()
copyDirContent [Char]
src [Char]
dest = (CopyDirAction -> IO ()) -> [CopyDirAction] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CopyDirAction -> IO ()
performAction ([CopyDirAction] -> IO ()) -> IO [CopyDirAction] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
  (Endo [CopyDirAction] -> [CopyDirAction] -> [CopyDirAction]
forall a. Endo a -> a -> a
`appEndo` []) (Endo [CopyDirAction] -> [CopyDirAction])
-> IO (Endo [CopyDirAction]) -> IO [CopyDirAction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT (Endo [CopyDirAction]) IO () -> IO (Endo [CopyDirAction])
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT ([Char] -> [Char] -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun [Char]
src [Char]
dest)

-- | Action to be carried out for copying a directory recursively.
--
data CopyDirAction
  = MkDir    FilePath
      -- ^ Create directory if missing.
  | CopyFile FilePath FilePath
      -- ^ Copy file if changed.

-- | Perform scheduled 'CopyDirAction'.
--
performAction :: CopyDirAction -> IO ()
performAction :: CopyDirAction -> IO ()
performAction = \case
  MkDir [Char]
d           -> Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
d
  CopyFile [Char]
src [Char]
dest -> [Char] -> [Char] -> IO ()
copyIfChanged [Char]
src [Char]
dest

-- | @copyDirContentDryRun src dest@ creates a to-do list
--   for recursively copying directory @src@ onto @dest@.
--
copyDirContentDryRun :: FilePath -> FilePath -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun :: [Char] -> [Char] -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun [Char]
src [Char]
dest = do
  Endo [CopyDirAction] -> WriterT (Endo [CopyDirAction]) IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Endo [CopyDirAction] -> WriterT (Endo [CopyDirAction]) IO ())
-> Endo [CopyDirAction] -> WriterT (Endo [CopyDirAction]) IO ()
forall a b. (a -> b) -> a -> b
$ ([CopyDirAction] -> [CopyDirAction]) -> Endo [CopyDirAction]
forall a. (a -> a) -> Endo a
Endo ([Char] -> CopyDirAction
MkDir [Char]
dest CopyDirAction -> [CopyDirAction] -> [CopyDirAction]
forall a. a -> [a] -> [a]
:)
  chlds <- IO [[Char]] -> WriterT (Endo [CopyDirAction]) IO [[Char]]
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (Endo [CopyDirAction]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [[Char]] -> WriterT (Endo [CopyDirAction]) IO [[Char]])
-> IO [[Char]] -> WriterT (Endo [CopyDirAction]) IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [[Char]]
getDirectoryContents [Char]
src
  forM_ chlds $ \ [Char]
x -> do
    isDir <- IO Bool -> WriterT (Endo [CopyDirAction]) IO Bool
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT (Endo [CopyDirAction]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> WriterT (Endo [CopyDirAction]) IO Bool)
-> IO Bool -> WriterT (Endo [CopyDirAction]) IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesDirectoryExist ([Char]
src [Char] -> [Char] -> [Char]
</> [Char]
x)
    case isDir of
      Bool
_ | [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"." Bool -> Bool -> Bool
|| [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".." -> () -> WriterT (Endo [CopyDirAction]) IO ()
forall a. a -> WriterT (Endo [CopyDirAction]) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Bool
True  -> [Char] -> [Char] -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun ([Char]
src [Char] -> [Char] -> [Char]
</> [Char]
x) ([Char]
dest [Char] -> [Char] -> [Char]
</> [Char]
x)
      Bool
False -> Endo [CopyDirAction] -> WriterT (Endo [CopyDirAction]) IO ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Endo [CopyDirAction] -> WriterT (Endo [CopyDirAction]) IO ())
-> Endo [CopyDirAction] -> WriterT (Endo [CopyDirAction]) IO ()
forall a b. (a -> b) -> a -> b
$ ([CopyDirAction] -> [CopyDirAction]) -> Endo [CopyDirAction]
forall a. (a -> a) -> Endo a
Endo ([Char] -> [Char] -> CopyDirAction
CopyFile ([Char]
src [Char] -> [Char] -> [Char]
</> [Char]
x) ([Char]
dest [Char] -> [Char] -> [Char]
</> [Char]
x) CopyDirAction -> [CopyDirAction] -> [CopyDirAction]
forall a. a -> [a] -> [a]
:)

-- | @copyIfChanged src dst@ makes sure that @dst@ exists
--   and has the same content as @dst@.
--
copyIfChanged :: FilePath -> FilePath -> IO ()
copyIfChanged :: [Char] -> [Char] -> IO ()
copyIfChanged [Char]
src [Char]
dst = do
  exist <- [Char] -> IO Bool
doesFileExist [Char]
dst
  if not exist then copyFile src dst else do
    new <- BS.readFile src
    old <- BS.readFile dst
    unless (old == new) $ copyFile src dst