Now pruning entire tree of directories created on startup.

Setting more sensible mode on directories created.

1 files changed, 36 insertions, 17 deletions

diff --git a/src/Trivmix.hs b/src/Trivmix.hs
index 3542e0d..0c1a1a4 100644
--- a/src/Trivmix.hs
+++ b/src/Trivmix.hs
@@ -12,6 +12,7 @@ import System.Directory
 import System.FilePath
 import System.Posix.Files
 import System.Posix.IO
+import System.Posix.Types
 import System.Environment
 import System.Process
 
@@ -95,9 +96,6 @@ optionParser = Options <$>
                                      )
                         )
 
-initialLevel :: Level
-initialLevel = Lin 0
-
 watchedAttrs :: [EventVariety]
 watchedAttrs = [ Modify
                , Move
@@ -109,6 +107,23 @@ watchedAttrs = [ Modify
                , DeleteSelf
                ]
 
+initialLevel :: Level
+initialLevel = Lin 0
+
+defFileMode :: FileMode
+defFileMode = foldl unionFileModes nullFileMode [ ownerReadMode
+                                             , ownerWriteMode
+                                             , groupReadMode
+                                             , groupWriteMode
+                                             , otherReadMode
+                                             ]
+
+defDirectoryMode :: FileMode
+defDirectoryMode = foldl unionFileModes nullFileMode [ ownerModes
+                                                  , groupModes
+                                                  , otherReadMode
+                                                  , otherExecuteMode
+                                                  ]
 main :: IO ()
 main = execParser opts >>= trivmix
   where
@@ -164,37 +179,41 @@ handleFiles inotify level files = do
 onStateFile :: FilePath -> String -> IO a -> IO a
 onStateFile file initial action = do
   let directory = takeDirectory file
-  dirExists <- doesDirectoryExist directory
+      directories = iterate takeDirectory directory
+  createDirs <- takeWhileM (\d -> not <$> doesDirectoryExist d) directories
   exists <- doesFileExist file
   let acquireFile = case exists of
         True -> return ()
         False -> do
           hPutStrLn stderr $ "Creating ‘" ++ file ++ "’ (file)"
-          createFile file fileMode >>= closeFd >> writeFile file initial
-      fileMode = foldl unionFileModes nullFileMode [ ownerReadMode
-                                                   , ownerWriteMode
-                                                   , groupReadMode
-                                                   , groupWriteMode
-                                                   ]
+          createFile file defFileMode >>= closeFd >> writeFile file initial
       releaseFile = case exists of
         True -> return ()
         False -> do
           hPutStrLn stderr $ "Removing ‘" ++ file ++ "’ (file)"
           removeFile file
-      acquireDir = case dirExists of
-        True -> return ()
-        False -> do
+      acquireDir = (flip mapM) (reverse createDirs) $ \directory -> do
           hPutStrLn stderr $ "Creating ‘" ++ directory ++ "’ (dir"
-          createDirectoryIfMissing True directory
-      releaseDir = case dirExists of
-        True -> return ()
-        False -> do
+          createDirectory directory
+          setFileMode directory defDirectoryMode
+      releaseDir = (flip mapM) createDirs $ \directory -> do
           hPutStrLn stderr $ "Removing ‘" ++ directory ++ "’ (dir)"
           removeDirectory directory
       acquire = acquireDir >> acquireFile
       release = releaseFile >> releaseDir
   bracket_ acquire release action
 
+takeWhileM :: Monad m => (a -> m Bool) -> [a] -> m [a]
+takeWhileM _ [] = return []
+takeWhileM pred (x:xs) = do
+  take <- pred x
+  case take of
+    True -> do
+      rest <- takeWhileM pred xs
+      return $ x:rest
+    False -> do
+      return []
+
 readLevel :: Chan Level -> MVar Level -> FilePath -> IO ()
 readLevel levelChan current file = catch action handler
   where