summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Trivmix.hs53
-rw-r--r--trivmix.cabal2
2 files changed, 37 insertions, 18 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
12import System.FilePath 12import System.FilePath
13import System.Posix.Files 13import System.Posix.Files
14import System.Posix.IO 14import System.Posix.IO
15import System.Posix.Types
15import System.Environment 16import System.Environment
16import System.Process 17import System.Process
17 18
@@ -95,9 +96,6 @@ optionParser = Options <$>
95 ) 96 )
96 ) 97 )
97 98
98initialLevel :: Level
99initialLevel = Lin 0
100
101watchedAttrs :: [EventVariety] 99watchedAttrs :: [EventVariety]
102watchedAttrs = [ Modify 100watchedAttrs = [ Modify
103 , Move 101 , Move
@@ -109,6 +107,23 @@ watchedAttrs = [ Modify
109 , DeleteSelf 107 , DeleteSelf
110 ] 108 ]
111 109
110initialLevel :: Level
111initialLevel = Lin 0
112
113defFileMode :: FileMode
114defFileMode = foldl unionFileModes nullFileMode [ ownerReadMode
115 , ownerWriteMode
116 , groupReadMode
117 , groupWriteMode
118 , otherReadMode
119 ]
120
121defDirectoryMode :: FileMode
122defDirectoryMode = foldl unionFileModes nullFileMode [ ownerModes
123 , groupModes
124 , otherReadMode
125 , otherExecuteMode
126 ]
112main :: IO () 127main :: IO ()
113main = execParser opts >>= trivmix 128main = execParser opts >>= trivmix
114 where 129 where
@@ -164,37 +179,41 @@ handleFiles inotify level files = do
164onStateFile :: FilePath -> String -> IO a -> IO a 179onStateFile :: FilePath -> String -> IO a -> IO a
165onStateFile file initial action = do 180onStateFile file initial action = do
166 let directory = takeDirectory file 181 let directory = takeDirectory file
167 dirExists <- doesDirectoryExist directory 182 directories = iterate takeDirectory directory
183 createDirs <- takeWhileM (\d -> not <$> doesDirectoryExist d) directories
168 exists <- doesFileExist file 184 exists <- doesFileExist file
169 let acquireFile = case exists of 185 let acquireFile = case exists of
170 True -> return () 186 True -> return ()
171 False -> do 187 False -> do
172 hPutStrLn stderr $ "Creating ‘" ++ file ++ "’ (file)" 188 hPutStrLn stderr $ "Creating ‘" ++ file ++ "’ (file)"
173 createFile file fileMode >>= closeFd >> writeFile file initial 189 createFile file defFileMode >>= closeFd >> writeFile file initial
174 fileMode = foldl unionFileModes nullFileMode [ ownerReadMode
175 , ownerWriteMode
176 , groupReadMode
177 , groupWriteMode
178 ]
179 releaseFile = case exists of 190 releaseFile = case exists of
180 True -> return () 191 True -> return ()
181 False -> do 192 False -> do
182 hPutStrLn stderr $ "Removing ‘" ++ file ++ "’ (file)" 193 hPutStrLn stderr $ "Removing ‘" ++ file ++ "’ (file)"
183 removeFile file 194 removeFile file
184 acquireDir = case dirExists of 195 acquireDir = (flip mapM) (reverse createDirs) $ \directory -> do
185 True -> return ()
186 False -> do
187 hPutStrLn stderr $ "Creating ‘" ++ directory ++ "’ (dir" 196 hPutStrLn stderr $ "Creating ‘" ++ directory ++ "’ (dir"
188 createDirectoryIfMissing True directory 197 createDirectory directory
189 releaseDir = case dirExists of 198 setFileMode directory defDirectoryMode
190 True -> return () 199 releaseDir = (flip mapM) createDirs $ \directory -> do
191 False -> do
192 hPutStrLn stderr $ "Removing ‘" ++ directory ++ "’ (dir)" 200 hPutStrLn stderr $ "Removing ‘" ++ directory ++ "’ (dir)"
193 removeDirectory directory 201 removeDirectory directory
194 acquire = acquireDir >> acquireFile 202 acquire = acquireDir >> acquireFile
195 release = releaseFile >> releaseDir 203 release = releaseFile >> releaseDir
196 bracket_ acquire release action 204 bracket_ acquire release action
197 205
206takeWhileM :: Monad m => (a -> m Bool) -> [a] -> m [a]
207takeWhileM _ [] = return []
208takeWhileM pred (x:xs) = do
209 take <- pred x
210 case take of
211 True -> do
212 rest <- takeWhileM pred xs
213 return $ x:rest
214 False -> do
215 return []
216
198readLevel :: Chan Level -> MVar Level -> FilePath -> IO () 217readLevel :: Chan Level -> MVar Level -> FilePath -> IO ()
199readLevel levelChan current file = catch action handler 218readLevel levelChan current file = catch action handler
200 where 219 where
diff --git a/trivmix.cabal b/trivmix.cabal
index 9b66048..b0d77a7 100644
--- a/trivmix.cabal
+++ b/trivmix.cabal
@@ -2,7 +2,7 @@
2-- documentation, see http://haskell.org/cabal/users-guide/ 2-- documentation, see http://haskell.org/cabal/users-guide/
3 3
4name: trivmix 4name: trivmix
5version: 2.2.6 5version: 2.3.0
6-- synopsis: 6-- synopsis:
7-- description: 7-- description:
8license: PublicDomain 8license: PublicDomain