{-# LANGUAGE OverloadedStrings #-}

module HaskellWorks.CabalCache.IO.File
  ( copyDirectoryRecursive
  , listMaybeDirectory
  ) where

import Control.Monad.Except

import qualified Data.Text                          as T
import qualified HaskellWorks.CabalCache.IO.Console as CIO
import qualified System.Directory                   as IO
import qualified System.Exit                        as IO
import qualified System.Process                     as IO

copyDirectoryRecursive :: MonadIO m => FilePath -> FilePath -> ExceptT String m ()
copyDirectoryRecursive :: FilePath -> FilePath -> ExceptT FilePath m ()
copyDirectoryRecursive FilePath
source FilePath
target = do
  Text -> ExceptT FilePath m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> ExceptT FilePath m ()) -> Text -> ExceptT FilePath m ()
forall a b. (a -> b) -> a -> b
$ Text
"Copying recursively from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
target
  ProcessHandle
process <- IO ProcessHandle -> ExceptT FilePath m ProcessHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessHandle -> ExceptT FilePath m ProcessHandle)
-> IO ProcessHandle -> ExceptT FilePath m ProcessHandle
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ProcessHandle
IO.spawnProcess FilePath
"cp" [FilePath
"-r", FilePath
source, FilePath
target]
  ExitCode
exitCode <- IO ExitCode -> ExceptT FilePath m ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> ExceptT FilePath m ExitCode)
-> IO ExitCode -> ExceptT FilePath m ExitCode
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
IO.waitForProcess ProcessHandle
process
  case ExitCode
exitCode of
    ExitCode
IO.ExitSuccess   -> () -> ExceptT FilePath m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IO.ExitFailure Int
n -> FilePath -> ExceptT FilePath m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> ExceptT FilePath m ())
-> FilePath -> ExceptT FilePath m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"cp exited with " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n

listMaybeDirectory :: MonadIO m => FilePath -> m [FilePath]
listMaybeDirectory :: FilePath -> m [FilePath]
listMaybeDirectory FilePath
filepath = do
  Bool
exists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
IO.doesDirectoryExist FilePath
filepath
  if Bool
exists
    then IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
IO.listDirectory FilePath
filepath
    else [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []