blob: 567c22ea1a8ab55a03f30e3583a04d9716cbcb95 (
plain)
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
55
56
57
58
59
60
61
62
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module PhotoStore where
import Control.Exception
import Control.Exception.Base
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Either
import Data
import Data.List
import GHC.Generics
import Prelude
import System.Directory
import System.FilePath
import System.IO.Error
data Config = Config
{ pendingPath :: String
, photosPath :: String
}
getDirectoryFiles path = getDirectoryContents path >>= return . filter f
where f filename = not (filename `elem` [".", ".."])
validAlbumName name = not ("." `isPrefixOf` name)
getAlbums :: Config -> IO [Album]
getAlbums config = do
pending <- getDirectoryFiles (pendingPath config)
permanent <- getDirectoryFiles (photosPath config)
return ([Album name True | name <- sort' pending, validAlbumName name] ++
[Album name False | name <- sort' permanent, validAlbumName name])
where sort' = reverse . sort
albumDirectory :: Config -> Album -> FilePath
albumDirectory config album
| pending album = joinPath [pendingPath config, name album]
| otherwise = joinPath [photosPath config, name album]
data RenameError = SameSourceAndTarget
| DuplicateFilesExist
deriving (Eq, Show, Generic)
renameAlbum :: Config -> Album -> Album -> EitherT RenameError IO ()
renameAlbum config source target = do
if sourceDir == targetDir then left SameSourceAndTarget
else return ()
srcFiles <- lift $ getDirectoryFiles sourceDir
lift $ createDirectoryIfMissing False targetDir
existingFiles <- lift $ getDirectoryFiles targetDir
if not . null $ intersect srcFiles existingFiles
then left DuplicateFilesExist
else return ()
let rename filename = renameFile (joinPath [sourceDir, filename])
(joinPath [targetDir, filename])
lift $ mapM rename srcFiles
lift $ removeDirectory sourceDir
return ()
where sourceDir = albumDirectory config source
targetDir = albumDirectory config target
|
