From d4148bd39303394cd9a0d416d42a1fc20a18cabf Mon Sep 17 00:00:00 2001
From: Kjetil Orbekk <kjetil.orbekk@gmail.com>
Date: Sat, 12 Sep 2015 17:02:11 -0400
Subject: Implement /rename.

Backend is done but js is still in progress.
---
 photos.cabal      |  2 ++
 src/Main.hs       | 23 +++++++++++++++++++++--
 src/PhotoStore.hs | 51 +++++++++++++++++++++++++++++++++++++++++++++++----
 web/index.html    | 22 +++++++++++++++++++++-
 4 files changed, 91 insertions(+), 7 deletions(-)

diff --git a/photos.cabal b/photos.cabal
index 3112609..e548c6f 100644
--- a/photos.cabal
+++ b/photos.cabal
@@ -29,3 +29,5 @@ executable photos
     , hflags
     , directory
     , transformers
+    , filepath
+    , either
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
diff --git a/web/index.html b/web/index.html
index ccbfe53..b4dcd7b 100644
--- a/web/index.html
+++ b/web/index.html
@@ -15,7 +15,13 @@
       }
       var element = makeElement(albumName);
       $(element).find('a').click(function() {
-        $(this).replaceWith($('<input type="text" autofocus="true">'));
+        var input =
+          $('<input type="text" value="'+albumName+'" autofocus="true">');
+        setTimeout(function() {
+          var position = input[0].value.length;
+          input[0].setSelectionRange(position, position);
+        }, 0);
+        $(this).replaceWith(input);
       });
       $('#pending-container').append(element);
     }
@@ -53,6 +59,20 @@
     }
     $(document).ready(function() {
       fetchAlbums();
+
+      var request = {
+          from: { name: 'x', pending: true },
+          to: { name: 'y', pending: false }
+        };
+      console.log('rename request: ', request);
+      $.ajax({
+        url: '/api/rename',
+        type: 'POST',
+        contentType: 'application/json',
+        data: JSON.stringify(request),
+        success: function(data) { console.log('Rename succes: ', data); },
+        error: function(unused, unusedStatus, error) { console.log('Rename failure: ' + error); }
+      });
     });
   </script>
 </head>
-- 
cgit v1.2.3