src/Destination.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

module Destination (
    Destination,
    DeclaredDestination(..),
    DestinationName(..), textDestinationName, showDestinationName,

    openDestination,
    copyToDestination,

    copyRecursive,
    copyRecursiveForce,
) where

import Control.Monad.IO.Class

import Data.Text (Text)
import Data.Text qualified as T

import System.FilePath
import System.Directory

import FileUtils


data Destination
    = FilesystemDestination FilePath

data DeclaredDestination = DeclaredDestination
    { destinationName :: DestinationName
    , destinationUrl :: Maybe Text
    }


newtype DestinationName = DestinationName Text
    deriving (Eq, Ord, Show)

textDestinationName :: DestinationName -> Text
textDestinationName (DestinationName text) = text

showDestinationName :: DestinationName -> String
showDestinationName = T.unpack . textDestinationName


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