{-# 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 qualified System.FilePath.Find 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 -> FilePath -> IO [FileInfo]
findWithInfo RecursionPredicate
recurse RecursionPredicate
filt FilePath
dir = RecursionPredicate
-> ([FileInfo] -> FileInfo -> [FileInfo])
-> [FileInfo]
-> FilePath
-> IO [FileInfo]
forall a.
RecursionPredicate -> (a -> FileInfo -> a) -> a -> FilePath -> IO a
Find.fold RecursionPredicate
recurse [FileInfo] -> FileInfo -> [FileInfo]
act [] FilePath
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 :: FilePath -> FilePath -> IO ()
copyDirContent FilePath
src FilePath
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 (FilePath -> FilePath -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun FilePath
src FilePath
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 FilePath
d           -> Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
d
  CopyFile FilePath
src FilePath
dest -> FilePath -> FilePath -> IO ()
copyIfChanged FilePath
src FilePath
dest

-- | @copyDirContentDryRun src dest@ creates a to-do list
--   for recursively copying directory @src@ onto @dest@.
--
copyDirContentDryRun :: FilePath -> FilePath -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun :: FilePath -> FilePath -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun FilePath
src FilePath
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 (FilePath -> CopyDirAction
MkDir FilePath
dest CopyDirAction -> [CopyDirAction] -> [CopyDirAction]
forall a. a -> [a] -> [a]
:)
  chlds <- IO [FilePath] -> WriterT (Endo [CopyDirAction]) IO [FilePath]
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 [FilePath] -> WriterT (Endo [CopyDirAction]) IO [FilePath])
-> IO [FilePath] -> WriterT (Endo [CopyDirAction]) IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
src
  forM_ chlds $ \ FilePath
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
$ FilePath -> IO Bool
doesDirectoryExist (FilePath
src FilePath -> FilePath -> FilePath
</> FilePath
x)
    case isDir of
      Bool
_ | FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." Bool -> Bool -> Bool
|| FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".." -> () -> WriterT (Endo [CopyDirAction]) IO ()
forall a. a -> WriterT (Endo [CopyDirAction]) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Bool
True  -> FilePath -> FilePath -> WriterT (Endo [CopyDirAction]) IO ()
copyDirContentDryRun (FilePath
src FilePath -> FilePath -> FilePath
</> FilePath
x) (FilePath
dest FilePath -> FilePath -> FilePath
</> FilePath
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 (FilePath -> FilePath -> CopyDirAction
CopyFile (FilePath
src FilePath -> FilePath -> FilePath
</> FilePath
x) (FilePath
dest FilePath -> FilePath -> FilePath
</> FilePath
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 :: FilePath -> FilePath -> IO ()
copyIfChanged FilePath
src FilePath
dst = do
  exist <- FilePath -> IO Bool
doesFileExist FilePath
dst
  if not exist then copyFile src dst else do
    new <- BS.readFile src
    old <- BS.readFile dst
    unless (old == new) $ copyFile src dst