Implement /rename.

Backend is done but js is still in progress.

2 files changed, 68 insertions, 6 deletions

diff --git a/src/Main.hs b/src/Main.hs
index c40af76..ba1acd4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators #-}
@@ -16,6 +17,7 @@ import Control.Monad
 import Data
 import PhotoStore
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Either
 
 defineFlag "port" (8081 :: Int) "Port to serve on"
 defineFlag "host" ("*6" :: String)  "Host to serve on (*6 for ipv6 mode)"
@@ -24,8 +26,18 @@ defineFlag "photos_path" ("" :: String) "Path to permanent albums"
 $(return [])
 
 instance ToJSON Album
+instance FromJSON Album
 
-type PhotoApi = "albums" :> Get '[JSON] [Album]
+data RenameRequest = RenameRequest
+  { from :: Album
+  , to :: Album
+  } deriving (Eq, Show, Generic)
+instance FromJSON RenameRequest
+instance ToJSON RenameError
+
+type PhotoApi =
+       "albums" :> Get '[JSON] [Album]
+  :<|> "rename" :> ReqBody '[JSON] RenameRequest :> Post '[JSON] (Either RenameError ())
 
 config = Config 
   { pendingPath = flags_pending_path
@@ -33,7 +45,14 @@ config = Config
   }
 
 server :: Server PhotoApi
-server = liftIO (getAlbums config)
+server = albums
+    :<|> rename
+
+  where albums = liftIO (getAlbums config)
+
+        rename :: RenameRequest -> EitherT ServantErr IO (Either RenameError ())
+        rename (RenameRequest from to) = liftIO $
+          runEitherT (renameAlbum config from to)
 
 photoApi :: Proxy PhotoApi
 photoApi = Proxy
diff --git a/src/PhotoStore.hs b/src/PhotoStore.hs
index 57b2ccc..2894e73 100644
--- a/src/PhotoStore.hs
+++ b/src/PhotoStore.hs
@@ -1,20 +1,63 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
 module PhotoStore where
 
+import Control.Exception.Base
 import Data
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Either
+import GHC.Generics
 import System.Directory
+import System.FilePath
+import Prelude
+import Control.Monad
+import Control.Exception
+import System.IO.Error
+import Data.List
 
 data Config = Config
   { pendingPath :: String
   , photosPath :: String
   }
 
+getDirectoryFiles path = getDirectoryContents path >>= return . filter f
+  where f filename = not (filename `elem` [".", ".."])
+
 validAlbumName name =
      name /= "."
   && name /= ".."
 
 getAlbums :: Config -> IO [Album]
 getAlbums config = do
-  pending <- getDirectoryContents (pendingPath config)
-  permanent <- getDirectoryContents (photosPath config)
-  return ([Album name True | name <- filter validAlbumName pending] ++
-          [Album name False | name <- filter validAlbumName permanent])
+  pending <- getDirectoryFiles (pendingPath config)
+  permanent <- getDirectoryFiles (photosPath config)
+  return ([Album name True | name <- pending] ++
+          [Album name False | name <- permanent])
+
+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