summaryrefslogtreecommitdiff
path: root/src/Destination.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Destination.hs')
-rw-r--r--src/Destination.hs48
1 files changed, 44 insertions, 4 deletions
diff --git a/src/Destination.hs b/src/Destination.hs
index f96e88c..dccac03 100644
--- a/src/Destination.hs
+++ b/src/Destination.hs
@@ -1,14 +1,22 @@
module Destination (
Destination,
DeclaredDestination(..),
- DestinationName(..),
+ DestinationName(..), textDestinationName, showDestinationName,
openDestination,
+ copyToDestination,
+
+ copyRecursive,
+ copyRecursiveForce,
) where
+import Control.Monad
+import Control.Monad.IO.Class
+
import Data.Text (Text)
import Data.Text qualified as T
+import System.FilePath
import System.Directory
@@ -24,9 +32,41 @@ data DeclaredDestination = DeclaredDestination
newtype DestinationName = DestinationName Text
deriving (Eq, Ord, Show)
+textDestinationName :: DestinationName -> Text
+textDestinationName (DestinationName text) = text
+
+showDestinationName :: DestinationName -> String
+showDestinationName = T.unpack . textDestinationName
+
-openDestination :: Text -> IO Destination
-openDestination url = do
- let path = T.unpack url
+openDestination :: FilePath -> Text -> IO Destination
+openDestination baseDir url = do
+ let path = baseDir </> T.unpack url
createDirectoryIfMissing True path
return $ FilesystemDestination path
+
+copyToDestination :: MonadIO m => FilePath -> Destination -> FilePath -> m ()
+copyToDestination source (FilesystemDestination base) inner = do
+ let target = base </> dropWhile isPathSeparator inner
+ liftIO $ do
+ createDirectoryIfMissing True $ takeDirectory target
+ copyRecursiveForce source target
+
+
+copyRecursive :: FilePath -> FilePath -> IO ()
+copyRecursive from to = do
+ doesDirectoryExist from >>= \case
+ False -> do
+ copyFile from to
+ True -> do
+ createDirectory to
+ content <- listDirectory from
+ forM_ content $ \name -> do
+ copyRecursive (from </> name) (to </> name)
+
+copyRecursiveForce :: FilePath -> FilePath -> IO ()
+copyRecursiveForce from to = do
+ doesDirectoryExist to >>= \case
+ False -> return ()
+ True -> removeDirectoryRecursive to
+ copyRecursive from to